P93 (***) Arithmetic puzzle: Given a list of integer numbers, find a correct way of inserting arithmetic signs such that the result is a correct equation. The idea to the problem is from Roland Beuret. Thanx.
Example: With the list of numbers [2,3,5,7,11] we can form the equations 2-3+5+7 = 11 or 2 = (3*5+7)/11 (and ten others!).
; remaining = list of number still to add ; val-stack = evaluated numbers on stack ; str-stack = expression strings corresponding to val-stack ; prec-stack = precedence of stack for parenthesis ; 0 = number, 1 = mul and div, 2 = add and sub ; if left op is <= current, no need to paren ; if right op is < current, no need to paren (define (p93 remaining val-stack str-stack prec-stack) (if (and (null? remaining) (= (length val-stack) 2) ) ; time to check for equality (cond ((= (first val-stack) (second val-stack)) (display (second str-stack)) (display " = ") (display (first str-stack)) (newline))) (begin (cond ((not (null? remaining)) ; push another number (precedence 2) on the stack, increasing depth by 1 (p93 (cdr remaining) (cons (car remaining) val-stack) (cons (number->string (car remaining)) str-stack) (cons 2 prec-stack)))) (cond ((>= (length val-stack) 2) ; try each operator on the top two stack elements, push result, strings, and precedence (let ((try-op (lambda (op-func op-str op-prec) (p93 remaining (cons (op-func (second val-stack) (first val-stack)) (cddr val-stack)) (cons (parenth (second str-stack) (second prec-stack) (first str-stack) (first prec-stack) op-str op-prec) (cddr str-stack)) (cons op-prec (cddr prec-stack)))))) (try-op + "+" 0) (try-op - "-" 0) (try-op * "*" 1) (cond ( (not (= (first val-stack) 0)) (try-op / "/" 1))))))))) (define (parenth left-str left-prec right-str right-prec op-str op-prec) (string-append (if (>= left-prec op-prec) left-str (string-append "(" left-str ")")) op-str (if (> right-prec op-prec) right-str (string-append "(" right-str ")")))) (define first car) (define second cadr)