Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1999
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

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

  • To: mathgroup at smc.vnet.net
  • Subject: [mg19651] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution improved)
  • From: "Andrzej Kozlowski" <andrzej at tuins.ac.jp>
  • Date: Tue, 7 Sep 1999 00:28:42 -0400
  • Sender: owner-wri-mathgroup at wolfram.com

You can still almost double the speed of your program if you incorporate the
Fred Simons' symmetry trick. I think the following code does this:

Langford1[n_] :=
Module[{sol = NestList[ RotateRight, Join[ {1, 0, 1}, Table[0, {2 n - 3}]],
n -2]},
    Do[sol =
          Flatten[Map[
               ReplaceList[#1, {x___, 0, y__ /; Length[{y}] === k, 0, z___}
:> {x, k, y, k, z}] &,
               sol
           ],1],
      {k, n,  2, -1}]
    ; sol
]


This makes it the second fastest solution. On my 233 PowerBook G3
Langford1[8] takes 12.4 seconds, your orignal Langford[8] 21.4  and the
super-fast Simons-Wolf 3.8 second.
--
Andrzej Kozlowski
Toyama International University
JAPAN
http://sigma.tuins.ac.jp
http://eri2.tuins.ac.jp


----------
>From: "Allan Hayes" <hay at haystack.demon.co.uk>
To: mathgroup at smc.vnet.net
>To: "Andrzej Kozlowski" <andrzej at tuins.ac.jp>
>Subject: [mg19651] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution
improved)
>Date: Mon, Sep 6, 1999, 8:30 PM
>

> 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: wrong bounding box
  • Next by Date: Re: crystal structure?
  • Previous by thread: Re: Re: Langford's Problem (another solution improved)
  • Next by thread: Re: Re: Langford's Problem (another solution improved)