Re: Re: Re: List-Selection

*To*: mathgroup at smc.vnet.net*Subject*: [mg20178] Re: [mg20118] Re: [mg20060] Re: [mg20021] List-Selection*From*: "Hans J.-I. Michel" <hans at dorsai.org>*Date*: Sun, 3 Oct 1999 21:07:43 -0400*Sender*: owner-wri-mathgroup at wolfram.com

Dear Everyone I don't have much to add to this. I am always amazed though at the speed n which a handfull of the experts produce solutions to questions. But I eagerly watched this correspondence hoping some would mention Latin Rectangle or Latin Squares. A good reference is Latin Squares and their application. by J. Dnes and A. Keedwell 1974. Please note that you may not need to search or sort the solution space. Depending on an approach to the problem. Here is my hint of a connection these topics are related Toeplitz matrixes (T), Circulant Matrices (C), Permutation Matrices (P), Latin Squares (L), N-Queens, Backtracking. Asides (error correction, Encryption [Cypher] {e.g., Loosely: Two orthogonal Latin Square can help make a Cypher}) Also see Ilan Vardi's book Computational Recreations in Mathematica, see Chapter 6. For example a determinant of a circulant matrix is DetCirculant[a_] := Times @@ Fourier[a] Like Mr Kozlowski I would like to know where this problem comes from. Please note that you may not need to search or sort the solution space. Depending on an approach to the problem. There may be an elangant way. No t necessarilly faster. Hans Michel ---------- > From: Andrzej Kozlowski <andrzej at tuins.ac.jp> To: mathgroup at smc.vnet.net > To: mathgroup at smc.vnet.net > Subject: [mg20178] [mg20118] Re: [mg20060] Re: [mg20021] List-Selection > Date: Saturday, October 02, 1999 3:04 AM > > Thanks to Rob's excellent observation I was able to solve Eugene's problem > completely. This is what happened. When I tried to find just one solution > the increase in speed was remarkable: > > In[6]:= > Backtrack[space, partialQ, finalQ] // Timing > Out[6]= > {4.86667 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}}} > > Finding all solutions however still took pretty long: > > In[7]:= > Length[Backtrack[space, partialQ, finalQ, All] ] // Timing > Out[7]= > {6359.82 Second, 320} > > This was done on a 266 mghz PowerMac G3, which was being used for other > purposes while the computation was going on, so it maybe could have been > done faster. Still, the average comes out at about 20 second per solutions > (compared to 5 for the first solution) so they are clearly not uniformly > distributed. > > (I hope Eugene will now tell us where this problem comes from and what s > its significance. The matrix m is something that is known as a Latin > rectangle. Any such rectangle can be extended to a Latin square. Latin > squares are useful in lots of branches of mathematics and in applications. > But this is all I know about this.) > -- > 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: mathgroup at smc.vnet.net > >To: Andrzej Kozlowski <andrzej at tuins.ac.jp> > >Cc: mathgroup at smc.vnet.net > >Subject: [mg20178] [mg20118] Re: [mg20060] Re: [mg20021] List-Selection > >Date: Thu, 30 Sep 1999 01:18:28 -0400 (EDT) > > > > > We can speed things up by a factor of more than 10 (without compiling by > > adding a condition to partialQ: we can't have more than 7*6 - 32 = 0 > > repeats at any stage if we want the final union to have all 32 elements. > > Explicitly, > > > > partialQ[l_] := > > Last[l[[-1]]] < Last[l[[-2]]] && > > 6 Length[l] - Length[Union[Flatten[l]]] <= 10; > > > > 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 Wed, 29 Sep 1999, Andrzej Kozlowski wrote: > > > >> I have succeeded in simplifying my backtracking program by remembering the > >> condition that no number appears twice in the same column. So now it goes > >> like this: > >> > >> In[7]:= > >> << DiscreteMath`Combinatorica` > >> In[8]:= > >> m = {{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, , 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}}; > >> > >> In[9]:= > >> space = Table[Drop[m, i], {i, 0, 6}]; > >> In[10]:= > >> partialQ[{a_}] := True > >> In[11]:= > >> partialQ[l_] := Last[l[[-1]]] < Last[l[[-2]]] > >> > >> In[12]:= > >> finalQ[l_] := Length[Union[Flatten[l]]] == 32 > >> > >> In[13]:= > >> Backtrack[space, partialQ, finalQ] // Timing > >> Out[16]= > >> {63.95 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}}} > >> > >> The (Jprogram is now as simple as one might hope for. Unfortunately the > >> increase in speed is too slight to make much difference when trying o > >> compute all solutions :-( > >> > >> -- > >> Andrzej Kozlowski > >> Toyama International University > >> JAPAN > >> http://sigma.tuins.ac.jp > >> http://eri2.tuins.ac.jp > >> > >> > >> ---------- > >> >From: "Andrzej Kozlowski" <andrzej at tuins.ac.jp> To: mathgroup at smc.vnet.net > To: mathgroup at smc.vnet.net > >> To: mathgroup at smc.vnet.net > >> >To: kewjoi at hixnet.co.za (Kew Joinery), mathgroup at smc.vnet.net > >> >Subject: [mg20178] [mg20118] [mg20060] Re: [mg20021] List-Selection > >> >Date: Sun, Sep 26, 1999, 8:57 AM > >> > > >> > >> > This seems to be a very computation intensive problem. One natural way to > >> > solv eit 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, , 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 is a natural way to speed this up but I do not want to try to do > >> > this. 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 y Carl > >> > Woll in recent examples. In principle this shoudl be possible, all the > >> > parameters seems to be of compilable type (one woudl have to change space > >> > to a tensor, e.g. Table[m,{7}]. This is wasteful but probably would be more > >> > than compenseted 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 > To: mathgroup at smc.vnet.net > >> To: mathgroup at smc.vnet.net > >> >>To: mathgroup at smc.vnet.net > >> >>Subject: [mg20178] [mg20118] [mg20060] [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 > > > >