Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1999
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

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
> 
> 
> 
> 




  • Prev by Date: Want to do Electrostatic problems in 3D?
  • Next by Date: Re: NonlinearRegress and numerical functions...
  • Previous by thread: Re: Re: List-Selection
  • Next by thread: Re: Re: List-Selection