Re: Re: Langford's Problem (another solution improved)
- To: mathgroup at smc.vnet.net
- Subject: [mg19620] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution improved)
- From: "Andrzej Kozlowski" <andrzej at tuins.ac.jp>
- Date: Sun, 5 Sep 1999 16:57:41 -0400
- Sender: owner-wri-mathgroup at wolfram.com
Just a small addition to the earlier message. One can speed up my second
solution below in the same way as Fred did with his: namely by making use of
the symmetry of solutions, i.e. the fact that the reverse of a solution is
also a solution. In our case this is even easier to exploit than in Fred's:
we simply modify our state space slightly. Here is the new implementation:
In[1]:=
<<DiscreteMath`Combinatorica`
In[2]:=
pos[i_,n_]:=Table[{j,j+i+1},{j,1,2n-i-1}];
pos[1,n_]:=Table[{j,j+2},{j,1,n-1}];
space[n_]:=Table[pos[i,n],{i,1,n}]
In[3]:=
partialQ[l_]:=Length[Flatten[l]]==Length[Union[Flatten[l]]]
In[4]:=
problem[n_]:=Backtrack[space[n],partialQ,partialQ,All]
Now we get a substantial spped up:
In[7]:=
problem[7]//Timing
Out[7]=
{10.4 Second, {{{1, 3}, {4, 7}, {8, 12}, {9, 14}, {5, 11}, {6, 13}, {2,
10}}, {{1, 3}, {4, 7}, {9, 13}, {6, 11}, {8, 14}, {5, 12}, {2,
10}}, {{1, 3}, {5, 8}, {10, 14}, {6, 11}, {7, 13}, {2, 9}, {4,
12}}, {{1, 3}, {6, 9}, {10, 14}, {7, 12}, {2, 8}, {4, 11}, {5,
13}}, {{1, 3}, {8, 11}, {9, 13}, {2, 7}, {4, 10}, {5, 12}, {6,
14}}, {{1, 3}, {9, 12}, {6, 10}, {2, 7}, {8, 14}, {4, 11}, {5,
13}}, {{1, 3}, {10, 13}, {4, 8}, {7, 12}, {5, 11}, {2, 9}, {6,
14}}, {{1, 3}, {10, 13}, {5, 9}, {6, 11}, {2, 8}, {7, 14}, {4,
12}}, {{1, 3}, {10, 13}, {5, 9}, {7, 12}, {2, 8}, {4, 11}, {6,
14}}, {{1, 3}, {10, 13}, {7, 11}, {4, 9}, {2, 8}, {5, 12}, {6,
14}}, {{2, 4}, {6, 9}, {10, 14}, {8, 13}, {1, 7}, {5, 12}, {3,
11}}, {{2, 4}, {7, 10}, {9, 13}, {1, 6}, {8, 14}, {5, 12}, {3,
11}}, {{2, 4}, {9, 12}, {7, 11}, {1, 6}, {8, 14}, {3, 10}, {5,
13}}, {{2, 4}, {10, 13}, {3, 7}, {6, 11}, {8, 14}, {5, 12}, {1,
9}}, {{2, 4}, {11, 14}, {6, 10}, {3, 8}, {7, 13}, {5, 12}, {1,
9}}, {{2, 4}, {11, 14}, {6, 10}, {7, 12}, {3, 9}, {1, 8}, {5,
13}}, {{3, 5}, {8, 11}, {10, 14}, {1, 6}, {7, 13}, {2, 9}, {4,
12}}, {{3, 5}, {10, 13}, {2, 6}, {7, 12}, {8, 14}, {4, 11}, {1,
9}}, {{3, 5}, {10, 13}, {7, 11}, {1, 6}, {8, 14}, {2, 9}, {4,
12}}, {{3, 5}, {11, 14}, {6, 10}, {8, 13}, {1, 7}, {2, 9}, {4,
12}}, {{3, 5}, {11, 14}, {8, 12}, {2, 7}, {4, 10}, {6, 13}, {1,
9}}, {{3, 5}, {11, 14}, {8, 12}, {4, 9}, {1, 7}, {6, 13}, {2,
10}}, {{4, 6}, {10, 13}, {1, 5}, {7, 12}, {8, 14}, {2, 9}, {3,
11}}, {{4, 6}, {11, 14}, {9, 13}, {3, 8}, {1, 7}, {5, 12}, {2,
10}}, {{5, 7}, {1, 4}, {10, 14}, {8, 13}, {6, 12}, {2, 9}, {3,
11}}, {{5, 7}, {11, 14}, {9, 13}, {1, 6}, {2, 8}, {3, 10}, {4,
12}}}}
This seems to me to be the fastest time so far but as I am running it on a
233 mhz G3 it might actually be slower than Fred's. Still, it has restored
my belief that it would be really useful to have a compiled Backtrack:
presumably with it we could solve such problems a lot faster still.
--
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: Hans Havermann <haver at total.net> , "Wolf, Hartmut" <hwolf at debis.com> ,
hay at haystack.demon.co.uk , F.H.Simons at tue.nl , mathgroup at smc.vnet.net
>Subject: [mg19620] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution)
>Date: Sun, Sep 5, 1999, 11:49 AM
>
> Once I saw Fred Simons solution I realized at once two things. The first is
> that probably one reason why Mathematica does not have a built in Backtrack
> function is that backtracking is basically a method rather than a function,
> which means that in most problems a custom backtracking solution will
> generally be faster than a "general" Backtrack function. Still, I must say
> it is easier to make use of a built in function than to have to program it
> each time from scratch so I still feel that it is worth having one. Which
> brings me to the second thing which is that is that I made a poor use of the
> existing Backtrack. The better way to proceed is to consider a state space
> made up of all possible pairs of positions rather than numbers, and then
> just choose pairs of positions rather than individual numbers as in my
> original algorithm. With this the built in Backtrack also works pretty fast.
> Here is the new implementation:
>
> First w load in the Combinatorica package (or use Allan Hayes functional
> "Backtrack2" function, which should be faster though that might run out of
> memory for larger lists)
>
> <<DiscreteMath`Combinatorica`
>
> Next we define our state space:
> In[1]:=
> pos[i_,n_]:=Table[{j,j+i+1},{j,1,2n-i-1}]
> In[2]:=
> space[n_]:=Table[pos[i,n],{i,1,n}]
>
> For example
> In[3]:=
> space[4]
> Out[3]=
> {{{1, 3}, {2, 4}, {3, 5}, {4, 6}, {5, 7}, {6, 8}}, {{1, 4}, {2, 5}, {3, 6},
> {4, 7}, {5, 8}}, {{1, 5}, {2, 6}, {3, 7}, {4, 8}}, {{1, 6}, {2, 7}, {3, 8}}}
>
> This means that the possible positions for 1 are {1,3}, {2,4},{3,5},{4, 6},
> {5, 7}, {6, 8} , for 2 they are {1, 4}, {2, 5}, {3, 6}, {4, 7}, {5, 8} and
> so on.
> Now, our test for a partial solution is extremly simple: we only require
> that no position be chosen twice!
>
> In[4]:=
> partialQ[l_]:=Length[Flatten[l]]==Length[Union[Flatten[l]]]
>
> The test for the final solution will be exactly the same.
> Finally the new problem soving function is now:
>
> In[5]:=
> problem[n_]:=Backtrack[space[n],partialQ,partialQ,All]
>
>
> We can now check
>
>
> In[6]:=
> problem[3]
> Out[6]=
> {{{2, 4}, {3, 6}, {1, 5}}, {{3, 5}, {1, 4}, {2, 6}}}
>
> In[7]:=
> problem[4]
> Out[7]=
> {{{2, 4}, {5, 8}, {3, 7}, {1, 6}}, {{5, 7}, {1, 4}, {2, 6}, {3, 8}}}
> In[8]:=
> problem[5]
> Out[8]=
> {}
> In[9]:=
> problem[6]
> Out[9]=
> {}
>
> In[10]:=
> problem[7]//Timing
> Out[10]=
> {21.3167 Second, {{{1, 3}, {4, 7}, {8, 12}, {9, 14}, {5, 11}, {6, 13}, {2,
> 10}}, {{1, 3}, {4, 7}, {9, 13}, {6, 11}, {8, 14}, {5, 12}, {2,
> 10}}, {{1, 3}, {5, 8}, {10, 14}, {6, 11}, {7, 13}, {2, 9}, {4,
> 12}}, {{1, 3}, {6, 9}, {10, 14}, {7, 12}, {2, 8}, {4, 11}, {5,
> 13}}, {{1, 3}, {8, 11}, {9, 13}, {2, 7}, {4, 10}, {5, 12}, {6,
> 14}}, {{1, 3}, {9, 12}, {6, 10}, {2, 7}, {8, 14}, {4, 11}, {5,
> 13}}, {{1, 3}, {10, 13}, {4, 8}, {7, 12}, {5, 11}, {2, 9}, {6,
> 14}}, {{1, 3}, {10, 13}, {5, 9}, {6, 11}, {2, 8}, {7, 14}, {4,
> 12}}, {{1, 3}, {10, 13}, {5, 9}, {7, 12}, {2, 8}, {4, 11}, {6,
> 14}}, {{1, 3}, {10, 13}, {7, 11}, {4, 9}, {2, 8}, {5, 12}, {6,
> 14}}, {{2, 4}, {6, 9}, {10, 14}, {8, 13}, {1, 7}, {5, 12}, {3,
> 11}}, {{2, 4}, {7, 10}, {9, 13}, {1, 6}, {8, 14}, {5, 12}, {3,
> 11}}, {{2, 4}, {9, 12}, {7, 11}, {1, 6}, {8, 14}, {3, 10}, {5,
> 13}}, {{2, 4}, {10, 13}, {3, 7}, {6, 11}, {8, 14}, {5, 12}, {1,
> 9}}, {{2, 4}, {11, 14}, {6, 10}, {3, 8}, {7, 13}, {5, 12}, {1,
> 9}}, {{2, 4}, {11, 14}, {6, 10}, {7, 12}, {3, 9}, {1, 8}, {5,
> 13}}, {{3, 5}, {8, 11}, {10, 14}, {1, 6}, {7, 13}, {2, 9}, {4,
> 12}}, {{3, 5}, {10, 13}, {2, 6}, {7, 12}, {8, 14}, {4, 11}, {1,
> 9}}, {{3, 5}, {10, 13}, {7, 11}, {1, 6}, {8, 14}, {2, 9}, {4,
> 12}}, {{3, 5}, {11, 14}, {6, 10}, {8, 13}, {1, 7}, {2, 9}, {4,
> 12}}, {{3, 5}, {11, 14}, {8, 12}, {2, 7}, {4, 10}, {6, 13}, {1,
> 9}}, {{3, 5}, {11, 14}, {8, 12}, {4, 9}, {1, 7}, {6, 13}, {2,
> 10}}, {{4, 6}, {10, 13}, {1, 5}, {7, 12}, {8, 14}, {2, 9}, {3,
> 11}}, {{4, 6}, {11, 14}, {9, 13}, {3, 8}, {1, 7}, {5, 12}, {2,
> 10}}, {{5, 7}, {1, 4}, {10, 14}, {8, 13}, {6, 12}, {2, 9}, {3,
> 11}}, {{5, 7}, {11, 14}, {9, 13}, {1, 6}, {2, 8}, {3, 10}, {4,
> 12}}, {{8, 10}, {1, 4}, {2, 6}, {9, 14}, {7, 13}, {5, 12}, {3,
> 11}}, {{8, 10}, {11, 14}, {1, 5}, {2, 7}, {3, 9}, {6, 13}, {4,
> 12}}, {{9, 11}, {1, 4}, {2, 6}, {7, 12}, {8, 14}, {3, 10}, {5,
> 13}}, {{9, 11}, {2, 5}, {10, 14}, {3, 8}, {1, 7}, {6, 13}, {4,
> 12}}, {{10, 12}, {1, 4}, {3, 7}, {6, 11}, {8, 14}, {2, 9}, {5,
> 13}}, {{10, 12}, {1, 4}, {3, 7}, {8, 13}, {5, 11}, {2, 9}, {6,
> 14}}, {{10, 12}, {1, 4}, {5, 9}, {2, 7}, {8, 14}, {6, 13}, {3,
> 11}}, {{10, 12}, {2, 5}, {4, 8}, {9, 14}, {1, 7}, {6, 13}, {3,
> 11}}, {{10, 12}, {2, 5}, {9, 13}, {3, 8}, {1, 7}, {4, 11}, {6,
> 14}}, {{10, 12}, {4, 7}, {1, 5}, {9, 14}, {2, 8}, {6, 13}, {3,
> 11}}, {{11, 13}, {1, 4}, {5, 9}, {3, 8}, {6, 12}, {7, 14}, {2,
> 10}}, {{11, 13}, {1, 4}, {5, 9}, {7, 12}, {2, 8}, {3, 10}, {6,
> 14}}, {{11, 13}, {2, 5}, {8, 12}, {4, 9}, {1, 7}, {3, 10}, {6,
> 14}}, {{11, 13}, {3, 6}, {4, 8}, {9, 14}, {1, 7}, {5, 12}, {2,
> 10}}, {{11, 13}, {5, 8}, {2, 6}, {9, 14}, {1, 7}, {3, 10}, {4,
> 12}}, {{11, 13}, {6, 9}, {1, 5}, {2, 7}, {8, 14}, {3, 10}, {4,
> 12}}, {{12, 14}, {2, 5}, {4, 8}, {6, 11}, {7, 13}, {3, 10}, {1,
> 9}}, {{12, 14}, {2, 5}, {6, 10}, {3, 8}, {7, 13}, {4, 11}, {1,
> 9}}, {{12, 14}, {2, 5}, {6, 10}, {4, 9}, {7, 13}, {1, 8}, {3,
> 11}}, {{12, 14}, {2, 5}, {7, 11}, {3, 8}, {4, 10}, {6, 13}, {1,
> 9}}, {{12, 14}, {3, 6}, {5, 9}, {8, 13}, {1, 7}, {4, 11}, {2,
> 10}}, {{12, 14}, {4, 7}, {2, 6}, {8, 13}, {5, 11}, {3, 10}, {1,
> 9}}, {{12, 14}, {6, 9}, {1, 5}, {3, 8}, {7, 13}, {4, 11}, {2,
> 10}}, {{12, 14}, {7, 10}, {1, 5}, {4, 9}, {2, 8}, {6, 13}, {3,
> 11}}, {{12, 14}, {8, 11}, {2, 6}, {4, 9}, {1, 7}, {3, 10}, {5,
> 13}}, {{12, 14}, {8, 11}, {3, 7}, {1, 6}, {4, 10}, {2, 9}, {5,
> 13}}}}
>
> This is vastly faster than before. It's still not as fast as Fred's solution
> (not to mention the optimized version by Hartmut) but it's fast enoguh and I
> dont't think the code could be made any simpler.
> --
> Andrzej Kozlowski
> Toyama International University
> JAPAN
> http://sigma.tuins.ac.jp
> http://eri2.tuins.ac.jp
>
>
> -