Partitioning with constraints on subsets

Question

Given the following data:

constraints = {{11, 2}, {11, 3}, {11, 4}, {11, 6}, {11, 9}, {1, 6}, {5, 6}, {2, 5}};

weights = {3, 7, 3, 2, 4, 2, 2, 2, 3, 2, 1};

I wish to partition the integers from 1 to 11 into subsets such that:

• each integer from 1 to 11 appears exactly once
• the sum of weights[[s]] for each subset s is 7, 8 or 9
• no subset contains any of the constraints pairs.

For clarity here is an example of such a solution:

example = {{1, 3, 4}, {2}, {5, 10, 11}, {6, 7, 8, 9}};

(* check 1 *)
Sort @ Flatten @ example == Range[11]
(* True *)

(* check 2 *)
AllTrue[example, 7 <= Total[weights[[#]]] <= 9 &]
(* True *)

(* check 3*)
Nor @@ SubsetQ @@@ Tuples[{example, constraints}]
(* True *)

How can I find all such solutions?

Answer 1

One can do it in five lines of code and ~0.02 seconds:

n = 11;
w = 7 | 8 | 9;

parts = Pick[#, #.weights Product[1 - Times@@Transpose@#[[;;,c]], {c, constraints}], w] &@
   Tuples[{0, 1}, n];
cliques = FindClique[#, ∞, All] &@ AdjacencyGraph[1 - Unitize[parts.Transpose@parts]];
subsets = Pick[Range@n, #, 1] & /@ parts;
num = Length /@ subsets;
partitions = Map[subsets[[#]] &, #, {2}] &@Pick[cliques, Plus @@ num[[#]] & /@ cliques, n];

1. Find all possible subsets whose weights sum to a value 7, 8 or 9. Tuples and binary notation (included/not included) helps a lot.

2. Find non-intersectings pairs of subsets and make a corresponding adjacency graph. Then FindClique does the hardest part of the job: find all possible sets of non-intersected subsets.

3. Transform binary notations to subsets.

4. Calculate the number of elements in each subset.

5. Find sets of subsets whose gives 11 elements in total.

The result is correct

And @@ ((Sort@Flatten@# == Range[11] && 
      AllTrue[#, 7 <= Total[weights[[#]]] <= 9 &] && 
      Nor @@ SubsetQ @@@ Tuples[{#, constraints}]) & /@ partitions)
(* True *)

Answer 2

I think there's no generally efficient way to do this, since you can always choose the constraints such that they don't restrict anything, in which case you want to find all possible subset partitions.

That being said, there's almost certainly a better approach than mine, but it works, and solves your example input in a second or so. Let's go:

constraints = {{11, 2}, {11, 3}, {11, 4}, {11, 6}, {11, 9}, {1, 6}, {5, 6}, {2, 5}};
weights = {3, 7, 3, 2, 4, 2, 2, 2, 3, 2, 1};

First we remove some unnecessary constraints (in this case, the last one is unnecessary, because the weights prohibit these two from appearing in the same set anyway):

constraints = Cases[constraints, l_List /; Total@weights[[l]] <= 9];

Now we get a list of all subsets of Range@11 which can potentially appear in the partition. That is, all subsets whose weights sum to a value between 7 and 9, and which don't contain one of the constraint pairs:

parts = Cases[
  Subsets@Range@11, 
  l_List /; 7 <= Total@weights[[l]] <= 9 && NoneTrue[constraints, SubsetQ[l, #] &]
]
Length @ parts (* 107 *)

So we've got 107 potential sublists for the partition. Now we just recursively piece them together into disjoint groups, and Sow the result whenever it contains all 11 numbers:

f[partition_, parts_] := Module[{newPartition},
  If[Length@Flatten@partition == 11,
   Sow@partition,
   If[parts != {},
     newPartition = Append[partition, parts[[1]]];
     (* Try adding the first part to the partition, and recursively
        call f with all remaining disjoint parts. *)
     f[newPartition, 
      Cases[Rest@parts, 
       l_List /; Intersection[l, Flatten@newPartition] == {}]];
     (* Try the next part instead. *)
     f[partition, Rest@parts]
     ];
   ]
  ]
solutions = Reap[f[{}, parts]][[2, 1]];
Length@solutions (* 210 *)

So we find 210 solutions (which contains your example solution, I checked). Now just to verify that all of these are valid:

And @@ ((Sort@Flatten@# == Range[11] &&
      AllTrue[#, 7 <= Total[weights[[#]]] <= 9 &] &&
      Nor @@ SubsetQ @@@ Tuples[{#, constraints}]) & /@ solutions)
(* True *)

Answer 3

Edit - oops I see this is conceptually the same as Martin's..

A little different brute force approach: start by finding all subsets that meet the restrictions:

 constraints = {{11, 2}, {11, 3}, {11, 4}, {11, 6}, {11, 9}, {1, 6}, {5, 6}, {2, 5}};
 weights = {3, 7, 3, 2, 4, 2, 2, 2, 3, 2, 1};
 subsets =      Select[ Subsets[Range[11], 5] , 7 <= Total[weights[[#]]] <= 9 && 
     Function[ {set}, 
          And @@ ( (( Length@Intersection[ set  , # ] != 2 ) & /@ 
                         constraints)) ]@#  & ] 

this is obviously very specialized to the particular problem, but this all runs in seconds.

{{2}, {1, 5}, {2, 4}, {2, 6}, {2, 7}, {2, 8}, {2, 10}, ... {6, 8, 9, 10}, {7, 8, 9, 10}, {7, 8, 10, 11}}

 Length@subsets (* 107 *)

arbitrarily pick all the subsets with a 2..

 sets = {#} & /@ Select[ subsets, MemberQ[#, 2] & ];

{{{2}}, {{2, 4}}, {{2, 6}}, {{2, 7}}, {{2, 8}}, {{2, 10}}}

recursively add to each set any set with no overlap..

 result = Sort /@ 
     First@Last@
       Reap[Do[ 
          sets = Flatten[  (  
              Function[{s}, If[Sort[Flatten[s]] == Range[11], Sow[s]];            
                Append[s, #] & /@ (Select[ subsets  , 
                  Intersection[ # , Flatten@s ] == {} & ])]) /@ sets , 1] ,
                          {5}]] // Union ;

>

  Length@result

210

  result[[1 ;; ;; 10]] // MatrixForm