A-M baby

Task/Arithmetic-evaluation/Factor/arithmetic-evaluation.factor

@@ -0,0 +1,42 @@
+USING: accessors kernel locals math math.parser peg.ebnf ;
+IN: rosetta.arith
+
+TUPLE: operator left right ;
+TUPLE: add < operator ;   C: <add> add
+TUPLE: sub < operator ;   C: <sub> sub
+TUPLE: mul < operator ;   C: <mul> mul
+TUPLE: div < operator ;   C: <div> div
+
+EBNF: expr-ast
+spaces   = [\n\t ]*
+digit    = [0-9]
+number   = (digit)+                         => [[ string>number ]]
+
+value    =   spaces number:n                => [[ n ]]
+           | spaces "(" exp:e spaces ")"    => [[ e ]]
+
+fac      =   fac:a spaces "*" value:b       => [[ a b <mul> ]]
+           | fac:a spaces "/" value:b       => [[ a b <div> ]]
+           | value
+
+exp      =   exp:a spaces "+" fac:b         => [[ a b <add> ]]
+           | exp:a spaces "-" fac:b         => [[ a b <sub> ]]
+           | fac
+
+main     = exp:e spaces !(.)                => [[ e ]]
+;EBNF
+
+GENERIC: eval-ast ( ast -- result )
+
+M: number eval-ast ;
+
+: recursive-eval ( ast -- left-result right-result )
+    [ left>> eval-ast ] [ right>> eval-ast ] bi ;
+
+M: add eval-ast recursive-eval + ;
+M: sub eval-ast recursive-eval - ;
+M: mul eval-ast recursive-eval * ;
+M: div eval-ast recursive-eval / ;
+
+: evaluate ( string -- result )
+    expr-ast eval-ast ;

Task/Arithmetic-evaluation/Groovy/arithmetic-evaluation-1.groovy

