本帖最后由 weixing1531 于 2022-7-2 09:40 编辑
小时候都玩过24点扑克游戏,简单来说一幅扑克牌(去掉大小王)共52张牌,随机抽取4张牌,然后根据4张牌的数值(J为11,Q为12,K为13)四则混合运算得到24点
算法源代码网上有很多,这里就不做说明了。
这里介绍一种最简单的方法:递归法,原理就是4张牌依次转换为3张牌、2张牌
源代码摘自https://club.excelhome.net/,由VBA编写,已翻译成F90,如下
[Fortran] 纯文本查看 复制代码 module hi
!use,intrinsic :: iso_fortran_env, only: real64
implicit none
integer,parameter::real64=SELECTED_REAL_KIND(11)
real(real64),parameter::EPS= 0.000001_real64 !实数相等判断精度
integer,parameter::COUNT_OF_NUMBER=4 !参与运算的数字个数 4张牌
integer,parameter::NUMBER_TO_BE_CAL=24 !运算目标值 24
integer,parameter::Number_Scale=13 !运算数字的范围 13
real(real64)::Number(COUNT_OF_NUMBER) !运算数字数组 必须为浮点数 否则除法运算得不到精确结果
character(256)::Expression(COUNT_OF_NUMBER) !运算表达式
contains
!24点递归算法。
!思路如下:
!采用遍历的方式,先从数组的N个元素中取出两个数,分别进行四则运算,其结果保存在数组中。该数组变换为N-1个元素
!再以新数组(N-1)个元素重复上述步骤的将上述两数运算结果与剩余数字组成的数组进行上述运算
!直至所有数组元素参与计算,即到最后仅剩2个元素时判断是否有计算结果
!Expression(i)中存放运算表达式,由于最终要计算到2个元素,所以最终表达式总是存放在Expression(1)中
!Number(i)中存放两两运算后的结果,由于最终要计算到2个元素,所以最终结果总是存放在Number(1)中
recursive function Search(n) result(res)
integer,intent(in)::n
logical::res
real(real64)::a,b
character(256)::Expa, Expb
integer::i, j
If (n == 1) Then !递归出口
If (Abs(Number(1) - NUMBER_TO_BE_CAL) < EPS) Then !当数字个数仅剩2个时,判断运算是否完成
res = .True.
i = Len_trim(Expression(1)) - 1 !删除答案最外围左右括号后最后字符的位置 WX增加
Expression(1) = Expression(1)(2:i) !删除最外围左右括号 WX增加
Else
res = .False.
End If
return
End If
!类似于冒泡法排序 共计C(n,2)种组合 从n个数抽取2个数
do i = 1, n
do j = i + 1 , n
!存放参与计算的两个数至临时变量
a = Number(i)
b = Number(j)
Expa = Expression(i)
Expb = Expression(j)
!由于每次进行更深入递归都不再生成新数组,而是以数组N-1个元素进行运算,故将最后一个元素放到j位置
Number(j) = Number(n)
Expression(j) = Expression(n)
!表达式赋值,运算结果赋值,进行递归运算
!运算1 a+b
!i位置存放i和j位置的两个数的运算结果
Expression(i) = "(" // trim(adjustl(Expa)) // "+" // trim(adjustl(Expb)) // ")"
Number(i) = a + b
!若有运算结果则结束程序
If (Search(n - 1)) Then !递归在这里
res = .True.
return
End If
!以下请参考上面
!运算2 a-b
!i位置存放i和j位置的两个数的运算结果
Expression(i) = "(" // trim(adjustl(Expa)) // "-" // trim(adjustl(Expb)) // ")"
Number(i) = a - b
If (Search(n - 1)) Then
res = .True.
return
End If
!运算3 b-a
!i位置存放i和j位置的两个数的运算结果
Expression(i) = "(" // trim(adjustl(Expb)) // "-" // trim(adjustl(Expa)) // ")"
Number(i) = b - a
If (Search(n - 1)) Then
res = .True.
return
End If
!运算4 a*b
!i位置存放i和j位置的两个数的运算结果
Expression(i) = "(" // trim(adjustl(Expa)) // "*" // trim(adjustl(Expb)) // ")"
Number(i) = a * b
If (Search(n - 1)) Then
res = .True.
return
End If
!运算5 a/b
!i位置存放i和j位置的两个数的运算结果
If (Abs(b) > EPS) Then !分母不为0
Expression(i) = "(" // trim(adjustl(Expa)) // "/" // trim(adjustl(Expb)) // ")"
Number(i) = a / b !必须为浮点数 否则除法运算得不到精确结果
If (Search(n - 1)) Then
res = .True.
return
End If
End If
!运算6 b/a
!i位置存放i和j位置的两个数的运算结果
If (Abs(a) > EPS) Then !分母不为0
Expression(i) = "(" // trim(adjustl(Expb)) // "/" // trim(adjustl(Expa)) // ")"
Number(i) = b / a !必须为浮点数 否则除法运算得不到精确结果
If (Search(n - 1)) Then
res = .True.
return
End If
End If
!若6种运算均没有运算结果,则将数组复原,继续进行循环遍历
Number(i) = a
Number(j) = b
Expression(i) = Expa
Expression(j) = Expb
end do
end do
res = .False. !若上述所有组合的6种运算都没有结果,则该数组无法满足运算要求
end function
end module
program main
use hi
implicit none
integer::i,N
write(*,*)"依次输入4张牌(每张范围为1-13):"
do i = 1 , COUNT_OF_NUMBER
10 write(*,"(a,i0,a)",advance="NO")"输入第",i,"张牌:"
read(*,*)N
If (N > Number_Scale .Or. N < 1 ) Then
write(*,"(a,i0,a)")"第",i, "张牌已超出范围,请重新输入!"
goto 10
End If
!整数转换为浮点数
Number(i)=real(N,real64)
!整数转换为字符串
write(Expression(i),"(i0)")N
end do
If (Search(COUNT_OF_NUMBER)) Then !有解 会改变Number()及Expression()的数据
write(*,"(a,i0,a)")"Answer:",NUMBER_TO_BE_CAL,"="//Expression(1) !若有多个答案 只会显示其中一个最快的答案
Else !无解
write(*,*)"Answer:None"
End If
read(*,*)
end program
|