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