id:sumim:20061027:p1 の続き。
いくら遅いマシンでも、Gauche や SWI-Prolog が十数秒〜数十秒で返してくるものを 10 分とは待たせすぎだろう…ということで、どこで時間を食っているのか調べてみました。まず手始めに、単純に 0 から 9 までの数字から 8 個を取り出してそれのすべての順列に当たるとどのくらい時間がかかるのか…。
[($0 to: $9) combinations: 8 atATimeDo: [:comb | comb permutationsDo: [:perm | "do nothing"]]] timeToRun
=> 4485 ms
５秒くらいで十分速い。これに文字列の置換作業を行なわせてみると…。
| string letters |
string := 'SEND + MORE = MONEY'.
letters := string onlyLetters asSet asArray.
[($0 to: $9) combinations: 8 atATimeDo: [:comb |
comb permutationsDo: [:digits |
| expression |
expression := string copy.
letters with: digits do: [:letter :digit | expression replaceAll: letter with: digit]]]
] timeToRun=> 64397 ms
ひと桁はね上がります。そして、いかにも重そうな Compiler class >> #evaluate: がさらにひと桁うわ乗せしてトドメを刺す…という構図のようです。
式として評価させるのではなく、Shiro さんの Gauche 版 のように数値の変換のときだけ文字列を使うというのではどうでしょう。とりあえず、Shiro さん版を直訳（っぽく…）してみます。
($0 to: $9) combinations: 8 atATimeDo: [:comb |
comb permutationsDo: [:digits |
[:s :e :n :d :m :o :r :y |
| send more money |
(s ~= $0 and: [m ~= $0 and: [
send := ({s.e.n.d} as: String) asInteger.
more := ({m.o.r.e} as: String) asInteger.
money := ({m.o.n.e.y} as: String) asInteger.
send + more = money]])
ifTrue: [^ {send. more. money}]] valueWithArguments: digits]]
これだと解を見つけると処理を終えてしまうので、あえてすべての可能性を探索するよう改変して速度を測ります。
| results |
results := OrderedCollection new.
{[($0 to: $9) combinations: 8 atATimeDo: [:comb |
comb permutationsDo: [:digits |
[:s :e :n :d :m :o :r :y |
| send more money |
(s ~= $0 and: [m ~= $0 and: [
send := ({s.e.n.d} as: String) asInteger.
more := ({m.o.r.e} as: String) asInteger.
money := ({m.o.n.e.y} as: String) asInteger.
send + more = money]])
ifTrue: [results add: {send. more. money} copy]] valueWithArguments: digits]]
] timeToRun. results asArray}=> #(151979 #(#(9567 1085 10652)))
どうやら期待したとおり効果的。やはり #replaceAll:with: や #evaluate: は、速度を気にするなら避けたほうがよさげです。ちなみに Gauche で同じこと（中断させずに全順列総なめ）をさせた場合は 55 秒ほどでした。
(use util.combinations)
(use util.match)
(define results '())
(combinations-for-each
(cut permutations-for-each
(match-lambda ((S E N D M O R Y)
(and (not (eqv? S #\0)) (not (eqv? M #\0))
(let ((SEND (x->integer (string S E N D)))
(MORE (x->integer (string M O R E)))
(MONEY (x->integer (string M O N E Y))))
(when (= (+ SEND MORE) MONEY)
(set! results (cons (list SEND MORE MONEY) results)))))))
<>) (string->list "0123456789") 8)
(display results)
では、文字列ではなく数値で処理させたらどうでしょう。
| results integer |
results := OrderedCollection new.
integer := [:ary | ary inject: 0 into: [:val :digit | val * 10 + digit]].
{[(0 to: 9) combinations: 8 atATimeDo: [:comb |
comb permutationsDo: [:digits |
[:s :e :n :d :m :o :r :y |
| send more money |
(s ~= 0 and: [m ~= 0 and: [
send := integer value: {s.e.n.d}.
more := integer value: {m.o.r.e}.
money := integer value: {m.o.n.e.y}.
send + more = money]])
ifTrue: [results add: {send. more. money} copy]] valueWithArguments: digits]]
] timeToRun. results asArray}=> #(30456 #(#(9567 1085 10652)))
これは劇的。ちなみに Gauche では 40 秒ほどと Squeak のような短縮ないようです。…というより string や x->integer あたりが優秀なのでしょう。
(use util.combinations)
(use util.match)
(define results '())
(define (digits->integer l) (fold (lambda (d v) (+ (* 10 v) d)) 0 l))
(combinations-for-each
(cut permutations-for-each
(match-lambda ((S E N D M O R Y)
(and (not (= S 0)) (not (= M 0))
(let ((SEND (digits->integer (list S E N D)))
(MORE (digits->integer (list M O R E)))
(MONEY (digits->integer (list M O N E Y))))
(when (= (+ SEND MORE) MONEY)
(set! results (cons (list SEND MORE MONEY) results)))))))
<>) '(0 1 2 3 4 5 6 7 8 9) 8)
(display results)
汎用にしても同じ効率を得るには、チェックをしているブロック [:s :e :n :d :m :o :r :y | ...] を、与えられた問題に対応させて動的に生成する仕組みを組み込んでやればよさそうです。コードはメンテ不能になりそうですが…(^_^;)。
String >> solve
| letters tokens words shouldntZeros expressions check results |
results := OrderedCollection new.
letters := self onlyLetters asSet.
tokens := Scanner new scanTokens: self.
words := OrderedCollection new.
shouldntZeros := Set new.
expressions := tokens collect: [:token |
token first isLetter ifFalse: [token] ifTrue: [
String streamContents: [:ss |
words add: token.
shouldntZeros add: token first.
ss nextPutAll: '(', token, ':={'.
token do: [:chr | ss nextPut: chr; nextPutAll: '1.'].
ss nextPutAll: '} inject: 0 into: [:val :digit | val * 10 + digit])']]].
check := Compiler evaluate: (String streamContents: [:ss |
ss nextPut: $[.
letters do: [:chr | ss nextPut: $:; nextPut: chr; nextPutAll: '1 '].
ss nextPutAll: '| |'.
words do: [:word | ss nextPutAll: word] separatedBy: [ss space].
ss nextPutAll: '| ('.
shouldntZeros do: [:chr | ss nextPut: chr; nextPutAll: '1 > 0 and:['].
expressions do: [:expr | ss nextPutAll: expr].
shouldntZeros size timesRepeat: [ss nextPut: $]].
ss nextPutAll: ') ifTrue: ['.
tokens
do: [:token |
ss nextPutAll: (token first isLetter
ifTrue: [token asString, ' printString']
ifFalse: [token asString printString])]
separatedBy: [ss nextPutAll: ', '' '', '].
ss nextPutAll: '] ifFalse: [nil]]']).
(0 to: 9) combinations: letters size atATimeDo: [:comb |
comb permutationsDo: [:perm |
(check valueWithArguments: perm)
ifNotNilDo: [:result | results add: result]]].
^ results asArray
案の定、ひどいことになりました。orz ただ速度面では 'SEND + MORE = MONEY' solve が目論見通り 30 秒ほどで答えを戻してきます。速くはないですが、当初の 10 分弱よりはいくぶんマシです。しかし、こうなるともはや LISP などのマクロでやれ…というたぐいの処理内容ですね(^_^;)。
