世界杯小组赛模拟出线程序
本帖最后由 weixing1531 于 2014-6-24 21:00 编辑小组共4只球队 单循环共6场比赛（主客场双循环共12场比赛）小组积分前两名出线
两大假定：
1.各队胜、平、负概率均等，均为1/3，不模拟进球
2.积分相同情况下，抽签决定出线
运行环境： Win7 i3 CVF6.6C
世界杯小组出线概率模拟结果：
欧冠主客场双循环小组出线概率模拟结果：
源程序：
module NrType ! 确定常数
implicit none
public ! 均设为公有变量
integer(selected_int_kind(2)),parameter::IxB=selected_int_kind(9) ! 整数类型选择
integer(IxB),parameter::DP=kind(1.0e0) ! 单精度实数
end module NrType
program football
use NrType
implicit none
save ! 均为静态变量
integer(IxB),parameter::NCSV=10 ! 输入输出文件号
integer(IxB),parameter::WIN=3,DRAW=1,LOSS=0 ! 胜3平1负0
integer(IxB),parameter::TEAMS=4,TEAMSCORE=3,CYCLING=2,NUM=21000000_IxB ! 小组球队数TEAMS 小组赛循环数CYCLING(世界杯小组赛为1,欧冠亚冠主客场小组赛为2) 球队积分TEAMSCORE 样本总数NUM
integer(IxB),allocatable::matrix(:,:),score(:),first(:),second(:),firstLoc(:),secondLoc(:)
integer(IxB)::i,j,k,n,point,total
open(NCSV,file='计算结果.csv')
allocate(matrix(TEAMS,TEAMS),score(TEAMS),first(NUM),second(NUM),firstLoc(NUM),secondLoc(NUM))
matrix=0 ! 矩阵元素初值为0 主对角线设为0
total=0
CALL RANDOM_SEED
do k=1,NUM
!write(NCSV,"(a,4(',',i2))")'表格',(i,i=1,TEAMS) ! 表头
do i=1,TEAMS
do j=1,i-1
do n=1,CYCLING ! 小组赛循环数CYCLING
call CalPoint(point) ! 比赛结果
matrix(i,j)=matrix(i,j)+point ! 关于主对角线对称 若为3分则对手为0分
if(point==DRAW)matrix(j,i)=matrix(j,i)+point ! 关于主对角线对称 平局两队各得1分
if(point==LOSS)matrix(j,i)=matrix(j,i)+WIN ! 关于主对角线对称 若为0分则对手为3分
end do
end do
end do
!do i=1,TEAMS
!write(NCSV,"(i2,4(',',i2))")i,matrix(i,:)
!end do
score=(/(sum(matrix(:,j)),j=1,TEAMS)/) ! 总积分
total=total+count(score==TEAMSCORE)
first(k)=maxval(score) ! 小组头名积分
firstLoc(k)=maxloc(score,1) ! 头名球队
!write(NCSV,"(a,4(',',i2))")'总积分',score ! 各队总积分
!write(NCSV,"(a,',',i2,',',a,',',i2)")'头名积分',first(k),'头名球队',firstLoc(k)
! 头名积分置0以便查找次名
score(firstLoc(k))=0 ! 头名积分置0 此时数组score已经改变
second(k)=maxval(score) ! 小组次名积分
secondLoc(k)=maxloc(score,1) ! 次名球队
!write(NCSV,"(a,',',i2,',',a,',',i2)")'次名积分',second(k),'次名球队',secondLoc(k)
matrix=0 ! 样本矩阵清零
end do
write(NCSV,"(a,5(',',a))")'球队积分','头名次数','次名次数','总次数','出线概率','头名概率' ! 表头
write(NCSV,"(4(i8,','),f9.7,',',f9.7)")TEAMSCORE,count(first==TEAMSCORE),count(second==TEAMSCORE),total,dble(count(first==TEAMSCORE)+count(second==TEAMSCORE))/dble(total),dble(count(first==TEAMSCORE))/dble(total)
write(*,*)'程序结束,按任意键退出!'
read(*,*)
contains
subroutine CalPoint(point) ! 模拟一场比赛胜平负结果
integer(IxB),intent(out)::point
real(DP)::harvest
real(DP),parameter::R1=0.33333333e0,R2=0.66666666e0 ! 胜平负概率相同,均为1/3
CALL RANDOM_NUMBER(harvest)
if(harvest<=R1)then ! 胜
point=WIN
else if(harvest<=R2)then ! 平
point=DRAW
else ! 负
point=LOSS
end if
return
end subroutine
end program football
这是一个很有趣的程序。楼主的代码风格也很好。
不过，建议不要在 win7 下使用 CVF。 fcode 发表于 2014-6-23 21:45
这是一个很有趣的程序。楼主的代码风格也很好。
不过，建议不要在 win7 下使用 CVF。 ...
发现一个问题原来积5分出线概率要比6分大1.24%
主观上不太接受可能两场平局导致平分抽签
页:
[1]