ネタ記録庫/SEND+MORE=MONEY

  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にしましょう。 - げんま

授業の課題 †

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 †

ライブラリに、順列組み合わせの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で解いてみる †

(追記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

トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2007-12-28 (金) 12:45:14 (4683d)