足して100になるような乱数のアルゴリズム

質問

エクセルで30行に0-4の間の乱数を発生させて合計数を常に100にするにはどうすればいいのでしょうか。
VBAではないのですがやりたいことはCのほうの過去ログにあったのですが
http://oshiete1.watch.impress.co.jp/qa4035587.html
見ても全くわかりませんでした。

回答No.3

watabe007 · ベストアンサー

>エクセルで30行に0-4の間の乱数を発生させて合計数を常に100

乱数　　個数　合計
　　0　　　0
　　1　　　0
　　2　　　0　　　　0
　　3　　20　　　　60
　　4　　10　　　　40　　　０から4の数値、30個の合計が100になる為には
─────────　　4の数値が最低限10個、必要
　　　　　30　　　100

4の出る確率を上げてみました。
Sub Test()
　　Dim v(29)
　　Dim i As Long, n As Long

　　Randomize
　　Do
　　　　For i = 0 To 29
　　　　　　n = Int(Rnd() * 8)
　　　　　　If n > 4 Then n = 4
　　　　　　v(i) = n
　　　　Next
　　Loop Until Application.Sum(v) = 100
　　Range("A1").Resize(30).Value = Application.Transpose(v)
End Sub

お礼

数値を変えてもうまく動きました。教えいただきありがとうございます。簡潔なのと回答が早かったのでこちらをBAにさせていただきました。他の方も教えていただきありがとうございました。

回答No.4

30246kiku

おもしろそうだったのでやってみました。

やってみたのは３パターン
・「test1」
　乱数でどこに、乱数で何（値 1 ～ 4）を、を求めて
　値を設定しないところは 0 のまま
・「test2」
　乱数でどこに、を求めて 1 を加算していく
　最悪無限ループに陥るかも
・「test3」
　test2 の改良バージョン

傾向としては、
test1 は、最大値がでやすい？（乱数でどこ・・・が同じなら加算していたので）
test2 / test3 は平均されやすい？（乱数の発生頻度と同じ？）

0 の出現は、 test2 / test3 では少ない様な気がします。
（乱数なので、そういうものとしても良いのかも）

While 内の実行回数の少ない順（変数 k の値）は、
　test1（100回以下） < test3（100回） < test2（100回以上）
の様な感じ（雰囲気で）

説明は省いても良いですかね

確かめられるのであれば、
　　Const CNUMSUM As Long = 100 ' 合計値
　　Const CROWMAX As Long = 30　' 行数
　　Const CNUMMAX As Long = 4　　' 最大値
の値を変更して、
　CROWMAX * CNUMMAX > CNUMSUM になっていればソコソコ動くと思います。

Public Sub test1()
　　Const CNUMSUM As Long = 100
　　Const CROWMAX As Long = 30
　　Const CNUMMAX As Long = 4
　　Dim iAry(1 To CROWMAX) As Long
　　Dim i As Long, k As Long
　　Dim iNum As Long, iR As Long

　　Randomize
　　For i = 1 To CROWMAX
　　　　iAry(i) = 0
　　Next

　　k = 0
　　iNum = CNUMSUM
　　While (iNum > 0)
　　　　k = k + 1
　　　　i = Int(CROWMAX * Rnd()) + 1
　　　　iR = Int((CNUMMAX) * Rnd()) + 1
　　　　If (iAry(i) + iR > CNUMMAX) Then iR = CNUMMAX - iAry(i)
　　　　If (iR > iNum) Then iR = iNum
　　　　iAry(i) = iAry(i) + iR
　　　　iNum = iNum - iR
　　Wend
　　Debug.Print "k = " & k

　　Range("A1").Resize(CROWMAX) = _
　　　　　　WorksheetFunction.Transpose(iAry)
End Sub

Public Sub test2()
　　Const CNUMSUM As Long = 100
　　Const CROWMAX As Long = 30
　　Const CNUMMAX As Long = 4
　　Dim iAry(1 To CROWMAX) As Long
　　Dim i As Long, k As Long
　　Dim iNum As Long

　　Randomize
　　For i = 1 To CROWMAX
　　　　iAry(i) = 0
　　Next

　　k = 0
　　iNum = CNUMSUM
　　While (iNum > 0)
　　　　k = k + 1
　　　　i = Int(CROWMAX * Rnd()) + 1
　　　　If (iAry(i) < CNUMMAX) Then
　　　　　　iAry(i) = iAry(i) + 1
　　　　　　iNum = iNum - 1
　　　　End If
　　Wend
　　Debug.Print "k = " & k

　　Range("B1").Resize(CROWMAX) = _
　　　　　　WorksheetFunction.Transpose(iAry)
End Sub

Public Sub test3()
　　Const CNUMSUM As Long = 100
　　Const CROWMAX As Long = 30
　　Const CNUMMAX As Long = 4
　　Dim iAry(1 To CROWMAX) As Long, iPos(1 To CROWMAX) As Long
　　Dim i As Long, j As Long, k As Long
　　Dim iNum As Long, iHdn As Long

　　Randomize
　　For i = 1 To CROWMAX
　　　　iAry(i) = 0
　　　　iPos(i) = i
　　Next

　　k = 0
　　iNum = CNUMSUM
　　iHdn = 0
　　While (iNum > 0)
　　　　k = k + 1
　　　　j = Int((CROWMAX - iHdn) * Rnd()) + 1
　　　　i = iPos(j)
　　　　iAry(i) = iAry(i) + 1
　　　　If (iAry(i) >= CNUMMAX) Then
　　　　　　iPos(j) = iPos(CROWMAX - iHdn)
　　　　　　iHdn = iHdn + 1
　　　　End If
　　　　iNum = iNum - 1
　　Wend
　　Debug.Print "k = " & k

　　Range("C1").Resize(CROWMAX) = _
　　　　　　WorksheetFunction.Transpose(iAry)
End Sub

回答No.2

nac03056

「３０個の乱数を並べて１００でなかったらやり直し」ってのが理屈は簡単そうです。

でも、おそらく時間がかかると思うので、合計１００になる状態を作っておいて（例えば１０個４で２０個３みたいな感じ）あとは、好みの回数だけ、ランダムな所から１引いて、ランダムな所に１加えるって作業を繰り返せば、それなりの状況が出来るのではないでしょうか？（もちろん０から１引いたり４に１足したらいけませんからその手の処理は必要です。）

その他であれば、３０カ所の中のランダムな所に１を加えるという作業を１００回繰り返すって方が、速度的には速いかも。（もちろん４だったら１は足しません）

お試しください。

回答No.1

kmee

言語が違っても、同じやり方のプログラムは作れます。

別解:
「1～30の乱数 r を発生させ、 r行目を+1する。既に4なら4でない行になるまで乱数発生を繰り返す」を100回繰り返す