Generate a random pattern with at-most n repeated consecutive elements
How about this?
rand[sample_, size_, n_] := Module[{
rs = RandomChoice[sample, RandomInteger[{0, n}]],
rand0},
rand0 =
NestList[RandomChoice[Delete[sample, #]] &, RandomChoice[sample],
size - 1 - Length[rs]];
Fold[Insert[#1, #2, RandomChoice[Position[#1, #2]]] &, rand0, rs]
]
Update: Borrowing part of swish's answer to generate consecutive-free samples and using it with Part
assignment (rand2
) and ReplacePart
(rand3
):
ClearAll[consecutiveFreeRandom , rand2,rand3]
consecutiveFreeRandom[sample_,size_]:= NestList[RandomChoice[Delete[sample, #]] &,
RandomChoice[sample], size-1]
rand2[sample_, size_, n_] := Module[{rpt = RandomInteger[{0, n}], pos, rand0},
pos = RandomSample[Range[size - rpt], rpt] ;
rand0 = consecutiveFreeRandom[sample, size - rpt];
rand0[[pos]] = Transpose[{rand0[[pos]], rand0[[pos]]}]; Flatten @ rand0 ]
rand3[sample_, size_, n_] := Module[{rpt = RandomInteger[{0, n}], pos, rand0},
pos = RandomSample[Range[size - rpt], rpt] ;
rand0 = consecutiveFreeRandom[sample, size - rpt] ;
rand0 = ReplacePart[rand0, # -> Sequence[rand0[[#]], rand0[[#]] ]& /@ pos]]
Examples:
SeedRandom[1]
rand2[Range@3, 20, 2]
{1, 2, 2, 3, 1, 3, 2, 3, 1, 3, 2, 1, 2, 1, 3, 2, 2, 1, 3, 2}
SeedRandom[1]
list = CharacterRange["A", "C"];
list[[rand2[Range @ Length @ list, 20, 2]]]
{"C", "A", "A", "B", "A", "B", "A", "B", "C", "B", "C", "A", "B", "A", "B", "A", "B", "A", "B", "C"}
SeedRandom[1]
rand3[Range@2, 30, 5]
{1, 2, 1, 2, 1, 2, 1, 1, 2, 1, 2, 1, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 2, 1, 1, 2}
By selecting positions up to the allowed number of consecutives from the positions in the consecutive-free sample and repeating the elements in those positions, (1) rand2
and rand3
avoid the potential error that rand
produces (when Position[#, #2]
in its last line is {}
) and (2) they are faster than rand
when the bound on the number of consecutives is large.
timings = ArrayReshape[Table[{i, ss, rp,
First[RepeatedTiming[Quiet@rand[Range[i], ss, rp]]] ,
First[RepeatedTiming[rand2[Range[i], ss, rp]]] ,
First[RepeatedTiming[rand3[Range[i], ss, rp]]] },
{i, {5, 100}}, {ss, {1000, 10000}}, {rp, {0, 1, 10, 500}}], {16, 6}];
timings[[All,{4, 5, 6}]] = NumberForm[#, {7, 5}]& /@ # & /@ timings[[All,{4, 5, 6}]];
Join[{{"input", "sample", "max number of", "timings", SpanFromLeft,
SpanFromLeft}, {"range", "size", "consecutives",
Item["rand", Frame -> True], Item["rand2", Frame -> True],
Item["rand3", Frame -> True]}}, table] //
Grid[#, Alignment -> Center, Dividers -> {All, {Range[25], {2 -> None}}}] &
Original answer:
ClearAll[f]
f = Module[{}, While[Count[Differences[rc = RandomChoice[#, #2]], 0] > #3,
rc = RandomChoice[#, #2]]; rc] &;
Alternatively, you can use Total[1 - Unitize[Differences[rc = RandomChoice[#, #2]]]] > #3
in place of Count[Differences[rc = RandomChoice[#, #2]], 0] > #3
.
SeedRandom[1]
f[Range@4, 10, 0]
{2, 3, 1, 4, 3, 4, 1, 3, 4, 1}
f[Range@4, 20, 2]
{4, 3, 2, 3, 4, 4, 3, 4, 1, 3, 3, 2, 4, 2, 3, 4, 1, 2, 3, 1}