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>
- Re: Re: Langford's Problem (another solution improved)