2010 = 1 + 2 + 3×(4×(5+6)×(7+8)+9)
と書いてある。去年は、
Did you know that 2009 is (1/2+3)*(4+5*(6*7+8*9))?
とあった。
そこで1から9を順番に使って数を作るプログラムを書いてみる。
年に1000行ぐらいはプログラムを書こうとか3ヶ月に1回ぐらいはプログラムを書こうを思っていたのに、半年ぐらいプログラムを書いていなかったし。
方針
「1から9までを順に使って作った数」は「1からkまでを順に使って作った数」と「kから9までを順に使って作った数」から作られるから、再帰を使って可能な組み合わせを全て作ればよい。ただそのまま再帰にすると同じ問題を何度も計算することになる。こういうのは動的計画法かメモ化を使う場面だろう。メモ化の方が簡単そうなので、メモ化を利用した。
あと同じ値になる式がいくつもある。たとえば(1+2)+3 = 1+(2+3) = 1*(2*3) = (1*2)*3) = 6 とか。それぞれ別々に扱っていくと組み合わせが膨大になりそうなので、ひとまとめにすることにした。
プログラム
プログラムはGaucheで。
make_number.scm
#!/usr/bin/env gosh (use srfi-1) ; iota find remove (use util.combinations) ; cartesian-product (use gauche.sequence) ; group-sequence (use gauche.parseopt) ;;; Exp == Value ;;; | (Op Exp Exp) ;;; ;;; Cexp 圧縮した式 ;;; Cexp == Value ;;; | ((Op Cexp Cexp) (Op Cexp Cexp) ...) リスト各要素は同じ値の式 ;;; ;;; Answer == (Value Cexp) (define (make-answer value cexp) (list value cexp)) (define (get-value answer) (car answer)) (define (get-cexp answer) (cadr answer)) (define (prefix->infix exp) (cond ((number? exp) exp) (else (let ((op (car exp)) (l (prefix->infix (cadr exp))) (r (prefix->infix (caddr exp)))) (list l op r))))) (define (expand-cexp cexp) ; Cexp -> (Exp Exp ...) (cond ((number? cexp) (list cexp)) (else (append-map (lambda (op-cexp-cexp) (let* ((op (car op-cexp-cexp)) (lexps (expand-cexp (cadr op-cexp-cexp))) (rexps (expand-cexp (caddr op-cexp-cexp)))) (map (lambda (l-r) (list op (car l-r) (cadr l-r))) (cartesian-product (list lexps rexps))))) cexp)))) (define (check-answer answer) (every (lambda (exp) (= (get-value answer) (eval exp (interaction-environment)))) (expand-cexp (get-cexp answer)))) (define (get-answers from to vals) (let1 all-answers (get-all-answers from to) (remove not (map (lambda (val) (find (lambda (answer) (= val (get-value answer))) all-answers)) vals)))) (define (print-answer answer) (print (get-value answer)) (for-each (lambda (exp) (print (prefix->infix exp))) (expand-cexp (get-cexp answer)))) (define get-all-answers (let1 table (make-hash-table 'equal?) (lambda (from to) (define (memo from to value) (hash-table-put! table (cons from to) value) value) (cond ((= from to) (list (make-answer from from))) ((hash-table-get table (cons from to) #f)) (else (memo from to (compress-answers (append-map (lambda (middle) (let ((l-answers (get-all-answers from middle)) (r-answers (get-all-answers (+ middle 1) to))) (all-combinations l-answers r-answers))) (iota (- to from) from))))))))) (define (compress-answers answers) (let1 group-answers (group-sequence (sort answers (lambda (x y) (< (car x) (car y)))) :key car) (map (lambda (group) (list (get-value (car group)) (append-map get-cexp group))) group-answers))) (define (all-combinations l-answers r-answers) (append-map-product l-answers r-answers (lambda (l-answer r-answer) (let1 answers (list (combinate-answer + '+ l-answer r-answer) (combinate-answer - '- l-answer r-answer) (combinate-answer * '* l-answer r-answer)) (cond ((zero? (get-value r-answer)) answers) (else (cons (combinate-answer / '/ l-answer r-answer) answers))))))) (define (append-map-product left right pred) (fold (lambda (l seed) (append (append-map (lambda (r) (pred l r)) right) seed)) '() left)) (define (combinate-answer op op-symbol l-answer r-answer) (make-answer (op (get-value l-answer) (get-value r-answer)) (list (list op-symbol (get-cexp l-answer) (get-cexp r-answer))))) (define (main args) (let-args (cdr args) ((from "from=i" 1) (to "to=i" 9) (vals "vals=e" (list 2011) => (lambda (e) (if (number? e) (list e) e)))) (for-each print-answer (get-answers from to vals))))
実行例。カッコの位置が違うだけで実質同じ式の重複がある。
$ ./make_number.scm --from=3 --to=6 "--vals=(21 22 23 24)" 21 ((3 * (4 + 5)) - 6) 23 ((3 * 4) + (5 + 6)) (((3 * 4) + 5) + 6) 24 ((3 - (4 - 5)) * 6) (((3 - 4) + 5) * 6)
