RandomInteger with equal number of 1 and -1

Question

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)

Answer 1

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.

Answer 2

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.

Answer 3

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]
     }]

Answer 4

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.