[[ネタ記録庫/数独]] #contents 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};