Re: Re: List-Selection
- To: mathgroup at smc.vnet.net
- Subject: [mg20176] Re: [mg20060] Re: [mg20021] List-Selection
- From: "Andrzej Kozlowski" <andrzej at tuins.ac.jp>
- Date: Sun, 3 Oct 1999 21:07:42 -0400
- Sender: owner-wri-mathgroup at wolfram.com
This is very interesting. Its well outside my area of expertise but one thing has intrigued me particularly. Mathematica indeed has no IntegerProgramming function. However, I remember from reading Cox, Little and O'Shea's "Using Algebraic Geometry" that Groebner basis can be used to do just that. I think they say that the built in Groebner basis in Mathematica is not flexible enough to do that, but I think they were only familiar with Mathematica 2. The main point seemed to be the ability to specify suitably weighted monomial orders, which I think can be done in Mathematica 4.0. Can this really be done? Could we hope to solve this problem using Groebner basis? I don't think I could try to answer this without a great deal of work but I think this should be something Daniel Lichtblau could tell us. -- Andrzej Kozlowski Toyama International University JAPAN http://sigma.tuins.ac.jp http://eri2.tuins.ac.jp ---------- >From: Rob Pratt <rpratt at email.unc.edu> >To: Kew Joinery <kewjoi at hixnet.co.za> >Cc: Andrzej Kozlowski <andrzej at tuins.ac.jp>, mathgroup at smc.vnet.net >Subject: [mg20176] Re: [mg20060] Re: [mg20021] List-Selection >Date: Fri, 1 Oct 1999 16:26:13 -0400 (EDT) > > 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 Combinatorica Backtrack, because is using > bit vector >> (incrementing) and one could be able to search longer without run out > of memory. >> Mr. Hayes 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 cutoff >> 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 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 >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,2 5, >> 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},{60 ,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 >> >> >> >> > >