#lang planet dyoo/whalesong ;(provide run-from-string) ;; DATA ;; data is internally represented as a sum of products of squares - a list (possibly empty) of lists (nonempty) of numbers ;; a product of squares - a list of numbers - is admissable if each square is at least double the following square ;; the empty list is zero ;; in addition, we need (define-struct error ()) ;; an error flag ;; CALCULATIONS ;; input: a number ;; output: its factorial (define (fact x) (if (= x 0) 1 (* x (fact (sub1 x))))) ;; input: two numbers, a and b ;; output: a choose b if defined, 0 else (define (choose a b) (if (or (> b a) (< a 0) (< b 0)) 0 (/ (fact a) (* (fact b) (fact (- a b)))))) ;; input: a number, n ;; output: the list (n ... 0) (define (upto n) (if (= 0 n) (list 0) (cons n (upto (- n 1))))) ;; input: two numbers, a and b ;; output: a simplification of sq^a * sq^b, always a sum of products of squares (define (adem a b) (if (>= a (* 2 b)) (list (list a b)) (foldr (lambda (c result) (if (= (remainder (choose (- (- b 1) c) (- a (* 2 c))) 2) 1) (cons (list (- (+ a b) c) c) result) result)) empty (upto (floor (/ a 2)))))) ;; SIMPLIFICATION ;; input: a sum of products of squares, or error ;; output: a sum of admissable products of squares, with repeats removed due to evaluation mod 2 (define (simplify sum) (cond [(error? sum) sum] [(member false (map admissable? sum)) (simplify (foldr (lambda (prod result) (append (simplify-product prod) result)) empty sum))] [else (remove-duplicate-pairs (map clean-product sum))])) ;; input: a product of squares ;; output: a sum of products of squares, the result of one application of the adem relations (define (simplify-product prod) (cond [(empty? (rest prod)) (list prod)] [(>= (first prod) (* 2 (second prod))) (map (lambda (lst) (cons (first prod) lst)) (simplify-product (rest prod)))] [else (map (lambda (lst) (append lst (rest (rest prod)))) (adem (first prod) (second prod)))])) ;; input: a product of squares ;; output: the same product, with 0s removed (sq^0 is the identity in this algebra) (define (clean-product prod) (let [(cleanprod (filter (lambda (x) (not (zero? x))) prod))] (if (empty? cleanprod) (list 0) cleanprod))) ;; input: a product of squares ;; output: true if admissable, false otherwise (define (admissable? prod) (cond [(empty? (rest prod)) true] [(>= (first prod) (* 2 (second prod))) (admissable? (rest prod))] [else false])) ;; input: a list ;; output: the list with duplicate pairs removed (define (remove-duplicate-pairs lst) (cond [(empty? lst) empty] [(member (first lst) (rest lst)) (remove-duplicate-pairs (remove-first (first lst) (rest lst)))] [else (cons (first lst) (remove-duplicate-pairs (rest lst)))])) ;; input: an element and a list ;; output: the list with the first instance of that element removed (define (remove-first elt lst) (cond [(empty? lst) empty] [(equal? elt (first lst)) (rest lst)] [else (cons (first lst) (remove-first elt (rest lst)))])) ;; INPUT / OUTPUT ;; input: a list of chars ;; output: true if they are all numerals, space, or +, false otherwise (define (legal-input? lst) (empty? (filter (lambda (el) (not (or (char=? el #\space) (char=? el #\+) (and (char>=? el #\0) (char<=? el #\9))))) lst))) ;; input: a string ;; output: the corresponding sum of products of squares (define (parse str) (if (legal-input? (string->list str)) (map (lambda (lst) (map string->number lst)) (filter (lambda (x) (not (empty? x))) (map (lambda (y) (filter (lambda (z) (not (equal? "" z))) y)) (map (lambda (str2) (string-split str2 " ")) (string-split str "+"))))) (make-error))) ;; input: a sum of products of squares, or error ;; output: a string (define (print input) (cond [(error? input) "bad input"] [(empty? input) "zero"] [else (foldr (lambda (prod result) (if (equal? result "") (print-product prod) (string-append (print-product prod) " + " result))) "" input)])) ;; input a product of squares ;; output: a string (define (print-product input) (foldr (lambda (sq result) (if (equal? result "") (number->string sq) (string-append (number->string sq) " " result))) "" input)) ;; the main function (define (run-from-string str) (print (simplify (parse str)))) ;; REPLACEMENT FUNCTIONS (these function are not currently implemented in whalesong) ;; input: a string to split and a string consisting of a single char ;; output: a list of strings, obtained from the input string split at every instance of the char (define (string-split str charstring) (let ([char (first (string->list charstring))]) (map list->string (foldr (lambda (c result) (if (char=? c char) (cons empty result) (cons (cons c (first result)) (rest result)))) (list empty) (string->list str))))) ;;; TESTS ;(run-from-string "2 5 + 1 2 3") ;"should be 6 1 + 5 1" ; ;(run-from-string "1 2 3 4 5 10") ;"should be zero" ; ;(run-from-string "19 10") ;"should be zero" ; ;(run-from-string "10 10 10") ;"should be 21 7 2 + 23 5 2 + 20 9 1 + 21 8 1 + 21 9" ; ;(run-from-string "2 10 8 4") ;"should be 15 7 2 + 17 7" ; ;(run-from-string "ot8whegow8h") ;"should be bad input" ; ;(run-from-string "++5++ +++ +2") ;"should be 5 + 2" ; ;(run-from-string "12363245") ;"should be 12363245" ; ;(run-from-string "1 6 2 3 14") ;"should be zero" ; ;(run-from-string "0 0") ;"should be 0" ; ;(run-from-string "0 3 0") ;"should be 3"