10

I hacked together several code snippets from various sources and created a crude implementation of a Wolfram Blog article at http://bit.ly/HWdUqK - for those that are mathematically inclined, it is very interesting!

Not surprisingly, given that I'm still a novice at Racket, the code takes too much time to calculate the results (>90 min versus 49 seconds for the author) and eats up a lot of memory. I suspect it is all about the definition (expListY) which needs to be reworked.

Although I have it working in DrRacket, I am also having problems byte-compiling the source, and still working on it (Error message: +: expects type <number> as 1st argument, given: #f; other arguments were: 1 -1)

Anybody want to take a stab at improving the performance and efficiency? I apologize for the unintelligible code and lack of better code comments.

PS: Should I be cutting and pasting the code directly here?

Jeremiah Willcock
  • 30,161
  • 7
  • 76
  • 78
lifebalance
  • 1,846
  • 3
  • 25
  • 57

5 Answers5

9

Probably similar to soegaard's solution, except this one rolls its own "parser", so it's self contained. It produces the complete 100-year listing in a bit under 6 seconds on my machine. There's a bunch of tricks that this code uses, but it's not really something that would be called "optimized" in any serious way: I'm sure that it can be made much faster with some memoization, care for maximizing tree sharing etc etc. But for such a small domain it's not worth the effort... (Same goes for the quality of this code...)

BTW#1, more than parsing, the original solution(s) use eval which does not make things faster... For things like this it's usually better to write the "evaluator" manually. BTW#2, this doesn't mean that Racket is faster than Mathematica -- I'm sure that the solution in that post makes it grind redundant cpu cycles too, and a similar solution would be faster.

#lang racket

(define (tuples list n)
  (let loop ([n n])
    (if (zero? n)
      '(())
      (for*/list ([y (in-list (loop (sub1 n)))] [x (in-list list)])
        (cons x y)))))

(define precedence
  (let ([t (make-hasheq)])
    (for ([ops '((#f) (+ -) (* /) (||))] [n (in-naturals)])
      (for ([op ops]) (hash-set! t op n)))
    t))

(define (do op x y)
  (case op
    [(+) (+ x y)] [(-) (- x y)] [(*) (* x y)] [(/) (/ x y)]
    [(||) (+ (* 10 x) y)]))

(define (run ops nums)
  (unless (= (add1 (length ops)) (length nums)) (error "poof"))
  (let loop ([nums     (cddr nums)]
             [ops      (cdr ops)]
             [numstack (list (cadr nums) (car nums))]
             [opstack  (list (car ops))])
    (if (and (null? ops) (null? opstack))
      (car numstack)
      (let ([op    (and (pair? ops) (car ops))]
            [topop (and (pair? opstack) (car opstack))])
        (if (> (hash-ref precedence op)
               (hash-ref precedence topop))
          (loop (cdr nums)
                (cdr ops)
                (cons (car nums) numstack)
                (cons op opstack))
          (loop nums
                ops
                (cons (do topop (cadr numstack) (car numstack))
                      (cddr numstack))
                (cdr opstack)))))))

(define (expr ops* nums*)
  (define ops  (map symbol->string ops*))
  (define nums (map number->string nums*))
  (string-append* (cons (car nums) (append-map list ops (cdr nums)))))

(define nums  (for/list ([i (in-range 10 0 -1)]) i))
(define year1 2012)
(define nyears 100)
(define year2 (+ year1 nyears))
(define years (make-vector nyears '()))
(for ([ops (in-list (tuples '(+ - * / ||) 9))])
  (define r (run ops nums))
  (when (and (integer? r) (<= year1 r) (< r year2))
    (vector-set! years (- r year1)
                 (cons ops (vector-ref years (- r year1))))))

(for ([solutions (in-vector years)] [year (in-range year1 year2)])
  (if (pair? solutions)
    (printf "~a = ~a~a\n"
            year (expr (car solutions) nums)
            (if (null? (cdr solutions))
              ""
              (format " (~a more)" (length (cdr solutions)))))
    (printf "~a: no combination!\n" year)))
Eli Barzilay
  • 29,301
  • 3
  • 67
  • 110
  • Super! Just for curiosity, I tried to byte-compile your code hoping it to be faster than the Interpreter mode, but that was not the case. – lifebalance Apr 16 '12 at 08:24
5

Below is my implementation. I tweaked and optimized a thing or two in your code, in my laptop it takes around 35 minutes to finish (certainly an improvement!) I found that the evaluation of expressions is the real performance killer - if it weren't for the calls to the procedure to-expression, the program would finish in under a minute.

I guess that in programming languages that natively use infix notation the evaluation would be much faster, but in Scheme the cost for parsing and then evaluating a string with an infix expression is just too much.

Maybe someone can point out a suitable replacement for the soegaard/infix package? or alternatively, a way to directly evaluate an infix expression list that takes into account operator precedence, say '(1 + 3 - 4 & 7) - where & stands for number concatenation and has the highest precedence (for example: 4 & 7 = 47), and the other arithmetic operators (+, -, *, /) follow the usual precedence rules.

#lang at-exp racket

(require (planet soegaard/infix)
         (planet soegaard/infix/parser))

(define (product lst1 lst2) 
  (for*/list ([x (in-list lst1)] 
              [y (in-list lst2)]) 
    (cons x y))) 

(define (tuples lst n)
  (if (zero? n)
      '(())
      (product lst (tuples lst (sub1 n)))))

(define (riffle numbers ops)
  (if (null? ops)
      (list (car numbers))
      (cons (car numbers)
            (cons (car ops)
                  (riffle (cdr numbers)
                          (cdr ops))))))

(define (expression-string numbers optuple)
  (apply string-append
         (riffle numbers optuple)))

(define (to-expression exp-str)
  (eval
   (parse-expression
    #'here (open-input-string exp-str))))

(define (make-all-combinations numbers ops)
  (let loop ((opts (tuples ops (sub1 (length numbers))))
             (acc '()))
    (if (null? opts)
        acc
        (let ((exp-str (expression-string numbers (car opts))))
          (loop (cdr opts)
                (cons (cons exp-str (to-expression exp-str)) acc))))))

(define (show-n-expressions all-combinations years)
  (for-each (lambda (year)
              (for-each (lambda (comb)
                          (when (= (cdr comb) year)
                            (printf "~s ~a~n" year (car comb))))
                        all-combinations)
              (printf "~n"))
            years))

Use it like this for replicating the results in the original blog post:

(define numbers '("10" "9" "8" "7" "6" "5" "4" "3" "2" "1"))
(define ops '("" "+" "-" "*" "/"))
; beware: this takes around 35 minutes to finish in my laptop
(define all-combinations (make-all-combinations numbers ops))
(show-n-expressions all-combinations
                    (build-list 5 (lambda (n) (+ n 2012))))

UPDATE :

I snarfed Eli Barzilay's expression evaluator and plugged it into my solution, now the pre-calculation of all combinations is done in around 5 seconds! The show-n-expressions procedure still needs some work to avoid iterating over the whole list of combinations each time, but that's left as an exercise for the reader. What matters is that now brute-forcing the values for all the possible expression combinations is blazing fast.

#lang racket

(define (tuples lst n)
  (if (zero? n)
      '(())
      (for*/list ((y (in-list (tuples lst (sub1 n))))
                  (x (in-list lst)))
        (cons x y))))

(define (riffle numbers ops)
  (if (null? ops)
      (list (car numbers))
      (cons (car numbers)
            (cons (car ops)
                  (riffle (cdr numbers)
                          (cdr ops))))))

(define (expression-string numbers optuple)
  (string-append*
   (map (lambda (x)
          (cond ((eq? x '&) "")
                ((symbol? x) (symbol->string x))
                ((number? x) (number->string x))))
        (riffle numbers optuple))))

(define eval-ops
  (let ((precedence (make-hasheq
                     '((& . 3) (/ . 2) (* . 2)
                       (- . 1) (+ . 1) (#f . 0))))
        (apply-op   (lambda (op x y)
                      (case op
                        ((+) (+ x y)) ((-) (- x y))
                        ((*) (* x y)) ((/) (/ x y))
                        ((&) (+ (* 10 x) y))))))
    (lambda (nums ops)
      (let loop ((nums     (cddr nums))
                 (ops      (cdr ops))
                 (numstack (list (cadr nums) (car nums)))
                 (opstack  (list (car ops))))
        (if (and (null? ops) (null? opstack))
            (car numstack)
            (let ((op    (and (pair? ops) (car ops)))
                  (topop (and (pair? opstack) (car opstack))))
              (if (> (hash-ref precedence op)
                     (hash-ref precedence topop))
                  (loop (cdr nums)
                        (cdr ops)
                        (cons (car nums) numstack)
                        (cons op opstack))
                  (loop nums
                        ops
                        (cons (apply-op topop (cadr numstack) (car numstack))
                              (cddr numstack))
                        (cdr opstack)))))))))

(define (make-all-combinations numbers ops)
  (foldl (lambda (optuple tail)
           (cons (cons (eval-ops numbers optuple) optuple) tail))
         empty (tuples ops (sub1 (length numbers)))))

(define (show-n-expressions all-combinations numbers years)
  (for-each (lambda (year)
              (for-each (lambda (comb)
                          (when (= (car comb) year)
                            (printf "~s ~a~n"
                                    year
                                    (expression-string numbers (cdr comb)))))
                        all-combinations)
              (printf "~n"))
            years))

Use it like this:

(define numbers '(10 9 8 7 6 5 4 3 2 1))
(define ops '(& + - * /))
; this is very fast now!
(define all-combinations (make-all-combinations numbers ops))
(show-n-expressions all-combinations numbers
                    (build-list 5 (lambda (n) (+ n 2012))))
Óscar López
  • 232,561
  • 37
  • 312
  • 386
4

As Óscar points out, the problem is that soegaard/infix is slow for this type of problem.

I found a standard shunting-yard parser for infix expressions on GitHub and wrote the following program in Racket:

#lang racket
(require "infix-calc.scm")

(define operators '("*" "/" "+" "-" ""))
(time
(for*/list ([o1  (in-list operators)]
            [o2  (in-list operators)]
            [o3  (in-list operators)]
            [o4  (in-list operators)]
            [o5  (in-list operators)]
            [o6  (in-list operators)]
            [o7  (in-list operators)]
            [o8  (in-list operators)]
            [o9  (in-list operators)]
            [expr (in-value
                  (apply string-append
                        (list "1" o1 "2" o2 "3" o3 "4" o4 "5" o5 "6" o6 "7" o7 "8" o8 "9" o9 "10")))]
             #:when (= (first (calc expr)) 2012))
 expr))

After a little less than 3 minutes the results are:

Welcome to DrRacket, version 5.2.900.2--2012-03-29(8c22c6c/a) [3m].
Language: racket; memory limit: 128 MB.
cpu time: 144768 real time: 148818 gc time: 25252
'("1*2*3+4*567*8/9-10"
  "1*2+34*56+7+89+10"
  "1*23+45*6*7+89+10"
  "1+2+3/4*5*67*8+9-10"
  "1+2+3+4*567*8/9-10"
  "1+2+34*56+7+8+9*10"
  "1+23+45*6*7+8+9*10"
  "1-2+345*6-7*8+9-10"
  "12*34*5+6+7*8-9*10"
  "12*34*5+6-7-8-9-10"
  "1234+5-6+789-10")

The infix parser was written by Andrew Levenson. The parser and the above code can be found here:

https://github.com/soegaard/Scheme-Infix-Calculator

soegaard
  • 30,661
  • 4
  • 57
  • 106
  • 1
    The main reason soegaard/infix is slow here, is that the output of scheme/infix is meant to be used during compilation. There are several sources of overhead: First the parser expects a port, so open-input-string is used to turn the string into a port, after parsing the result is a syntax object (which normally would be compiled), but here is given to eval (and using eval is slow). – soegaard Apr 16 '12 at 07:40
  • Thanks for the insight. It is unfortunate that I can only choose one answer among so many good ones! – lifebalance Apr 17 '12 at 03:15
3

this isn't a complete answer, but i think it's an alternative to the library Óscar López is asking for. unfortunately it's in clojure, but hopefully it's clear enough...

(def default-priorities
  {'+ 1, '- 1, '* 2, '/ 2, '& 3})

(defn- extend-tree [tree priorities operator value]
  (if (seq? tree)
    (let [[op left right] tree
          [old new] (map priorities [op operator])]
      (if (> new old)
        (list op left (extend-tree right priorities operator value))
        (list operator tree value)))
    (list operator tree value)))

(defn priority-tree
  ([operators values] (priority-tree operators values default-priorities))
  ([operators values priorities] (priority-tree operators values priorities nil))
  ([operators values priorities tree]
    (if-let [operators (seq operators)]
      (if tree
        (recur
          (rest operators) (rest values) priorities
          (extend-tree tree priorities (first operators) (first values)))
        (let [[v1 v2 & values] values]
          (recur (rest operators) values priorities (list (first operators) v1 v2))))
      tree)))

; [] [+ & *] [1 2 3 4] 1+23*4
; [+ 1 2] [& *] [3 4] - initial tree
; [+ 1 [& 2 3]] [*] [4] - binds more strongly than + so replace right-most node
; [+ 1 [* [& 2 3] 4]] [] [] - descend until do not bind more tightly, and extend

(println (priority-tree ['+ '& '*] [1 2 3 4])) ; 1+23*4
(println (priority-tree ['& '- '* '+ '&] [1 2 3 4 5 6])) ; 12 - 3*4 + 56

the output is:

(+ 1 (* (& 2 3) 4))
(+ (- (& 1 2) (* 3 4)) (& 5 6))

[update] adding the following

(defn & [a b] (+ b (* 10 a)))

(defn all-combinations [tokens length]
  (if (> length 0)
    (for [token tokens
          smaller (all-combinations tokens (dec length))]
      (cons token smaller))
    [[]]))

(defn all-expressions [operators digits]
  (map #(priority-tree % digits)
    (all-combinations operators (dec (count digits)))))

(defn all-solutions [target operators digits]
  (doseq [expression
          (filter #(= (eval %) target)
            (all-expressions operators digits))]
    (println expression)))

(all-solutions 2012 ['+ '- '* '/ '&] (range 10 0 -1))

solves the problem, but it's slow - 28 minutes to complete. this is on a nice, fairly recent laptop (i7-2640M).

(+ (- (+ 10 (* 9 (& 8 7))) (& 6 5)) (* 4 (& (& 3 2) 1)))
(+ (- (+ (+ (* (* 10 9) 8) 7) 6) 5) (* 4 (& (& 3 2) 1)))
(- (- (+ (- (& 10 9) (* 8 7)) (* (& (& 6 5) 4) 3)) 2) 1)

(i only printed 2012 - see code above - but it would have evaluated the entire sequence).

so, unfortunately, this doesn't really answer the question, since it's no faster than Óscar López's code. i guess the next step would be to put some smarts into the evaluation and so save some time. but what?

[update 2] after reading the other posts here i replaced eval with

(defn my-eval [expr]
  (if (seq? expr)
    (let [[op left right] expr]
      (case op
        + (+ (my-eval left) (my-eval right))
        - (- (my-eval left) (my-eval right))
        * (* (my-eval left) (my-eval right))
        / (/ (my-eval left) (my-eval right))
        & (& (my-eval left) (my-eval right))))
    expr))

and the running time drops to 45 secs. still not great, but it's a very inefficient parse/evaluation.

[update 3] for completeness, the following is an implementation of the shunting-yard algorithm (a simple one that is always left-associative) and the associated eval, butit only reduces the time to 35s.

(defn shunting-yard
  ([operators values] (shunting-yard operators values default-priorities))
  ([operators values priorities]
    (let [[value & values] values]
      (shunting-yard operators values priorities nil (list value))))
  ([operators values priorities stack-ops stack-vals]
;    (println operators values stack-ops stack-vals)
    (if-let [[new & short-operators] operators]
      (let [[value & short-values] values]
        (if-let [[old & short-stack-ops] stack-ops]
          (if (> (priorities new) (priorities old))
            (recur short-operators short-values priorities (cons new stack-ops) (cons value stack-vals))
            (recur operators values priorities short-stack-ops (cons old stack-vals)))
          (recur short-operators short-values priorities (list new) (cons value stack-vals))))
      (concat (reverse stack-vals) stack-ops))))

(defn stack-eval
  ([stack] (stack-eval (rest stack) (list (first stack))))
  ([stack values]
    (if-let [[op & stack] stack]
      (let [[right left & tail] values]
        (case op
          + (recur stack (cons (+ left right) tail))
          - (recur stack (cons (- left right) tail))
          * (recur stack (cons (* left right) tail))
          / (recur stack (cons (/ left right) tail))
          & (recur stack (cons (& left right) tail))
          (recur stack (cons op values))))
      (first values))))
andrew cooke
  • 45,717
  • 10
  • 93
  • 143
  • +1 for doing it in clojure. can you post a mickey mouse benchmark of your code? just having a small idea of relative performance between clojure and racket would be ticklish – lurscher Apr 16 '12 at 02:35
  • @andrewcooke I believe that if we could plug your `priority-tree` procedure in my answer (see the last edit) it'd be faster than that. Sadly I'm not fluent enough in clojure to make the conversion myself. – Óscar López Apr 16 '12 at 03:19
  • 1
    it's pretty simple! `recur` is equivalent to `priority-tree` (clojure needs explicit tail recursion); the strange lines at the start of `priority-tree` are just supplying default arguments; `let [[v1 v2 & values] values]` sets `v1` to `(first values), `v2` to `(first (tail values))` and rebinds `values` to `(tail (tail vaules))`. i think the rest is v similar to scheme... but i must sleep! – andrew cooke Apr 16 '12 at 03:25
3

Interesting! I had to try it, it's in Python, hope you don't mind. It runs in about 28 seconds, PyPy 1.8, Core 2 Duo 1.4

from __future__ import division
from math import log
from operator import add, sub, mul 
div = lambda a, b: float(a) / float(b)

years = set(range(2012, 2113))

none = lambda a, b: a * 10 ** (int(log(b, 10)) + 1) + b
priority = {none: 3, mul: 2, div: 2, add: 1, sub: 1}
symbols = {none: '', mul: '*', div: '/', add: '+', sub: '-', None: ''}

def evaluate(numbers, operators):
    ns, ops = [], []
    for n, op in zip(numbers, operators):
        while ops and (op is None or priority[ops[-1]] >= priority[op]):
            last_n = ns.pop()
            last_op = ops.pop()
            n = last_op(last_n, n)
        ns.append(n)
        ops.append(op)
    return n

def display(numbers, operators):
    return ''.join([
        i for n, op in zip(numbers, operators) for i in (str(n), symbols[op])])

def expressions(years):
    numbers = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
    operators = none, add, sub, mul, div
    pools = [operators] * (len(numbers) - 1) + [[None]]
    result = [[]]
    for pool in pools:
        result = [x + [y] for x in result for y in pool]
    for ops in result:
        expression = evaluate(numbers, ops)
        if expression in years:
            yield '%d = %s' % (expression, display(numbers, ops))

for year in sorted(expressions(years)):
    print year
lifebalance
  • 1,846
  • 3
  • 25
  • 57
Ecir Hana
  • 10,864
  • 13
  • 67
  • 117
  • Can you check this again? For 2102, there exists no combination, even as per the original blog article. Your answer generates 12 combinations (at least on Python IDLE, Python 2.7.2 (default, Jun 12 2011, 14:24:46) [MSC v.1500 64 bit (AMD64)] on win32): 2102 = 10*9/8*765/4-3+2*1, 2102 = 10*9/8*765/4-3+2/1, 2102 = 10*9/8*765/4-3/2*1, 2102 = 10*9/8*765/4-3/2/1, 2102 = 10-9+876/5*4*3+2-1, 2102 = 10/9*876/5*4*3+2*1 2102 = 10/9*876/5*4*3+2/1 2102 = 10/9+876/5*4*3+2-1 2102 = 109*8*7/6+543*2-1 2102 = 109*87/6+543-21 2102 = 10987/6+543/2*1 2102 = 10987/6+543/2/1 – lifebalance Apr 21 '12 at 18:04
  • try to `eval()` any of the combination above, e.g. `eval('10-9+876/5*4*3+2-1')` says `2012`. Not sure why the other methods display different results. Probably it has something to do with integer division, not sure though.... – Ecir Hana Apr 24 '12 at 14:19
  • Ok, i think it's because of the integer division. Replace the second line `from operator import add, sub, mul, div` with two lines `from operator import add, sub, mul` and `div = lambda a, b: float(a) / float(b)` and it should work as the other methods. More here: http://www.python.org/dev/peps/pep-0238/ – Ecir Hana Apr 24 '12 at 14:30
  • For archiving purposes: you could also just `from __future__ import division` at the top. – Ecir Hana May 09 '12 at 10:49
  • as requested, __future__ added at the top. – lifebalance Jun 05 '12 at 14:30