5
$\begingroup$

I'm looking for a function that can do this

applyDistributed[F, Dot[a, b, c]]
= {Dot[F[a, b, c]],
  Dot[F[a, b], F[c]],
  Dot[F[a], F[b, c]],
  Dot[F[a], F[b], F[c]]}

Honestly I don't even know where to start. I can't imagine how to program in the number of arguments that F should take

$\endgroup$
1
  • $\begingroup$ Do you mean this? applyDistributed[F_, a_, b_, c_] := {Dot[F[a, b, c]], Dot[F[a, b], F[c]], Dot[F[a], F[b, c]], Dot[F[a], F[b], F[c]]} $\endgroup$
    – bill s
    Feb 9 at 1:20

3 Answers 3

6
$\begingroup$
Clear["Global`*"];

Using @bmf' s definition for the partitioning

applyDistributed[func_, x_] :=
 Module[{list = List @@ x, func2 = Head@x},
  func2 @@@ Apply[func, Internal`PartitionRagged[list, #] & /@
     Apply[Join, Permutations /@
       IntegerPartitions[Length[list]]], {2}]]

applyDistributed[F, a . b . c]

(* {F[a, b, c], F[a, b] . F[c], F[a] . F[b, c], F[a] . F[b] . F[c]} *)

applyDistributed[F, a*b*c]

(* {F[a, b, c], F[c] F[a, b], F[a] F[b, c], F[a] F[b] F[c]} *)

applyDistributed[F, a + b + c]

(* {F[a, b, c], F[c] + F[a, b], F[a] + F[b, c], F[a] + F[b] + F[c]} *)

applyDistributed[F, a . b . c . d]

(* {F[a, b, c, d], F[a, b, c] . F[d], F[a] . F[b, c, d], F[a, b] . F[c, d], 
 F[a, b] . F[c] . F[d], F[a] . F[b, c] . F[d], F[a] . F[b] . F[c, d], 
 F[a] . F[b] . F[c] . F[d]} *)
$\endgroup$
2
  • $\begingroup$ very nicely done! $\endgroup$
    – bmf
    Feb 9 at 2:40
  • $\begingroup$ Oh that's great that it works with any head. Amazing! $\endgroup$
    – Albercoc
    Feb 9 at 10:18
5
$\begingroup$

One way to achieve that is to start from

list = {a, b, c};

and after you generate all the sublists

res = Internal`PartitionRagged[list, #] & /@ 
  Apply[Join, Permutations /@ IntegerPartitions[Length[list]]]

list

you can apply a function on the above result

ResourceFunction["ThroughOperator"][{foo}] @@@ res

res

As you see I have used a new resource function, available to us as of 2022 which is called ThroughOperator. This is a development thanks to @Sjoerd Smit.

It was first suggested here. In the comment section under the answer @Sjoerd Smit gives motivation for its development and subsequent use for those interested. It was further used in this thread if you want to further study it.

$\endgroup$
4
  • 2
    $\begingroup$ ThroughOperator noted, thanks! Also thank you for the references $\endgroup$
    – Albercoc
    Feb 9 at 10:20
  • 1
    $\begingroup$ @Albercoc glad I was able to help. Check the other answer by BobHanlon. It's more direct and really elegant :) $\endgroup$
    – bmf
    Feb 9 at 10:21
  • 1
    $\begingroup$ (+1) Very nice. Without being pedantic, I think (since v11.1) that TakeList could be substituted for Internal`PartitionRagged (but you probably already know that)? : res2=TakeList[list,#]&/@Apply[Join, Permutations /@ IntegerPartitions[Length[list]]] $\endgroup$
    – user1066
    Feb 9 at 20:26
  • $\begingroup$ @user1066 you are not being pedantic at all. Indeed, TakeList should have been the go-to approach, I just like undocumented stuff. Maybe a bit too much (blushing) $\endgroup$
    – bmf
    Feb 10 at 1:52
5
$\begingroup$
alist = {a, b, c};
ReplaceList[alist, {w__, x___, y___} ->
     {F @@ {w}, F @@ {x}, F @@ {y}}
    ] /. F[] :> Nothing // DeleteDuplicates // Dot @@@ # &

{F[a] . F[b, c], F[a] . F[b] . F[c], F[a, b] . F[c], F[a, b, c]}

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.