How to partition a set with a condition on subsets?
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]
** Original Answer**
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 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}} *)
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 &]
{}