エクセルを使って位置の平均を効率良く出したいです。

質問

0から1に無限に人が均等に分布しているものとし、無限人中1位が限りなく1に近付き、無限人中ビリが限りなく0に近付くものとします。無限人の平均は1/2、ランダムに選ばれた2人で大きい方の平均は2/3、小さい方は1/3です。2度大きい方を選び、その選ばれた2人のうち大きい方は4/5、小さい方は8/15です。このような平均をエクセルを使って出したいのですが何か方法はないでしょうか？計算式が必要になるかと思います。無限人中16人を選び出しA1からP1に平均が出るようにしたいです。A1の入れ方と大小の条件の入れ方お願いします。大小の条件とはA1>B1、B1>C1、D1>C1などです。ちなみにこの場合A1から11/15、7/15、1/5、3/5になるかと思います。計算式はA1からP1を使った方程式になるかもしれません。

回答No.5

ramayana · ベストアンサー

ANo.1です。

ご質問「反復計算をONにしてエクセルで解いてもらう事は出来ないでしょうか？」

ワークシート関数だけの反復計算で解く方法は、思いつきません。簡単なVBAと組み合わせて近似計算する方法ならあります。（１）のようにワークシートに関数を入れておき、（２）のようなVBAを作成して、VBAの「近似」マクロを実行すると、A1からP1に近似結果が格納されます（A>B、B>C、D>Cの条件での期待値）。

（１）
A1からP1に、「=A3/$A$12」、…、「=P3/$A$12」と入力
A4からP4に、「=RAND()」、…、「=RAND()」と入力
A6に「=(A4>B4)」、A7に「=(B4>C4)」、A8に「=(D4>C4)」と入力
A10に「=AND(A6, A7, A8)」と入力
A12に数字1000を入力（もっと大きな数字を入力すると、計算時間が長くなるが、精度は高くなる）

（２）
Sub 近似()
　　Const N As Integer = 16
　　Dim TMax As Integer
　　 Dim T As Integer
　　Dim i As Integer
　　TMax = Cells(12, 1) 'A12
　　 Range(Cells(3, 1), Cells(3, N)).ClearContents
　　Do While T < TMax
　　　　Application.ActiveSheet.Calculate
　　　　Application.Calculation = xlCalculationManual
　　　　If Cells(10, 1) Then　 'A10
　　　　　　　 For i = 1 To N
　　　　　　　　　 Cells(3, i) = Cells(3, i) + Cells(4, i)
　　　　　　　Next i
　　　　　　　 Cells(12, 2) = T 'B12
　　　　 End If
　　 Loop
End Sub

回答No.4

ramayana

（ANo.3の続きです）

Private Function Prv_NextNumber(Sample As Variant, N As Long, Place As Long, Value) As Long
Dim i As Long
Dim j As Long
For j = Value + 1 To N
For i = Place To 1 Step -1
If Sample(i) = j Then Exit For
Next i
If i = 0 Then Exit For
Next j
If j <= N Then Prv_NextNumber = j
End Function

お礼

ありがとうございます。VBAがわかる人を探していました。ぜひ「VBAで順位の期待値を出したい。」で検索して答えて下さい。カルタ大会で使用しようと思っています。

回答No.3

ramayana

（ANo.2の続きです）

'順列を列挙する
'Populationは、母集団（１次元配列）又は母集団サイズ（Long型）
'kは、サンプルサイズ
Function Permutations(Population As Variant, ByVal k As Long) As Variant
Dim Res As Variant
Dim Sample As Variant
Dim N As Long '母集団サイズ
Dim G As Long 'サンプルの個数
Dim i As Long
Dim j As Long
Dim Shift As Long
If IsArray(Population) Then
N = UBound(Population) - LBound(Population) + 1
Else
N = Population
End If
G = N - k + 1
For i = N - k + 2 To N
G = G * i
Next i
ReDim Res(1 To G)
ReDim Sample(1 To k)
For i = 1 To k
Sample(i) = i
Next i
Res(1) = Sample
j = 1
Do
Sample = Prv_NextSample(Sample, N)
If VarType(Sample) = vbEmpty Then
Exit Do
Else
j = j + 1
Res(j) = Sample
End If
Loop
If IsArray(Population) Then
Shift = LBound(Population) - 1
For j = 1 To UBound(Res)
For i = 1 To k
Res(j)(i) = Population(Res(j)(i) + Shift)
Next i
Next j
End If
Permutations = Res
End Function

Private Function Prv_NextSample(Sample As Variant, N As Long) As Variant
Dim k As Long
Dim i As Long
Dim j As Long
Dim l As Long
Dim Res As Variant
k = UBound(Sample)
ReDim Res(1 To k)
For i = k To 1 Step -1
l = Prv_NextNumber(Sample, N, i, Sample(i))
If l > 0 Then Exit For
Next i
If i > 0 Then
For j = 1 To i - 1
Res(j) = Sample(j)
Next j
Res(i) = l
For j = i + 1 To k
Res(j) = Prv_NextNumber(Res, N, j, 0)
Next j
Prv_NextSample = Res
End If
End Function

