I have expressions like
xx1=FF[1, 1] GG[1, 1] + FF[1, 1] GG[2, 2] + FF[2, 2] GG[2, 2]
xx2=2*FF[1, 2] GG[1, 1] + FF[1, 1] GG[1, 2] + FF[2, 2] GG[2, 2]
and I want to transform it to special matrices
CreateMatrix[xx1] (* {{1, 1}, {0, 1}} *)
CreateMatrix[xx2] (* {{0, 1, 0}, {2, 0, 0}, {0, 0, 1}} *)
The logic of CreateMatrix
is that we construct a grid like this (here using elements from xx1
):
{{FF[1, 1] GG[1, 1], FF[1, 1] GG[2, 2]},
{FF[2, 2] GG[1, 1], FF[2, 2] GG[2, 2]}}
and if say FF[1,1] GG[1,1]
exists in the expression then its coefficient takes the place of F[1,1], GG[1,1]
in the grid. Elements that exist in the grid but not in the expression are taken to be zero.
My code works, but is slow (it runs a double-for-loop to fill the matrix):
CreateMatrix[state_] := (
ElementsFF = Union[Cases[state, _FF, {0, Infinity}]];
ElementsGG = Union[Cases[state, _GG, {0, Infinity}]];
MatrixSize = Length[ElementsFF];
startTime = AbsoluteTime[];
If[MatrixSize > 0,
dM = IdentityMatrix[MatrixSize];
For[k = 1, k <= MatrixSize, k++,
For[l = 1, l <= MatrixSize, l++,
dM[[k, l]] = state /. {ElementsFF[[k]]*ElementsGG[[l]] -> 1};
];
];
Block[{FF}, FF[__] = 0; dM = dM];
Print["After MatrixConstr: " <> ToString[AbsoluteTime[] - startTime]];
startTime = AbsoluteTime[];,
dM = 0;
];
Return[dM];
)
xx1= FF[1, 1] GG[1, 1] + FF[1, 1] GG[2, 2] + FF[2, 2] GG[2, 2]
CreateMatrix[xx1]
A small part of the code is already optimized from an earlier partial question.
Can you create a faster algorithm for the given problem?
Comparison
I test with three huge matrices (those which I need later).
My original approach
- {136.7564571, 51.4342097, 20.0780016} seconds
kguler's solution
- {123.7996434, 46.8804843, 19.1074500} seconds
Mr.Wizard's solution1
- {123.3144573, 47.5587309, 18.2832670} seconds
Mr.Wizard's solution2
- {0.0510345, 0.0315209, 0.0255171} seconds (!!!)