codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; happy new year (define (mappend f . xss) (apply append (apply map f xss))) (define (catenate ss) (apply string (mappend string->list ss))) (define (numb xs) (let loop ((n (- (char->integer (car xs)) 48)) (xs (cdr xs))) (cond ((null? xs) (values n xs)) ((member (car xs) (string->list "0123456789")) (loop (+ (* 10 n) (- (char->integer (car xs)) 48)) (cdr xs))) (else (values n xs))))) (define (fact xs) (cond ((null? xs) (error 'fact "missing factor")) ((char=? (car xs) #\space) (fact (cdr xs))) ((member (car xs) (string->list "0123456789")) (let-values (((n rest) (numb xs))) (values n rest))) ((char=? (car xs) #\() (let-values (((n rest) (expr (cdr xs)))) (if (or (null? rest) (not (char=? (car rest) #\)))) (error 'fact "missing right parenthesis") (values n (cdr rest))))) (else (error 'fact "expected number or left parenthesis")))) (define (term xs) (let-values (((f rest) (fact xs))) (let loop ((n f) (xs rest)) (cond ((null? xs) (values n xs)) ((char=? (car xs) #\space) (loop n (cdr xs))) ((char=? (car xs) #\*) (let-values (((f rest) (fact (cdr xs)))) (loop (* n f) rest))) ((char=? (car xs) #\/) (let-values (((f rest) (fact (cdr xs)))) (loop (/ n f) rest))) (else (values n xs)))))) (define (expr xs) (let-values (((t rest) (term xs))) (let loop ((n t) (xs rest)) (cond ((null? xs) (values n xs)) ((char=? (car xs) #\space) (loop n (cdr xs))) ((char=? (car xs) #\+) (let-values (((t rest) (term (cdr xs)))) (loop (+ n t) rest))) ((char=? (car xs) #\-) (let-values (((t rest) (term (cdr xs)))) (loop (- n t) rest))) (else (values n xs)))))) (define (evaluate str) (let-values (((x xs) (expr (string->list str)))) (if (null? xs) x (error 'evaluate "extra characters at end")))) (define nums (list "10" "9" "8" "7" "6" "5" "4" "3" "2" "1")) (define ops (list "" "+" "-" "*" "/")) (define (tuples xs n) (let loop ((n (- n 1)) (zs (map list xs))) (if (zero? n) zs (loop (- n 1) (mappend (lambda (z) (map (lambda (x) (cons x z)) xs)) zs))))) (define (riffle xs ys) (let loop ((xs xs) (ys ys) (zs (list))) (if (null? xs) (reverse (append (reverse ys) zs)) (loop ys (cdr xs) (cons (car xs) zs))))) (define (happy-new-year n) (let loop ((xs (tuples ops 9)) (zs (list))) (if (null? xs) zs (let ((expr (catenate (riffle nums (car xs))))) (loop (cdr xs) (if (= (evaluate expr) n) (cons expr zs) zs)))))) (for-each (lambda (x) (display x) (newline)) (happy-new-year 2013))
Private
[
?
]
Run code
Submit