@@ -0,0 +1,144 @@
+enum Op {
+    ADD('+', 2),
+    SUBTRACT('-', 2),
+    MULTIPLY('*', 1),
+    DIVIDE('/', 1);
+
+    static {
+        ADD.operation = { a, b -> a + b }
+        SUBTRACT.operation = { a, b -> a - b }
+        MULTIPLY.operation = { a, b -> a * b }
+        DIVIDE.operation = { a, b -> a / b }
+    }
+
+    final String symbol
+    final int precedence
+    Closure operation
+
+    private Op(String symbol, int precedence) {
+        this.symbol = symbol
+        this.precedence = precedence
+    }
+
+    String toString() { symbol }
+
+    static Op fromSymbol(String symbol) {
+        Op.values().find { it.symbol == symbol }
+    }
+}
+
+interface Expression {
+    Number evaluate();
+}
+
+class Constant implements Expression {
+    Number value
+
+    Constant (Number value) { this.value = value }
+
+    Constant (String str) {
+        try { this.value = str as BigInteger }
+        catch (e) { this.value = str as BigDecimal }
+    }
+
+    Number evaluate() { value }
+
+    String toString() { "${value}" }
+}
+
+class Term implements Expression {
+    Op op
+    Expression left, right
+
+    Number evaluate() { op.operation(left.evaluate(), right.evaluate()) }
+
+    String toString() { "(${op} ${left} ${right})" }
+}
+
+void fail(String msg, Closure cond = {true}) {
+    if (cond()) throw new IllegalArgumentException("Cannot parse expression: ${msg}")
+}
+
+Expression parse(String expr) {
+    def tokens = tokenize(expr)
+    def elements = groupByParens(tokens, 0)
+    parse(elements)
+}
+
+List tokenize(String expr) {
+    def tokens = []
+    def constStr = ""
+    def captureConstant = { i ->
+        if (constStr) {
+            try { tokens << new Constant(constStr) }
+            catch (NumberFormatException e) { fail "Invalid constant '${constStr}' near position ${i}" }
+            constStr = ''
+        }
+    }
+    for(def i = 0; i<expr.size(); i++) {
+        def c = expr[i]
+        def constSign = c in ['+','-'] && constStr.empty && (tokens.empty || tokens[-1] != ')')
+        def isConstChar = { it in ['.'] + ('0'..'9') || constSign }
+        if (c in ([')'] + Op.values()*.symbol) && !constSign) { captureConstant(i) }
+        switch (c) {
+            case ~/\s/:               break
+            case isConstChar:         constStr += c; break
+            case Op.values()*.symbol: tokens << Op.fromSymbol(c); break
+            case ['(',')']:           tokens << c; break
+            default:                  fail "Invalid character '${c}' at position ${i+1}"
+        }
+    }
+    captureConstant(expr.size())
+    tokens
+}
+
+List groupByParens(List tokens, int depth) {
+    def deepness = depth
+    def tokenGroups = []
+    for (def i = 0; i < tokens.size(); i++) {
+        def token = tokens[i]
+        switch (token) {
+            case '(':
+                fail("'(' too close to end of expression") { i+2 > tokens.size() }
+                def subGroup = groupByParens(tokens[i+1..-1], depth+1)
+                tokenGroups << subGroup[0..-2]
+                i += subGroup[-1] + 1
+                break
+            case ')':
+                fail("Unbalanced parens, found extra ')'") { deepness == 0 }
+                tokenGroups << i
+                return tokenGroups
+            default:
+                tokenGroups << token
+        }
+    }
+    fail("Unbalanced parens, unclosed groupings at end of expression") { deepness != 0 }
+    def n = tokenGroups.size()
+    fail("The operand/operator sequence is wrong") { n%2 == 0 }
+    (0..<n).each {
+        def i = it
+        fail("The operand/operator sequence is wrong") { (i%2 == 0) == (tokenGroups[i] instanceof Op) }
+    }
+    tokenGroups
+}
+
+Expression parse(List elements) {
+    while (elements.size() > 1) {
+        def n = elements.size()
+        fail ("The operand/operator sequence is wrong") { n%2 == 0 }
+        def groupLoc = (0..<n).find { i -> elements[i] instanceof List }
+        if (groupLoc != null) {
+            elements[groupLoc] = parse(elements[groupLoc])
+            continue
+        }
+        def opLoc = (0..<n).find { i -> elements[i] instanceof Op && elements[i].precedence == 1 } \
+                        ?: (0..<n).find { i -> elements[i] instanceof Op && elements[i].precedence == 2 }
+        if (opLoc != null) {
+            fail ("Operator out of sequence") { opLoc%2 == 0 }
+            def term = new Term(left:elements[opLoc-1], op:elements[opLoc], right:elements[opLoc+1])
+            elements[(opLoc-1)..(opLoc+1)] = [term]
+            continue
+        }
+    }
+    return elements[0] instanceof List ? parse(elements[0]) : elements[0]
+}

Task/Arithmetic-evaluation/Groovy/arithmetic-evaluation-2.groovy

@@ -0,0 +1,36 @@
+def testParse = {
+    def ex = parse(it)
+    print """
+Input: ${it}
+AST:   ${ex}
+value: ${ex.evaluate()}
+"""
+}
+
+
+testParse('1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2')
+assert (parse('1+1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+(1+1/15)/14)/13)/12)/11)/10)/9)/8)/7)/6)/5)/4)/3)/2')
+        .evaluate() - Math.E).abs() < 0.0000000000001
+testParse('1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1')
+testParse('1 - 5 * 2 / 20 + 1')
+testParse('(1 - 5) * 2 / (20 + 1)')
+testParse('2 * (3 + ((5) / (7 - 11)))')
+testParse('(2 + 3) / (10 - 5)')
+testParse('(1 + 2) * 10 / 100')
+testParse('(1 + 2 / 2) * (5 + 5)')
+testParse('2*-3--4+-.25')
+testParse('2*(-3)-(-4)+(-.25)')
+testParse('((11+15)*15)*2-(3)*4*1')
+testParse('((11+15)*15)* 2 + (3) * -4 *1')
+testParse('(((((1)))))')
+testParse('-35')
+println()
+
+try { testParse('((11+15)*1') } catch (e) { println e }
+try { testParse('((11+15)*1)))') } catch (e) { println e }
+try { testParse('((11+15)*x)') } catch (e) { println e }
+try { testParse('+++++') } catch (e) { println e }
+try { testParse('1 /') } catch (e) { println e }
+try { testParse('1++') } catch (e) { println e }
+try { testParse('*1') } catch (e) { println e }
+try { testParse('/ 1 /') } catch (e) { println e }

