Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

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

Search the Archive

Re: rules on vector sequence

  • To: mathgroup at smc.vnet.net
  • Subject: [mg98084] Re: [mg98018] rules on vector sequence
  • From: DrMajorBob <btreat1 at austin.rr.com>
  • Date: Sun, 29 Mar 2009 02:49:10 -0500 (EST)
  • References: <200903281041.FAA04380@smc.vnet.net>
  • Reply-to: drmajorbob at bigfoot.com

Here's a faster version:

Clear[sums, insertions, insertPositions]
insertPositions[{x__}] := Flatten@Position[Unitize@{x, 1}, 1]
insertions[x : {__List}] := Union @@ insertions /@ x
insertions[x_List] := Insert[x, 0, #] & /@ insertPositions@x
sums[1] = {};
sums[2] = {{-2, 2}, {-1, 1}, {1, -1}, {2, -2}};
sums[3] = Union @@ (Permutations@PadLeft[#, 3, 0] & /@ sums@2);
sums[4] = Module[{nonZero = {-2, -1, 1, 2}},
    Union @@
     Permutations /@
      Join[Select[Tuples@{nonZero, nonZero, nonZero, nonZero},
        0 == Total@# &], insertions@insertions@sums@2]
    ];
sums[n_Integer /; n > 4] :=
  Union @@ (Permutations@PadLeft[#, n, 0] & /@ sums@4)

Timing[new = sums@17; Length@new]

{1.67356, 86224}

Timing[Length@sums@18]

{2.2947, 110772}

Timing[Length@sums@19]

{3.07204, 140220}

Timing[Length@sums@20]

{4.13911, 175180}

This is no longer recursive, so it won't store huge results (and use up  
memory), like the previous solution.

The new, slightly faster "insertions" is not really important, since it's  
used only for sums[4]. The older "insertions" would do just as well.

Bobby

On Sat, 28 Mar 2009 21:50:21 -0500, Filippo Miatto  
<sottosupremo at gmail.com> wrote:

> wow i have to study how this works! ; )
> thanks a lot!
>
> On Mar 28, 2009, at 11:57 PM, DrMajorBob wrote:
>
>> Here's a solution:
>>
>> Clear[sums, insertions]
>> insertions[x : {__List}] := Union @@ insertions /@ x
>> insertions[x_List] := Union[Insert[x, 0, #] & /@ Range[1 + Length@x]]
>> sums[1] = {};
>> sums[2] = {{-2, 2}, {-1, 1}, {1, -1}, {2, -2}};
>> sums[4] = Module[{nonZero = {-2, -1, 1, 2}},
>>   Union @@
>>    Permutations /@
>>     Join[Select[Tuples@{nonZero, nonZero, nonZero, nonZero},
>>       0 == Total@# &], insertions@insertions@sums@2]
>>   ];
>> sums[len_?Positive] := sums[len] = insertions@sums[len - 1]
>>
>> Timing[Length@sums@17]
>>
>> {7.9271, 86224}
>>
>> sums@3
>>
>> {{-2, 0, 2}, {-2, 2, 0}, {-1, 0, 1}, {-1, 1, 0}, {0, -2, 2}, {0, -1,
>>  1}, {0, 1, -1}, {0, 2, -2}, {1, -1, 0}, {1, 0, -1}, {2, -2, 0}, {2,
>>  0, -2}}
>>
>> Length@sums@4
>>
>> 60
>>
>> Length@sums@5
>>
>> 220
>>
>> s6 = sums@6;
>> Length@s6
>> Total /@ s6 // Union
>> Total /@ Unitize@s6 // Union
>> Length@s6 == Length@Union@s6
>>
>> 600
>>
>> {0}
>>
>> {2, 4}
>>
>> True
>>
>> Bobby
>>
>>
>> On Sat, 28 Mar 2009 05:41:26 -0500, Filippo Miatto  
>> <sottosupremo at gmail.com> wrote:
>>
>>> Dear all,
>>> I need to generate all the vectors, of a given length N, that have
>>> these three properties:
>>>
>>> 1- the entries have to be among -2,-1,0,1,2
>>> 2- the sum of all the entries has to be 0
>>> 3- only two or four of the entries can be different from 0
>>>
>>> do you have any suggestions on how i can do that? i tried something
>>> but without success.. expecially i don't know how to implement the
>>> third rule..
>>> thank you in advance!
>>> Filippo
>>>
>>
>>
>>
>> --DrMajorBob at bigfoot.com
>



-- 
DrMajorBob at bigfoot.com


  • Prev by Date: Re: HoldAll for Integrate
  • Next by Date: Re: Option instead of a function argument: is it possible?
  • Previous by thread: Re: rules on vector sequence
  • Next by thread: Re: rules on vector sequence