I'm trying to write a function in Scheme that returns the first n elements in a list. I'm want to do that without loops, just with this basic structure below.
What I've tried is:
(define n-first
(lambda (lst n)
(if (or(empty? lst) (= n 0))
(list)
(append (car lst) (n-first (cdr lst) (- n 1))))))
But I'm getting an error:
append: contract violation
expected: list?
given: 'in
I've tried to debug it and it looks that the tail of the recursion crashes it, meaning, just after returning the empty list the program crashes.
When replacing "append" operator with "list" I get:
Input: (n-first '(the cat in the hat) 3)
Output:
'(the (cat (in ())))
But I want to get an appended list.
A list that looks like (1 2 3) i constructed like (1 . (2 . (3 . ()))) or if you're more familiar with cons (cons 1 (cons 2 (cons 3 '()))). Thus (list 1 2 3)) does exactly that under the hood. This is crucial information in order to be good at procedures that works on them. Notice that the first cons cannot be applied before the (cons 2 (cons 3 '())) is finished so a list is always created from end to beginning. Also a list is iterated from beginning to end.
So you want:
(define lst '(1 2 3 4 5))
(n-first lst 0) ; == '()
(n-first lst 1) ; == (cons (car lst) (n-first (- 1 1) (cdr lst)))
(n-first lst 2) ; == (cons (car lst) (n-first (- 2 1) (cdr lst)))
append works like this:
(define (append lst1 lst2)
(if (null? lst1)
lst2
(cons (car lst1)
(append (cdr lst1) lst2))))
append is O(n) time complexity so if you use that each iteration of n parts of a list then you get O(n^2). For small lists you won't notice it but even a medium sized lists of a hundred thousand elements you'll notice append uses about 50 times longer to complete than the cons one and for large lists you don't want to wait for the result since it grows exponentially.
try so
(define first-n
(lambda (l)
(lambda (n)
((lambda (s)
(s s l n (lambda (x) x)))
(lambda (s l n k)
(if (or (zero? n)
(null? l))
(k '())
(s s (cdr l) (- n 1)
(lambda (rest)
(k (cons (car l) rest))))))))))
(display ((first-n '(a b c d e f)) 4))
(display ((first-n '(a b)) 4))
In scheme you must compute mentally the types of each expression, as it does not have a type checker/ type inference included.
I am encountering a issue that I need to add up the second number of each list. For example, suppose I have a list of lists like below,
(list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12))
Then my job is to add up 4 + 7 + 5 + 3 + 12 = 31. However, the list can have multiple sub lists. But the second item inside a list can either be a number or a list. If it is a list, then we need to dig deeper into this list until we get a number.
Thanks!
Solution
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define (my-and x y)
(and x y))
(define (every? l)
(foldr my-and #t l))
(define (flat-list? l)
(cond ((null? l) #t)
((every? (map atom? l)) #t)
(else #f)))
(define (add-only-seconds l)
(define (l-sec-add l acc)
(cond ((null? l) acc)
((atom? l) acc)
((flat-list? l) (+ (second l) acc))
((list? l) (apply + acc (map (lambda (x) (l-sec-add x 0)) l)))))
(l-sec-add l 0))
Example test
(define example-list (list (list -4
(list (list -1 4) (list 1 7)))
(list 1 (list (list -2 5) (list 3 3)))
(list 3 12)))
(add-only-seconds example-list) ;; 31
I used common-lisp-typical functions atom? and every?.
Since and cannot be used in foldr, I defined my-add to make add a function which can be used infoldr`.
how to implement this function
if get two list (a b c), (d e)
and return list (a+d b+d c+d a+e b+e c+e)
list element is all integer and result list's element order is free
I tried this like
(define (addlist L1 L2)
(define l1 (length L1))
(define l2 (length L2))
(let ((result '()))
(for ((i (in-range l1)))
(for ((j (in-range l2)))
(append result (list (+ (list-ref L1 i) (list-ref L2 j))))))))
but it return error because result is '()
I don't know how to solve this problem please help me
A data-transformational approach:
(a b c ...) (x y ...)
1. ==> ( ((a x) (b x) (c x) ...) ((a y) (b y) (c y) ...) ...)
2. ==> ( (a x) (b x) (c x) ... (a y) (b y) (c y) ... ...)
3. ==> ( (a+x) (b+x) ... )
(define (addlist L1 L2)
(map (lambda (r) (apply + r)) ; 3. sum the pairs up
(reduce append '() ; 2. concatenate the lists
(map (lambda (e2) ; 1. pair-up the elements
(map (lambda (e1)
(list e1 e2)) ; combine two elements with `list`
L1))
L2))))
testing (in MIT-Scheme):
(addlist '(1 2 3) '(10 20))
;Value 23: (11 12 13 21 22 23)
Can you simplify this so there's no separate step #3?
We can further separate out the different bits and pieces in play here, as
(define (bind L f) (join (map f L)))
(define (join L) (reduce append '() L))
(define yield list)
then,
(bind '(1 2 3) (lambda (x) (bind '(10 20) (lambda (y) (yield (+ x y))))))
;Value 13: (11 21 12 22 13 23)
(bind '(10 20) (lambda (x) (bind '(1 2 3) (lambda (y) (yield (+ x y))))))
;Value 14: (11 12 13 21 22 23)
Here you go:
(define (addlist L1 L2)
(for*/list ((i (in-list L1)) (j (in-list L2)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 21 12 22 13 23)
The trick is to use for/list (or for*/list in case of nested fors) , which will automatically do the append for you. Also, note that you can just iterate over the lists, no need to work with indexes.
To get the result "the other way round", invert L1 and L2:
(define (addlist L1 L2)
(for*/list ((i (in-list L2)) (j (in-list L1)))
(+ i j)))
> (addlist '(1 2 3) '(10 20))
'(11 12 13 21 22 23)
In scheme, it's not recommended using function like set! or append!.
because it cause data changed or Variable, not as Funcitonal Programming Style.
should like this:
(define (add-one-list val lst)
(if (null? lst) '()
(cons (list val (car lst)) (add-one-list val (cdr lst)))))
(define (add-list lst0 lst1)
(if (null? lst0) '()
(append (add-one-list (car lst0) lst1)
(add-list (cdr lst0) lst1))))
first understanding function add-one-list, it recursively call itself, and every time build val and fist element of lst to a list, and CONS/accumulate it as final answer.
add-list function just like add-one-list.
(define (addlist L1 L2)
(flatmap (lambda (x) (map (lambda (y) (+ x y)) L1)) L2))
(define (flatmap f L)
(if (null? L)
'()
(append (f (car L)) (flatmap f (cdr L)))))
1 ]=> (addlist '(1 2 3) '(10 20))
;Value 2: (11 12 13 21 22 23)
Going with Will and Procras on this one. If you're going to use scheme, might as well use idiomatic scheme.
Using for to build a list is a bit weird to me. (list comprehensions would fit better) For is usually used to induce sequential side effects. That and RSR5 does not define a for/list or for*/list.
Flatmap is a fairly common functional paradigm where you use append instead of cons to build a list to avoid nested and empty sublists
It doesn't work because functions like append don't mutate the containers. You could fix your problem with a mutating function like append!. Usually functions that mutate have a ! in their name like set! etc.
But it's possible to achieve that without doing mutation. You'd have to change your algorithm to send the result to your next iteration. Like this:
(let loop ((result '()))
(loop (append result '(1)))
As you can see, when loop will get called, result will be:
'()
'(1)
'(1 1)
'(1 1 1)
....
Following this logic you should be able to change your algorithm to use this method instead of for loop. You'll have to pass some more parameters to know when you have to exit and return result.
I'll try to add a more complete answer later today.
Here's an implementation of append! I just wrote:
(define (append! lst1 lst2)
(if (null? (cdr lst1))
(set-cdr! lst1 lst2)
(append! (cdr lst1) lst2)))
I'm trying to create a function to count all the elements in a list, including the elements of its sublists. initially, to get started, i came up with a basic function myList:
(define myLength
(lambda (L)
(cond
((null? L) 0)
(else (+ 1 (myLength (cdr L)))))))
However, it doesn't help me account for function calls like:
(numAtoms '()) "...should be 0"
(numAtoms '(())) "...should be 0"
(numAtoms '(1 1)) "...should be 2"
(numAtoms '(1 (1 1) 1)) "...should be 4"
(numAtoms '(1 (1 (1 1)) 1)) "...should be 5"
I'm trying to use basic functions like length, null?, and list?.
I think the trick here is to imagine how you can transform your input into the code that you'd want to use to compute the sum. Let's write each of your inputs in the fully expanded form, in terms of cons and '() and whatever other atoms appear in your data:
'() == '()
'(()) == (cons '() '())
'(1 1) == (cons 1 (cons 1 '()))
'(1 (1 1) 1) == (cons 1 (cons 1 (cons 1 '())) (cons 1 '()))
'(1 (1 (1 1)) 1) == ...
Now, look what would happen if you replaced each occurrence of cons with +, and each occurrence of '() with 0, and each occurrence of something that's not '() with 1. You'd have:
'() => 0 == 0
(cons '() '()) => (+ 0 0) == 0
(cons 1 (cons 1 '())) => (+ 1 (+ 1 0)) == 2
(cons 1 (cons 1 (cons 1 '())) (cons 1 '())) => (+ 1 (+ 1 (+ 1 0)) (+ 1 0)) == 4
... => ... == ...
Notice that those sums are exactly the values that you want! Based on this, it seems like you might not want to treat your input as a list so much as a tree built from cons cells. In general, you can map over a tree by specifying a function to apply to the recursive results of processing a pair, and a function to process the atoms of the tree:
(define (treeduce pair-fn atom-fn tree)
(if (pair? tree)
(pair-fn (treeduce pair-fn atom-fn (car tree))
(treeduce pair-fn atom-fn (cdr tree)))
(atom-fn tree)))
You could then implement that mapping of cons to + and everything else to 1 if it's a list and 0 if it's not by:
(define (non-null-atoms tree)
(treeduce +
(lambda (atom)
(if (not (null? atom))
1
0))
tree))
This yields the kinds of results you'd expect:
(non-null-atoms '()) ;=> 0
(non-null-atoms '(())) ;=> 0
(non-null-atoms '(1 1)) ;=> 2
(non-null-atoms '(1 (1 1) 1)) ;=> 4
(non-null-atoms '(1 (1 (1 1)) 1)) ;=> 5
Here is a recursive template you can use:
(define (num-atoms lst)
(cond ((pair? lst) (+ (num-atoms <??>)
(num-atoms <??>)))
((null? lst) <??>) ; not an atom
(else <??>))) ; an atom
This next example uses a helper that has the accumulated value (num) as an argument.
(define (num-atoms lst)
;; locally defined helper
(define (helper num lst)
(cond ((pair? lst) (helper (helper <??> <??>) <??>)) ; recurse with the sum of elements from car
((null? lst) <??>) ; return accumulated value
(else (helper <??> <??>)))) ; recurse with add1 to num
;; procedure starts here
(helper 0 lst))
Hope it helps
Make my-length work for any argument type, list or 'atom'; then the recursive algorithm becomes almost trivial:
(define (my-length l)
(cond ((null? l) 0)
((list? l) (+ (my-length (car l)) (my-length (cdr l))))
(else 1))) ; atom
> (my-length '(1 (1 (1 1)) 1)))
5
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?
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)))
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))))
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
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))))
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