# Split expression into nested list of summands, times and dot products

In order to avoid the XY Problem we might have encountered in another question I asked, here I ask a new question with full context:

I want to get a list representation of an expanded expression, such that the outer level resembles the summands and in the next level I have two list consisting of all elements that are ordinarily multiplicated and the elements that are matrix multiplicated.

Expression:

(k*f[a] + f[b]).(f[a, b] + g[a, b])


Desired Output:

{{{k}, {f[a], f[a, b]}},
{{k}, {f[a], g[a, b]}},
{{},  {f[b], f[a, b]}},
{{},  {f[b], g[a, b]}}}


I have a working solution with Tensor Expand, but that is way too slow, if the expression gets too big.

Also, I did not intend to post it here, so be warned, it is cumbersome.

Clear[doProducts];
doProducts[list_] := {Times @@ list[], Dot @@ # & /@ list[]}
Clear[createProducts];
createProduct[list_] := list[]*list[]
Clear[splitTimes];
splitTimes[arg_] := Module[{expr = arg},
If[MatchQ[expr, HoldPattern[Times[_, __]]], expr = Level[expr, 1],
expr = {expr}];
Return[expr];
];
Clear[splitTimesDot];
splitTimesDot[arg_] := Module[{expr = arg, pos},
pos = Flatten@Position[expr, Dot[_, __]];
If[Length[pos] == 0, pos = 1, pos = pos[]];
(*Print["pos:",pos]*);
splitList[arg, pos]
];
Clear[splitDot];
splitDot[arg_] := Module[{expr = arg},
If[MatchQ[expr, HoldPattern[Dot[_, __]]], expr = Level[expr, 1],
expr = {expr}];
Return[expr];
];
Clear[splitList];
splitList[list_List, position_Integer] := {Take[list, position - 1],
Take[list, position - 1 - Length[list]]};
Clear[myExpand];
myExpand[expr_] :=
Assuming[Cases[expr, _Symbol, All] \[Element] Reals,
TensorExpand@expr];
Clear[mapSecond];
mapSecond[function_, list_List] := {list[],
Map[function, list[]]};
Clear[prepareExpression];
prepareExpression[arg_] := Module[{expr = myExpand[arg], list, pos},
Print["prepareExpressionStart"];
list = {expr};
If[MatchQ[expr, HoldPattern[Plus[_, __]]],
list = Level[expr, 1]];
(*Print["list1", list]*);
list = splitTimes[#] & /@ list;
(*Print["list2",list]*);
list = splitTimesDot[#] & /@ list;
(*Print["list3",list]*);
Return[mapSecond[splitDot, #] & /@ list];
];
milliSeconds :=
ToExpression[ToString[UnixTime[]] <> DateString["Millisecond"]];


If I now call

prepareExpression[(k*f[a] + f[b]).(f[a, b] + g[a, b])]


I get the desired result:

{{{k}, {{f[a], f[a, b]}}}, {{k}, {{f[a], g[a, b]}}}, {{}, {{f[b],
f[a, b]}}}, {{}, {{f[b], g[a, b]}}}}


Question (as mentioned above): How can I speed this up, with TensorExpand being so terribly slow and Distribute disrupting my Level?

More complicated test case

expr = (3/c*f[a] + f[b]).(g[a, b] - 3*h[a, b]*c)
desiredResult = prepareExpression[(3/c*f[a] + f[b]).(g[a, b] - 3*h[a, b]*c)]
{{{3, 1/c}, {{f[a], g[a, b]}}}, {{-9}, {{f[a],
h[a, b]}}}, {{}, {{f[b], g[a, b]}}}, {{-3, c}, {{f[b], h[a, b]}}}}


Test Case 3

testCase3 = (k*{{1, 1}, {2, 2}}.f[a] +
f[b].g[a, b]).(3*(-{{3, 3}, {2, 2}}).f[{{1, 2}, {3, 4}}, b]);
prepareExpression[testCase3]
{{{3}, {{f[b], g[a, b], {{-3, -3}, {-2, -2}},
f[{{1, 2}, {3, 4}}, b]}}}, {{3,
k}, {{{{1, 1}, {2, 2}}, f[a], {{-3, -3}, {-2, -2}},
f[{{1, 2}, {3, 4}}, b]}


Testcase where TensorCalc is too slow

This already takes over a minute just to apply regular TensorCalc

TensorExpand[(k*f[a].g[b] + f[b].g[a]).(f[c].g[d] -
3*f[d].g[c]).(f[h].g[i] + f[i].g[h]).(f[j].g[k] +
f[k].g[j]).(f[l].g[m] + f[m].g[l]).(f[p].g[q] +
f[o].g[n]).(f[n].g[o] + f[o].g[n]).(f[n].g[o] +
f[o].g[n]).(f[p].g[q] -
3 k*f[q].g[p]).(f[r].g[s].+f[s].g[r]).(f[t].g[u] +
f[u].g[t]*3)] // AbsoluteTiming

• Does something like Distribute[expr] /. {Plus -> List, Dot[Times[k_: Nothing, f_[x__]], g_[y__]] :> {{k}, {f[x], g[y]}}} work? Or is that not general enough? – chuy Jun 21 '18 at 18:44
• Thank you! Unfortunatly that fails on another test case, that I just added to the OP. Can you elaborate, what k_: Nothing means? – infinitezero Jun 21 '18 at 22:39
• What's an example of an input where TensorExpand is too slow? – Carl Woll Jun 22 '18 at 14:10
• I've added another one. Distribute Solves that one in a fraction of a second while TensorExpand takes 65s. – infinitezero Jun 22 '18 at 17:24
• @CarlWoll By the way, the reason TensorExpand is so slow is revealed by looking at its source code with Get["GeneralUtilities"]; PrintDefinitions[TensorExpand]. One can tell that it was written by Major Noob since there's the line Expand[Expand[expr //. $TensorExpandRules] //.$TensorExpandRules], where \$TensorExpandRules` is a list of 118 rules. This is another example of a built-in function one should stay away from like the plague. – QuantumDot Jun 22 '18 at 19:17