So I have code that should find the average of a list but I see no printed value in console
#lang racket
(define x (list '10 '60 '3 '55 '15 '45 '40))
(define (average x)
(/ (sum x) (length x)))
(display average (current-output-port))
(define (sum)
(if (null? x)
0
(+ (car x) (sum (cdr x)))))
it simply displays
#<procedure:average>
Your code has following problems:
sum was used before it was defined.
sum did not take a parameter.
average function was not evaluated in display.
I have used exact->inexact because that's what I think your intention is.
Following works.
(define x (list 10 60 3 55 15 45 40))
(define (sum x)
(if (null? x)
0
(+ (car x) (sum (cdr x)))))
(define (average x)
(/ (sum x) (length x)))
(display (exact->inexact (average x)) (current-output-port))
(define (average l)
(/ (foldr (lambda (x y) (+ x y)) 0 l)
(length l)))
sum and length are each O(n) resulting in a O(2n) process for average. Below we show how continuation passing style can be used to make average a O(n) process as well.
(define (average xs (return /))
(if (empty? xs)
(return 0 0)
(average (cdr xs)
(lambda (sum len)
(return (+ sum (car xs))
(+ len 1))))))
(printf "~a~n" (average '(10 60 3 55 15 45 40)))
;; 228/7
Using exact->inexact in average means only an inexact result can be returned. Making additional computations with inexact numbers leads to additional inexactitude. You might think that inexact->exact could reverse any of this however it can only make an approximation.
(average '(10 60 3 55 15 45 40)
;; 32 4/7
(inexact->exact (exact->inexact (average '(10 60 3 55 15 45 40))))
;; 32 40210710958665/70368744177664
For this reason it generally make sense only to convert an exact number to an inexact one just before it is displayed.
(printf "~a\n" (exact->inexact (average '(10 60 3 55 15 45 40))))
;; 32.57142857142857
Our average procedure also throws an error when an empty list is given.
(average '())
;; error /: division by zero
Alternatively, we could write average using a named let expression. Also O(n).
(define (average xs)
(let loop ((xs xs)
(sum 0)
(len 0))
(if (empty? xs)
(/ sum len)
(loop (cdr xs)
(+ sum (car xs))
(+ len 1)))))
(average '(10 60 3 55 15 45 40)
;; 32 4/7
I might be using a different version of scheme; https://scheme.cs61a.org/ is the compiler I use. It worked for me when I included the a parameter for the function sum like this:
(define (sum x)
(if (null? x)
0
(+ (car x) (sum (cdr x)))))
Hope this helps!
Related
I want to create a function in Scheme that takes a list of numbers and displays the number that are less than the average. The answer should be 3 but returns 2. I believe it is not reading "15." What am I doing wrong?
(define x (list 10 60 3 55 15 45 40))
(display "The list: ")
(let ((average (/ (apply + (cdr x)) (car x))))
(length (filter (lambda (x) (< x average)) (cdr x))))
Output:
The list:
(10 60 3 55 15 45 40)
The average:
32.57
Number of values less than average:
2
Sure, let's do this step by step!
First off, let's define a function to get us the average of a list. We'll call this function mean.
(define (mean lst)
(/ (apply + lst) (length lst)))
We get the average by adding all the numbers together and dividing that sum by how many numbers were in the list (that is to say, the length of the list). There are Racket libraries that could provide us with this function, such as the Statistics Functions library from the math-lib package. But we'll do it ourselves since it's simple enough.
Next we have the meat of our algorithm, where we define a function that takes a list, gets the average, and filters out every element less than the average.
(define (less-than-average lst)
(filter (λ (x) (< x (mean lst))) lst))
Looks pretty similar to your code, right? Let's see if it works:
(less-than-average (list 10 60 3 55 15 45 40))
I ran this in DrRacket and it gave me 10 3 15, which is the correct answer. So why did this work, when you (very similar) code does not?
The problem with your code is that the value you are storing in average is incorrect. Viz,
(define x (list 10 60 3 55 15 45 40))
(let ((average (/ (apply + (cdr x)) (car x))))
average)
evaluates to 21.8. As you state, the correct average is 32.57. Your current technique for computing this average is to add up everything in the list after the first element (that's what (apply + (cdr x)) does) then dividing that sum by the first element. This will not give you the mean value of the list. What you ought to be doing is summing up the entire list (via (apply + x)), then dividing that by how many numbers were in the list (ie (length x)).
This answer tries to pay attention to performance. The other answer by Alex has a mean function which walks the list twice: once to add up the elements, and once to compute the length. It then calls this function for every element of the list when filtering it, resulting a function which takes time quadratic in the length of the list being averaged. This is not a problem for small lists.
Here is a mean function which walks the list once.
(define (list-average l)
(let average-loop ([tail l] [sum 0] [len 0])
(if (null? tail)
(/ sum len)
(average-loop (rest tail) (+ sum (first tail)) (+ len 1)))))
This is a little better than one which walks it twice, but the difference is probably not significant (naively it might be twice as fast, in practice probably less).
Here is a filtering function which is careful to call the mean function only once. This is a whole complexity class faster than one which calls it for every element, resulting in a function which takes time proportional to the length of the list, not the length of the list squared.
(define (<=-average l)
(define average (list-average l))
(filter (λ (e) (<= e average)) l))
I will not comment too much, I have just written such a function here and you can study it:
(define less-than-average
(lambda (list return)
((lambda (self) (self self list 0 0 return))
(lambda ( self list acc n col)
(if (null? list)
(col (/ acc n) list)
(let ((a (car list)))
(self self
(cdr list)
(+ acc a)
(+ n 1)
(lambda (average l*) ; when the average is known,
(if (< a average)
(col average (cons a l*))
(col average l* ))))))))))
1 ]=> (less-than-average (list 10 60 3 55 15 45 40)
(lambda (avg l*)
(newline)
(display avg)
(newline)
(display l*)
(newline)) )
228/7
(10 3 15)
Where does this implementation of the Josephus problem fall short? For those who are unfamiliar with the Josephus Problem, the goal is to delete every 3rd entry from a circularly linked list until only one remains. In this example I am deleting every "mth" value.
(define (joseph lst)
(let ((m (+ 1 (random (length lst)))))
(define (joseph-h i xlst mlst)
(cond ((<= (length xlst) 1) xlst)
((null? (cdr mlst))
(joseph-h i xlst xlst))
((= i m)
(joseph-h 1 (delete (car mlst) xlst) (cdr mlst)))
(else
(joseph-h (+ i 1) xlst (cdr mlst)))))
(joseph-h 0 lst lst)))
(joseph (list 1 2 3 4 5 6 7))
(define (delete v lst)
(cond ((= v (car lst))
(cdr lst))
(else
(cons (car lst) (delete v (cdr lst))))))
I always end up with the last number of the list as the answer. I know that this is not right.
You're taking the algorithm too literally, by creating a list and deleting elements ("killing" people) from it. A simpler solution would be to use arithmetic operations to model the problem, here's a possible implementation, adapted from my own previous answer:
(define (joseph n k)
(let loop ([i 1]
[acc 0])
(if (> i n)
(add1 acc)
(loop (add1 i)
(modulo (+ acc k) i)))))
For example, to see which position survives in the list '(1 2 3 4 5 6 7) after killing every third person, do this:
(joseph 7 3)
=> 4
Wikipedia provides an interesting discussion regarding the possible solutions for this problem, my solution adapts the simple python function shown, after converting it to tail recursion.
I give three solutions at my blog. The most literal version deletes from a list of n items in steps of m, representing the list as a cyclic list:
(define (cycle xs)
(set-cdr! (last-pair xs) xs) xs)
(define (josephus3 n m)
(let loop ((k (- m 1)) (alive (cycle (range 0 n))) (dead '()))
(cond ((= (car alive) (cadr alive))
(reverse (cons (car alive) dead)))
((= k 1)
(let ((dead (cons (cadr alive) dead)))
(set-cdr! alive (cddr alive))
(loop (- m 1) (cdr alive) dead)))
This does the deletions by actually removing the killed elements from the alive list and placing them on the dead list. The range function is from my Standard Prelude; it returns the integers from 0 to n-1:
(define (range first past . step)
(let* ((xs '()) (f first) (p past)
(s (cond ((pair? step) (car step))
((< f p) 1) (else -1)))
(le? (if (< 0 s) <= >=)))
(do ((x f (+ x s))) ((le? p x) (reverse xs))
(set! xs (cons x xs)))))
The original Josephus problem killed 41 men in steps of 3, leaving the 31st man as the survivor, counting from 1:
(josephus3 41 3)
(2 5 8 11 14 17 20 23 26 29 32 35 38 0 4 9 13 18 22 27 31 36
40 6 12 19 25 33 39 7 16 28 37 10 24 1 21 3 34 15 30)
You might also enjoy the other two versions at my blog.
this is possibly much of an elementary question, but I'm having trouble with a procedure I have to write in Scheme. The procedure should return all the prime numbers less or equal to N (N is from input).
(define (isPrimeHelper x k)
(if (= x k) #t
(if (= (remainder x k) 0) #f
(isPrimeHelper x (+ k 1)))))
(define ( isPrime x )
(cond
(( = x 1 ) #t)
(( = x 2 ) #t)
( else (isPrimeHelper x 2 ) )))
(define (printPrimesUpTo n)
(define result '())
(define (helper x)
(if (= x (+ 1 n)) result
(if (isPrime x) (cons x result) ))
( helper (+ x 1)))
( helper 1 ))
My check for prime works, however the function printPrimesUpTo seem to loop forever. Basically the idea is to check whether a number is prime and put it in a result list.
Thanks :)
You have several things wrong, and your code is very non-idiomatic. First, the number 1 is not prime; in fact, is it neither prime nor composite. Second, the result variable isn't doing what you think it is. Third, your use of if is incorrect everywhere it appears; if is an expression, not a statement as in some other programming languages. And, as a matter of style, closing parentheses are stacked at the end of the line, and don't occupy a line of their own. You need to talk with your professor or teaching assistant to clear up some basic misconceptions about Scheme.
The best algorithm to find the primes less than n is the Sieve of Eratosthenes, invented about twenty-two centuries ago by a Greek mathematician who invented the leap day and a system of latitude and longitude, accurately measured the circumference of the Earth and the distance from Earth to Sun, and was chief librarian of Ptolemy's library at Alexandria. Here is a simple version of his algorithm:
(define (primes n)
(let ((bits (make-vector (+ n 1) #t)))
(let loop ((p 2) (ps '()))
(cond ((< n p) (reverse ps))
((vector-ref bits p)
(do ((i (+ p p) (+ i p))) ((< n i))
(vector-set! bits i #f))
(loop (+ p 1) (cons p ps)))
(else (loop (+ p 1) ps))))))
Called as (primes 50), that returns the list (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47). It is much faster than testing numbers for primality by trial division, as you are attempting to do. If you must, here is a proper primality checker:
(define (prime? n)
(let loop ((d 2))
(cond ((< n (* d d)) #t)
((zero? (modulo n d)) #f)
(else (loop (+ d 1))))))
Improvements are possible for both algorithms. If you are interested, I modestly recommend this essay on my blog.
First, it is good style to express nested structure by indentation, so it is visually apparent; and also to put each of if's clauses, the consequent and the alternative, on its own line:
(define (isPrimeHelper x k)
(if (= x k)
#t ; consequent
(if (= (remainder x k) 0) ; alternative
;; ^^ indentation
#f ; consequent
(isPrimeHelper x (+ k 1))))) ; alternative
(define (printPrimesUpTo n)
(define result '())
(define (helper x)
(if (= x (+ 1 n))
result ; consequent
(if (isPrime x) ; alternative
(cons x result) )) ; no alternative!
;; ^^ indentation
( helper (+ x 1)))
( helper 1 ))
Now it is plainly seen that the last thing that your helper function does is to call itself with an incremented x value, always. There's no stopping conditions, i.e. this is an infinite loop.
Another thing is, calling (cons x result) does not alter result's value in any way. For that, you need to set it, like so: (set! result (cons x result)). You also need to put this expression in a begin group, as it is evaluated not for its value, but for its side-effect:
(define (helper x)
(if (= x (+ 1 n))
result
(begin
(if (isPrime x)
(set! result (cons x result)) ) ; no alternative!
(helper (+ x 1)) )))
Usually, the explicit use of set! is considered bad style. One standard way to express loops is as tail-recursive code using named let, usually with the canonical name "loop" (but it can be any name whatever):
(define (primesUpTo n)
(let loop ((x n)
(result '()))
(cond
((<= x 1) result) ; return the result
((isPrime x)
(loop (- x 1) (cons x result))) ; alter the result being built
(else (loop (- x 1) result))))) ; go on with the same result
which, in presence of tail-call optimization, is actually equivalent to the previous version.
The (if) expression in your (helper) function is not the tail expression of the function, and so is not returned, but control will always continue to (helper (+ x 1)) and recurse.
The more efficient prime?(from Sedgewick's "Algorithms"):
(define (prime? n)
(define (F n i) "helper"
(cond ((< n (* i i)) #t)
((zero? (remainder n i)) #f)
(else
(F n (+ i 1)))))
"primality test"
(cond ((< n 2) #f)
(else
(F n 2))))
You can do this much more nicely. I reformated your code:
(define (prime? x)
(define (prime-helper x k)
(cond ((= x k) #t)
((= (remainder x k) 0) #f)
(else
(prime-helper x (+ k 1)))))
(cond ((= x 1) #f)
((= x 2) #t)
(else
(prime-helper x 2))))
(define (primes-up-to n)
(define (helper x)
(cond ((= x 0) '())
((prime? x)
(cons x (helper (- x 1))))
(else
(helper (- x 1)))))
(reverse
(helper n)))
scheme#(guile-user)> (primes-up-to 20)
$1 = (2 3 5 7 11 13 17 19)
Please don’t write Scheme like C or Java – and have a look at these style rules for languages of the lisp-family for the sake of readability: Do not use camel-case, do not put parentheses on own lines, mark predicates with ?, take care of correct indentation, do not put additional whitespace within parentheses.
I have a function that takes a number such as 36, and reverses it to say '(6 3)
Is there anyway to combine that 6 3 to make it one number?
Here is the code that I have written.
(define (number->rdigits num)
(if (rdigits (/ (- num (mod num 10)) 10)))))
(define reversible?
(lambda (n)
(cond
[(null? n) #f]
[else (odd? (+ n (list (number->rdigits n))))])))
Thanks!
You can do this using an iterative function that takes each element of the list in turn, accumulating a result. For example:
(define (make-number lst)
(define (make a lst)
(if (null? lst)
a
(make (+ (* 10 a) (car lst)) (cdr lst))))
(make 0 lst))
(display (make-number '(6 3)))
The make function uses an accumulator a and the rest of the digits in lst to build up the final result one step at a time:
a = 0
a = 0*10 + 6 = 6
a = 6*10 + 3 = 63
If you had more digits in your list, this would continue:
a = 63*10 + 5 = 635
a = 635*10 + 9 = 6359
A less efficient implementation that uses a single function could be as follows:
(define (make-number lst)
(if (null? lst)
0
(+ (* (expt 10 (length (cdr lst))) (car lst)) (make-number (cdr lst)))))
This function needs to calculate the length of the remainder of the list for each iteration, as well as calling the expt function repeatedly. Also, this implementation is not properly tail recursive so it builds up multiple stack frames during execution before unwinding them all after it reaches its maximum recursion depth.
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