Re: List-Selection

*To*: mathgroup at smc.vnet.net*Subject*: [mg20052] Re: [mg20021] List-Selection*From*: "Andrzej Kozlowski" <andrzej at tuins.ac.jp>*Date*: Wed, 29 Sep 1999 03:33:18 -0400*Sender*: owner-wri-mathgroup at wolfram.com

This seems to be a very computation intensive problem. One natural way to solve it is using backtracking. I can give a solution which I am sure is not the most efficient but probably the easiest to write down. The "simple" way to solve such problems is to use the Backtrack function from the Combinatorica package. This function is unfortunately rather slow and Allan Hayes has written a much faster version (which doesn't really backtrack) in connection with the Langford problem discussed here recently. Unfortunately Allan's function, although much faster, has a tendency to run out of memory, and particularly in this problem. So I will use the built in Backtrack. We first load in the Combinatorica package. In[1]:= << DiscreteMath`Combinatorica` I will use the matrix provided by Eugene as my example. For convenience I will first sort it: In[2]:= m = Sort[{{1, 2, 4, 8, 16, 32}, {2, 1, 3, 7, 15, 31}, {3, 4, 2, 6, 14, 30}, {4, 3, 1, 5, 13, 29}, {5, 6, 8, 4, 12, 28}, {6, 5, 7, 3, 11, 27}, {7, 8, 6, 2, 10, 26}, {8, 7, 5, 1, 9, 25}, {9, 10, 12, 16, 8, 24}, {10, 9, 11, 15, 7, 23}, {11, 12, 10, 14, 6, 22}, {12, 11, 9, 13, 5, 21}, {13, 14, 16, 12, 4, 20}, {14, 13, 15, 11, 3, 19}, {15, 16, 14, 10, 2, 18}, {16, 15, 13, 9, 1, 17}, {17, 18, 20, 24, 32, 16}, {18, 17, 19, 23, 31, 15}, {19, 20, 18, 22, 30, 14}, {20, 19, 17, 21, 29, 13}, {21, 22, 24, 20, 28, 12}, {22, 21, 23, 19, 27, 11}, {23, 24, 22, 18, 26, 10}, {24, 23, 21, 17, 25, 9}, {25, 26, 28, 32, 24, 8}, {26, 25, 27, 31, 23, 7}, {27, 28, 26, 30, 22, 6}, {28, 27, 25, 29, 21, 5}, {29, 30, 32, 28, 20, 4}, {30, 29, 31, 27, 19, 3}, {31, 32, 30, 26, 18, 2}, {32, 31, 29, 25, 17, 1}}]; To use backtrack we need to define the state space, a partial test function and a final test function. We shall look for solutions ordered in the usual way only. Therefore as our state space we can take: In[3]:= space = Table[Drop[m, i], {i, 0, 6}]; The partial test function says that a partial solution can be extended provided its last element comes later in the ordering than the previous one and they are not equal: In[4]:= partialQ[{a_}] := True In[5]:= partialQ[l_] := (Sort[{l[[-2]], l[[-1]]}] == {l[[-2]], l[[-1]]}) && (l[[-2]] != l[[-1]]) the final tes tis Eugene7s condition: In[6]:= finalQ[l_] := Union[Flatten[l]] == Range[32] Now by default Bactrack finds only one solution and at least in thsi case it does it reasonably fast: In[7]:= Backtrack[space, partialQ, finalQ] // Timing Out[7]= {70.1333 Second, {{1, 2, 4, 8, 16, 32}, {2, 1, 3, 7, 15, 31}, {3, 4, 2, 6, 14, 30}, {12, 11, 9, 13, 5, 21}, {20, 19, 17, 21, 29, 13}, {23, 24, 22, 18, 26, 10}, {28, 27, 25, 29, 21, 5}}} It's quite a different matter if we try to find all solutions using: In[8]:= Backtrack[space, partialQ, finalQ, All] // Timing After an hour I lost patience and aborted. There seems to be a natural way to speed this up but I do not want to try to implement it. The way is to try to re-write all this code including the Backtrack function in such a way that it could be compiled, in the way used by Carl Woll in recent cases discussed on this list. In principle this should be possible, all the parameters seems to be of compileable type (one would have to change space to a tensor, e.g. Table[m,{7}]. This is wasteful but probably would be more than compensated for by the extra speed due to compiling). Or maybe all this is just a false lead and someone can find a much better algorithm. -- Andrzej Kozlowski Toyama International University JAPAN http://sigma.tuins.ac.jp http://eri2.tuins.ac.jp ---------- >From: kewjoi at hixnet.co.za (Kew Joinery) >To: mathgroup at smc.vnet.net >Subject: [mg20052] [mg20021] List-Selection >Date: Sat, Sep 25, 1999, 3:40 PM > > Hello everyone, > The item FastList-Selection (finding 7 consecutive elements) was solved > efficiently. Is there a way to do so for slightly different task? > Given matrix m(32x6) , find exactly 7 elements(rows) to satisfy the condition: > Union[Flatten[some 7 rows of m]] = = Range[32] > > Note: each number NEVER happens to be twice in same row or column! > Here is some matrix (satisfying the Note): > > > {{1,2,4,8,16,32},{2,1,3,7,15,31},{3,4,2,6,14,30},{4,3,1,5,13,29},{5,6,8,4,12, > 28},{6,5,7,3,11,27},{7,8,6,2,10,26},{8,7,5,1,9,25},{9,10,12,16,8,24},{10, > 9,11,15,7,23},{11,12,10,14,6,22},{12,11,9,13,5,21},{13,14,16,12,4,20},{14, > 13,15,11,3,19},{15,16,14,10,2,18},{16,15,13,9,1,17},{17,18,20,24,32,16},{ > 18,17,19,23,31,15},{19,20,18,22,30,14},{20,19,17,21,29,13},{21,22,24,20, > 28,12},{22,21,23,19,27,11},{23,24,22,18,26,10},{24,23,21,17,25,9},{25,26, > 28,32,24,8},{26,25,27,31,23,7},{27,28,26,30,22,6},{28,27,25,29,21,5},{29, > 30,32,28,20,4},{30,29,31,27,19,3},{31,32,30,26,18,2},{32,31,29,25,17,1}} > > Thank you for your attention . > Eugene > >