- 追加された行はこの色です。
- 削除された行はこの色です。
[[ネタ記録庫/数独]]
[[ネタ記録庫/SEND+MORE=MONEY]]
#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};
- 「正解なんて用意されてないのさ、全探索ごくろうさま!」のタイムを見てみたいです。 -- [[げんま]] &new{2007-04-13 (金) 22:36:49};
- <a href=" http://weblog.xanga.com/kolin83/616928573/ebony-porn.html ">ebony porn</a> <a href=" http://weblog.xanga.com/kolin83/616928651/ethnic-gay-porn.html ">ethnic gay porn</a> <a href=" http://weblog.xanga.com/kolin83/616928767/fake-tits.html ">fake tits</a> <a href=" http://weblog.xanga.com/kolin83/616929390/familysex.html ">familysex</a> <a href=" http://weblog.xanga.com/kolin83/616929456/fat-pussy.html ">fat pussy</a> -- [[fat pussy]] &new{2007-09-20 (木) 10:08:05};
- <a href=" http://weblog.xanga.com/tonesring/616667293/aflac-ringtones.html ">aflac ringtones</a> <a href=" http://weblog.xanga.com/tonesring/616667496/motorola-ringtones-free.html ">motorola ringtones free</a> <a href=" http://weblog.xanga.com/tonesring/616667714/nfl-ringtones.html ">nfl ringtones</a> <a href=" http://weblog.xanga.com/tonesring/616667848/school-ringtones.html ">school ringtones</a> -- [[school ringtones]] &new{2007-09-20 (木) 10:10:25};
- すばらしーい。さすがにこの手のバックトラックの問題はPrologの書き方が美しいですねぇ。 -- [[おがさわら]] &new{2007-09-20 (木) 10:27:59};
#comment