Постфиксный калькулятор (он же Reverse-Polish Notation – RPN) калькулятор

В качестве упражнения я собрал калькулятор постфиксов на современном Фортране. Помимо языка, мне интересно узнать, как вы относитесь к алгоритму. Насколько я помню по своему первокурснику (химия – давно), проблема имеет стандартное решение на языке 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

0

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *