3体問題

日常の数学・物理    ーー それでも地球はまわっている



サッカー1次突破


■Wカップ初戦の勝者は、1次リーグ突破の確率が87%にもなるという。 これって普通のことだろうか?
  ※4チームが総当りし、上位2チームが勝ち抜けとする。
    勝てば、勝ち点3。 引分けは、勝ち点1。 負けは、勝ち点0。

★条件1:4チームが完全に互角の力を持っているとする。
★条件2:引分け試合になる可能性が、30%であるとする。(サッカーは、互いに無得点のドローが多い)
★条件3:最終的に勝ち点が同じの場合は、くじ引きで勝ち抜けを決める。・・・実際は、得失点差だけど。

1000回試行の結果: 76.2%

ちなみに 引分けになる可能性を99%に引き上げると 10000回試行の結果 100%でした。
逆に、引分け条件を0%にすると 10000回試行の結果 71.57 %でした。
※尚、引分け100%では除算ゼロエラーがでます(初戦で勝ったチームも負けたチ-ムもいないため)

十進BASIC

! 本大会サッカー シミュレーション                 十進BASIC
! 1次リーグの勝者は、2次リーグへ87%の確率で進出しているが普通のことだろうか?
! こんなに大きな確率になるのは、
! 1)1回戦を勝つようなチームは、二回戦以降も勝ち決勝リーグ進出するものが含まれる
! 2)1回勝つことで勝ち点3からはじめられる。 あわせて、サッカーでは引き分けが多い。
! 等が考えられる。
! もし、4チームが同じ力を持っているとしてどうだろう?
! 但し、引分けの可能性が、30%とする。

! Win 勝ち点3 Lose 勝ち点 0 引分け 1
RANDOMIZE
DIM No$(4),No(4),No3(4)

! 総当りで試合をさせる 日本 ブラジル クロアチア オーストラリア JAPN BRGL CROA AUST
DO
   INPUT PROMPT "引分けの起こる確率は?(何%?:0~100%)":HIKIWAKE
LOOP WHILE 0>HIKIWAKE OR HIKIWAKE>100  ! 引分けの起こる確率 0~100%

! ------初期設定-------
LET Kaisu=1000 !  試行回数
! ------初期設定-------

FOR k=1 TO Kaisu
   PRINT ""
   PRINT "施行";k;"回目"
   CALL ini !初期化
    
   PRINT "★初戦"
   CALL war_1st !初戦
   PRINT "★第2戦"
   CALL war_2nd !第2戦
   PRINT "★第3戦"
   CALL war_3rd !第3戦
    
    
   CALL SORT !バブルソートし上位順に並べ替えする
   CALL NOT_EQ ! 不等号の数の調査
    
   IF EQ_CNT=0 THEN CALL NTEQ0 ! A=B=C=D 不等号なし くじ必要
   IF EQ_CNT=1 THEN CALL NTEQ1 ! A>B=C=D A=B=C>D A=B>C=D 不等号1つ くじ必要・不要
   IF EQ_CNT=2 THEN CALL NTEQ2 ! A>B=C>D A>B>C=D 不等号2つ くじ必要・不要
   IF EQ_CNT=3 THEN ! 不等号3つ くじ不要
      LET FST=1
      LET SND=2
   END IF
    
   PRINT "勝ち抜けチーム="; No$(FST);No(FST);No$(SND);No(SND)
    
   CALL CNT !初戦に勝ち、進出、非進出で加算する
NEXT k

PRINT Kaisu;"施行中"
PRINT "勝率=";SUMWIN_WIN/(SUMWIN_WIN+SUMWIN_LOSE)*100;"%"
PRINT "負け率=";SUMWIN_LOSE/(SUMWIN_WIN+SUMWIN_LOSE)*100;"%"

!■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
SUB NTEQ2 ! A>B=C>D A>B>C=D 不等号2つ くじ必要・不要
   IF No(2)=No(3) THEN
      LET FST=1
      LET SND=MOD(INT(RND*10000),2)+2 !2位か3位でくじ
   END IF
    
   IF No(2)>No(3) THEN
      LET FST=1
      LET SND=2
   END IF
    
END SUB