Task/Arithmetic-evaluation/Icon/arithmetic-evaluation.icon

@@ -0,0 +1,101 @@
+procedure main()                                                #: simple arithmetical parser / evaluator
+   write("Usage: Input expression = Abstract Syntax Tree = Value, ^Z to end.")
+   repeat {
+      writes("Input expression : ")
+      if not writes(line := read()) then break
+      if map(line) ? { (x := E()) & pos(0) } then
+         write(" = ", showAST(x), " = ", evalAST(x))
+      else
+         write(" rejected")
+   }
+end
+
+procedure evalAST(X)                                            #: return the evaluated AST
+   local x
+
+   if type(X) == "list" then {
+      x := evalAST(get(X))
+      while x := get(X)(x, evalAST(get(X) | stop("Malformed AST.")))
+   }
+   return \x | X
+end
+
+procedure showAST(X)                                            #: return a string representing the AST
+   local x,s
+
+   s := ""
+   every x := !X do
+      s ||:= if type(x) == "list" then "(" || showAST(x) || ")" else x
+   return s
+end
+
+########
+# When you're writing a big parser, a few utility recognisers are very useful
+#
+procedure ws()    # skip optional whitespace
+   suspend tab(many(' \t')) | ""
+end
+
+procedure digits()
+   suspend tab(many(&digits))
+end
+
+procedure radixNum(r)    # r sets the radix
+   static chars
+   initial chars := &digits || &lcase
+   suspend tab(many(chars[1 +: r]))
+end
+########
+
+global token
+record HansonsDevice(precedence,associativity)
+
+procedure opinfo()
+   static O
+   initial {
+      O := HansonsDevice([], table(&null))                         # parsing table
+      put(O.precedence, ["+", "-"], ["*", "/", "%"], ["^"])        # Lowest to Highest precedence
+      every O.associativity[!!O.precedence] := 1                   # default to 1 for LEFT associativity
+      O.associativity["^"] := 0                                    # RIGHT associativity
+   }
+   return O
+end
+
+procedure E(k)                                                  #: Expression
+   local lex, pL
+   static opT
+   initial opT := opinfo()
+
+   /k := 1
+   lex := []
+   if not (pL := opT.precedence[k]) then                        # this op at this level?
+      put(lex, F())
+   else {
+      put(lex, E(k + 1))
+      while ws() & put(lex, token := =!pL) do
+         put(lex, E(k + opT.associativity[token]))
+   }
+   suspend if *lex = 1 then lex[1] else lex                     # strip useless []
+end
+
+procedure F()                                                   #: Factor
+   suspend ws() & (    # skip optional whitespace, and ...
+      (="+" & F())              |          # unary + and a Factor, or ...
+      (="-" || V())             |          # unary - and a Value, or ...
+      (="-" & [-1, "*", F()])   |          # unary - and a Factor, or ...
+     2(="(", E(), ws(), =")")   |          # parenthesized subexpression, or ...
+       V()                                 # just a value
+   )
+end
+
+procedure V()                                                   #: Value
+   local r
+   suspend ws() & numeric(    # skip optional whitespace, and ...
+       =(r := 1 to 36) || ="r" || radixNum(r)             |     # N-based number, or ...
+       digits() || (="." || digits() | "") || exponent()        # plain number with optional fraction
+   )
+end
+
+procedure exponent()
+   suspend tab(any('eE')) || =("+" | "-" | "") || digits() | ""
+end

