[Date Index]
[Thread Index]
[Author Index]
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
> >
> >
Prev by Date:
**Re: unix font problem**
Next by Date:
**Re: How to change the font size of the help browser?**
Previous by thread:
**Re: Re: List-Selection**
Next by thread:
**Re: Re: List-Selection**
| |