[[ネタ記録庫/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にしましょう。 - げんま
* 授業の課題 [#w55b6646]
 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 [#if874cf2]
ライブラリに、順列組み合わせの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で解いてみる [#n5f2521d]
(''追記'':[[nobsunさんのコード:http://haskell.g.hatena.ne.jp/nobsun/20061019/alphametic]]のほうがスマート。)
([[らくがきえんじん:http://d.hatena.ne.jp/syd_syd/20061018]]にも書いた。)

何も考えてない。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<<改訂版>> [#rad040bb]
- 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) [#nddbaf73]
-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! 個の組み合わせを試すんだよね? -- [[げんま]] &new{2007-04-13 (金) 15:56:43};
- 書いておきながらよく分かってないんだけど,おそらく全探索のはず.なぜこんなに速いんだろう... -- [[sue]] &new{2007-04-13 (金) 20:52:33};
- よく考えたら,これは一つ目の解を出すまでの時間だから,たまたま早かった,というのもありうる... -- [[sue]] &new{2007-04-13 (金) 20:54:21};
- すばらしーい。さすがにこの手のバックトラックの問題はPrologの書き方が美しいですねぇ。 -- [[おがさわら]] &new{2007-09-20 (木) 10:27:59};
- <a href="http://vanessahudgens.moy.su">Vanessa Hudgens nude (naked)</a> [url=http://vanessahudgens.moy.su]Vanessa Hudgens nude (naked)[/url] <a href=http://vanessahudgens.moy.su>Vanessa Hudgens nude (naked)</a> [url= http://vanessahudgens.moy.su ] Vanessa Hudgens nude (naked) [/url] -- [[Vanessa Hudgens nude (naked)]] &new{2007-12-28 (金) 03:45:14};

#comment

トップ   編集 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS