Plus 10

plus10play.scm

#!/opt/local/bin/gosh
; 切符の足して10になるアレを解く
(use srfi-1)
(define Op '(Add Sub Mul Div))

(define (make-expr l r)
  (map (lambda (x) (list x l r)) Op))

(define (evaluate expr)
  (cond ((number? expr) expr)
        ((eq? (car expr) 'Add) (+ (evaluate (cadr expr)) (evaluate (caddr expr))))
        ((eq? (car expr) 'Sub) (- (evaluate (cadr expr)) (evaluate (caddr expr))))
        ((eq? (car expr) 'Mul) (* (evaluate (cadr expr)) (evaluate (caddr expr))))
        ((eq? (car expr) 'Div) (/ (evaluate (cadr expr)) (evaluate (caddr expr))))))

(define (make-first-lst lst)
  (if (null? lst)
      ()
      (cons (list (car lst))
            (map (lambda (x) (cons (car lst) x))
                 (make-first-lst (cdr lst))))))

(define (make-last-lst lst)
  (if (null? lst)
      ()
      (cons lst
            (make-last-lst (cdr lst)))))

(define (make-expr-from-lst lst)
  (if (null? (cdr lst))
      lst
      (append-map make-expr-from-lst
           (append-map
             (lambda (first middle last)
               (map (lambda (x) (append first (list x) last))
                    middle))
             (cons () (make-first-lst lst))
             (map (lambda (x y) (make-expr x y)) lst (cdr lst))
             (append (make-last-lst (cddr lst)) '(() ()))))))

(define (expr2displist expr)
  (cond ((number? expr) expr)
        ((eq? (car expr) 'Add)
         (list '+ (expr2displist (cadr expr)) (expr2displist (caddr expr))))
        ((eq? (car expr) 'Sub)
         (list '- (expr2displist (cadr expr)) (expr2displist (caddr expr))))
        ((eq? (car expr) 'Mul)
         (list '* (expr2displist (cadr expr)) (expr2displist (caddr expr))))
        ((eq? (car expr) 'Div)
         (list '/ (expr2displist (cadr expr)) (expr2displist (caddr expr))))))

(define (print-each lst)
  (for-each (lambda (expr) (print (expr2displist expr))) lst))

(define (solve lst)
  (filter (lambda (x) (= (evaluate x) 10))
          (make-expr-from-lst lst)))

(define (main args)
  (if (null? (cdr args))
      (format (current-error-port) "Please input args.\n")
      (print-each (solve (map (lambda (x) (string->number x)) (cdr args))))))