Code Golf:数学表达式评估器(尊重PEMDAS)

:[[/%^(:[[+-/^,&i|:[$[' ']^j+0__:k<3:]]

好的,我实现了一个monadic解析器组合库,然后使用该库来解决这个问题.所有人都告诉它仍然只有70行可读代码.

我假设取幂关联到右边,其他操作符关联到左边.一切都适用于浮动(System.Doubles).我没有对错误输入或除零进行任何错误处理.

// Core Parser Library
open System
let Fail() = fun i -> None
type ParseMonad() =
    member p.Return x = fun i -> Some(x,i)
    member p.Bind(m,f) = fun i -> 
        match m i with
        | Some(x,i2) -> f x i2
        | None -> None
let parse = ParseMonad()
let (<|>) p1 p2 = fun i -> 
    match p1 i with
    | Some r -> Some(r)
    | None -> p2 i
let Sat pred = fun i -> 
    match i with
    | [] -> None
    | c::cs -> if pred c then Some(c, cs) else None
// Auxiliary Parser Library
let Digit = Sat Char.IsDigit
let Lit (c : char) r = 
    parse { let! _ = Sat ((=) c)
            return r }
let Opt p = p <|> parse { return [] }
let rec Many p = Opt (Many1 p)
and Many1 p = parse { let! x = p
                      let! xs = Many p
                      return x :: xs }
let Num = parse {
    let! sign = Opt(Lit '-' ['-'])
    let! beforeDec = Many Digit
    let! rest = parse { let! dec = Lit '.' '.'
                        let! afterDec = Many Digit
                        return dec :: afterDec } |> Opt
    let s = new string(List.concat([sign;beforeDec;rest])
                       |> List.to_array) 
    match(try Some(float s) with e -> None)with
    | Some(r) -> return r
    | None -> return! Fail() }
let Chainl1 p op = 
    let rec Help x = parse { let! f = op
                             let! y = p
                             return! Help (f x y) } 
                     <|> parse { return x }
    parse { let! x = p
            return! Help x }
let rec Chainr1 p op =
    parse { let! x = p
            return! parse { let! f = op
                            let! y = Chainr1 p op
                            return f x y }
                    <|> parse { return x } }
// Expression grammar of this code-golf question
let AddOp = Lit '+' (fun x y -> 0. + x + y) 
        <|> Lit '-' (fun x y -> 0. + x - y)
let MulOp = Lit '*' (fun x y -> 0. + x * y) 
        <|> Lit '/' (fun x y -> 0. + x / y)
let ExpOp = Lit '^' (fun x y -> Math.Pow(x,y))
let rec Expr = Chainl1 Term AddOp
and Term = Chainl1 Factor MulOp
and Factor = Chainr1 Part ExpOp
and Part = Num <|> Paren
and Paren = parse { do! Lit '(' ()
                    let! e = Expr
                    do! Lit ')' ()
                    return e }
let CodeGolf (s:string) =
    match Expr(Seq.to_list(s.ToCharArray())) with
    | None -> "bad input"
    | Some(r,_) -> r.ToString()
// Examples
printfn "%s" (CodeGolf "1.1+2.2+10^2^3") // 100000003.3
printfn "%s" (CodeGolf "10+3.14/2")      // 11.57
printfn "%s" (CodeGolf "(10+3.14)/2")    // 6.57
printfn "%s" (CodeGolf "-1^(-3*4/-6)")   // 1
printfn "%s" (CodeGolf "-2^(2^(4-1))")   // 256 
printfn "%s" (CodeGolf "2*6/4^2*4/3")    // 1

解析器表示类型是

type P<'a> = char list -> option<'a * char list>

顺便说一下,非错误处理解析器的常见问题.

PARLANSE中的递归下降解析器,具有LISP语法的类C语言:[70行,1376个字符不计算SO所需的缩进量]编辑:规则已更改,有人坚持浮点数,已修复.没有库调用,浮动转换,输入和打印除外.[现在94行,1825个字符]

(define main (procedure void)
   (local
      (;; (define f (function float void))
          (= [s string] (append (input) "$"))
          (= [i natural] 1)

         (define S (lambda f
            (let (= v (P))
               (value (loop
                          (case s:i)
                            "+" (;; (+= i) (+= v (P) );;
                            "-" (;; (+= i) (-= v (P) );;
                            else (return v)
                          )case
                       )loop
                  v
              )value
         )define

         (define P (lambda f
            (let (= v (T))
               (value (loop
                          (case s:i)
                            "*" (;; (+= i) (= v (* v (T)) );;
                            "/" (;; (+= i) (= v (/ v (T)) );;
                            else (return v)
                          )case
                       )loop
                  v
              )value
         )define

         (define T (lambda f
            (let (= v (O))
               (value (loop
                          (case s:i)
                            "^" (;; (+= i) (= v (** v (T)) );;
                            else (return v)
                          )case
                       )loop
                  v
              )value
         )define

         (define O (lambda f
           (let (= v +0)
            (value 
               (case s:i)
                  "(" (;; (+= i) (= v (E)) (+= i) );;
                  "-" (;; (+= i) (= v (- 0.0 (O))) );;
               else (= v (StringToFloat (F))
          )value
          v
        )let
     )define

     (define F (lambda f)
        (let (= n (N))
             (value
              (;; (ifthen (== s:i ".")
                     (;; (+= i)
                         (= n (append n "."))
                         (= n (concatenate n (N)))
                     );;
                  )ifthen
                  (ifthen (== s:i "E")
                     (;; (+= i)
                         (= n (append n "E"))
                         (ifthen (== s:i "-")
                         (;; (+= i)
                             (= n (append n "-"))
                             (= n (concatenate n (N)))
                         );;
                     );;
                  )ifthen
              );;
              n
         )let
     )define               

     (define N (lambda (function string string)
        (case s:i
            (any "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
               (value (+= i)
                      (append ? s:(-- i))
               )value
            else ?
        )case
     )define

      );;
      (print (S))
   )local
)define

假设一个格式良好的表达式,浮点数至少有一个前导数字,指数可选为Enn或E-nnn.没有编译和运行.

Pecularities:定义f本质上是签名typedef.lambdas是解析函数,每个语法规则一个.通过写(F args)调用函数F. PARLANSE函数是词法范围的,因此每个函数都可以隐式访问要计算的表达式s和字符串扫描索引i.

实现的语法是:

E = S $ ;
S = P ;
S = S + P ;
P = T ;
P = P * T ;  
T = O ;
T = O ^ T ;
O = ( S ) ;
O = - O ;
O = F ;
F = digits {. digits} { E {-} digits} ;

我将之前的解决方案高尔夫压缩到这个宝石:

let rec D a=function|c::s when System.Char.IsDigit c->D(c::a)s|s->a,s
and L p o s=
 let rec K(a,s)=match o s with|None->a,s|Some(o,t)->let q,t=p t in K(o a q,t)
 K(p s)
and E=L(L F (function|'*'::s->Some((*),s)|'/'::s->Some((/),s)|_->None))(
function|'+'::s->Some((+),s)|'-'::s->Some((-),s)|_->None)
and F s=match P s with|x,'^'::s->let y,s=F s in x**y,s|r->r
and P=function|'('::s->let r,_::s=E s in r,s|s->(
let a,s=match(match s with|'-'::t->D['-']t|_->D[]s)with|a,'.'::t->D('.'::a)t|r->r
float(new string(Seq.to_array(List.rev a))),s)
and G s=string(fst(E(Seq.to_list s)))

测试:

printfn "%s" (G "1.1+2.2+10^2^3") // 100000003.3
printfn "%s" (G "10+3.14/2")      // 11.57
printfn "%s" (G "(10+3.14)/2")    // 6.57
printfn "%s" (G "-1^(-3*4/-6)")   // 1
printfn "%s" (G "-2^(2^(4-1))")   // 256 
printfn "%s" (G "2*6/4^2*4/3")    // 1
printfn "%s" (G "3-2-1")          // 0