Efficient way to partition list of expressions based on its contents
This isn't "functional", but using GroupBy[]
for filtering along with Sow[]
/Reap[]
works quite well:
partit[polys_List, vars_List] := Module[{init = polys, tmp},
Reap[Do[tmp = GroupBy[init, SubsetQ[Take[vars, k], Variables[#]] &];
Sow[tmp[True], "selected"];
init = tmp[False],
{k, Length[vars]}], "selected"][[-1, 1]]]
Test:
polys = {x, 2 + x + y + z, y, 2 + x + y, 2 + x, -1 + y, y + z, z};
partit[polys, {x, y, z}]
{{x, 2 + x}, {y, 2 + x + y, -1 + y}, {2 + x + y + z, y + z, z}}
partit[polys, {y, z, x}]
{{y, -1 + y}, {y + z, z}, {x, 2 + x + y + z, 2 + x + y, 2 + x}}
partit[polys, {z, x, y}]
{{z}, {x, 2 + x}, {2 + x + y + z, y, 2 + x + y, -1 + y, y + z}}
The idea is to assemble appropriate criteria in order to search for the appropriate polys each time, store them, remove them from the list and continue until all appropriate criteria are exhausted; it uses Fold
for the main loop; it still uses Complement
to remove successful hits from the list (I don't know if one can refrain from using it unless a more involved data structure is used for storing the polys); it uses Cases
to select the appropriate polys each time but it could switch to using Select
easily; Join
is used to assemble output but Flatten
can be also used. All in all, I don't know if it's a better solution than the one proposed but I enjoyed writing it.
polys = {x, 2 + x + y + z, y, 2 + x + y, 2 + x, -1 + y, y + z, z};
vars = {x, y, z};
(* successive groups of included vars *)
sucn = FoldList[Flatten[{##}] &, Sequence @@ TakeDrop[vars, 1]]
(* successive groups of excluded vars *)
sucx = Complement[vars, #] & /@ sucn
(* successive group pairs of included/excluded variables *)
sucg = Transpose[{sucn, sucx}]
(* select polys that contain some (or all) of the included vars
and do not contain (any of) the excluded vars *)
fsel = Function[{poly, included, excluded},
And[
Or @@ (MemberQ[poly, #] & /@ included),
Not[Or @@ (MemberQ[poly, #] & /@ excluded)]]];
(*
this works too
fsel = Function[{poly, included, excluded},
And[
Or @@ (MemberQ[poly, Alternatives @@ included]),
Not[Or @@ (MemberQ[poly, Alternatives @@ excluded])]]];
*)
(* correctly recognize monomials *)
monomialQ = MemberQ[vars, #] &;
self[poly_?monomialQ, included_, excluded_] := fsel[{poly}, included, excluded]
(* account for the rest of the cases of polys *)
self[poly_, included_, excluded_] := fsel[poly, included, excluded]
(* the main event *)
Fold[
With[{nd = #2[[1]], xd = #2[[-1]]},
With[{sel = Cases[#1[[1]], pattn_ :> pattn /; self[pattn, nd, xd]]},
{Complement[#1[[1]], sel], Join[#1[[-1]], {sel}]}]
] &, {polys, {}}, sucg][[-1]]
When vars = {y, z, x}
the output is
When vars = {z, x, y}
the output is