Task/Arithmetic-evaluation/J/arithmetic-evaluation-1.j

@@ -0,0 +1,66 @@
+parse=:parse_parser_
+eval=:monad define
+  'gerund structure'=:y
+  gerund@.structure
+)
+
+coclass 'parser'
+classify=: '$()*/+-'&(((>:@#@[ # 2:) #: 2 ^ i.)&;:)
+
+rules=: ''
+patterns=: ,"0 assert 1
+
+addrule=: dyad define
+   rules=: rules,;:x
+   patterns=: patterns,+./@classify"1 y
+)
+
+'Term'   addrule '$()',   '0',     '+-',: '0'
+'Factor' addrule '$()+-', '0',     '*/',: '0'
+'Parens' addrule '(',    '*/+-0', ')',:  ')*/+-0$'
+rules=: rules,;:'Move'
+
+buildTree=: monad define
+  words=: ;:'$',y
+  queue=: classify '$',y
+  stack=: classify '$$$$'
+  tokens=: ]&.>i.#words
+  tree=: ''
+  while.(#queue)+.6<#stack do.
+    rule=: rules {~ i.&1 patterns (*./"1)@:(+./"1) .(*."1)4{.stack
+    rule`:6''
+  end.
+  'syntax' assert 1 0 1 1 1 1 -: {:"1 stack
+  gerund=: literal&.> (<,'%') (I. words=<,'/')} words
+  gerund;1{tree
+)
+
+literal=:monad define ::]
+  ".'t=.',y
+  5!:1<'t'
+)
+
+Term=: Factor=: monad define
+  stack=: ({.stack),(classify '0'),4}.stack
+  tree=: ({.tree),(<1 2 3{tree),4}.tree
+)
+
+Parens=: monad define
+  stack=: (1{stack),3}.stack
+  tree=: (1{tree),3}.tree
+)
+
+Move=: monad define
+  'syntax' assert 0<#queue
+  stack=: ({:queue),stack
+  queue=: }:queue
+  tree=: ({:tokens),tree
+  tokens=: }:tokens
+)
+
+parse=:monad define
+  tmp=: conew 'parser'
+  r=: buildTree__tmp y
+  coerase tmp
+  r
+)

Task/Arithmetic-evaluation/J/arithmetic-evaluation-2.j

@@ -0,0 +1,2 @@
+   eval parse '1+2*3/(4-5+6)'
+2.2

Task/Arithmetic-evaluation/J/arithmetic-evaluation-3.j

@@ -0,0 +1,10 @@
+   parse '2*3/(4-5)'
+┌─────────────────────────────────────────────────────┬───────────────────┐
+│┌───┬───────┬───┬───────┬───┬─┬───────┬───┬───────┬─┐│┌───────┬─┬───────┐│
+││┌─┐│┌─────┐│┌─┐│┌─────┐│┌─┐│(│┌─────┐│┌─┐│┌─────┐│)│││┌─┬─┬─┐│4│┌─┬─┬─┐││
+│││$│││┌─┬─┐│││*│││┌─┬─┐│││%││ ││┌─┬─┐│││-│││┌─┬─┐││ ││││1│2│3││ ││6│7│8│││
+││└─┘│││0│2│││└─┘│││0│3│││└─┘│ │││0│4│││└─┘│││0│5│││ │││└─┴─┴─┘│ │└─┴─┴─┘││
+││   ││└─┴─┘││   ││└─┴─┘││   │ ││└─┴─┘││   ││└─┴─┘││ ││└───────┴─┴───────┘│
+││   │└─────┘│   │└─────┘│   │ │└─────┘│   │└─────┘│ ││                   │
+│└───┴───────┴───┴───────┴───┴─┴───────┴───┴───────┴─┘│                   │
+└─────────────────────────────────────────────────────┴───────────────────┘

Task/Arithmetic-evaluation/Julia/arithmetic-evaluation.julia

@@ -0,0 +1,41 @@
+julia> expr="2 * (3 -1) + 2 * 5"
+"2 * (3 -1) + 2 * 5"
+
+julia> parsed = parse(expr) #Julia provides low-level access to language parser for AST/Expr creation
+:(+(*(2,-(3,1)),*(2,5)))
+
+julia> t = typeof(parsed)
+Expr
+
+julia> names(t) #shows type fields
+(:head,:args,:typ)
+
+julia> parsed.args #Inspect our 'Expr' type innards
+3-element Any Array:
+ :+
+ :(*(2,-(3,1)))
+ :(*(2,5))
+
+julia> typeof(parsed.args[2]) #'Expr' types can nest
+Expr
+
+julia> parsed.args[2].args
+3-element Any Array:
+  :*
+ 2
+  :(-(3,1))
+
+julia> parsed.args[2].args[3].args #Will nest until lowest level of AST
+3-element Any Array:
+  :-
+ 3
+ 1
+
+julia> eval(parsed)
+14
+
+julia> eval(parse("1 - 5 * 2 / 20 + 1"))
+1.5
+
+julia> eval(parse("2 * (3 + ((5) / (7 - 11)))"))
+3.5

Task/Arithmetic-evaluation/Mathematica/arithmetic-evaluation-1.mathematica

@@ -0,0 +1,34 @@
+(*parsing:*)
+parse[string_] :=
+ Module[{e},
+  StringCases[string,
+     "+" | "-" | "*" | "/" | "(" | ")" |
+      DigitCharacter ..] //. {a_String?DigitQ :>
+      e[ToExpression@a], {x___, PatternSequence["(", a_e, ")"],
+       y___} :> {x, a,
+       y}, {x :
+        PatternSequence[] |
+         PatternSequence[___, "(" | "+" | "-" | "*" | "/"],
+       PatternSequence[op : "+" | "-", a_e], y___} :> {x, e[op, a],
+       y}, {x :
+        PatternSequence[] | PatternSequence[___, "(" | "+" | "-"],
+       PatternSequence[a_e, op : "*" | "/", b_e], y___} :> {x,
+       e[op, a, b],
+       y}, {x :
+        PatternSequence[] | PatternSequence[___, "(" | "+" | "-"],
+       PatternSequence[a_e, b_e], y___} :> {x, e["*", a, b],
+       y}, {x : PatternSequence[] | PatternSequence[___, "("],
+       PatternSequence[a_e, op : "+" | "-", b_e],
+       y : PatternSequence[] |
+         PatternSequence[")" | "+" | "-", ___]} :> {x, e[op, a, b],
+       y}} //. {e -> List, {a_Integer} :> a, {a_List} :> a}]
+
+(*evaluation*)
+evaluate[a_Integer] := a;
+evaluate[{"+", a_}] := evaluate[a];
+evaluate[{"-", a_}] := -evaluate[a];
+evaluate[{"+", a_, b_}] := evaluate[a] + evaluate[b];
+evaluate[{"-", a_, b_}] := evaluate[a] - evaluate[b];
+evaluate[{"*", a_, b_}] := evaluate[a]*evaluate[b];
+evaluate[{"/", a_, b_}] := evaluate[a]/evaluate[b];
+evaluate[string_String] := evaluate[parse[string]]

Task/Arithmetic-evaluation/Mathematica/arithmetic-evaluation-2.mathematica

@@ -0,0 +1,2 @@
+parse["-1+2(3+4*-5/6)"]
+evaluate["-1+2(3+4*-5/6)"]