Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

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

Search the Archive

Re: Solve - takes very long time

  • To: mathgroup at smc.vnet.net
  • Subject: [mg121872] Re: Solve - takes very long time
  • From: DrMajorBob <btreat1 at austin.rr.com>
  • Date: Wed, 5 Oct 2011 04:03:29 -0400 (EDT)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • References: <414601534.1771400.1317787650538.JavaMail.root@jaguar8.sfu.ca>
  • Reply-to: drmajorbob at yahoo.com

The Pick solution is faster here, although both are so fast it hardly  
matters.

Pick is also simpler, which definitely counts with me.

Quit

interpret[s_] :=
  Flatten@{FromDigits /@ Transpose@Take[#, 3],
      FromDigits@Flatten@Take[#, -3]} &[
   Flatten@Position[s, #, {1}, 2] & /@ {100, 10, 1, -100, -10, -1}]
Timing[
  dual = Permutations@{100, 10, 1, 100, 10, 1, -100, -10, -1};
  interpret /@ dual[[Flatten at Position[dual.Range@9, 0]]] // Sort;]

{0.012462, Null}

Quit

interpret[s_] :=
  Flatten@{FromDigits /@ Transpose@Take[#, 3],
      FromDigits@Flatten@Take[#, -3]} &[
   Flatten@Position[s, #, {1}, 2] & /@ {100, 10, 1, -100, -10, -1}]
Timing[
  dual = Permutations@{100, 10, 1, 100, 10, 1, -100, -10, -1};
  interpret /@ Pick[dual, dual.Range@9, 0] // Sort;]

{0.008316, Null}

Bobby

On Tue, 04 Oct 2011 23:07:30 -0500, Ray Koopman <koopman at sfu.ca> wrote:

> I was wondering if something like that might be possible, but it
> didn't jump out at me. If I had figured it out, I might have used
>   Pick[dual, dual.Range@9, 0]
> instead of
>   dual[[Flatten at Position[dual.Range@9, 0]]].
> It's a little easier to read, and on my system it's just as fast.
>
> ----- DrMajorBob <btreat1 at austin.rr.com> wrote:
>> Or even better (9 times faster):
>>
>> interpret[s_List] :=
>>   Flatten@{FromDigits /@ Transpose@Take[#, 3],
>>       FromDigits@Flatten@Take[#, -3]} &[
>>    Flatten@Position[s, #, {1}, 2] & /@ {100, 10, 1, -100, -10, -1}]
>> Timing[
>>   dual = Permutations@{100, 10, 1, 100, 10, 1, -100, -10, -1};
>>   interpret /@ dual[[Flatten at Position[dual.Range@9, 0]]] // Sort]
>>
>> {0.010079, {{124, 659, 783}, {125, 739, 864}, {127, 359, 486}, {127,
>>     368, 495}, {128, 439, 567}, {134, 658, 792}, {142, 596, 738}, {142,
>>      695, 837}, {143, 586, 729}, {152, 487, 639}, {152, 784,
>>     936}, {162, 387, 549}, {162, 783, 945}, {173, 286, 459}, {173, 295,
>>      468}, {182, 394, 576}, {182, 493, 675}, {214, 569, 783}, {214,
>>     659, 873}, {215, 478, 693}, {215, 748, 963}, {216, 378, 594}, {216,
>>      738, 954}, {218, 349, 567}, {218, 439, 657}, {234, 657,
>>     891}, {235, 746, 981}, {241, 596, 837}, {243, 576, 819}, {243, 675,
>>      918}, {251, 397, 648}, {271, 593, 864}, {271, 683, 954}, {281,
>>     394, 675}, {314, 658, 972}, {317, 529, 846}, {317, 628, 945}, {324,
>>      567, 891}, {324, 657, 981}, {341, 586, 927}, {342, 576,
>>     918}, {352, 467, 819}}}
>>
>> Bobby
>>
>> On Tue, 04 Oct 2011 15:52:09 -0500, DrMajorBob <btreat1 at austin.rr.com>
>> wrote:
>>
>>> I missed the fact that you'd already explained this, but the same idea
>>> yields THIS solution:
>>>
>>> interpret[s_List] :=
>>>   Flatten@{FromDigits /@ Transpose@Take[#, 3],
>>>       FromDigits@Flatten@Take[#, -3]} &[
>>>    Flatten@Position[s, #] & /@ {100, 10, 1, -100, -10, -1}]
>>> nine = Range@9;
>>> interpret /@
>>>    Select[Permutations@{100, 10, 1, 100, 10, 1, -100, -10, -1},
>>>           #.nine == 0 &] // Timing
>>>
>>> {0.096459, {{127, 359, 486}, {127, 368, 495}, {128, 439, 567}, {125,
>>>     739, 864}, {124, 659, 783}, {182, 394, 576}, {162, 387, 549}, {182,
>>>      493, 675}, {162, 783, 945}, {142, 596, 738}, {142, 695,
>>>     837}, {152, 487, 639}, {152, 784, 936}, {173, 295, 468}, {173, 286,
>>>      459}, {143, 586, 729}, {134, 658, 792}, {218, 349, 567}, {216,
>>>     378, 594}, {218, 439, 657}, {216, 738, 954}, {214, 569, 783}, {214,
>>>      659, 873}, {215, 478, 693}, {215, 748, 963}, {317, 529,
>>>     846}, {317, 628, 945}, {314, 658, 972}, {281, 394, 675}, {251, 397,
>>>      648}, {271, 593, 864}, {271, 683, 954}, {241, 596, 837}, {341,
>>>     586, 927}, {243, 576, 819}, {243, 675, 918}, {342, 576, 918}, {352,
>>>      467, 819}, {234, 657, 891}, {235, 746, 981}, {324, 567,
>>>     891}, {324, 657, 981}}}
>>>
>>> That uses far less memory (1/8 as many permutations), and it's also
>>> faster:
>>>
>>> FromDigits /@ Partition[#, 3] & /@
>>>    Select[Permutations@
>>>      Range@9, #[[1]] < #[[4]] && #[[2]] < #[[5]] && #[[3]] < #[[6]] &&  
>>> \
>>> #.{100, 10, 1, 100, 10, 1, -100, -10, -1} == 0 &] // Timing
>>>
>>> {2.02554, {{124, 659, 783}, {125, 739, 864}, {127, 359, 486}, {127,
>>>     368, 495}, {128, 439, 567}, {134, 658, 792}, {142, 596, 738}, {142,
>>>      695, 837}, {143, 586, 729}, {152, 487, 639}, {152, 784,
>>>     936}, {162, 387, 549}, {162, 783, 945}, {173, 286, 459}, {173, 295,
>>>      468}, {182, 394, 576}, {182, 493, 675}, {214, 569, 783}, {214,
>>>     659, 873}, {215, 478, 693}, {215, 748, 963}, {216, 378, 594}, {216,
>>>      738, 954}, {218, 349, 567}, {218, 439, 657}, {234, 657,
>>>     891}, {235, 746, 981}, {241, 596, 837}, {243, 576, 819}, {243, 675,
>>>      918}, {251, 397, 648}, {271, 593, 864}, {271, 683, 954}, {281,
>>>     394, 675}, {314, 658, 972}, {317, 529, 846}, {317, 628, 945}, {324,
>>>      567, 891}, {324, 657, 981}, {341, 586, 927}, {342, 576,
>>>     918}, {352, 467, 819}}}
>>>
>>> Timing[Length[
>>>    solns = FromDigits /@ Partition[#, 3] & /@
>>>      Select[Permutations@
>>>        Range@9, #[[1]] < #[[4]] && #.{100, 10, 1, 100, 10,
>>>            1, -100, -10, -1} == 0 &]]]
>>>
>>> {1.56286, 168}
>>>
>>> Surely "interpret" could be simpler, but I haven't thought of a way, as
>>> yet... and it doesn't need to be fast.
>>>
>>> Bobby
>>>
>>> On Tue, 04 Oct 2011 13:25:36 -0500, Ray Koopman <koopman at sfu.ca> wrote:
>>>
>>>> The basic condition can be written as
>>>>
>>>> 100*(x2 + y2) + 10*(x1 + y1) + (x0 + y0) = 100*z2 + 10*z1 + z0,
>>>>
>>>> in which form it is clear that we can always swap corresponding xi and
>>>> yi, and that solutions therefore come is sets of 8. Requiring xi < yi
>>>> for all i is just a way of picking a "canonical" member of each set.
>>>>
>>>> ----- DrMajorBob <btreat1 at austin.rr.com> wrote:
>>>>> The conditions #[[2]] < #[[5]] and #[[3]] < #[[6]] do not belong,
>>>>> however.
>>>>>
>>>>> Bobby
>>>>>
>>>>> On Tue, 04 Oct 2011 00:30:53 -0500, Ray Koopman <koopman at sfu.ca>  
>>>>> wrote:
>>>>>
>>>>>> On Oct 3, 1:26 am, Fredob <fredrik.dob... at gmail.com> wrote:
>>>>>>> Hi,
>>>>>>>
>>>>>>> I tried the following on Mathematica 8 and it doesn't seem to stop
>>>>>>> running (waited 40 minutes on a 2.6 Ghz processor w 6 GB of primary
>>>>>>> memory).
>>>>>>>
>>>>>>> Solve[
>>>>>>>  {100*Subscript[x, 2] + 10*Subscript[x, 1] + Subscript[x, 0] +
>>>>>>>   100*Subscript[y, 2] + 10*Subscript[y, 1] + Subscript[y, 0] ==
>>>>>>>   100*Subscript[z, 2] + 10*Subscript[z, 1] + Subscript[z, 0],
>>>>>>>   Subscript[x, 0] > 0, Subscript[y, 0] > 0, Subscript[z, 0] > 0,
>>>>>>>   Subscript[x, 1] > 0, Subscript[y, 1] > 0, Subscript[z, 1] > 0,
>>>>>>>   Subscript[x, 2] > 0, Subscript[y, 2] > 0, Subscript[z, 2] > 0,
>>>>>>>   Subscript[x, 0] <= 9, Subscript[y, 0] <= 9, Subscript[z, 0] <= 9,
>>>>>>>   Subscript[x, 1] <= 9, Subscript[y, 1] <= 9, Subscript[z, 1] <= 9,
>>>>>>>   Subscript[x, 2] <= 9, Subscript[y, 2] <= 9, Subscript[z, 2] <= 9,
>>>>>>>   Subscript[x, 0] != Subscript[y, 0] != Subscript[z, 0] !=
>>>>>>>   Subscript[x, 1] != Subscript[y, 1] != Subscript[z, 1] !=
>>>>>>>   Subscript[x, 2] != Subscript[y, 2] != Subscript[z, 2]},
>>>>>>>  {Subscript[x, 2], Subscript[y, 2], Subscript[z, 2], Subscript[x,  
>>>>>>> 1],
>>>>>>>   Subscript[y, 1], Subscript[z, 1], Subscript[x, 0], Subscript[y,  
>>>>>>> 0],
>>>>>>>   Subscript[z, 0] },
>>>>>>>  Integers]
>>>>>>>
>>>>>>> The problem was a homework for my daugther where you are supposed  
>>>>>>> to
>>>>>>> use all digits to build - but only once - 2 three digit numbers and
>>>>>>> addition.
>>>>>>
>>>>>> For each of the 42 solutions found by the brute force search given
>>>>>> below there are seven other solutions that may be obtained by
>>>>>> interchanging x0,y0 and/or x1,y1 and/or x2,y2.
>>>>>>
>>>>>> FromDigits/@Partition[#,3]& /@ Select[Permutations@Range@9,
>>>>>>   #[[1]] < #[[4]] && #[[2]] < #[[5]] && #[[3]] < #[[6]] &&
>>>>>>   #.{100,10,1,100,10,1,-100,-10,-1} == 0 &]
>>>>>>
>>>>>> {{124,659,783}, {125,739,864}, {127,359,486},
>>>>>>  {127,368,495}, {128,439,567}, {134,658,792},
>>>>>>  {142,596,738}, {142,695,837}, {143,586,729},
>>>>>>  {152,487,639}, {152,784,936}, {162,387,549},
>>>>>>  {162,783,945}, {173,286,459}, {173,295,468},
>>>>>>  {182,394,576}, {182,493,675}, {214,569,783},
>>>>>>  {214,659,873}, {215,478,693}, {215,748,963},
>>>>>>  {216,378,594}, {216,738,954}, {218,349,567},
>>>>>>  {218,439,657}, {234,657,891}, {235,746,981},
>>>>>>  {241,596,837}, {243,576,819}, {243,675,918},
>>>>>>  {251,397,648}, {271,593,864}, {271,683,954},
>>>>>>  {281,394,675}, {314,658,972}, {317,529,846},
>>>>>>  {317,628,945}, {324,567,891}, {324,657,981},
>>>>>>  {341,586,927}, {342,576,918}, {352,467,819}}


-- 
DrMajorBob at yahoo.com



  • Prev by Date: Re: Solve - takes very long time
  • Next by Date: average of the consecutive coin tosses
  • Previous by thread: Re: Solve - takes very long time
  • Next by thread: simplification