お礼

すごいですね。僕にはさっぱりわかりません。A1からP1にA1からP1を使った方程式を入力し、反復計算をONにしてエクセルで解いてもらう事は出来ないでしょうか？まず方程式がわかりませんが。

回答No.2

ramayana

（ANo.1 の続きです。）

Sub Main()
Const N As Integer = 4 '条件に現れる人数
Dim CaseCount As Integer '条件に合致するケースの数
Dim Perms As Variant 'すべてのケース
Dim Incidents(1 To N, 1 To N) As Integer '条件に合致するケース
Dim AV(1 To N) As Double '期待値
Dim i As Integer
Dim j As Integer
Dim PermsTop As Range
Dim IncidentsTop As Range
Dim AVTop As Range
'出力領域の設定
With ActiveSheet
Set PermsTop = Cells(3, 2)
Set IncidentsTop = PermsTop(1, N + 3)
Set AVTop = IncidentsTop(N + 1, 1)
PermsTop(-1, 0) = "すべてのケース"
IncidentsTop(-1, 0) = "条件に合致するケース"
For j = 1 To N
PermsTop(0, j) = Chr(j + 64)
IncidentsTop(0, j) = Chr(j + 64)
IncidentsTop(j, 0) = "順位" & j
AVTop(1, 0) = "期待値"
Next j
End With
'すべてのケースを列挙
Perms = Permutations(N, N)
'条件に合致するケースを抜き出す
For i = 1 To UBound(Perms)
For j = 1 To N
PermsTop(i, j) = Perms(i)(j)
Next j
'If文の条件式は、問題に応じて変更する
If _
Perms(i)(1) > Perms(i)(2) _
And Perms(i)(2) > Perms(i)(3) _
And Perms(i)(4) > Perms(i)(3) _
Then
CaseCount = CaseCount + 1
For j = 1 To N
Incidents(Perms(i)(j), j) = Incidents(Perms(i)(j), j) + 1
PermsTop.Parent.Range(PermsTop(i, 1), PermsTop(i, N)).Interior.ColorIndex = 3
Next j
End If
Next i
'期待値の計算
For j = 1 To N
For i = 1 To N
IncidentsTop(i, j) = Incidents(i, j)
AV(j) = AV(j) + i * Incidents(i, j)
Next i
AV(j) = AV(j) / (CaseCount * (N + 1))
AVTop(1, j) = AV(j)
Next j
End Sub

回答No.1

ramayana

「16人を選び出しA1からP1に平均が出るようにしたいです」の意味が、はっきりしません。

１　もし、1番目の人の平均、2番目の人の平均、…、16番目の人の平均を出したいなら、それぞれ、1/17、2/17、…、16/17にすれば良いだけです。

一般に、0から1の間で、一様に分布し、かつ独立な確率変数を値に持つn人を、小さいほうから順番に並べたとき、k番目の人の値の期待値（平均）E(n, k)は、

[1]　E(n, k) = k/(n+1)

で与えられます（証明は後述）。

２　もし、何らかの大小関係を満たすような条件の下で、それぞれの期待値を計算したいなら、基本的には[1]式を使うのですが、計算が複雑になります。例として、A>B、B>C、D>Dの場合に期待値を計算するVBAプログラムを示します。

Mainの中の、Nの値と、If文の条件式を変えることにより、いろいろな問題に対応できます。ただ、Nが小さいときに限られます。N=16だと、多分、動きません。

「2度大きい方を選び、その選ばれた2人のうち大きい方は4/5、小さい方は8/15」といった計算なら、プログラムの

　　　　　Perms(i)(1) > Perms(i)(2) _　
　 And Perms(i)(2) > Perms(i)(3) _
　 And Perms(i)(4) > Perms(i)(3)

の部分を

　　　　　Perms(i)(1) > Perms(i)(2) _　
　 And Perms(i)(3) > Perms(i)(4) _
　 And Perms(i)(1) > Perms(i)(3)

に変えます。

３　[1]式の証明

k番目の人の値がXであるということは、n人中k-1人がXより小さく、n-k人がXより大きいということです。また、

（１）　k番目の人を選ぶ選び方はn通り。

（２）　k番目の人が一人選ばれたという条件の下で、順位が上のk-1人を選ぶ選び方は、n-1からk-1を選ぶ組み合わせの数に等しく、(n-1)!/((k-1)!(n-k)!)通り。

（３）　残りのn-k人は、（１）と（２）が定まれば、自動的に定まり、１通りだけ。

（４）　ある人の値がXだったとして、すでに選ばれたk-1人の値がXより小で、残りn-k人の値がXより大である確率は、X^(k-1)(1-X)^(n-k)。

以上のことと、ベイズの定理を使って、k番目の人の値Xの確率密度関数f(u)は、

　　f(u) = n(n-1)!/((k-1)!(n-k)!)×u^(k-1)(1-u)^(n-k)

となります。Xの期待値E(n, k)は、

　　E(N, k) = ∫[0 to 1]uf(u)du

なので、右辺の積分を計算して、[1] 式が得られます。