Re: Langford's Problem (yet another improvement!)

*To*: mathgroup at smc.vnet.net*Subject*: [mg19669] Re: [mg19644] Langford's Problem (yet another improvement!)*From*: "Wolf, Hartmut" <hwolf at debis.com>*Date*: Thu, 9 Sep 1999 02:19:44 -0400*Organization*: debis Systemhaus*References*: <7qv31d$34c$1@dragonfly.wolfram.com> <199909070428.AAA06911@smc.vnet.net.>*Sender*: owner-wri-mathgroup at wolfram.com

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 > ] > ------<snipped>----- > Some refinements are possible; > ------<snipped>----- > > 3) we could use Fold instead of Do > Dear Allan, I am very fond of your way of writing down the core algorithm in _Mathematica_, and I was also searching for something like that. However I couldn't find the expression for the matching pattern, namely {x___, 0, y__ /; Length[{y}] === k, 0, z___} That marvellous condition in the middle! (My prior success with the pattern in my brute force solution had let me into false tracks and I couldn't manage to give my pattern a name.) Deplorably your solution doesn't perform as well as Fred Simons' procedural solution (with my improvements). *But this has changed now!* I felt that sequential patten matching on the linear structure should be better than doing the Do. But where is the imperformance hidden? It certainly is that 'marvellous' y__/;Length[{y}], where amoungst many possible matches only one is good. So I tried again with my ansatz: the solution is, not to build up the pattern but the replacement rule! Because it's so pretty I'll show you nearly all of my notebook Here is your version rewritten with Fold: In[1]:= LangfordStep[partialSolution_, k_] := Flatten[ Map[(ReplaceList[#, {x___, 0, y__ /; Length[{y}] === k, 0, z___} :> {x, k, y, k, z}] &), partialSolution], 1] In[2]:= Langford[n_] := Fold[LangfordStep, {Table[0, {2n}]}, Reverse[Range[n]] ] In[4]:= Length[Langford[7]] // Timing Out[4]= {5.748 Second, 52} In[5]:= Length[Langford[8]] // Timing Out[5]= {38.325 Second, 300} In[6]:= Remove[Langford, LangfordStep] ________________________________________ Now to find the improved replacement rule: In[7]:= makeBlankSeqN[1] := Module[{y}, {{y_}, {y}}] In[8]:= makeBlankSeqN[n_] := Module[{y},{Append[#[[1]], y_],Append[#[[2]], y]}&@ makeBlankSeqN[n - 1]] In[11]:= ruleClamp[n_] := RuleDelayed @@ {{x___,0,Sequence @@ #[[1]],0,z___}, {x, n,Sequence @@ #[[2]], n, z}}&@ makeBlankSeqN[n] In[12]:= ruleClamp[4] Out[12]= {x___,0,y$12_,y$11_,y$10_,y$9_,0,z___} :> {x,4,y$12,y$11,y$10,y$9,4,z} In[13]:= LangfordStep[partialSolution_, k_] := (ruleClamp[k] = ruleClamp[k]; Flatten[Map[ReplaceList[#, ruleClamp[k]] &, partialSolution], 1]) In[14]:= Langford[n_] := Fold[LangfordStep, {Table[0, {2n}]}, Reverse[Range[n]] ] In[16]:= Length[Langford[7]] // Timing Out[16]= {0.611 Second, 52} In[17]:= Length[Langford[8]] // Timing Out[17]= {3.515 Second, 300} And now if you add my improvements to Fred's Solution (including his idea to compute only one of the solution pairs each) then you get In[10]:= Length[Langford[7]] // Timing Out[10]= {0.31 Second, 26} In[21]:= Length[Langford[8]] // Timing Out[21]= {1.682 Second, 150} In[22]:= Length[Langford[11]] // Timing Out[22]= {566.955 Second, 17792} Is it possible to further improve? I think so! But then do it at the very core of the algorithm. Every LangfordStep generates solutions and deletes some. If you can manage to recognize false tracks and delete *early*, you'll improve. If you look at the results, you'll see that certain patterns don't show up there. So the question is, how to get at those rules and *prove* them. That's the mathematical side of the problem, after the _Mathematica_ side has been settled (or -- hopefully! -- not?) With kind regards, Hartmut Wolf

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