年度始めすぐは、なにかと暇なので勉強が捗っちゃうねーｗ
2 3 5 7 11 から等式を作って正しい計算結果になる式をリストアップしなさい。
例として、2-3+5+7 = 11 とか 2 = (3*5+7)/11 があるよ。(あと 10 個ある。)
という問題。
まずは汎用手続き
(define nil '()) (define (enumerate-interval low high) (if (> low high) nil (cons low (enumerate-interval (+ low 1) high)))) (define (accumulate op initial seq) (if (null? seq) initial (op (car seq) (accumulate op initial (cdr seq))))) (define (flatmap proc seq) (accumulate append nil (map proc seq))) (define (remove item seq) (filter (lambda (x) (not (eq? x item))) seq)) (define (permutations s c) (if (or (= c 0) (null? s)) (list nil) (flatmap (lambda (x) (map (lambda (p) (cons x p)) (permutations (remove x s) (- c 1)))) s))) (define (repeated-permutations s n) (if (= n 0) (list nil) (flatmap (lambda (x) (map (lambda (p) (cons x p)) (repeated-permutations s (- n 1)))) s))) (define (uniq lis) (define ht (make-hash-table 'equal?)) (define (iter l) (if (null? l) (hash-table-keys ht) (let ((key (hash-table-get ht (car l) nil))) (and (null? key) (hash-table-put! ht (car l) (car l))) (iter (cdr l))))) (iter lis))
次にスタックまわりの手続き
(define *stack* nil) (define level-ratio 100) (define (last-pushed) (if (empty?) nil (car *stack*))) (define (after-popped) (if (empty?) nil (cdr *stack*))) (define (init-stack) (set! *stack* nil)) (define (empty?) (null? *stack*)) (define (push x) (set! *stack* (cons x *stack*))) (define (pop) (if (empty?) nil (let ((result (last-pushed))) (set! *stack* (after-popped)) result))) (define (pop-all level) (define (iter ops) (if (or (empty?) (< (priority (last-pushed)) (* level level-ratio))) ops (iter (append ops (cons (operator (pop)) nil))))) (iter nil)) ;; (define (priority p) (if (null? p) 0 (cdr p))) (define (operator p) (car p)) (define (operator? x) (or (eq? x '+) (eq? x '-) (eq? x '*) (eq? x '/))) (define (make-priority op level) (let ((priority (cond ((eq? op '*) 20) ((eq? op '/) 20) ((eq? op '+) 10) ((eq? op '-) 10) (else 0)))) (cons op (+ priority (* level level-ratio))))) (define (exchange-operator op level) (define (iter ops) (if (or (empty?) (<= (priority (last-pushed)) (priority (make-priority op level)))) ops (iter (append ops (cons (operator (pop)) nil))))) (iter nil))
メインの問題を解くプログラム。
(define (exp->rpn exp) (define (iter e r level) (if (null? e) (append r (pop-all level)) (if (list? (car e)) (iter (cdr e) (iter (car e ) r (+ level 1)) level) (cond ((operator? (car e)) (let ((ops (exchange-operator (car e) level))) (push (make-priority (car e) level)) (iter (cdr e) (append r ops) level))) (else (iter (cdr e) (append r (list (car e))) level)))))) (init-stack) (iter exp nil 0)) (define (eval-rpn rpn) (define (iter r) (if (null? r) (pop) (let ((e (car r))) (cond ((eq? e '+) (let ((addend (pop))) (push (+ (pop) addend)))) ((eq? e '-) (let ((subtrahend (pop))) (push (- (pop) subtrahend)))) ((eq? e '*) (let ((multiplier (pop))) (push (* (pop) multiplier)))) ((eq? e '/) (let ((divisor (pop))) (if (= divisor 0) (error "attempt to calculate a division by zero") (push (/ (pop) divisor))))) (else (push e))) (iter (cdr r))))) (init-stack) (guard (e ((<error> e) -999)) (iter rpn))) (define (build-exp o d) (if (null? o) nil (cons (car o) (cons (car d) (build-exp (cdr o) (cdr d)))))) (define (build-exps ops dgt) (map cdr (map (lambda (o) (build-exp (cons '_ o) dgt)) ops))) (define operators (repeated-permutations (list '+ '- '* '/ '=) 4)) (define digits '(2 3 5 7 11)) (define (ins-parens exp) (let ((len (length exp))) (cond ((= len 7) (let ((a (list-ref exp 0)) (op1 (list-ref exp 1)) (b (list-ref exp 2)) (op2 (list-ref exp 3)) (c (list-ref exp 4)) (op3 (list-ref exp 5)) (d (list-ref exp 6))) `( (((,a ,op1 ,b) ,op2 ,c) ,op3 ,d) ((,a ,op1 (,b ,op2 ,c)) ,op3 ,d) (,a ,op1 ((,b ,op2 ,c) ,op3 ,d)) (,a ,op1 (,b ,op2 (,c ,op3 ,d))) ((,a ,op1 ,b) ,op2 (,c ,op3 ,d)) ))) ((= len 5) (let ((a (list-ref exp 0)) (op1 (list-ref exp 1)) (b (list-ref exp 2)) (op2 (list-ref exp 3)) (c (list-ref exp 4))) `( ((,a ,op1 ,b) ,op2 ,c) (,a ,op1 (,b ,op2 ,c)) ))) (else exp)))) (define (holds-equation? equation) (let ((left (eval-rpn (exp->rpn (car equation)))) (right (eval-rpn (exp->rpn (cadr equation))))) (= left right))) (define (tenkai equations) (define (iter e result) (if (null? e) result (iter (cdr e) (append result (list (list (car e) (cadr equations))))))) (iter (car equations) nil)) (define (modosu equations) (let* ((left (car equations)) (right (cadr equations)) (l-min (car (exp->rpn left))) (r-min (car (exp->rpn right)))) (if (< l-min r-min) (list left '= right) (list right '= left)))) (define (split-equal lst) (define (iter l left) (if (eq? (car l) '=) (list left (cdr l)) (iter (cdr l) (append left (cons (car l) nil))))) (iter lst nil)) (define (count-equal lst) (length (filter (lambda (x) (eq? x '=)) lst))) (define (arithmetic-puzzle) (map modosu (filter holds-equation? (flatmap (lambda (e) (tenkai (sort (map ins-parens (split-equal e))))) (filter (lambda (exp) (= 1 (count-equal exp))) (build-exps operators digits))))))
最後のほうは考えるのが面倒くさくなってローマ字表記みたいな手続き名になっていますが、
良い子のプログラマー諸君はマネしてはいけません。
arithmetic-puzzle 手続きを見るとわかる通り、
オペレータ（演算子）と数字から計算式の組み合わせを作り、
イコールが一つだけの式を絞り込み、
さらにイコールで左辺と右辺を分解し、
カッコの組み合わせを左辺と右辺の式それぞれに適用し、
その結果から新しい式を展開して作り出し、
左辺と右辺をの計算式をそれぞれ計算してイコールになるものを絞り込み、
分解した式を整形して元に戻す
ということをやっていますｗ
データは次から次へと流れる滝のように処理されます。
このように処理を行う事を「カスケード」と言います。
結果
gosh> (arithmetic-puzzle) (((((2 - 3) + 5) + 7) = (11)) (((2 - 3) + (5 + 7)) = (11)) (((2 - (3 - 5)) + 7) = (11)) ((2 - (3 - (5 + 7))) = (11)) ((2 - ((3 - 5) - 7)) = (11)) ((2 * (3 - 5)) = (7 - 11)) ((2) = ((3 - (5 + 7)) + 11)) ((2) = (3 - ((5 + 7) - 11))) ((2) = (3 - (5 + (7 - 11)))) ((2) = (((3 - 5) - 7) + 11)) ((2) = ((3 - 5) - (7 - 11))) ((2) = (((3 * 5) + 7) / 11)))
Lisp な人は出力結果はリストです。きれいに出力しようとかあまり気にしません。
でも、もう少し気にしてみた。
gosh> (begin (map print (arithmetic-puzzle)) 'done) ((((2 - 3) + 5) + 7) = (11)) (((2 - 3) + (5 + 7)) = (11)) (((2 - (3 - 5)) + 7) = (11)) ((2 - (3 - (5 + 7))) = (11)) ((2 - ((3 - 5) - 7)) = (11)) ((2 * (3 - 5)) = (7 - 11)) ((2) = ((3 - (5 + 7)) + 11)) ((2) = (3 - ((5 + 7) - 11))) ((2) = (3 - (5 + (7 - 11)))) ((2) = (((3 - 5) - 7) + 11)) ((2) = ((3 - 5) - (7 - 11))) ((2) = (((3 * 5) + 7) / 11)) done
いらないカッコもあったりしますが気にしてはいけません。
ちなみに答えの数ですが、
gosh> (length (arithmetic-puzzle)) 12
12 個あります。適当に検算しましたが問題なさそうです。
