ANo.1です。
ご質問「反復計算をONにしてエクセルで解いてもらう事は出来ないでしょうか?」
ワークシート関数だけの反復計算で解く方法は、思いつきません。簡単なVBAと組み合わせて近似計算する方法ならあります。(1)のようにワークシートに関数を入れておき、(2)のようなVBAを作成して、VBAの「近似」マクロを実行すると、A1からP1に近似結果が格納されます(A>B、B>C、D>Cの条件での期待値)。
(1)
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を入力(もっと大きな数字を入力すると、計算時間が長くなるが、精度は高くなる)
(2)
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
(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
(ANo.2の続きです)
'順列を列挙する
'Populationは、母集団(1次元配列)又は母集団サイズ(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
(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
お礼
ありがとうございます。VBAがわかる人を探していました。ぜひ「VBAで順位の期待値を出したい。」で検索して答えて下さい。カルタ大会で使用しようと思っています。