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

*To*: mathgroup at smc.vnet.net*Subject*: [mg19662] Re: [mg19644] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution improved)*From*: "Wolf, Hartmut" <hwolf at debis.com>*Date*: Wed, 8 Sep 1999 02:24:12 -0400*Organization*: debis Systemhaus*References*: <7qv31d$34c$1@dragonfly.wolfram.com> <199909070428.AAA06911@smc.vnet.net.>*Sender*: owner-wri-mathgroup at wolfram.com

Hello Allan, you proposed another solution to Langford's Problem, which is a direct attack like Fred H Simons' was, however you used a different programming style, the functional style, including heavy use of pattern maching -- usually the "preferred one" with _Mathematica_. Fred's style is completely procedural (and perhaps a reworked C routine). Otherwise, apart from not using Fred's starting condition -- Andrzej Kozlowski did that for you -- the algorithms are the 'same', yet you used my idea working downwards. In order to differentiate the cases of style from those of algorithmics, i reworked Fred's algorithm up to your style of programming, including my more complicated start-up and finishing procedures, and this gives me the opportunity to explain them a little bit more. Then i compaired. Allan Hayes schrieb: > > 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 > ] > -----<snip>----- For that i got on my machine: In[3]:= Length[Langford[7]] // Timing Out[3]= {6.279 Second, 52} In[4]:= Length[Langford[8]] // Timing Out[4]= {41.479 Second, 300} > > 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 replacements 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. > I did it and modification (1) gave In[73]:= Length[Langford[7]] // Timing Out[73]= {6.259 Second, 50} In[74]:= Length[Langford[8]] // Timing Out[74]= {41.269 Second, 300} a little improvement? No way! The odd case is wrong, this reminds much of Martin Gardners error in "Mathematical Games" of November 1967, Scientific American. However modification (2) yielded In[78]:= Length[Langford[7]] // Timing Out[78]= {5.668 Second, 52} In[79]:= Length[Langford[8]] // Timing Out[79]= {38.375 Second, 300} a 7-10% improvement (i don't understand why, perhaps you can explain that to me). Modification (3) is something i would have started with (but only for aesthetic reasons), modification (2) does no longer apply in that case. Here the coding and measurement: In[11]:= LangfordStep[partialSolution_, k_] := Flatten[ Map[ (ReplaceList[#, {x___, 0, y__ /; Length[{y}] === k, 0, z___} :> {x, k, y, k, z}] &), partialSolution], 1] In[12]:= Langford[n_] := Fold[LangfordStep, {Table[0, {2n}]}, Reverse[Range[n]] ] In[14]:= Length[Langford[7]] // Timing Out[14]= {5.628 Second, 52} In[15]:= Length[Langford[8]] // Timing Out[15]= {38.095 Second, 300} It is of sligtly better performance (i.e. *not* worse!) Now porting my improvement of Fred's solution to your style: Apart from working downwards it consisted of choosing the right starting condition to only get "half" of the solutions, such that reversing those would then add up to all solutions. That prunes the decision tree *at the beginning*, such excluding many futile trials. Further there is an improvement at the ending, where substition in not necessary if you initialize with all 1's instead of all 0's. In[44]:= LangfordFinish[partialSolution_] := Cases[partialSolution, {___, 1, _, 1, ___}] For starting we have two different cases for n even and n odd. Odd case is simple. We just restrict to solutions where the center of the largest clamp n is to the left of the middle. In[51]:= LangfordStartOdd[n_?OddQ] := With[{cut = (n - 1)/2}, Flatten[ Map[(ReplaceList[#, {x___ /; Length[{x}] < cut, 1, y__ /; Length[{y}] === n, 1, z___} :> {x, n, y, n, z}] &), {Table[1, {2n}]} ], 1] ] In[56]:= Langford[n_?OddQ] := LangfordFinish[Fold[LangfordStep, LangfordStartOdd[n], Reverse[Range[2, n - 1]] ]] In[58]:= Length[Langford[7]] // Timing Out[58]= {2.423 Second, 26} This is *less* than half of the computing time above! For the even case we have a solution where clamp n may be exactly in the middle. Not respecting this will double-count some solutions, so we have to be careful: In[59]:= LangfordStartEvenPart1[n_?EvenQ] := With[{cut = (n - 2)/2}, Flatten[ Map[(ReplaceList[#, {x___ /; Length[{x}] < cut, 1, y__ /; Length[{y}] === n, 1, z___} :> {x, n, y, n, z}] &), {Table[1, {2n}]} ], 1] ] In[61]:= LangfordStartSymmetricCase[n_] := {Join[#, Reverse[#]] &@Table[If[i == n/2, n, 1], {i, n}]} In[63]:= LangfordStepOdd[symmetricConfiguration_, n_?OddQ] := With[{cut = (n - 1)/2}, Flatten[ Map[(ReplaceList[#, {x___ /; Length[{x}] < cut, 1, y__ /; Length[{y}] === n, 1, z___} :> {x, n, y, n, z}] &), symmetricConfiguration], 1] ] In[65]:= LangfordStartEven[n_?EvenQ] := LangfordStep[LangfordStartEvenPart1[n], n - 1] ~Join~ LangfordStepOdd[LangfordStartSymmetricCase[n], n - 1] In[67]:= Langford[n_?EvenQ] := LangfordFinish[ Fold[LangfordStep, LangfordStartEven[n], Reverse[Range[2, n - 2]] ]] In[69]:= Length[Langford[8]] // Timing Out[69]= {16.124 Second, 150} again better than half of the previous result! It might be interesting to compare with Adrzej's adaption of Fred's starting conditions: In[122]:= SimonsStart[n_] := NestList[RotateRight, Join[{1, 0, 1}, Table[0, {2 n - 3}]], n - 2] In[123]:= Langford[n_] := Fold[LangfordStep, SimonsStart[n], Reverse[Range[2, n]] ] In[126]:= Length[Langford[7]] // Timing Out[126]= {3.304 Second, 26} In[127]:= Length[Langford[8]] // Timing Out[127]= {21.521 Second, 150} So these "starting" conditions are not set up at the proper side. With kind regards, Hartmut Wolf

**References**:**Re: Re: Langford's Problem (another solution improved)***From:*"Allan Hayes" <hay@haystack.demon.co.uk>