[Date Index]
[Thread Index]
[Author Index]
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
Prev by Date:
**Re: Element extraction**
Next by Date:
**Re: How to NDSolve the differential equation**
Previous by thread:
**Re: Re: Langford's Problem (another solution improved)**
Next by thread:
**Re: Re: Re: Langford's Problem (another solution improved)**
| |