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: Langford's Problem (yet another improvement!)

  • To: mathgroup at smc.vnet.net
  • Subject: [mg19717] Re: [mg19644] Langford's Problem (yet another improvement!)
  • From: "Allan Hayes" <hay at haystack.demon.co.uk>
  • Date: Mon, 13 Sep 1999 02:40:53 -0400
  • References: <7qv31d$34c$1@dragonfly.wolfram.com> <199909070428.AAA06911@smc.vnet.net.> <7r7jd9$cgf@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Dear Hartmut,
Your idea of using , for example

{x___,0,y$1_,y$2_,y$3_,y$4_,0,z___} :>
 {x,4,y$1,y$2,y$3,y$4,4,z}

instead of

{x___, 0, y__ /; Length[{y}] === 4, 0, z___}
 :> {x, 4, y, 4, z}]

is an excellent example of efficient use of pattern matching

Rule:   use simple tests and conditions - avoid them completely if possible
in favour of pattern "shapes".

I give a slight modification, amongst other changes I use Unique instead of
Module - there is very little difference in the timing.

Clear["`*"]

makeBlankSeqN[n_] :=
  Transpose[Table[{Pattern[#, Blank[]], #} &[Unique[y]], {n}]]

ruleClamp[n_] :=
(ruleClamp[n] = {x___, 0, Sequence @@ #[[1]], 0, z___} -> {x, n,
              Sequence @@ #[[2]], n, z} &@makeBlankSeqN[n])

Langford[n_] :=
  Fold[With[{rl=ruleClamp[#2]}, Join @@
      Map[
    ReplaceList[#1,rl]&,#1]] & , {Table[0, {2n}]},
   Reverse[Range[n]]]

Length[Langford[7]] // Timing
Length[Langford[8]] // Timing
Length[Langford[9]] // Timing
Length[Langford[10]] // Timing

{0.82 Second, 52}
{4.5 Second, 300}
{29.82 Second, 0}
{221.3 Second, 0}

The times for your original, without special start to take advantage of the
symmety (copied after the times), were

Length[Langford[7]] // Timing
Length[Langford[8]] // Timing
Length[Langford[9]] // Timing
Length[Langford[10]] // Timing

{0.76 Second, 52}
{5.66 Second, 300}
{31.52 Second, 0}
{222.62 Second, 0}

Clear["`*"]

makeBlankSeqN[1] := Module[{y}, {{y_}, {y}}]

makeBlankSeqN[n_] :=
  Module[{y}, {Append[#[[1]], y_], Append[#[[2]], y]} &@makeBlankSeqN[n -
1]]

ruleClamp[n_] :=
  RuleDelayed @@ {{x___, 0, Sequence @@ #[[1]], 0, z___}, {x, n,
            Sequence @@ #[[2]], n, z}} &@makeBlankSeqN[n]

LangfordStep[partialSolution_, k_] := (ruleClamp[k] = ruleClamp[k];
    Flatten[Map[ReplaceList[#, ruleClamp[k]] &, partialSolution], 1])

Langford[n_] := Fold[LangfordStep, {Table[0, {2n}]}, Reverse[Range[n]]]


Thanks for finding the error in my suggested improvement 2).

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





Wolf, Hartmut <hwolf at debis.com> wrote in message
news:7r7jd9$cgf at smc.vnet.net...
> 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
>
>





  • Prev by Date: Re: Re: Finding a relative prime
  • Next by Date: Excel
  • Previous by thread: Re: Langford's Problem (yet another improvement!)
  • Next by thread: Re: Re: Langford's Problem (yet another improvement!)