puzzle : 4つの数で10を作る問題（または小町算？）

問２「９以下の自然数を４つ適当に選ぶ（重複を許す）。この４つの自然数と四則演算を用いて１０を生成することを考えよう。このとき（１）条件を満たすどのような自然数の組み合わせでも生成することが可能であるか？　（２）任意の組み合わせが与えられたときに、可能な計算順序の組み合わせを出力するアルゴリズムを考えよ。　（３）四則演算以外の演算について、一般に何かを語るための準備をせよ」
Twitter / satomi.k

(2)までやってみた。しかもシェルから呼び出せるようにインターフェイスまでつけてしまった。

core

アルゴリズム的には可能な組合せを全て試す総当たりで（他が思いつきません）
ある計算の順序が固定されたn個の数の並びについて、n個の数の問題→（n-1個の数の全ての結果）と（残り1個の数）との間で許される演算をすべて試して、これをn個の場合の結果とするという風に再帰で表現
1つの順序が固定された数字の並びに対しての計算量は許される演算の数がmとして、O(m^n)
「演算」自体を「もの」として扱うというSchemerなら当たり前の発想からすると、演算をコレクションしたり、構成を変えたりということは割と普通。同じ調子で、+ - * /以外の二項演算にも拡張可能なように作ってある。

background

電車に乗っている時の暇つぶしとして、切符に、意味はわからないけれども書かれている4桁の数字を四則演算で組み合わせて10にするという遊び。DSFF4のミニゲーム。いろんなところで見かけるパズルなのに、具体的な名前がよくわからない。小町算？（twitterで@iratqqさんに教えていただきました）

小町算 - Wikipedia

implementation（またの名を、このプログラムを書いた裏目的）

gaucheの便利なライブラリの活用（特にgauche.parseopt）
gaucheのオブジェクトシステム事始め（define-class, make, define-method）
schemeではschemeの比較的プリミティブな機能だけを使った「勉強のためのプログラム」しか書いた無かったので、高級な機能を積極的に用い、まともに動くアプリケーションを書く練習をする

ソースコードは長いので最後につけます。
以下、長いので続きを読むで。

usage

プログラムを例えばkomachiという名前で保存してパスの通るところにおいたとします。

% komachi 9 9 9 9
(((9 * 9) + 9) / 9) = 10
((9 + (9 * 9)) / 9) = 10

引数に任意個の数字と演算子を与えることができます。演算子は省略するとデフォルトでは+-*/の組合せを試します。またデフォルトで抽出するのは答えが10の場合ですがこれも変更可能です（後述）。

% komachi 1 4 7
(7 - (1 - 4)) = 10
(7 + (4 - 1)) = 10
((4 - 1) + 7) = 10
(4 - (1 - 7)) = 10
(4 + (7 - 1)) = 10
((7 - 1) + 4) = 10
((7 + 4) - 1) = 10
((4 + 7) - 1) = 10

% komachi 2 3 4
(4 + (2 * 3)) = 10
((2 * 3) + 4) = 10
(4 + (3 * 2)) = 10
((3 * 2) + 4) = 10
((4 * 3) - 2) = 10
((3 * 4) - 2) = 10

% komachi 2 3 4 + \*
((3 * 2) + 4) = 10
(4 + (3 * 2)) = 10
((2 * 3) + 4) = 10
(4 + (2 * 3)) = 10

-t オプションで答えを10以外のものに変更可能です。

% komachi -t 9 2 3 4
(4 + (2 + 3)) = 9
((2 + 3) + 4) = 9
(4 + (3 + 2)) = 9
((3 + 2) + 4) = 9
(3 + (2 + 4)) = 9
((2 + 4) + 3) = 9
(3 + (4 + 2)) = 9
((4 + 2) + 3) = 9
((4 + 3) + 2) = 9
(2 + (4 + 3)) = 9
((3 + 4) + 2) = 9
(2 + (3 + 4)) = 9

-l オプションを指定すると全ての指定した個数分の数の組合せを試します。
この場合は引数に数字を与えても無視されますが、演算子の指定は有効です。

% komachi -l 2 +
(5 + 5) = 10
(4 + 6) = 10
(6 + 4) = 10
(3 + 7) = 10
(7 + 3) = 10
(2 + 8) = 10
(8 + 2) = 10
(9 + 1) = 10
(1 + 9) = 10

