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: Numbers problem

  • To: mathgroup at smc.vnet.net
  • Subject: [mg19585] Re: [mg19524] Re: [mg19520] Numbers problem
  • From: "Allan Hayes" <hay at haystack.demon.co.uk>
  • Date: Sat, 4 Sep 1999 01:34:23 -0400
  • References: <7qfn5a$aq9@smc.vnet.net> <7qkvhb$s9m$6@dragonfly.wolfram.com>
  • Sender: owner-wri-mathgroup at wolfram.com

I  should have noted in my previous posting, partially copied below, that my
function Backtrack2 does not backtrack but tries all possibilities as it
goes along (it needs a different name). So it may be faster for finding all
solutions but not for finding a small number of solutions.

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



Allan Hayes <hay at haystack.demon.co.uk> wrote in message
news:7qkvhb$s9m$6 at dragonfly.wolfram.com...
> Andrzej,
> Your solution suggested that it might be worthwhile trying to speed up
> Backtrack - which was written with Mathematica 1.2. Backtrack2, below,
seems tro be
> more than twice as fast as Backtrack.
>
> First with DiscreteMath`Combinatorica`Backtrack
>
> << DiscreteMath`Combinatorica`
>
> space[n_] := Table[Range[n], {2n}]
>
> test[l_List, i_] := (Last[#] - First[#]) &@Flatten[Position[l, i]] - 1 ==
i
>
> partialQ[l_] := (Count[l, Last[l]] <=
> 2 && (test[l, Last[l]] || Count[l, Last[l]] == 1))
>
>
> finalQ[l_] := Apply[And, Map[test[l, #] &, Union[l]]]
>
> problem[n_] := Backtrack[space[n], partialQ, finalQ, All]
>
> In[339]:=
> problem[4] // Timing
>
>     {1.65 Second, {{2, 3, 4, 2, 1, 3, 1, 4}, {4, 1, 3, 1, 2, 4, 3, 2}}}
>
> In[340]:=
> problem[5] // Timing
>
>     {22.08 Second, {}}
>
>
> Now with a new Backtrack
>
> Backtrack2[space_, partialQ_, solutionQ_, number_:1] :=
>   Cases[
>     Fold[Cases[
>           Join @@ Outer[Append, #1, space[[#2]], 1], _?
>             partialQ, {1}] &, {{}}, Range[Length[space]]]
>     , _?solutionQ, {1}, number]
>
>
> Backtrack2[ space[4], partialQ, finalQ, Infinity] // Timing
>
>     {0.66 Second, {{2, 3, 4, 2, 1, 3, 1, 4}, {4, 1, 3, 1, 2, 4, 3, 2}}}
>
> Backtrack2[ space[5], partialQ, finalQ, Infinity] // Timing
>
>     {5.99 Second, {}}
>
>

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: A psfonts.map to use the mathematicafonts with LaTeX
  • Next by Date: Re: Range[imin,imax,di]; was it better in 3.0 than in 4.0 ?
  • Previous by thread: Re: Re: Numbers problem
  • Next by thread: Re: Avoid out of memory in Simplify