# Finding the maximal number of lists that form certain rules?

I have the following example:

data={1, 2, 3, 4, 5, 6, 7, 8, 9};
NN=Length[data]/3;
subdata=Subsets[data, {3}];


I want to know all the possibility for the following rules:

pick up NN=3 terms from the subdata:

select1={{1, 2, 3}, {4, 5, 6}, {7, 8, 9}};
select2={{1, 2, 4}, {3, 5, 7}, {6, 8, 9}};
select3={{1, 2, 5}, {3, 4, 8}, {6, 7, 9}};
select4={{1, 2, 6}, {3, 4, 7}, {5, 8, 9}};


Condition1: every list such as select2 forms one permutation such as data and no repeated terms in all the selectlists (select1, select2, select3, select4).

Condition2: Every term in the whole selectlists can only be used for one time. That means randomly pick NN=3 terms from selectlists (select1, select2, select3, select4), except the lists itself I should not have any permutations. Please see the following example which doesn't fufill:

select1={{1, 2, 3}, {4, 5, 6}, {7, 8, 9}};
select2={{1, 2, 4}, {3, 5, 7}, {6, 8, 9}};
select3={{1, 2, 5}, {3, 4, 8}, {6, 7, 9}};
select4={{1, 2, 6}, {3, 4, 7}, {5, 8, 9}};


I can chose three terms from select3, select4 and select2 such that {{1, 2, 5}, {3, 4, 7}, {6, 8, 9}} form one permutation again. So select4={{1, 2, 6}, {3, 4, 7}, {5, 8, 9}} should be changed to something like select4={{1, 2, 7}, {3, 4, 9}, {5, 6, 8}}where there is no possible way to form one permutation except the lists itself.

select1={{1, 2, 3}, {4, 5, 6}, {7, 8, 9}};
select2={{1, 2, 4}, {3, 5, 7}, {6, 8, 9}};
select3={{1, 2, 5}, {3, 4, 8}, {6, 7, 9}};
select4={{1, 2, 7}, {3, 4, 9}, {5, 6, 8}};


I want to know the maximal number forming selectN (N=?) where all the lists selectN fulfill Condition1 and Condition2

I know the following case:

data={1, 2, 3, 4, 5, 6};
NN=Length[data]/3;
subdata=Subsets[data, {3}];


I can get the maximal number selectN (N=10) by counting manually which fufill Condition1 and Condition2.

  selects={{{1, 2, 3}, {4, 5, 6}},
{{1, 2, 4}, {3, 5, 6}},
{{1, 2, 5}, {3, 4, 6}},
{{1, 2, 6}, {3, 4, 5}},
{{1, 3, 4}, {2, 5, 6}},
{{1, 3, 5}, {2, 4, 6}},
{{1, 3, 6}, {2, 4, 5}},
{{1, 4, 5}, {2, 3, 6}},
{{1, 4, 6}, {2, 3, 5}},
{{1, 5, 6}, {2, 3, 4}}}


But when the data gets larger, it's difficult to count without programming. Thank you for any suggestions!

• I'm not sure I understand condition 2: what does "addition case" mean? And what does "give any above condition 1" mean?. As for condition 1: Is it correct that select5 = {{1, 2, 9}, {1, 2, 8}, {5, 8, 9}} fulfills condition 1? (Since the total is 45) Commented Oct 26, 2019 at 15:20
• ha, sorry. select5 is not fufill because there are repeated number in select5 (what I mean I think should be one Permutation) Commented Oct 26, 2019 at 15:22
• I think I understand now: Condition 2 means that it is not allowed that I can find a new list fulfilling condition 1 by combining subsets from several different lists - is that correct? Commented Oct 26, 2019 at 15:33
• Assuming the above interpretation of condition 2 is correct, do the 3 subsets have to be from 3 different sets? What I mean is, would select1 = {{1,2,3},{4,5,6},{7,8,9}}; select2 = {{1,2,3},{4,5,7},{6,8,9}} fulfill condition 2? (Since I can select {1,2,3} from select1 and {4,5,7},{6,8,9} from select2) Commented Oct 26, 2019 at 15:36
• yes, you are right that "Condition 2 means that it is not allowed that I can find a new list fulfilling condition 1 by combining subsets from several different lists". Commented Oct 26, 2019 at 16:25

## 1 Answer

n = 9; r = 3;
data = Range[n];
subsets = Subsets[data, {r}];


The following constructs all possible selections. By construction the first part of condition 1 holds already:

selects = Nest[Catenate[Table[With[{remain = Complement[data, Sequence @@ i]}, Append[i, #] & /@
ArrayPad[Subsets[Rest[remain], {r - 1}], {0, {1, 0}}, First[remain]]], {i, #}]] &, {{}}, n/r];
sz = Length[selects]


280

The conditions can be expressed as linear programming constraints:

(* sz 0/1-variables are used to indicate whether each selection included or not *)
c = ConstantArray[-1., sz]; (* Minimize the negative sum of variables to include as many as possible *)
lu = ConstantArray[{0, 1}, sz];

(* Without loss of generality we can let {{1, 2, 3}, {4, 5, 6}, {7, 8, 9}} be included *)
lu[[1]] = {1, 1};

(* Second part of condition 1 *)
m1 = SparseArray[Join @@ MapIndexed[Thread[Thread[{First[#2], #}] -> 1.] &, #]] &[
Quotient[Lookup[PositionIndex[Catenate[selects]], subsets], n/r, 1 - n/r]]
b1 = ConstantArray[{1., -1}, Length[m1]];

(* Condition 2 *)
m2 = SparseArray[Mod[Total[SparseArray[Thread[Tuples[#, 2] -> 1.], {sz, sz}] & /@
Partition[m1["NonzeroPositions"][[All, 2]], sz n/r/Binomial[n, r]]], n/r]]
b2 = ConstantArray[{n/r - 1., -1}, Length[m2]];

res = LinearProgramming[c, Join[m1, m2], Join[b1, b2], lu, Integers];


res happens to contain 13 ones, and the specific solution found is:

Pick[selects, res, 1] // Column

{{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}
{{1, 2, 8}, {3, 6, 9}, {4, 5, 7}}
{{1, 2, 9}, {3, 5, 6}, {4, 7, 8}}
{{1, 3, 4}, {2, 7, 9}, {5, 6, 8}}
{{1, 3, 7}, {2, 4, 6}, {5, 8, 9}}
{{1, 4, 5}, {2, 3, 8}, {6, 7, 9}}
{{1, 4, 7}, {2, 6, 9}, {3, 5, 8}}
{{1, 4, 9}, {2, 6, 8}, {3, 5, 7}}
{{1, 5, 6}, {2, 4, 7}, {3, 8, 9}}
{{1, 5, 9}, {2, 4, 8}, {3, 6, 7}}
{{1, 6, 7}, {2, 3, 5}, {4, 8, 9}}
{{1, 6, 8}, {2, 5, 7}, {3, 4, 9}}
{{1, 7, 8}, {2, 5, 9}, {3, 4, 6}}

• thank you very much! The way of linear programming constraints is very nice, thank you very much! Commented Oct 28, 2019 at 3:25