misc.

(1 + 2) + 3と1 + (2 + 3)のように本当は同じものでも括弧のつき方が異なるものは別物として扱っています。

source

#!/usr/bin/env gosh

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

;;; operation object
(define-class <Operation> ()
  ((symb :init-keyword :symb :accessor symb)
   (op :init-keyword :op :accessor op)))

(define-method apply-operation ((opr <Operation>) . args)
  (apply (op opr) args))

(define-method object-equal? ((op1 <Operation>)
			      (op2 <Operation>))
  (eq? (symb op1) (symb op2)))

;;; record object
(define-class <Record> ()
  ((sol :init-keyword :sol :accessor solution)
   (his :init-keyword :his :accessor history)))

(define-method do-binary-operation ((opr <Operation>)
				    (r1 <Record>)
				    (r2 <Record>))
  (make <Record>
    :sol (apply-operation opr
			  (solution r1)
			  (solution r2))
    :his `(,(history r1) ,(symb opr) ,(history r2))))

(define-method print ((r <Record>))
  (print (history r) " = " (solution r)))

(define-method match? ((r <Record>) (sol <integer>))
  (eq? (solution r) sol))

(define-method object-equal? ((r1 <Record>)
			      (r2 <Record>))
  (equal? (history r1) (history r2)))

(define (numeral->record n)
  (make <Record>
    :sol n
    :his n))

;;; generator
(define (numerals-operations-combination records operations)
  (if (null? records)
      '()
      (let* ((rec (car records))
	     (results (numerals-operations-combination (cdr records)
						       operations)))
	(if (null? results)
	    (cons rec results)
	    (apply append
		   (map (lambda (r)
			  (apply append
				 (map (lambda (op)
					(list (do-binary-operation op r rec)
					      (do-binary-operation op rec r)))
				      operations)))
			results))))))

;;; argument processor
(define (get-operations args)
  (define (iter acc args)
    (if (null? args)
	acc
	(guard (e
		((<message-condition> e)
		 (slot-ref e 'message)
		 (iter acc (cdr args)))
		)
	  (let1 symb (string->symbol (car args))
	    (iter (lset-adjoin equal?
			       acc
			       (make <Operation>
				 :symb symb
				 :op (eval symb
					   (scheme-report-environment 5))))
		  (cdr args))))))
  (let1 op (iter '() args)
    (if (null? op)
	(iter '() (map symbol->string '(+ - * /)))
	op)))

(define (get-numerals args)
  (filter identity (map string->number args)))

(define (get-records args)
  (map numeral->record (get-numerals args)))

;;; iterator
(define (list-compact lis)
  (define (iter acc l)
    (if (null? l)
	(reverse acc)
	(if (member (car l) acc)
	    (iter acc (cdr l))
	    (iter (cons (car l) acc) (cdr l)))))
  (iter '() lis))

(define (filter-combinations init-records sol operations)
  (list-compact (filter (cut match? <> sol)
			(numerals-operations-combination init-records
							 operations))))

(define (forall-combinations proc len sol operations)
  (for-each proc
	    (apply lset-union equal?
		   (map (lambda (numerals)
			  (filter-combinations (map numeral->record numerals)
					       sol
					       operations))
			(cartesian-product (make-list len (iota 10)))))))

(define (foreach-permutations proc init-records sol operations)
  (for-each proc
	    (apply lset-union equal?
		   (map (lambda (perm)
			  (filter-combinations perm sol operations))
			(permutations* init-records equal?)))))

;; usage
(define (usage prog-name)
  (string-join
   (list
    #`"Usage: ,prog-name [-p][-l<length>][-t<target>] [digit-or-operation ...]"
    "options:"
    "\t-l<length>\tSearch all combinations of <length> digits. (default : 10)"
    "\t-t<target>\tSet target solution to <target>.")
   "\n"
   'suffix))

;; main
(define (main args)
  (let-args (cdr args)
      ((len "l=i")
       (sol "t=i" 10)
       (help "h")
       . restargs
       )
    (let ((op (get-operations restargs))
	  (num (get-records restargs)))
      (cond (help (print (usage (car args))))
	    ((integer? len)
	     (forall-combinations print len sol op))
	    ((= (length num) 0)
	     (error "1 or more numerals are required."))
	    (else
	     (foreach-permutations print num sol op))))))