Here's code that finds a good (but perhaps not optimal) solution (again,
if I've understood the problem statement). It's a "greedy" algorithm
that selects tickets in turn. It looks at all possible lottery draws
and selects one with minimal match with tickets already bought; that
draw is the next ticket bought.
q={8,11,13,14,16,22,23,28,31,32,34,35};
s=KSubsets[q,7];
minMatch:=Module[{t,m},
t=Outer[Intersection,s,tickets,1];
m=Min[Max[Length/@#]&/@t]
]
maxMatch[s_List]:=Max[Length/@(#\[Intersection]s&/@tick)]
buyNext:=Module[{t},
t=maxMatch/@s;
Flatten[s[[First[Position[t,Min[t]]]]]]
]
k=5;
tickets={Take[q,7]}
While[minMatch<k,
AppendTo[tickets,buyNext]
];
tickets
For k=2, the result is {{8,11,13,14,16,22,23}}.
For k=3 and 4, the result is
{{8,11,13,14,16,22,23},{8,11,28,31,32,34,35}}
For k=5, the result is 10 tickets:
{{8,11,13,14,16,22,23},{8,11,28,31,32,34,35},{8,13,14,16,28,31,32},
{8,13,14,22,28,34,35},{8,13,16,23,31,34,35},{8,14,22,23,31,32,34},
{8,16,22,23,28,32,35},{11,13,14,16,32,34,35},{11,13,14,23,28,31,34},
{11,13,16,22,28,31,35}}
For k=6, the result is 63 tickets.
On my 2.2 GHz Pentium 4, this code took 28 seconds for k=6, but less
than one second for k=5.
A much more efficient code is:
ClearAll[maxMatch,minMatch,buyNext]
maxMatch[s_List]:=maxMatch[s]=Max[Length/@(#\[Intersection]s&/@tickets)]
buyNext:=Module[{nxt},
nxt=Flatten[s[[First[Position[t,Min[t]]]]]];
t=MapIndexed[Max[#1,Length[First[s[[#2]]]\[Intersection]nxt]]&,t];
minMatch=Min[t];
AppendTo[tickets,nxt]
]
tickets={};
minMatch=0;
s=KSubsets[q,7];
t=0&/@s;
k=6;
Timing[
While[minMatch<k,
buyNext
];
]
tickets//Dimensions
This code solved for k=6 in 1 second and k=7 in 13 seconds. It prevails
because unnecessary Outer products are eliminated, and intersections of
subsets of q with tickets already bought are eliminated.
Bobby Treat