Re: Re: List-Selection

*To*: mathgroup at smc.vnet.net*Subject*: [mg20170] Re: [mg20060] Re: [mg20021] List-Selection*From*: Rob Pratt <rpratt at email.unc.edu>*Date*: Sun, 3 Oct 1999 21:07:38 -0400*Sender*: owner-wri-mathgroup at wolfram.com

I first tried Backtrack as follows, where m2 is the matrix for the larger problem (64 by 7). Needs["DiscreteMath`Combinatorica`"]; space = Table[Drop[m2, i], {i, 0, 11}]; partialQ[{a_}] := True; partialQ[l_] := Last[l[[-1]]] < Last[l[[-2]]] && 7 Length[l] - Length[Union[Flatten[l]]] <= 20; finalQ[l_] := Length[Union[Flatten[l]]] == 64; Backtrack[space, partialQ, finalQ] // Timing $Aborted But I got no results after several hours, so I Aborted. Then I thought of attacking the problem via MinimumVertexCover in the Combinatorica package. Here, m1 is the matrix for the smaller problem (32 by 6). SubsetToVector[s_List,n_Integer]:=Table[If[MemberQ[s,i],1,0],{i,1,n}] adj1=Map[SubsetToVector[#,32]&,m1]; g1=Graph[adj1,CircularVertices[Length[adj1]]]; MinimumVertexCover[g1]//Timing $Aborted Since this method was fruitless even on the smaller problem, I won't bother describing the details of the formulation. I then tried a third approach using integer programming. Both problems can be subsumed into the following general (and NP-complete!) problem: given a collection of k arbitrary subsets of the set S = {1,2,,...,n}, find the minimum number of subsets whose union is S (and return these subsets). This general problem can be formulated as an integer programming problem. For 1 <= i <= n define decision variable x_i to be 1 if subset i is chosen and 0 otherwise. For 1 <= i <= n and 1 <= j <= k, let a_{i,j} be 1 if subset i contains element j and 0 otherwise. Then we want to Minimize Sum[x_i, {i,1,n}] Subject To Sum[a_{i,j} x_i, {i,1,n}] >= 1 for 1 <= j <= k x_i = 0 or x_i = 1 for all i If we ignore the integrality constraints (or replace them with 0 <= x_i <= 1), we can use Mathematica to solve the resulting linear programming relaxation. ?LinearProgramming LinearProgramming[c, m, b] finds the vector x which minimizes the quantity c.x subject to the constraints m.x >= b and x >= 0. c1=Table[1,{32}];b1=Table[1,{32}]; adj1=Map[SubsetToVector[#,32]&,m1]; Timing[sol1=LinearProgramming[c1,adj1,b1]] \!\({1.10000000000218278`\ Second, {1\/3, 0, 1\/3, 0, 0, 1\/3, 0, 1\/3, 0 , 0, 1\/3, 1\/3, 0, 0, 1\/3, 1\/3, 0, 1\/3, 0, 1\/3, 1\/3, 0, 1\/3, 0, 1\/3, 1\/3, 0, 0, 1\/3, 1\/3, 0, 0}}\) c1.sol1 \!\(16\/3\) Ceiling[16/3] 6 c2=Table[1,{64}];b2=Table[1,{64}]; adj2=Map[SubsetToVector[#,64]&,m2]; Timing[sol2=LinearProgramming[c2,adj2,b2]] \!\({3.3499999999985448`\ Second, {1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7, 1\/7}}\) c2.sol2 \!\(64\/7\) Ceiling[64/7] 10 As you can see, the LP solutions are not integer in either case. Furthermore, the lower bounds they provide (for the IP solutions) are the same as the trivial lower bounds Ceiling[32/6] = 6 and Ceiling[64/7] == 10, respectively. As Mathematica seems to have no IntegerProgramming command (neither built-in nor on MathSource), I resorted to a commercial IP solver and obtained a solution in a few minutes. sol={7,16,18,21,28,29,39,48,51,54,57,62}; Union[Flatten[Table[m2[[sol[[i]]]],{i,1,Length[sol]}]]]==Range[64] True I should mention that most of the computational time was in verifying optimality of the integer solution. If you happen to know the minimum number of subsets a priori (as you apparently did in these two cases), that constraint could be added to the formulation to save time. Rob Pratt Department of Operations Research The University of North Carolina at Chapel Hill rpratt at email.unc.edu http://www.unc.edu/~rpratt/ On Fri, 1 Oct 1999, Kew Joinery wrote: > Hello Everyone , > I would like to thank Mr. Kozlowski for spending more then 2 hours for this > problem. (I spent much more- Human is curious about unknown). > The example illustrate the ability of Mathematica to be weak in the most important > spectrum of Discrete Mathematics Searching (Sorting is handily controlled). There > is no build in function Search (probably is impossible to build in one). The > best custom implementation is Combinatoricas Backtrack, because is using bit vector > (incrementing) and one could be able to search longer without run out of memory. > Mr. Hayess backtrack is faster but is memory hungry .So Mathematica needs one > build-in function just to perform at least exhaustive search over a candidate > solutions. Better one would be to involve pruning possibilities like cut off > k-subsets from rank r1 to rank r2. > Consider in this case custom implementation construct all 7-subsets from 32 set > (which is 3365856) and map them over the matrix, then perform exhaustive search. > Thanks to Mr. Pratt for the nice pruning in the solution space. So Mr.Kozlowski was > patient to perform complete search and to find all 320 solutions. > Now I ask you how to approach the next instance? > This is steal small instance: n=6 so the desirable matrix is m(64x7) > Note: to construct matrix whit property NO number appears twice in the same column > or the same row + that all numbers are equally distributed the matrix should be > long prime^n. > *** the task is: Find JUST ONE solution satisfying the condition: > Union[Flatten[ some 12 rows of m ]] = = Range[64] > > Here is the modest matrix for n=6 =96>m( 2^6=64 x n+1=7) > > {{1,2,4,8,16,32,64},{2,1,3,7,15,31,63},{3,4,2,6,14,30,62},{4,3,1,5,13,29,61},{ > 5,6,8,4,12,28,60},{6,5,7,3,11,27,59},{7,8,6,2,10,26,58},{8,7,5,1,9,25, > 57},{9,10,12,16,8,24,56},{10,9,11,15,7,23,55},{11,12,10,14,6,22,54},{12, > 11,9,13,5,21,53},{13,14,16,12,4,20,52},{14,13,15,11,3,19,51},{15,16,14,10, > 2,18,50},{16,15,13,9,1,17,49},{17,18,20,24,32,16,48},{18,17,19,23,31,15, > 47},{19,20,18,22,30,14,46},{20,19,17,21,29,13,45},{21,22,24,20,28,12,44},{ > 22,21,23,19,27,11,43},{23,24,22,18,26,10,42},{24,23,21,17,25,9,41},{25,26, > 28,32,24,8,40},{26,25,27,31,23,7,39},{27,28,26,30,22,6,38},{28,27,25,29, > 21,5,37},{29,30,32,28,20,4,36},{30,29,31,27,19,3,35},{31,32,30,26,18,2, > 34},{32,31,29,25,17,1,33},{33,34,36,40,48,64,32},{34,33,35,39,47,63,31},{ > 35,36,34,38,46,62,30},{36,35,33,37,45,61,29},{37,38,40,36,44,60,28} ,{38, > 37,39,35,43,59,27},{39,40,38,34,42,58,26},{40,39,37,33,41,57,25},{41,42, > 44,48,40,56,24},{42,41,43,47,39,55,23},{43,44,42,46,38,54,22},{44,43,41, > 45,37,53,21},{45,46,48,44,36,52,20},{46,45,47,43,35,51,19},{47,48,46,42, > 34,50,18},{48,47,45,41,33,49,17},{49,50,52,56,64,48,16},{50,49,51,55,63, > 47,15},{51,52,50,54,62,46,14},{52,51,49,53,61,45,13},{53,54,56,52,60,44, > 12},{54,53,55,51,59,43,11},{55,56,54,50,58,42,10},{56,55,53,49,57,41,9},{ > 57,58,60,64,56,40,8},{58,57,59,63,55,39,7},{59,60,58,62,54,38,6},{6 0,59, > 57,61,53,37,5},{61,62,64,60,52,36,4},{62,61,63,59,51,35,3},{63,64,62,58, > 50,34,2},{64,63,61,57,49,33,1}} > > Note: use ColumnForm to see some nice features of m. > > Thank you for your attention and any suggestions. > Eugene > > > >