6
$\begingroup$

I want to generate a list of random integers with only three values 1,0,-1. I know it can be done through RandomInteger[{-1, 1}, n]. How can I impose constraint on this list so that every integers in this list add up to 0?

(I have tried some approaches in Random numbers that sum up to specific value, but they did not work)

$\endgroup$
4
  • 1
    $\begingroup$ Does not the condition that the integers sum to 0 violate their being "random"? $\endgroup$
    – murray
    Jun 18, 2019 at 15:00
  • $\begingroup$ @murray They're not independent, but the whole list is still random I think $\endgroup$
    – Chris K
    Jun 18, 2019 at 15:03
  • 1
    $\begingroup$ You can certainly have a "restricted randomization" such that the sum of the numbers equals zero. But you'll need to add more structure to your request. For example, you could have the probability of selecting -1 and 1 be zero and the probability of 0 being 1. You'd end up with all zeros and satisfy both the randomness and the restriction. You could have the probabilities of -1, 0, and 1 being $p$, $1-2p$, and $p$, respectively, with the added restriction that the sum equal zero. $\endgroup$
    – JimB
    Jun 18, 2019 at 15:40
  • $\begingroup$ Are you interested in uniform sampling of the possible tuples? $\endgroup$
    – Carl Woll
    Jun 18, 2019 at 17:58

4 Answers 4

13
$\begingroup$

A combination of IntegerPartitions, RandomChoiceand RandomSample:

n = 30;
RandomSample @ RandomChoice @ IntegerPartitions[0, {n}, {-1, 0, 1}]

{-1, 1, 1, 1, 1, -1, -1, 0, -1, 1, 1, -1, -1, -1, 1, -1, 1, 1, -1, 0, 1, -1, -1, 1, -1, -1, 1, 1, -1, 1}

Total @ %

0

You can also do

RandomSample @
 PadRight[Flatten @ ConstantArray[{1, -1}, RandomChoice[Range[0, Floor[n/2]]]], n]

{-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, -1, -1, -1, 0, 0, -1, 0, 0, 0, 0, 1, 0}

Total @ %

0

For large n, the second approach is much faster than the first.

$\endgroup$
4
  • $\begingroup$ RandomSample with no second argument gives a random permutation: RandomSample@RandomChoice@IntegerPartitions[0, {n}, {-1, 0, 1}] $\endgroup$
    – Roman
    Jun 18, 2019 at 15:45
  • $\begingroup$ @Roman, thank you; very good point. $\endgroup$
    – kglr
    Jun 18, 2019 at 15:47
  • $\begingroup$ I have strong doubts whether such a sequence can be treated as a random one. In fact we deal with the one-dimensional random walk. $\endgroup$
    – user64494
    Jun 20, 2019 at 10:12
  • $\begingroup$ @user64494, i also have difficulty wrapping my mind around "random with restrictions" when restrictions depend on the whole thing (as opposed to individual elements). $\endgroup$
    – kglr
    Jun 20, 2019 at 10:27
6
$\begingroup$

If you want to sample uniformly from all possible tuples that sum to 0, you can do the following:

zero[n_] := With[
    {
    ones = RandomChoice[
        Table[Multinomial[i,i,n-2i], {i,0,Floor[n/2]}] -> Range[0,Floor[n/2]]
    ]
    },

    RandomSample @ PadRight[
        Join[ConstantArray[1,ones],ConstantArray[-1,ones]],
        n
    ]
]

For example, here's a tally of the random 4-tuples summing to 0:

SeedRandom[1];
Tally @ Table[zero[4], 10^5]

{{{1, 1, -1, -1}, 5215}, {{-1, 1, 0, 0}, 5353}, {{-1, -1, 1, 1}, 5381}, {{1, -1, 0, 0}, 5167}, {{1, -1, -1, 1}, 5169}, {{0, 1, 0, -1}, 5189}, {{0, -1, 1, 0}, 5311}, {{-1, 1, -1, 1}, 5263}, {{0, -1, 0, 1}, 5376}, {{0, 0, 1, -1}, 5268}, {{1, 0, -1, 0}, 5303}, {{0, 0, 0, 0}, 5218}, {{1, 0, 0, -1}, 5220}, {{1, -1, 1, -1}, 5095}, {{0, 0, -1, 1}, 5245}, {{-1, 0, 0, 1}, 5313}, {{-1, 1, 1, -1}, 5253}, {{0, 1, -1, 0}, 5264}, {{-1, 0, 1, 0}, 5397}}

Looks pretty close to uniform sampling.

As a comparison, note the distribution using the accepted answer:

nonuniform[n_] := RandomSample @ PadRight[
    Flatten@ConstantArray[{1,-1},RandomChoice[Range[0,Floor[n/2]]]],
    n
]

Tally @ Table[nonuniform[4], 10^5]

{{{-1, 0, 1, 0}, 2739}, {{0, 0, 0, 0}, 33695}, {{0, 1, 0, -1}, 2771}, {{-1, -1, 1, 1}, 5682}, {{0, 0, 1, -1}, 2807}, {{1, -1, 0, 0}, 2697}, {{0, 0, -1, 1}, 2790}, {{-1, 0, 0, 1}, 2765}, {{-1, 1, 0, 0}, 2738}, {{0, -1, 0, 1}, 2654}, {{-1, 1, -1, 1}, 5482}, {{1, -1, -1, 1}, 5555}, {{0, -1, 1, 0}, 2768}, {{1, 0, -1, 0}, 2721}, {{-1, 1, 1, -1}, 5519}, {{1, 1, -1, -1}, 5512}, {{0, 1, -1, 0}, 2727}, {{1, 0, 0, -1}, 2710}, {{1, -1, 1, -1}, 5668}}

Not very uniform.

$\endgroup$
2
$\begingroup$

Given the lack of details in your specification, I suspect the following very simple approach will be adequate to your needs:

zeroSum[n_] := With[{
   n3 = Floor[n/3]
   },
  RandomSample@Catenate@{
     ConstantArray[-1, n3],
     ConstantArray[1, n3],
     ConstantArray[0, n - 2*n3]
     }]
$\endgroup$
2
$\begingroup$

Since probability to get zero sum at random is quite high, you can generate several random lists and choose one with zero sum. For example using NestWhile:

zeroSum[n_] := NestWhile[RandomInteger[{-1, 1}, n]&, 1, (Total[#]!=0)&];

Re-generating large lists is however not very effecient. Thus, you can generate one list and modify several elements (at random positions) to make the sum vanish. To make this approach even faster you can use Compile:

ClearAll[zeroSumCompiled];
zeroSumCompiled = Compile[{{n, _Integer}},
    Module[{randomList, total, randomPosition, randomElement, delta},
        randomList = RandomInteger[{-1,1}, n];
        total = Total@randomList;
        delta = -Sign[total];
        While[total!=0,
            randomPosition = RandomInteger[{1,n}];
            randomElement = randomList[[randomPosition]];
            If[Abs[randomElement+delta]<=1,
                randomList[[randomPosition]] = randomList[[randomPosition]] + delta;
                total = total + delta
                ]
            ];
        randomList
        ]
    ];

Comparing timings with kglr's method for large lists:

kglrsMethod[n_] := RandomSample@PadRight[Flatten@ConstantArray[{1, -1}, RandomChoice[Range[0, Floor[n/2]]]], n]

RepeatedTiming[kglrsMethod[10000];]

{0.00041, Null}

RepeatedTiming[zeroSumCompiled[10000];]

{0.000068, Null}

I.e. zeroSumCompiled is about 5 times faster than kglrsMethod for large lists.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.