SUB NTEQ1 ! A>B=C=D A=B=C>D A=B>C=D 不等号1つ くじ必要・不要
   IF No(1)>No(2) THEN !2位~4位から選ぶ
      LET FST=1
      LET SND=MOD(INT(RND*10000),3)+2
   END IF
    
   IF No(2)>No(3) THEN !上位2チーム
      LET FST=1
      LET snd=2
   END IF
   IF No(3)>No(4) THEN !1位~3位のうち、2チーム
      DO
         LET FST=MOD(INT(RND*10000),3)+1
         LET SND=MOD(INT(RND*10000),3)+1
      LOOP UNTIL FST>SND
   END IF
    
END SUB

SUB NTEQ0 ! A=B=C=D 不等号なし くじ必要
   DO
      LET FST=MOD(INT(RND*10000),4)+1
      LET SND=MOD(INT(RND*10000),4)+1
   LOOP UNTIL FST>SND
    
   PRINT No$(FST);No(FST);No3(FST);No$(SND);No(SND);No3(SND)
END SUB

SUB NOT_EQ ! 不等号の数の調査
   PRINT "不等号の数の調査";
   LET EQ_CNT=0
   FOR I=2 TO 4
      IF No(I-1)>No(I) THEN LET EQ_CNT=EQ_CNT+1
   NEXT I
   PRINT "不等号の数=";EQ_CNT
END SUB

SUB CNT
! このうち、初戦に勝ったチームが、上位2チームになった場合は、
! 進出へ1足す そうでなかった場合は、 非進出へ1足す
   LET No3_CNT=0
   FOR I=1 TO 4
      IF No3(I)=1 THEN LET No3_CNT=No3_CNT+1
   NEXT I
   PRINT "初戦を勝ったチーム数=";No3_CNT
    
   IF No3(FST)=1 THEN LET SUMWIN_WIN=SUMWIN_WIN+1  !その1チ-ム目が初戦勝ち点3をあげていればSUMWIN_WINにプラス
   IF No3(SND)=1 THEN LET SUMWIN_WIN=SUMWIN_WIN+1  !その2チーム目が初戦勝ち点3をあげていればSUMWIN_WINにプラス
    
   LET WIN_LOSE=No3_CNT-No3(FST)-No3(SND)  !初戦勝ったチ-ム数(1or2)から  突破したチーム数(1or2)を引く
   LET SUMWIN_LOSE=SUMWIN_LOSE+WIN_LOSE
    
   PRINT "初戦勝って進出した=";SUMWIN_WIN;"初戦勝ったのに進出ならず=";SUMWIN_LOSE
END SUB


SUB war_1st
! 初戦 オーストラリア-日本 / *ブラジル-クロアチア
   LET WIN_LOSE=MOD(INT(RND*100000000),100)
   IF WIN_LOSE<HIKIWAKE THEN ! 引分け
      PRINT "引分け2点"
      LET AUST=AUST+1
      LET JAPN=JAPN+1
   END IF
   IF WIN_LOSE>=HIKIWAKE AND WIN_LOSE<HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET AUST=AUST+3
      LET AUST3=1 ! 初戦勝った場合はフラグをあげる
      PRINT "勝敗3点"
   END IF
    
   IF WIN_LOSE>=HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET JAPN=JAPN+3
      PRINT "勝敗3点"
      LET JAPN3=1 ! 初戦勝った場合はフラグをあげる
   END IF
   !------------------------------------------------------------------------------
   LET WIN_LOSE=mod(INT(RND*100000000),100)
   IF WIN_LOSE<HIKIWAKE THEN ! 引分け
      PRINT "引分け2点"
      LET BRGL=BRGL+1
      LET CROA=CROA+1
   END IF
   IF WIN_LOSE>=HIKIWAKE AND WIN_LOSE<HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET BRGL=BRGL+3
      PRINT "勝敗3点"
      LET BRGL3=1 ! 初戦勝った場合はフラグをあげる
   END IF
    
   IF WIN_LOSE>=HIKIWAKE+(100-HIKIWAKE)/2THEN
      LET CROA=CROA+3
      PRINT "勝敗3点"
      LET CROA3=1 ! 初戦勝った場合はフラグをあげる
   END IF
    
END SUB


