生活の中のシミュレーション
■Ｗカップ、初戦の勝者は、１次リーグ突破の確率が８７％にもなるという。 これって普通のことだろうか？
※４チームが総当りし、上位２チームが勝ち抜けとする。
勝てば、勝ち点３。 引分けは、勝ち点１。 負けは、勝ち点０。
★条件１：４チームが互角の力を持っているとする。
★条件２：引分け試合になる可能性が、３０％であるとする。（サッカーは、互いに無得点のドローが多い）
★条件３：最終的に勝ち点が同じの場合は、くじ引きで勝ち抜けを決める。･･･実際は、得失点差だけど。
●結果：１０００回試行の結果： ７６．２％
---------------------------------------------------------------------------
! 本大会サッカー シミュレーション 十進ＢＡＳＩＣ
! １次リーグの勝者は、２次リーグへ８７％の確率で進出しているが普通のことだろうか？
! こんなに大きな確率になるのは、
! １）１回戦を勝つようなチームは、二回戦以降も勝ち決勝リーグ進出するものが含まれる
! ２）１回勝つことで勝ち点３からはじめられる。 あわせて、サッカーでは引き分けが多い。
! 等が考えられる。
! もし、４チームが同じ力を持っているとしてどうだろう？
! 但し、引分けの可能性が、３０％とする。
! Win 勝ち点３ 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>99
! LET HIKIWAKE=40 !引分けの起こる確率 0〜100％
LET Kaisu=1000 ! 試行回数
FOR k=1 TO Kaisu
PRINT ""
CALL ini !初期化
PRINT "初戦"
CALL war_1st !初戦
PRINT "第２戦"
CALL war_2nd !第２戦
PRINT "第３戦"
CALL war_3rd !第３戦
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 不等号１つ くじ必要・不要
IF EQ_CNT=2 THEN CALL NTEQ2 ! A>B=C>D A>B>C=D 不等号２つ くじ必要・不要
IF EQ_CNT=3 THEN ! 不等号３つ くじ不要
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 不等号２つ くじ必要・不要
IF No(2)=No(3) THEN
LET FST=1
LET SND=MOD(INT(RND*10000),2)+2 !２位か３位でくじ
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 不等号１つ くじ必要・不要
IF No(1)>No(2) THEN !２位〜４位から選ぶ
LET FST=1
LET SND=MOD(INT(RND*10000),3)+2
END IF
IF No(2)>No(3) THEN !上位２チーム
LET FST=1
LET snd=2
END IF
IF No(3)>No(4) THEN !１位〜３位のうち、２チーム
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
! このうち、初戦に勝ったチームが、上位２チームになった場合は、
! 進出へ１足す そうでなかった場合は、 非進出へ１足す
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
IF No3(SND)=1 THEN LET SUMWIN_WIN=SUMWIN_WIN+1
LET WIN_LOSE=No3_CNT-No3(FST)-No3(SND)
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
! ２戦目 クロアチア−日本 ／ ブラジル−オーストラリア
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
! ３戦目 ブラジル−日本 ／ クロアチア−オーストラリア
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
LET BRGL3=0
LET CROA3=0
LET AUST3=0
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
LET No3(2)=BRGL3
LET No3(3)=CROA3
LET No3(4)=AUST3
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