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

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