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

**crystal structure?**

**Re: Re: Langford's Problem (another solution)**

**Re: crystal structure?**

**Re: Re: Langford's Problem (another solution improved)**