Make10 してみた！

Make 10 してみよう！ — a wandering wolf
「してみよう！」と言われたらするしかないと思ったのでちょっとやってみた。

;; make10

(use srfi-1)
(use gauche.collection)
(use util.combinations)

(define (atom? x)
  (and (not (pair? x)) (not (null? x))))

(define (twist-list li1 li2 :optional (result '()))
  (if (and (null? li1) (null? li2))
      (reverse result)
      (let ((li1-len (length li1))
            (li2-len (length li2)))
        (if (> li1-len li2-len)
            (twist-list (cdr li1) li2
                        (cons (car li1) result))
            (twist-list li1 (cdr li2)
                        (cons (car li2) result))))))

(define (pn exp :optional (oprt '()) (opln '()))
  (if (atom? exp)
      exp
      (pn2 (cdr exp)
           oprt
           (cons (pn (car exp)) opln))))

(define (pn2 exp oprt opln)
  (cond ((null? exp) (cons (car oprt)
                           (cons (cadr opln)
                                 (list (car opln)))))
        ((null? oprt) (pn (cdr exp)
                          (cons (car exp) oprt)
                          opln))
        ((> (weight (car exp))
            (weight (car oprt)))
         (pn2 (cdr (cdr exp))
              oprt
              (cons
               (cons (car exp)
                     (cons (car opln)
                           (list (pn (car (cdr exp))))))
               (cdr opln))))
        (else (pn (cdr exp)
                  (cons (car exp) (cdr oprt))
                  (list (cons (car oprt)
                              (cons (cadr opln)
                                    (list (car opln)))))))))

(define (weight oprator)
  (case oprator
   ('+ 1)
   ('- 1)
   ('* 2)
   ('/ 2)
   ('^ 3)))

(define (make10 exp)
  (let [(test-list (map (^l (pn (twist-list exp l)))
                        (append-map permutations*
                                    (combinations* '(+ - * / + - * / + - * /) 3))))]
    (fold (^(test result)
            (let [(a (eval test (interaction-environment)))]
              (if (= a 10)
                  (cons test result)
                  result)))
          '()
          test-list)))


(make10 '(1 3 5 7)) ;;=> ((+ (+ (- 1 3) 5) 7))

中置記法を前置記法に直す部分はめんどくさかったので、 Common Lisp で書かれていたものをそのまま Scheme に翻訳しただけ。
中置記法から前置記法(ポーランド記法)への変換 - sketch code
特にひねりもないけど、出来たので満足。
(eval 使ってるのが個人的に嫌なんだけど、とりあえずいいや)