Services & ResourcesWolfram ForumsMathGroup Archive

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

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

• References:
  • rules on vector sequence
    • From: Filippo Miatto <sottosupremo@gmail.com>