“SEND + MORE = MONEY”ソルバーを Squeak Smalltalk で　その３

OOPL

某所でナニした、ハードコードだけど総当たりでは恐らくこれが最もシンプルかつ最速の部類だろうというやつ。

| answers check n1 n2 n3 |
answers := OrderedCollection new.
check := [:S :E :N :D :M :O :R :Y |
   S > 0 and: [M > 0] and: [
      (n1 := ((S*10+E)*10+N)*10+D)
      +(n2 := ((M*10+O)*10+R)*10+E)
      =(n3 := (((M*10+O)*10+N)*10+E)*10+Y)]].
(0 to: 9) combinations: check numArgs atATimeDo: [:comb |
   comb permutationsDo: [:digits |
      (check valueWithArguments: digits)
            ifTrue: [answers add: {#SEND->n1. #MORE->n2. #MONEY->n3}]]].
^answers asArray


手元の環境(2.4GHz Core i7, Win7 32bit) で CogVM なら 1.6秒、レガシーVM でも 5秒をたたき出す。簡潔でわかりやすいのに無駄がなく、速くて素敵なコードです。ほれぼれします。


それに対して次のコードは、枝刈りを徹底してやる代わりに、操作は富豪的にしたバージョン。キーになるアイデア（文字の候補を収めたコレクションを使い回して枝刈りを効率化）が思った通りに動作するか確認のために書いたままのコードなのでもうちょっとリファインして読みやすくできそうですが（たとえば覆面の文字をオブジェクトにするとか）、気力が萎えてしまったのでそのまま晒します。^^;

枝刈りをしているので速度を測ってもあまり意味はありませんが、SEND + MORE = MONEY の場合、CogVM で 1.8秒、レガシーVM でも 6.4秒くらいとまずまず。

| solve answers |
solve := [:words |
   | nonZeros max map arr mat results resultFrom queue |
   nonZeros := words asSet collect: #first.
   max := (words allButLast collect: [:wd | (10 raisedTo: wd size)-1]) sum asString size.
   map := words concatenation asSet inject: Dictionary new into: [:dic :chr |
      dic at: chr put: (((nonZeros includes: chr) ifTrue: [1] ifFalse: [0]) to: 9) asOrderedCollection. dic].
   arr := (words collect: [:wd | wd reversed forceTo: max paddingWith: $0]), {String new: max withAll: $0}.
   mat := Matrix rows: max columns: words size+1 contents: (Array streamContents: [:ss |
      1 to: max do: [:pos | arr do: [:wd | ss nextPut: (map at: (wd at: pos) ifAbsent: [{0}])]]]).
   mat swapColumn: mat columnCount-1 withColumn: mat columnCount.
   results := OrderedCollection new.
   resultFrom := [:mx |
      words with: #(1 2 4) collect: [:wd :nCol |
         wd -> (((mx atColumn: nCol) collectWithIndex: [:each :idx |
            idx <= wd size ifTrue: [each first asString] ifFalse: ['']]) reversed concatenation as: String)]].
   queue := OrderedCollection with: mat.
   [queue notEmpty] whileTrue: [
      | pos |
      mat := queue removeFirst.
      pos := mat asArray findFirst: [:digs | digs size > 1].
      pos = 0 ifTrue: [results add: (resultFrom value: mat)] ifFalse: [
         (mat asArray at: pos) do: [:digi | [:exit |
            | next chars |
            next := mat veryDeepCopy.
            chars := next asIdentitySet select: [:char | char isKindOf: OrderedCollection].
            chars do: [:char | char remove: digi ifAbsent: []].
            (next asArray at: pos) removeAll; add: digi.
            [:exit2 |
               | row |
               1 to: next rowCount do: [:nRow |
                  | operas |
                  row := next atRow: nRow.
                  ((operas := row allButLast) allSatisfy: [:digis | digis size = 1]) ifFalse: [exit2 value] ifTrue: [
                     | sum |
                     sum := operas sum first.
                     (row last includes: sum\\10) ifFalse: [exit value].
                     chars do: [:char | char remove: sum\\10 ifAbsent: []].
                     (row last isKindOf: OrderedCollection) ifTrue: [row last removeAll; add: sum\\10].
                     (next at: nRow+1 at: next columnCount-1 ifInvalid: {0}) at: 1 put: sum//10
                  ]
               ]
            ] valueWithExit.
            (next allSatisfy: #notEmpty) ifTrue: [queue addFirst: next]] valueWithExit.
         ]
      ]
   ].
   results asArray].

{[answers := solve value: #(SEND MORE MONEY)] timeToRun. answers}.
"cog => {1887 . {{#SEND->'9567' . #MORE->'1085' . #MONEY->'10652'}}} "
"leg => {6369 . {{#SEND->'9567' . #MORE->'1085' . #MONEY->'10652'}}} "

{[answers := solve value: #(APPLE GRAPE CHERRY)] timeToRun. answers}. 
"cog => {532 . {{#APPLE->'63374' . #GRAPE->'90634' . #CHERRY->'154008'}}} "
"leg => {1791 . {{#APPLE->'63374' . #GRAPE->'90634' . #CHERRY->'154008'}}} "