# Efficient way to partition list of expressions based on its contents

I have a list of polynomials polys linear in a set of variables vars. How do I partition the list based on successive dependence on vars?

More concretely, suppose that here is my list of polynomials in three variables:

polys = {x, 2 + x + y + z, y, 2 + x + y, 2 + x, -1 + y, y + z, z};
vars = {x, y, z};


I need a fast, functional way to partition this list, so that the first group depends only on x, the next group only on x and y, the next group only on x, y and z, ... and so on...

Here is my function that does it:

notFreeQ[a_] := Not[FreeQ[#, a]] &

partit[polys_, vars_] :=
Reverse[First@Last@Reap[
Fold[Complement[#1, Sow[Select[#1, notFreeQ[#2]], "selected"]] &,
polys, Reverse[vars]], "selected"]]

partit[polys, vars]

(* {{x, 2 + x}, {-1 + y, y, 2 + x + y}, {2 + x + y + z, y + z, z}} *)


I believe there should be a more efficient functional way of achieving my task. In particular, I do not like how I have to use Sow/Reap on the polynomials that satisfy the criteria, only to discard the actual result of the function Fold. I am also unhappy with using Complement to select the remaining polynomials since it is inefficient.

Can someone help me do a better job partitioning the list of polynomials?

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