Fortran Coder

查看: 2027|回复: 2

[原创] 世界杯小组赛模拟出线程序

[复制链接]

49

帖子

12

主题

1

精华

专家

F 币
471 元
贡献
293 点
发表于 2014-6-23 21:23:52 | 显示全部楼层 |阅读模式
本帖最后由 weixing1531 于 2014-6-24 21:00 编辑

小组共4只球队   单循环共6场比赛(主客场双循环共12场比赛)  小组积分前两名出线

两大假定:
1.各队胜、平、负概率均等,均为1/3,不模拟进球
2.积分相同情况下,抽签决定出线

运行环境: Win7 i3 CVF6.6C

世界杯小组出线概率模拟结果:

世界杯小组出线概率

世界杯小组出线概率


欧冠主客场双循环小组出线概率模拟结果:

欧冠主客场双循环小组出线概率

欧冠主客场双循环小组出线概率


源程序:
[Fortran] 纯文本查看 复制代码
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



football.zip (543.31 KB, 下载次数: 0)

评分

参与人数 1F 币 +30 贡献 +30 收起 理由
fcode + 30 + 30 赞一个!

查看全部评分

回复

使用道具 举报

1388

帖子

12

主题

5

精华

论坛跑堂

Fcode跑堂伙计

F 币
569 元
贡献
455 点

新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

发表于 2014-6-23 21:45:00 | 显示全部楼层
这是一个很有趣的程序。楼主的代码风格也很好。

不过,建议不要在 win7 下使用 CVF。

49

帖子

12

主题

1

精华

专家

F 币
471 元
贡献
293 点
 楼主| 发表于 2014-6-23 21:54:54 | 显示全部楼层
fcode 发表于 2014-6-23 21:45
这是一个很有趣的程序。楼主的代码风格也很好。

不过,建议不要在 win7 下使用 CVF。 ...

发现一个问题  原来积5分出线概率要比6分大1.24%
主观上不太接受  可能两场平局导致平分抽签
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

QQ|捐赠本站|Archiver|关于我们 About Us|群聊|Fcode

GMT+8, 2019-6-27 11:06

Powered by Discuz! X3.2

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表