В качестве упражнения я собрал калькулятор постфиксов на современном Фортране. Помимо языка, мне интересно узнать, как вы относитесь к алгоритму. Насколько я помню по своему первокурснику (химия — давно), проблема имеет стандартное решение на языке C, которое я считаю оптимальным в каком-то смысле. Однако я не стал его искать и написал что-то, что, вероятно, в некоторых отношениях отличается. Программа запускается и проходит тесты.
Мне интересно знать, приемлемо ли данное решение или есть ли у него какие-либо серьезные скрытые недостатки / недостатки. Для людей, не знакомых с простым синтаксисом современного Фортрана, я предлагаю следующее быстрое современное руководство по Фортрану.
Благодаря!
module mod_postfix
implicit none
private
integer, parameter :: TOKEN_MAX_LEN = 50
public :: EvalPostfix
contains
real(kind(1d0)) function EvalPostfix( CmdStrn ) result(res)
character(len=*), intent(in) :: CmdStrn
integer :: iToken, nTokens, shift
character(len=:) , allocatable :: Token
character(len=TOKEN_MAX_LEN), allocatable :: stack(:)
nTokens = GetNTokens(CmdStrn)
allocate(stack(nTokens))
do iToken = 1, nTokens
call GetToken(CmdStrn,iToken,Token)
stack(iToken) = Token
enddo
shift=0
call simplify_stack(nTokens,Stack,shift)
read(Stack(nTokens),*)res
end function EvalPostfix
recursive subroutine simplify_stack(n,Stack,shift)
integer , intent(in) :: n
character(len=TOKEN_MAX_LEN), intent(inout) :: Stack(:)
integer , intent(inout) :: shift
character(len=:), allocatable :: sOp
integer :: i
real(kind(1d0)) :: v1, v2, res
logical :: IsBinary, IsUnary, IsNonary, IsOperator
if(n==0)return
sOp = trim(Stack(n))
!.. Case Binary Operators
IsBinary = index( "+ - * / max min mod **", sOp ) > 0
IsUnary = index( " sin cos tan asin acos atan exp log int sqrt abs", sOp ) > 0
IsNonary = index( " random_number PI", sOp ) > 0
IsOperator = IsBinary .or. IsUnary .or. IsNonary
if( ( .not. IsOperator ) .and. n == shift + 1 )return
call simplify_stack(n-1,stack,shift)
if( IsBinary )then
read(Stack(n-1),*)v2
read(Stack(n-2),*)v1
if( sOp == "+" ) res = v1+v2
if( sOp == "-" ) res = v1-v2
if( sOp == "*" ) res = v1*v2
if( sOp == "/" ) res = v1/v2
if( sOp == "max" ) res = max(v1,v2)
if( sOp == "min" ) res = min(v1,v2)
if( sOp == "mod" ) res = mod(v1,v2)
if( sOp == "**" ) res = v1**v2
write(Stack(n),"(e24.16)")res
shift=shift+2
do i=n-3,1,-1
Stack(i+2)=Stack(i)
enddo
elseif( IsUnary )then
read(Stack(n-1),*)v1
if( sOp == "sin" ) res = sin (v1)
if( sOp == "cos" ) res = cos (v1)
if( sOp == "tan" ) res = tan (v1)
if( sOp == "asin") res = asin(v1)
if( sOp == "acos") res = acos(v1)
if( sOp == "atan") res = atan(v1)
if( sOp == "exp" ) res = exp (v1)
if( sOp == "log" ) res = log (v1)
if( sOp == "sqrt") res = sqrt(v1)
if( sOp == "abs" ) res = abs (v1)
if( sOp == "int" ) res = dble(int(v1))
write(Stack(n),"(e24.16)")res
shift=shift+1
do i=n-2,1,-1
Stack(i+1)=Stack(i)
enddo
elseif( IsNonary )then
if( sOp == "random_number")call random_number(res)
if( sOp == "PI" )res=4.d0*atan(1.d0)
write(Stack(n),"(e24.16)")res
if(n == shift + 1)return
call simplify_stack(n-1,stack,shift)
end if
end subroutine simplify_stack
!> Counts the number of tokens
integer function GetNTokens( strn, separator_list_ ) result( n )
implicit none
character(len=*) , intent(in) :: strn
character(len=*), optional, intent(in) :: separator_list_
!
character , parameter :: SEPARATOR_LIST_DEFAULT = " "
character(len=:), allocatable :: separator_list
integer :: i,j
n=0
if(len_trim( strn ) == 0)return
if(present(separator_list_))then
allocate(separator_list,source=separator_list_)
else
allocate(separator_list,source=SEPARATOR_LIST_DEFAULT)
endif
i=1
do
j=verify(strn(i:),separator_list)
if(j<=0)exit
n=n+1
j=i-1+j
i=scan(strn(j:),separator_list)
if(i<=0)exit
i=j-1+i
if(i>len(strn))exit
enddo
if(allocated(separator_list))deallocate(separator_list)
end function GetNTokens
subroutine GetToken( strn, iToken, token, separator_list_ )
implicit none
character(len=*), intent(in) :: strn
integer , intent(in) :: iToken
character(len=:), allocatable, intent(out):: token
character(len=*), optional , intent(in) :: separator_list_
!
character , parameter :: SEPARATOR_LIST_DEFAULT = " "
character(len=:), allocatable :: separator_list
integer :: i,j,n
if(present(separator_list_))then
allocate(separator_list,source=separator_list_)
else
allocate(separator_list,source=SEPARATOR_LIST_DEFAULT)
endif
if(iToken<1)return
if(iToken>GetNTokens(strn,separator_list))return
if(allocated(token))deallocate(token)
i=1
n=0
do
j=verify(strn(i:),separator_list)
if(j<=0)exit
n=n+1
j=i-1+j
i=scan(strn(j:),separator_list)
if(i<=0)then
i=len_trim(strn)+1
else
i=j-1+i
endif
if(n==iToken)then
allocate(token,source=strn(j:i-1))
exit
endif
enddo
end subroutine GetToken
end module Mod_Postfix
program TestPostfixCalculator
use mod_postfix
implicit none
real(kind(1d0)) , parameter :: THRESHOLD = 1.d-10
real(kind(1d0)) :: res
character(len=:), allocatable :: sPostfix
call assert("+" , abs( EvalPostfix(" 3 4 +") - 7 ) < THRESHOLD )
call assert("-" , abs( EvalPostfix(" 3 4 -") + 1 ) < THRESHOLD )
call assert("*" , abs( EvalPostfix(" 3 4 *") - 12 ) < THRESHOLD )
call assert("/" , abs( EvalPostfix(" 3 4 /") - 0.75 ) < THRESHOLD )
call assert("max", abs( EvalPostfix(" 3 4 max") - 4 ) < THRESHOLD )
call assert("min", abs( EvalPostfix(" 3 4 min") - 3 ) < THRESHOLD )
call assert("mod", abs( EvalPostfix("13 5 mod") - 3 ) < THRESHOLD )
call assert("**" , abs( EvalPostfix(" 2 5 **" ) - 32 ) < THRESHOLD )
call assert("cos", abs( EvalPostfix(" PI 3 / cos" ) - 0.5 ) < THRESHOLD )
res = sqrt( (log(10.d0)-atan(2.d0))/max(cos(6.d0),exp(3.d0)) )
sPostfix ="10 log 2 atan - 6 cos 3 exp max / sqrt"
call assert("expression1", abs( EvalPostfix(sPostfix) - res ) < THRESHOLD )
!.. etc. etc.
contains
subroutine assert(msg,cond)
use, intrinsic :: iso_fortran_env, only : OUTPUT_UNIT
character(len=*), intent(in) :: msg
logical , intent(in) :: cond
write(OUTPUT_UNIT,"(a)",advance="no") "["//msg//"] "
if( cond )then
write(OUTPUT_UNIT,"(a)") "passed"
else
write(OUTPUT_UNIT,"(a)") "FAILED"
endif
end subroutine assert
end program TestPostfixCalculator