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

*To*: mathgroup at smc.vnet.net*Subject*: [mg19651] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution improved)*From*: "Andrzej Kozlowski" <andrzej at tuins.ac.jp>*Date*: Tue, 7 Sep 1999 00:28:42 -0400*Sender*: owner-wri-mathgroup at wolfram.com

You can still almost double the speed of your program if you incorporate the Fred Simons' symmetry trick. I think the following code does this: Langford1[n_] := Module[{sol = NestList[ RotateRight, Join[ {1, 0, 1}, Table[0, {2 n - 3}]], n -2]}, Do[sol = Flatten[Map[ ReplaceList[#1, {x___, 0, y__ /; Length[{y}] === k, 0, z___} :> {x, k, y, k, z}] &, sol ],1], {k, n, 2, -1}] ; sol ] This makes it the second fastest solution. On my 233 PowerBook G3 Langford1[8] takes 12.4 seconds, your orignal Langford[8] 21.4 and the super-fast Simons-Wolf 3.8 second. -- Andrzej Kozlowski Toyama International University JAPAN http://sigma.tuins.ac.jp http://eri2.tuins.ac.jp ---------- >From: "Allan Hayes" <hay at haystack.demon.co.uk> To: mathgroup at smc.vnet.net >To: "Andrzej Kozlowski" <andrzej at tuins.ac.jp> >Subject: [mg19651] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution improved) >Date: Mon, Sep 6, 1999, 8:30 PM > > I came up with the following solution using ReplaceList. > The method seems fairly general - certainly, little thought was needed once > the idea of using ReplaceList occurred to me. > > Langford[n_] := > Module[{sol = {Table[0, {2n}]}}, > Do[sol = > Join @@ > Map[ > ReplaceList[#1, {x___, 0, y__ /; Length[{y}] === k, 0, z___} > :> {x, k, y, k, z}] &, > sol > ], > {k, n, 1, -1}] > ; sol > ] > > I got the following speed comparisons: > > Langford[8]; // Timing > {48.33 Second, Null} > > Fred Simons: 42.4 Second > > Fred Simons/Hartmut Wolf : 13.46 Second; > > Andrzej Kozlowski Latest: 209.76 Second > (with my, missnamed, Backtrack2, this became 61.9 Second) > > > Some refinements are possible; > > 1) we could replace > > ReplaceList[#1, {x___, 0, y__ /; Length[{y}] === k, 0, z___} :> {x, > k, y, k, z}] & > with > ReplaceList[#1, {x___, 0, y__ /; Length[{y}] === k, 0, z___} :> {x, > k, y, k, z}, k] & > so that ReplaceList knows to stop when k repalcements have been found > > 2) we could insert the k directly using With: > > With[{k=k}, > Join @@ > Map[ > ReplaceList[#1, {x___, 0, y__ /; Length[{y}] === k, 0, z___} > :> {x, k, y, k, z}] &, > sol > ] > ] > > 3) we could use Fold instead of Do > > But they have little effect on this particular computation. > > Allan > --------------------- > Allan Hayes > Mathematica Training and Consulting > Leicester UK > www.haystack.demon.co.uk > hay at haystack.demon.co.uk > Voice: +44 (0)116 271 4198 > Fax: +44 (0)870 164 0565 > > > > > >