123-45-67+89=100

scheme

http://d.hatena.ne.jp/fortran66/20100502/1272731623
を見て面白そうだったのでやってみました。
方法は単純でルールの中で存在する可能性のある全ての式を作ってそれをevalするというもの。

Rule

  • 問題は、１ ２ ３ ４ ５ ６ ７ ８ ９ のどこかに数学記号を３つ入れて答えが１００になるようにする
  • 記号は複数回使って良い
  • 数字は並べ替えちゃだめ

Code

(use srfi-42)
(use srfi-1)

(define (list->number xs)  ;;(<> '(1 2 3)) -> 123
  (fold (lambda (x n) (+ (* n 10 ) x)) 0 xs))

(define (add-tag tag xs) (cons tag xs))

(define (divide-n n xs) ;;n個のしきりで分割(tree)
  (cond ((= n 0) (list (add-tag 'number xs)))
	(else
	 (append-ec (: i 1 (length xs)) 
		    (receive (lhs rhs) (split-at xs i)
		      (cond ((= n 1) (map (cute list 'OP  <> (add-tag 'number rhs))
					  (divide-n(- n 1) lhs)))
			    (else
			     (append (map (cute list 'OP  <> (add-tag 'number rhs))
					  (divide-n(- n 1) lhs))
				     (map (cute list 'OP (add-tag 'number lhs) <>)
					  (divide-n(- n 1) rhs))))))))))

(define (transform ops tree) ;;OPを+ * - /などに(number 1 2 3)を123に変えた形に変換
  (match tree
    [('number . xs) (list (list->number xs))]
    [('OP x y)
     (list-ec (: op ops) (: lhs (transform ops x)) (: rhs (transform ops y))
	      (list op lhs rhs))]))

(define (find-answer ans ops n xs)
  (let1 env (interaction-environment)
    (filter (lambda (exp) (= ans (eval exp env)))
	    (append-map (cut transform ops <>) (divide-n n xs)))))

(define (unwrap-procedure tree);;#<subr +>のような表示を+に変える。
  (map (lambda (x)
	 (cond ((list? x) (unwrap-procedure x))
	       ((procedure? x) (procedure-info x))
	       (else x)))
       tree))

(define (solve ans n)
  (for-each (compose print unwrap-procedure)
	    (find-answer ans (list + * / -) n (iota 9 1))))

(solve 100 3)

;; gosh> (- 123 (+ 45 (- 67 89)))
;; (- 123 (- (+ 45 67) 89))
;; (+ (- 123 (+ 45 67)) 89)
;; (+ (- (- 123 45) 67) 89)