6
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ 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$. $\endgroup$ – David G. Stork Apr 8 '16 at 22:51
  • 2
    $\begingroup$ 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. $\endgroup$ – OAMAZF Apr 8 '16 at 23:07
3
$\begingroup$

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 &]

{}

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – OAMAZF Apr 9 '16 at 1:48
  • $\begingroup$ @OAMAZF, oops:) Updated with a fix. $\endgroup$ – kglr Apr 9 '16 at 1:52
  • $\begingroup$ kglr Thank You very much for you answer :) . $\endgroup$ – OAMAZF Apr 9 '16 at 3:20
4
$\begingroup$

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]

enter image description here

enter image description here

** 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}}}
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – user31159 Apr 10 '16 at 0:05
  • $\begingroup$ @Xavier thank you...perhaps you will find a better way...I am always learning from this site :) $\endgroup$ – ubpdqn Apr 10 '16 at 0:54
3
$\begingroup$

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}} *)    
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.