SUB war_2nd
! 2戦目 クロアチア-日本 / ブラジル-オーストラリア
   LET WIN_LOSE=mod(INT(RND*100000000),100)
   IF WIN_LOSE<HIKIWAKE THEN ! 引分け
      PRINT "引分け2点"
      LET CROA=CROA+1
      LET JAPN=JAPN+1
   END IF
    
   IF WIN_LOSE>=HIKIWAKE AND WIN_LOSE<HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET CROA=CROA+3
      PRINT "勝敗3点"
   END IF
    
   IF WIN_LOSE>=HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET JAPN=JAPN+3
      PRINT "勝敗3点"
   END IF
   !------------------------------------------------------------------------------
   LET WIN_LOSE=mod(INT(RND*100000000),100)
   IF WIN_LOSE<HIKIWAKE THEN ! 引分け
      PRINT "引分け2点"
      LET BRGL=BRGL+1
      LET AUST=AUST+1
   END IF
   IF WIN_LOSE>=HIKIWAKE AND WIN_LOSE<HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET BRGL=BRGL+3
      PRINT "勝敗3点"
   END IF
    
   IF WIN_LOSE>=HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET CROA=CROA+3
      PRINT "勝敗3点"
   END IF
END SUB

SUB war_3rd
! 3戦目 ブラジル-日本 / クロアチア-オーストラリア
   LET WIN_LOSE=mod(INT(RND*100000000),100)
   IF WIN_LOSE<HIKIWAKE THEN ! 引分け
      PRINT "引分け2点"
      LET BRGL=BRGL+1
      LET JAPN=JAPN+1
   END IF
    
   IF WIN_LOSE>=HIKIWAKE AND WIN_LOSE<HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET BRGL=BRGL+3
      PRINT "勝敗3点"
   END IF
    
   IF WIN_LOSE>=HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET JAPN=JAPN+3
      PRINT "勝敗3点"
   END IF
   !------------------------------------------------------------------------------
   LET WIN_LOSE=mod(INT(RND*100000000),100)
   IF WIN_LOSE<HIKIWAKE THEN ! 引分け
      PRINT "引分け2点"
      LET CROA=CROA+1
      LET AUST=AUST+1
   END IF
   IF WIN_LOSE>=HIKIWAKE AND WIN_LOSE<HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET CROA=CROA+3
      PRINT "勝敗3点"
   END IF
    
   IF WIN_LOSE>=HIKIWAKE+(100-HIKIWAKE)/2 THEN
      LET AUST=AUST+3
      PRINT "勝敗3点"
   END IF
END SUB



SUB ini !初期化
   LET JAPN=0
   LET BRGL=0
   LET CROA=0
   LET AUST=0
    
   LET JAPN3=0  !  初戦  勝ち点3のフラグ  0  or 1
   LET BRGL3=0  !  初戦  勝ち点3のフラグ  0  or 1
   LET CROA3=0  !  初戦  勝ち点3のフラグ  0  or 1
   LET AUST3=0  !  初戦  勝ち点3のフラグ  0  or 1
    
    
END SUB


SUB sort ! 上位順にバブルソートで、並べかえる。
   LET No$(1)="JPN"
   LET No$(2)="BRA"
   LET No$(3)="CRO"
   LET No$(4)="AUS"
   LET No(1)=JAPN    !  勝ち点
   LET No(2)=BRGL    !  勝ち点
   LET No(3)=CROA    !  勝ち点
   LET No(4)=AUST    !  勝ち点
   LET No3(1)=JAPN3  !  初戦  勝ち点3のフラグ  0  or 1
   LET No3(2)=BRGL3  !  初戦  勝ち点3のフラグ  0  or 1
   LET No3(3)=CROA3  !  初戦  勝ち点3のフラグ  0  or 1
   LET No3(4)=AUST3  !  初戦  勝ち点3のフラグ  0  or 1
    
    
   DO !ソートエンジン部分
      LET HT=0
      FOR I=4 TO 2 STEP -1
         IF No(I-1)<No(I) THEN
            swap No(I-1),No(I)
            swap No3(I-1),No3(I)
            swap No$(I-1),No$(I)
            LET HT=1
         END IF
      NEXT I
   LOOP UNTIL HT=0
    
   PRINT No$(1);No(1);No$(2);No(2);No$(3);No(3);No$(4);No(4)
END SUB

END