DouKaku?

(use srfi-1)

(define (atom? x)
  (not (or (null? x) (pair? x))))
(define (atom-list? ls)
  (and (pair? ls) (atom? (car ls))))

(define (my-flatten ls)
  (cond ((null? ls) '())
        ((pair? ls)
         (cond ((atom? (car ls)) (list ls))
               ((atom-list? (car ls))
                (append (list (car ls)) (my-flatten (cdr ls))))
               (else
                (append (my-flatten (car ls)) (my-flatten (cdr ls))))))
        (else (list ls))))

(define (_ a b)
  (cond ((< b 10) (+ (* a 10) b))
        ((< b 100) (+ (* a 100) b))
        ((< b 1000) (+ (* a 1000) b))
        ((< b 10000) (+ (* a 10000) b))
        ((< b 100000) (+ (* a 100000) b))
        ((< b 1000000) (+ (* a 1000000) b))
        ((< b 10000000) (+ (* a 10000000) b))
        ((< b 100000000) (+ (* a 100000000) b))
        ((< b 1000000000) (+ (* a 1000000000) b))
;        (else #f)
        ))

(define ops '(_ + - * /))

(define (apply-op op x y)
  (case op
    ((_) (_ x y))
    ((+) (+ x y))
    ((-) (- x y))
    ((*) (* x y))
    ((/) (/ x y))
    ))

(define (apply-rev-op op x y)
  (case op
;    ((_) (_ x y))
    ((+) (- x y))
    ((-) (+ x y))
    ((*) (/ x y))
    ((/) (* x y))))

(define (komachi n sum)
  (define (append-op-n ls op n) (append ls (list op n)))

  (define (1..k= k p)
; [1..k] = p となる組み合わせ
    (if (= 1 k) ;
      ; 1 = 1   ; p!=1ならアウト
        (if (= p 1) '((1)) '())
    ; [1..k-1] ?? k = p
        (my-flatten (map (lambda (op) (1..k (- k 1) op k p)) ops))
        ))

  (define (eval-exp exp)
    (define (iter rest product)
      (cond ((null? rest) product)
            ((eq? '* (car rest))
             (iter (cddr rest) (* product (cadr rest))))
            ((eq? '/ (car rest))
             (iter (cddr rest) (/ product (cadr rest))))
            ))
    (iter (cdr exp) (car exp)))

  (define (1..k?<..>= k op exp p)
; [1..k] op (exp) = p
    (if (= 1 k)
        (case op
          ((_)
           (let1 exp* (cons (_ 1 (car exp)) (cdr exp))
                 (if (= (eval-exp exp*) p)
                     exp*
                     '())))
          ((+ -) ; 1 +- exp = p
           (if (= (apply-op op 1 (eval-exp exp)) p)
               (append (list 1 op) exp)
               '()))
          ((* /)
           (let1 exp* (append (list 1 op) exp)
                 (if (= (eval-exp exp*) p)
                     exp*
                     '())))
          )
        (case op
          ((_)
           (my-flatten
            (map (lambda (op2) (1..k?<..>= (- k 1) op2 (cons (_ k (car exp)) (cdr exp)) p)) ops)))
          ((+ -)
           (map (lambda (x) (append x (list op) exp))
                (my-flatten (1..k= k (apply-rev-op op p (eval-exp exp))))
                ))
          ((* /)
           (my-flatten
            (map (lambda (op2) (1..k?<..>= (- k 1) op2 (append (list k op) exp) p)) ops)))
          )
        ))

  (define (1..k k op n p)
; [1..k] op n = p となる組み合わせが全部ほしい
    (if (= 1 k)
      ;k=1 : [1] op n = p
        (case op
          ((_)
           (if (= (_ 1 n) p) (list (_ 1 n)) '()))
          ((+ -)
           (if (= (apply-op op 1 n) p) (list 1 op n) '()))
          ((*)
           (if (= n p) (list 1 '* n) '()))
          ((/) '()) ; 1/n (n>1) cannot be p
          )
      ;k>1
        (case op
          ((_); [1..k-1] ?? k_n = p
           (my-flatten (map (lambda (op2) (1..k (- k 1) op2 (_ k n) p)) ops)))
          ((+ -) ; [1..k] ± n = p ;
           (map (lambda (x) (append-op-n x op n))
                (my-flatten (1..k= k (apply-rev-op op p n)))))
          ((* /) ; [1..k] */ n = p :: [1..c] ? ([c+1..k] */ n) = p
           (my-flatten (map (lambda (op2) (1..k?<..>= (- k 1) op2 (list k op n) p)) ops)))
           ; 結合則が加減算とは違う
          )
        ))

  (remove null? (1..k= n sum)))

(map print (komachi 9 100))