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)