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