RandomInteger with equal number of 1 and -1
A combination of IntegerPartitions
, RandomChoice
and 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.
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.
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]
}]