ネタ記録庫/SEND+MORE=MONEY

Thanks

YEAR OF THE CAT

  S E N D
+ M O R E
----------
M O N E Y
(S,M != 0)

10/18の OCaml講義第3回 by ガリグ先生で、授業の課題として出ました。
授業では、search関数はガリグ先生のお手本があって、生徒はcheck関数を書くだけでしたが。
計算量が苦しいなら、M=1はOKにしましょう。 - げんま

授業の課題 &dagger;

let toint (li : int list) =
  List.fold_left (fun a b -> (a * 10 + b)) 0 li;;

let check (d : (char * int) list) =
  let f l = (toint (List.map (fun a -> List.assoc a d) l)) in
  ((List.assoc 'S' d != 0) &&
   (List.assoc 'M' d != 0) &&
   ((f ['S'; 'E'; 'N'; 'D']) + (f ['M'; 'O'; 'R'; 'E']) = (f ['M'; 'O'; 'N'; 'E'; 'Y'])));;

let rec search dict letters numbers =
  match letters with
    [] -> if check dict then [dict] else []
  | a :: letters ->
      let rec choose tried numbers =
	 match numbers with
	   [] -> []
	 | n :: numbers ->
	     let sols = search ((a, n) :: dict) letters (tried @ numbers) in
	     sols @ choose (n::tried) numbers
      in
      choose [] numbers ;;

let rec interval m n =
  if m > n then [] else m :: interval (m+1) n;;

let solve () =
  search [] ['S';'E';'N';'D';'M';'O';'R';'Y'] (interval 0 9);;

solve();;

↑

Gauche &dagger;

ライブラリに、順列組み合わせのpermutationなどがあったので、かなり楽ができました。見つかったらreturnラベルで大域脱出。2.6Ghzで13秒。 - げんま

(use srfi-1)
(use util.combinations)
(use util.match)

(define return #f)

(define (eval-poly li x)
  (fold (lambda (a b) (+  a (* b x))) 0 li))

(define (check li)
  (match li
    ((S E N D M O R Y)
     (if
      (and
       (not (= S 0))
       (not (= M 0))
       (= (+ (eval-poly (list S E N D) 10)
	       (eval-poly (list M O R E) 10))
	    (eval-poly (list M O N E Y) 10)))
      (return (list S E N D '+ M O R E '= M O N E Y))))))

(define (solve)
  (combinations-for-each
   (lambda (a) (permutations-for-each check a))
   (iota 10) 8))

(print
 (call/cc
  (lambda (cc)
   (set! return cc)
   (solve))))

↑

Haskellで解いてみる &dagger;

(追記：nobsunさんのコードのほうがスマート。) (らくがきえんじんにも書いた。)

何も考えてない。15分くらいででけた。こういう問題にはリストモナドがめっぽう強い。（けいご） Showのインスタンスが必要なのはご愛嬌。

import Control.Monad.State

ten = [0..9]

-- StateT [Int] [] Intが何であるかを考えるより、単に [Int]->[(Int,[Int])] だと思えばよい 
-- (「リストlを貰って、その中のどれかの要素eと、lからeを取った残りl'の対(e,l')を返す」という非決定的な関数)
getNum :: StateT [Int] [] Int
getNum = StateT $ ?ns -> do{n <- ns; return (n, filter (n/=) ns)}

sendmory = do
  s <- getNum
  if s==0 then lift [] else return ()
  m <- getNum
  if m==0 then lift [] else return ()
  e <- getNum
  n <- getNum
  d <- getNum
  o <- getNum
  r <- getNum
  y <- getNum
  if s*1000+e*100+n*10+d+m*1000+o*100+r*10+e==m*10000+o*1000+n*100+e*10+y then return (s,e,n,d,m,o,r,y) else lift []

