# How to partition a set with a condition on subsets?

I want to partition a set of $n$ elements into $k$ subsets with a condition
For example:
partitioning this set {1,...,5} into 3 subsets with this condition: if $|i-j|<d$ then $i$ can't be with $j$ in the same subset, with $i,j\in \{1,...,5\}$ and $d\in \mathbb{N}$.
For $d=2$ we have $7$ partition:

$\{\{1\}\{2,4\}\{3,5\}\}$, $\{\{1,3\}\{2,4\}\{5\}\}$, $\{\{1,3\}\{2,5\}\{4\}\}$, $\{\{1,4\}\{2,5\}\{3\}\}$

$\{\{1,4\}\{2\}\{3,5\}\}$, $\{\{1,5\}\{2,4\}\{3\}\}$,$\{\{1,3,5\}\{2\}\{4\}\}$, $\{\{1,3\}\{2,4\}\{5\}\}$

Thank You.

• I don't see why your condition can always be satisfied. For instance, if you want to break $\{ 1 \ldots 10 \}$ into $k = 3$ subsets such that if $|i - j| < 3$ then $i$ cannot be in the same subset as $j$. – David G. Stork Apr 8 '16 at 22:51
• David G. Stork In your case we have 0 ways to partition a set of 10 elements into 3 subsets with this condition $|i-j|<3$, its like Stirling numbers of second kind if we have $k>n$ then we have 0 ways to partition the set. – OAMAZF Apr 8 '16 at 23:07

A brute force approach (not to be used with large lists):

partitionsF[lst_, k_, cond_] := Module[{s1 = Subsets[lst, {1, Infinity}], s2,
sF1 = (And @@ (! cond @@ # & /@ Subsets[#, {2}])) &,
sF2 = And[ Union @@ # == lst, ## & @@ (Intersection@@# == {} & /@ Subsets[#, {2}])] &},
s2 = Subsets[Pick[s1, sF1 /@ s1], {k}];
Pick[s2, sF2 /@ s2]]


Examples

partitionsF[Range[5], 3, Abs[# - #2] < 2 &]


{{{1}, {2, 4}, {3, 5}}, {{2}, {4}, {1, 3, 5}}, {{2}, {1, 4}, {3, 5}}, {{3}, {1, 4}, {2, 5}}, {{3}, {1, 5}, {2, 4}}, {{4}, {1, 3}, {2, 5}}, {{5}, {1, 3}, {2, 4}}}

partitionsF[Range[5], 3, Abs[# - #2] < 3 &]


{{{3}, {1, 4}, {2, 5}}}

partitionsF[Range[5], 2, Abs[# - #2] < 2 &]


{{{2, 4}, {1, 3, 5}}}

partitionsF[Range[5], 2, Abs[# - #2] < 3 &]


{}

• kglr Thank you for your answer but the condition is the opposite if $i$ and $j$ don't verify the condition they cannot be in the same subset, for example partitionsF[Range[5], 3, Max@#- Min@# < 2 &] that mean partition of $\{1,...,5\}$ into 3 subsets with $|i-j|<2$ and it's the same example I gave in the statement and I found 7 ways to partition this set but in your answer you find 3 ways that i have not found. – OAMAZF Apr 9 '16 at 1:48
• @OAMAZF, oops:) Updated with a fix. – kglr Apr 9 '16 at 1:52
• kglr Thank You very much for you answer :) . – OAMAZF Apr 9 '16 at 3:20

Update My original answer was fun but not efficient.

sfunc[r_, d_, k_] := Module[{rng, s, df, se, g, fp, su, c, ans},
rng = Range[r];
s = Rest@Subsets[rng];
df[x_?(Length@# == 1 &)] := Infinity;
df[x_] := Min[Differences@x];
se = Select[s, df[#] >= d &];
g = RelationGraph[Intersection[#1, #2] == {} &, se];
c = FindClique[g, {k}, All]
]


Now testing (the first column is d, the second column k, the third column is number of partitons):

disp[n_] :=
Grid[{#1, #2,
OpenerView[{Length[#3], #3}]} & @@@ ({##, sfunc[n, ##]} & @@@
Tuples[Range[2, n - 1], 2]), Frame -> All]


Just for fun:

r = Range[5];
s = Rest@Subsets[r];
df[x_?(Length@# == 1 &)] := Infinity;
df[x_] := Min[Differences@x];
se = Select[s, df[#] >= 2 &];
g = RelationGraph[Intersection[#1, #2] == {} &, se];
fp[u_, v_] := DeleteCases[FindPath[g, u, v, {2}, All], {{_}, {_}, {_}}]
su = Subsets[VertexList[g], {2}];
c = Catenate[fp @@@ su];
ans = Union[Sort /@ Pick[c, Sort[Flatten[#]] == r & /@ c]]


yields:

{{{1}, {2, 4}, {3, 5}}, {{2}, {4}, {1, 3, 5}}, {{2}, {1, 4}, {3,
5}}, {{3}, {1, 4}, {2, 5}}, {{3}, {1, 5}, {2, 4}}, {{4}, {1,
3}, {2, 5}}, {{5}, {1, 3}, {2, 4}}}


You could adjust to obtain desired ordering,e.g.

SortBy[#, Min[#] &] & /@ ans


yields:

{{{1}, {2, 4}, {3, 5}}, {{1, 3, 5}, {2}, {4}}, {{1, 4}, {2}, {3,
5}}, {{1, 4}, {2, 5}, {3}}, {{1, 5}, {2, 4}, {3}}, {{1, 3}, {2,
5}, {4}}, {{1, 3}, {2, 4}, {5}}}

• This is super nice, +1. I was also looking for a solution with the function FindClique, but I used it with the pairs of elements in r satisfying the condition. Reconstructing all the complete subgraphs and taking the null intersections between them became messy after that. I find your idea of constructing a graph where each node is a complete graph very nice. – user31159 Apr 10 '16 at 0:05
• @Xavier thank you...perhaps you will find a better way...I am always learning from this site :) – ubpdqn Apr 10 '16 at 0:54

This should do

ConditionalPartition[list_, k_, cond_] := Module[{y},
y = Table[{}, {k}];
Do[Do[
If[y[[j]] == {} || (AllTrue[y[[j]], cond[#, list[[i]]] &] && Quiet[y[[j + 1]] =!= {}]),
AppendTo[y[[j]], list[[i]]];
Break[]]
, {j, k}], {i, Length@list}];
If[Sort[list] == Sort@Flatten[y, 1], y, \$Failed]
]


list is the set, k the amount of subsets and cond a function that evaluates to True if both arguments may appear together in one subset.

The function hoever is dependent on the ordering of list and provides only one solution.

ConditionalPartition[{1, 2, 3, 4, 5}, 3, ! Abs[# - #2] < 2 &]
(* {{1, 3, 5}, {2}, {4}} *)
ConditionalPartition[{1, 5, 4, 2, 3}, 3, ! Abs[# - #2] < 2 &]
(* {{1, 4}, {5, 3}, {2}} *)