神経衰弱では先攻と後攻のどちらが有利か？
突然ですが、あなたが友人と１対１で、神経衰弱をするとします。
勝負に勝ちたいとき、先攻を選びますか？それとも後攻を選びますか？
先攻の場合、１回目で２枚のカードをめくるとき、ペアができる確率は79/1431（≒5.52%）です。
後攻の場合、２枚のカードを知った状態でめくるのですから、ペアができる確率は高まります。ただ、それでも大して高い値ではなく、ほとんどの場合、ペアはできません。
ここで順番が先攻に回ってきます。今度は４枚のカードの数を知った状態でめくるので、ペアの出来る確率が更に高まります。
つまり、ペアができる確率は後になるにつれてだんだん高くなりそうです。この点からすると、後攻の方が有利そうです。その反面、先攻は、後攻より順番が回ってくる回数が多いので、その点で、先攻の方が有利そうです。
一体、先攻と後攻のどちらを選べばいいのでしょう？
確率で厳密に解くこともできるでしょうが、あまりにも複雑です。
そこで、Excelでモンテカルロ法を用いて検討してみました。モンテカルロ法は、乱数を用いたシミュレーションです。
ただし、ゲームの条件は次のようにしました。
- ジョーカーを含む54枚で競技を行うこと
- あなたと相手は、めくったカードを全て覚えられる記憶力の持ち主であること
です。
シミュレーションに用いたコードを以下に示します。
ExcelシートからVisual Basicを起動し、標準モジュールにコードをコピーペーストしたら、「勝負」マクロを実行してみて下さい。
なお、このマクロは、コンピュータ同士が対戦するシミュレーション用ソフトです。人間がゲームすることはできません。
Option Explicit
Private Const m_cstSuit As String = "A" ' A列: スート
Private Const m_cstNumber As String = "B" ' B列: カードの番号
Private Const m_cstOwner As String = "C" ' C列: 所有者
Private Const m_cstGame As String = "E" ' E列: 勝負の回数
Private Const m_cstWinner As String = "F" ' F列: 勝者
Private Sub カードを並べる()
Dim i As Integer ' 制御変数
Dim j As Integer ' 制御変数
Dim strSuit As String ' シャッフル用変数
Dim strNumber As String ' シャッフル用変数
' 作業列のクリア
Range(m_cstSuit & ":" & m_cstOwner).Clear
' ジョーカ以外のカードの準備。配列番号の"+1"は１行目のタイトル行を考慮
For i = 1 To (13 * 4)
Select Case (i - 1) \ 13
Case 0: Range(m_cstSuit & i + 1).Value = "C"
Case 1: Range(m_cstSuit & i + 1).Value = "D"
Case 2: Range(m_cstSuit & i + 1).Value = "H"
Case 3: Range(m_cstSuit & i + 1).Value = "S"
Case Else
End Select
Select Case i Mod 13
Case 1: Range(m_cstNumber & i + 1).Value = "A"
Case 11: Range(m_cstNumber & i + 1).Value = "J"
Case 12: Range(m_cstNumber & i + 1).Value = "Q"
Case 0: Range(m_cstNumber & i + 1).Value = "K"
Case Else: Range(m_cstNumber & i + 1).Value = i Mod 13
End Select
Next i
' ジョーカの準備
Range(m_cstSuit & "54").Value = "J"
Range(m_cstNumber & "54") = "oker"
Range(m_cstSuit & "55").Value = "J"
Range(m_cstNumber & "55") = "oker"
' 乱数の初期化
Randomize
' 1行目はタイトルなので2行目から最終行までシャッフルする
For i = 2 To Range(m_cstSuit & Rows.Count).End(xlUp).Row
' 1～54までの乱数を発生。さらにタイトル行分の１を加える
j = Int(Rnd * 54 + 1) + 1
' 対象行と乱数の行を入れ替えることでシャッフル
strSuit = Range(m_cstSuit & i).Value
Range(m_cstSuit & i).Value = Range(m_cstSuit & j).Value
Range(m_cstSuit & j).Value = strSuit
strNumber = Range(m_cstNumber & i).Value
Range(m_cstNumber & i).Value = Range(m_cstNumber & j).Value
Range(m_cstNumber & j).Value = strNumber
Next i
End Sub
Private Sub 対戦する(ByVal intNumberOfPaticipants As Integer)
Dim blnMatch As Boolean ' ペアが揃ったことを示すフラグ
Dim intCard As Integer ' 処理対象のカード番号
Dim intPaticipant As Integer ' ゲームをしている選手
Dim intTurn As Integer ' めくっているカードの枚数
Dim j As Integer ' 作業変数
' 1番目の人がゲームを始める
intPaticipant = 1
' 処理対象とするカード番号を1番にする
intCard = 1
' 処理対象のカードは１番目の人にとって１枚目である
intTurn = 1
' カードが無くなるまでループ
Do
' １枚目をめくる処理が終了するまでループ
Do
' まだペアは見つかっていない
blnMatch = False
' intCardが示すカードと既にめくられたカードでペアを確認する
For j = 1 To intCard - 1 ' intCard <= 1ならループに入らない
' 以下、配列番号の"+1"は１行目のタイトル行分を考慮している
' 確認中のカードが誰のものでもない場合に処理を続行
If Range(m_cstOwner & (j + 1)).Value = "" Then
' 番号を比較して、ペアになるか確認する
If Range(m_cstNumber & (j + 1)).Value _
= Range(m_cstNumber & (intCard + 1)).Value Then
' ペアの場合、カードのそれぞれに所有者を設定する
Range(m_cstOwner & (j + 1)).Value = intPaticipant
Range(m_cstOwner & (intCard + 1)).Value = intPaticipant
' ペアが見つかったという意味のフラグを上げる
blnMatch = True
' 高速化のため、Forループを終了する
Exit For
End If
End If
Next j
' 次のカードに移動
intCard = intCard + 1
' 処理対象のカード番号がトランプの枚数を越えたら終了する
If intCard > 54 Then Exit Sub
' カードをめくる枚数をインクリメント
intTurn = intTurn + 1
' ただし、ペアが見つかった場合、次は１枚目をめくることになる
If blnMatch = True Then intTurn = 1
Loop Until intTurn >= 2
' ２枚目をめくる処理では、１枚目とペアであるか確認する
If Range(m_cstNumber & (intCard + 1)).Value _
= Range(m_cstNumber & intCard).Value Then
' ペアである場合には、カードのそれぞれに所有者を設定する
Range(m_cstOwner & (intCard)).Value = intPaticipant
Range(m_cstOwner & (intCard + 1)).Value = intPaticipant
' 選手を交代せずに処理対象のカード番号を進める
intCard = intCard + 1
' 処理対象のカード番号がトランプの枚数を越えたら終了する
If intCard > 54 Then Exit Sub
' ペアが見つかったので、次は１枚目をめくることになる
intTurn = 1
Else
' ペアが見つからなかったら選手交代。処理対処のカード番号はそのまま
intPaticipant = intPaticipant Mod intNumberOfPaticipants + 1
' 次の人は、１枚目をめくる前に今回の２枚目とのペア確認ができる
intTurn = 0
End If
Loop
End Sub
Private Sub 判定する( _
ByVal intNumberOfPaticipants As Integer, _
ByVal intGameNumber As Integer)
Dim blnJoin As Boolean ' ゲームに参加できたことを示すフラグ
Dim i As Integer ' 制御変数
Dim intOffset As Integer ' 個人成績を表示するための列方向のオフセット
Dim intWinner As Integer ' 勝者
Dim strPair() As String ' ペア取得数
' ペア取得数を保持する配列サイズを確保
ReDim strPair(1 To intNumberOfPaticipants)
' 暫定勝者を第１番目の人とする
intWinner = LBound(strPair)
' ペアの数を数える
For i = LBound(strPair) To UBound(strPair)
strPair(i) = WorksheetFunction.CountIf(Range(m_cstOwner & ":" & m_cstOwner), i) / 2
' もし、この選手の取得数が暫定勝者以上なら暫定勝者交代
If Val(strPair(i)) >= Val(strPair(intWinner)) Then intWinner = i
Next i
' 結果を表示する
Range(m_cstGame & intGameNumber + 1).Value = intGameNumber
Range(m_cstWinner & intGameNumber + 1).Value = intWinner
' 個別成績表示用の列方向のオフセット量を求める
intOffset = Asc(m_cstWinner) - Asc(m_cstSuit) + 1
' ゲームに参加できたプレーヤの発見フラグを降ろしておく
blnJoin = False
' ゲームに参加できていない人は表示をさせないように、逆順で表示する
For i = UBound(strPair) To LBound(strPair) Step -1
' ペア取得が0でない人が現れたら、その人から前の人はゲームに参加している
If strPair(i) <> 0 Then blnJoin = True
' ペア取得数を表示する
If blnJoin = True Then
Cells(intGameNumber + 1, intOffset + i).Value = strPair(i)
End If
Next i
End Sub
Public Sub 勝負()
Const cstTitleRow As Integer = 1 ' 1行目はタイトル
Const cstNumberOfPaticipants As Integer = 2 ' 参加選手人数
Const cstNumberOfGames As Integer = 100 ' 勝負の回数
Dim i As Integer ' 制御変数
Dim intOffset As Integer ' 個人成績を表示するための列方向のオフセット
' 指定した回数だけ勝負を実施する
For i = 1 To cstNumberOfGames
Call カードを並べる
Call 対戦する(cstNumberOfPaticipants)
Call 判定する(cstNumberOfPaticipants, i)
Next i
'シートにタイトルをつける
Range(m_cstSuit & cstTitleRow).Value = "スート"
Range(m_cstNumber & cstTitleRow).Value = "番号"
Range(m_cstOwner & cstTitleRow).Value = "所有者"
Range(m_cstGame & cstTitleRow).Value = "回数"
Range(m_cstWinner & cstTitleRow).Value = "勝者"
' 成績表示用の列方向のオフセット量を求める
intOffset = Asc(m_cstWinner) - Asc(m_cstSuit) + 1
For i = 1 To cstNumberOfPaticipants
Cells(cstTitleRow, intOffset + i).Value = i & "人目"
Next i
' 列の幅を整える
Columns.AutoFit
' セルの書式を中央揃えにする
Cells.HorizontalAlignment = xlCenter
End Sub
簡単なゲームなのに、VBAのアルゴリズムはなかなか複雑で、３回くらい書き換えました。
神経衰弱を２人で戦ったときの勝敗シミュレーション結果
それはともかくとして、２人で対戦した時の実行結果は、だいたいこんな感じになります。
（モンテカルロ法は乱数を用いるので、結果は毎回異なります。）
E列とF列にそれぞれ勝負の回数とその時の勝者が表示されます。
他の列の見方は、以下の通りです。
A列とB列は、行ごとに組合せることで、１枚のカードを示します。
2列目はハートの2で、3列目はダイヤの9といった具合です。
神経衰弱にスート（マーク）は関係ありませんが、雰囲気作りです。
また、将来、色が一緒なら取れるというような拡張に使うことができます。
C列は、このカードを取ったプレーヤーを示しています。
5列目のクラブの5と7列目のダイヤの5はペアであって、それを１番目のプレーヤが取ったことになります。
G列、H列はそれぞれ１番目、２番目のプレーヤが取得したペア数です。
54枚で戦っているので、全部で27ペアです。14ペア以上取れれば勝ちです。
例として100回勝負をさせてみたところ、１番目のプレーヤ（先攻）が勝った回数が51回、２番目のプレーヤ（後攻）が勝った回数が49回でした。この試行例では先攻の勝率が勝りました。
ただし、100回程度では、試行によって、後攻の勝率が高い場合も出てきます。
結論としては、人間がやる勝負の場合、記憶力の良い方が勝ちます。記事を終わります。
人数を多くした場合の結果
でも、それじゃつまらないですね。
せっかく、お越しいただいたのに、結論が貧弱過ぎます。
そこで、人数を多くした場合はどのようになるか試してみましょう。
人数は、勝負のサブルーチンの定数を変えることで変更できます。
今回は、次のように変更して、22人での対戦にしてみましょう。
Const cstNumberOfPaticipants As Integer = 22 ‘ 参加選手人数
更に、精度を高めるため、勝負の数も1000回くらいに増やしてみましょう。
Const cstNumberOfGames As Integer = 1000 ‘ 勝負の回数
これで、再度シミュレーションしてみます。
E列からAA列くらいまで、ずらりと数字が入ります。
それぞれの列の合計を取り、勝負数の1000で割ると、各プレーヤの一回当たりの取得ペア数が計算できます。
神経衰弱の獲得ペア数の期待値
取得ペア数の分布をグラフに表してみました。
今回のシミュレーションでは、一人目は0.064ペア取得しています。すなわち、ペアができる確率は6.4%で、あらかじめ計算していた5.52%より1割6分増しです。でも、モンテカルロ法の精度はあまり良くないので、まずまず一致しているといえるでしょう。
1番目から７番目のプレーヤくらいまでは約0.2ペア/番ずつリニアに上がっていきます。
8番目から13番目のプレーヤくらいまでは、後の順番になるにつれて若干増加していくものの、ほぼ1.5ペアくらいのところにあります。
中盤戦で順番がまわってきたら、いくら記憶力が良くても１～２ペア取れれば恩の字といったところです。
14番目くらいから急に取れる数が増え始め、17番目のプレーヤが最大で、平均して2.868ペア取れることになります。これくらい人数がいる場合、３ペア取れればほぼ勝てそうです。
18番目のプレーヤからは取れる数が減り始めます。21番目のプレーヤは、ゲームができる可能性が少しはあります。でも、22番目のプレーヤには順番が回ってきません。
うーん、面白いなぁ、この形。
僕のハンドルネームを取って、「みすくの分布」なんて、ネーミングされないかなぁ。
以上の結果から、大勢で神経衰弱をやる場合には、17番目になって、勝てる確率を高めてください。
ここで、改めて、対戦相手が２人の場合を考えてみます。
先攻はこの曲線の奇数番目のペア獲得数の和、後攻は偶数番目のペア獲得数の和が取得できる訳です。
6人で神経衰弱をする場合の獲得ペア数の期待値
同様に６人で対戦する場合は、１番目のプレーヤは、曲線の順番を６で割って１余ったところのペア獲得数の和、２番目のプレーヤは６で割って２余ったところのペア獲得数の和のペアを獲得できます。
この計算をすると、６人で対戦する場合は、５番目のプレーヤになるのが最も有利だということが分かります。２番目になってはいけません。
まとめ
是非このシミュレーションシステムを有効に使い、さりげなく有利な順番のところに陣取って神経衰弱を戦って下さい。
コメント