instance (Show s, Show e, Show n, Show d, Show m, Show o, Show r, Show y)=>
  Show (s,e,n,d,m,o,r,y) where
  show (s,e,n,d,m,o,r,y) = "("++show s++","++show e++","++show n++","++
                                show d++","++show m++","++show o++","++
                                show r++","++show y++")"
  
main = print (evalStateT sendmory ten)

sydney$ ghc -package mtl Desktop/hoge.hs -o a.out
sydney$ time ./a.out 
[(?,?,?,?,?,?,?,?)]

real    0m4.544s
user    0m4.341s
sys     0m0.076s

体感5秒位 (PPC, 2.3GHz dual) ただし今インタプリタ(ghci)で試したら25秒くらいかかった。

↑

そっちがMonadなら、こっちはamb<<改訂版>> &dagger;

48秒@2.6GHz- げんま

(use srfi-1)

;; stack of cc.
(define fail '())

;; nondeterminsm operator
(define (amb li)
  (if (null? li)
      ((pop! fail))
      (call/cc
       (lambda (cc)
	 (push! fail (lambda ()
		       (cc (amb (cdr li)))))
	 (car li)))))

(define (toint li)
  (fold (lambda (a b) (+ a (* b 10))) 0 li))

(define (solve)
  (let ((digs (iota 10 0))
         (digs1 (iota 9 1)))
    (let* ((S (amb digs1))
            (E (amb (lset-difference = digs (list S))))
            (N (amb (lset-difference = digs (list S E))))
            (D (amb (lset-difference = digs (list S E N))))
            (M (amb (lset-difference = digs1 (list S E N D))))
            (O (amb (lset-difference = digs (list S E N D M))))
            (R (amb (lset-difference = digs (list S E N D M O))))
            (Y (amb (lset-difference = digs (list S E N D M O R)))))
      (if
       (= (+ (toint (list S E N D))
              (toint (list M O R E)))
          (toint (list M O N E Y)))
       (list S E N D '+ M O R E '= M O N E Y)
       (amb '())))))

(print
 (call/cc
  (lambda (cc)
    ;; initial value for fail
    (push! fail
	   (lambda ()
	     (cc 'no-choise)))
    (solve))))

↑

憶えたての Prolog でやってみる(sue) &dagger;

Program

?- use_module(library(bounds)).
smm(S, E, N, D, M, R, O, Y) :-   
	Digits = [S, E, N, D, M, R, O, Y],
	Digits in 0..9,
	all_different(Digits),
	S #> 0,
	M #> 0,
	Send = S * 1000 + E * 100 + N * 10 + D,
	More = M * 1000 + O * 100 + R * 10 + E,
	Money = M * 10000 + O * 1000 + N * 100 + E * 10 + Y,
	Send + More #= Money,
	label(Digits).

実行結果

?- [sendmoremoney].
% sendmoremoney compiled 0.00 sec, 16 bytes

Yes
?- time(smm(S, E, N, D, M, R, O, Y)).
% 40,088 inferences, 0.02 CPU in 0.02 seconds (111% CPU, 2004400 Lips) 

S = 9,
E = 5,
N = 6,
D = 7,
M = 1,
R = 8,
O = 0,
Y = 2

直感的．

0.02秒?　all_different(Digits)は、10C8 * 8! 個の組み合わせを試すんだよね? -- げんま? 2007-04-13 (金) 15:56:43
書いておきながらよく分かってないんだけど，おそらく全探索のはず．なぜこんなに速いんだろう... -- sue? 2007-04-13 (金) 20:52:33
よく考えたら，これは一つ目の解を出すまでの時間だから，たまたま早かった，というのもありうる... -- sue? 2007-04-13 (金) 20:54:21
すばらしーい。さすがにこの手のバックトラックの問題はPrologの書き方が美しいですねぇ。 -- おがさわら? 2007-09-20 (木) 10:27:59

ネタ記録庫/SEND+MORE=MONEY

トップページ

OCaml Tips

ネタ記録庫

関数型言語によるWeb開発

ScalaByExample(訳)

限定継続

お勉強リンク

発表資料