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

*To*: mathgroup at smc.vnet.net*Subject*: [mg19644] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution improved)*From*: "Allan Hayes" <hay at haystack.demon.co.uk>*Date*: Tue, 7 Sep 1999 00:28:38 -0400*References*: <7qv31d$34c$1@dragonfly.wolfram.com>*Sender*: owner-wri-mathgroup at wolfram.com

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

**Follow-Ups**:**Re: Langford's Problem (yet another improvement!)***From:*"Wolf, Hartmut" <hwolf@debis.com>

**Re: Re: Re: Langford's Problem (another solution improved)***From:*"Wolf, Hartmut" <hwolf@debis.com>