2011-11-02
Project Euler 92
問題はこちら。
これはかなり前に解いていたのですが、
ちょっと（というかかなりｗ）遅かったので今回高速化してみました。
案外うまくいきました。僕の低速PCでも3秒くらい。
import Data.List import Data.Char -- 辞書順重複組み合わせ。 -- comb [0,1,2] 2 で [[0,0],[0,1],[0,2],[1,1],[1,2],[2,2]] comb :: [a] -> Int -> [[a]] comb _ 0 = [[]] comb [] _ = [] comb (x:xs) n = map (x:) (comb (x:xs) (n-1)) ++ comb xs n -- 各桁の二乗を足し続けて89ならTrue。 -- f [8,5] で True f :: [Int] -> Bool f xs | a == 89 = True | a == 1 = False | otherwise = f b where a = sum $ map (^2) xs b = map (digitToInt) (show a) -- 階乗。かいじょう！ k :: Int -> Int k n = product [1..n] -- リストに一つしか現れない数字を除去し、複数現れる数字をまとめる。 --g [1,1,2,3,3,3,4] で [[1,1],[3,3,3]] g [] = [] g xs | (b == 1) = g (tail xs) | otherwise = a : g (drop b xs) where a = takeWhile (== head xs) xs b = length a -- 普通の順列、あるいは同じものを含む順列の数（ただし先頭に0を含まない）。 -- j [1,2,2,3,3,3] で 60。つまり6!/(2!*3!)を計算してる。 j :: [Int] -> Int j xs = div (k (length xs)) (product $ map (k) $ map (length) $ g xs) -- 0を含む時の順列の数！！！（先頭に0がきてはいけない） -- jj [0,1,2,3] で 18。この場合3*3!を計算してる。 jj :: [Int] -> Int jj xs = sum [ j (delete x xs) | x <- tail (nub xs) ] -- リストの先頭に0がある時は関数jj、ないなら関数jで。 h :: [Int] -> Int h xs | (head xs == 0) = jj xs | otherwise = j xs -- 1から9999999の数字を桁の重複組み合わせで効率良く出す。これだと19440個だけ調べれば良い。 -- [[1],[2],・・・[0,4,5],・・・[1,3,3,4,5],[9,9,9,9,9]・・・] a :: [[Int]] a = concat [ tail $ comb [0..9] x | x <- [1..7] ] --こたえだよ！おにいちゃん！ main = print $ sum $ map h $ filter f a
今回のコードはそこまで圧倒的にくそくないです。たぶん。
Permalink | コメント(0) | トラックバック(0) | 17:18 
Project Euler 54
問題はこちら。
バグ取りによって一時死去したけれど、復活して完成。とりあえずうｐ。
変にまわりくどいし、Haskellなのに超長いし（他の人々のと比較して2〜4倍長い）、
しかも型書いてないし（ぉぃ、とんでもなく圧倒的にくそいよお。
disらないでください。すいませんorz
本当にくそいです。
import Data.List import Data.Char import Data.Maybe -- データ構造 ([カードの数値],"スート")。 ehuda = zip ['T','J','Q','K','A'] [10,11,12,13,14] f s | isAlpha a = fromJust (lookup a ehuda) | otherwise = read (take 1 s)::Int where a = head s g ss = (reverse $ sort $ map f ss , map last ss) -- ポーカーの役判定。cardの型は([カードの数字],"スート")。 -- リストの要素が全て同じならTrue。 same xs | (length xs < 2) = True | (head xs == xs !! 1) = same (tail xs) | otherwise = False -- nカードなら(True,[役の数字部分],[数字全体])。以下全てこの型。 nCard (xs,ys) z n | (length xs < n) = (False,[],[]) | same t = (True,t,z) | otherwise = nCard (tail xs,ys) z n where t = take n xs -- ワンペア。 onePair card = nCard card (fst card) 2 -- ツーペア（なんかあれｗ）。 twoPair' card z | same a && same b = (True,a++b,z) | same a && same c = (True,a++c,z) | same d && same e = (True,d++e,z) | otherwise = (False,[],[]) where f = fst card a = take 2 f b = take 2 $ drop 2 f c = drop 3 f d = take 2 $ tail f e = drop 3 f twoPair card = twoPair' card (fst card) -- スリーカード。 threeCard card = nCard card (fst card) 3 -- ストレート。 stright card | f == (reverse $ take 5 $ iterate (+1) (last f)) = (True,f,f) | otherwise = (False,[],[]) where f = fst card -- フラッシュ。 flash card | same (snd card) = (True,f,f) | otherwise = (False,[],[]) where f = fst card --フルハウス。 hullHouse' card z | same a && same b = (True,a++b,z) | same c && same d = (True,c++d,z) | otherwise = (False,[],[]) where f = fst card a = take 3 f b = drop 3 f c = take 2 f d = drop 2 f hullHouse card = hullHouse' card (fst card) -- フォーカード。 fourCard card = nCard card (fst card) 4 -- タプルの第1要素と第2第3要素を返す。 fst3 (a,b,c) = a snth3 (a,b,c) = (b,c) -- ストレートフラッシュ。 strightFlash card | (fst3 (stright card) && fst3 (flash card)) = (True,f,f) | otherwise = (False,[],[]) where f = fst card -- ロイヤルストレートフラッシュ。 loyalStrateFlash card | (fst card == [10..14] && fst3 (flash card)) = (True,[10..14],[10..14]) | otherwise = (False,[],[]) -- カードの役の(得点,([役の数字部分],[数字全体])) poker card | fst3 (loyalStrateFlash card) = (9,snth3 (loyalStrateFlash card)) | fst3 (strightFlash card) = (8,snth3 (strightFlash card)) | fst3 (fourCard card) = (7,snth3 (fourCard card)) | fst3 (hullHouse card) = (6,snth3 (hullHouse card)) | fst3 (flash card) = (5,snth3 (flash card)) | fst3 (stright card) = (4,snth3 (stright card)) | fst3 (threeCard card) = (3,snth3 (threeCard card)) | fst3 (twoPair card) = (2,snth3 (twoPair card)) | fst3 (onePair card) = (1,snth3 (onePair card)) | otherwise = (0,(fst card,fst card)) -- ポーカーのルール。 pokerRule [s1,s2] | (point1 > point2) = 1 | (point1 == point2) && (a > c) = 1 | (point1 == point2) && (a == c) && (b > d) = 1 | otherwise = 0 where [(point1,(a,b)),(point2,(c,d))] = map poker [s1,s2] -- 二人でのポーカープレイ。 pokerPlay [] = 0 pokerPlay ss = pokerRule (take 2 ss) + pokerPlay (drop 2 ss) -- テキストファイルからデータ取得してポーカープレイ。 ff [] = [] ff s = (take 2 s) : ff (drop 3 s) gg [] = [] gg s = (take 5 s) : gg (drop 5 s) main = do a <- readFile "poker.txt" print $ pokerPlay $ map g $ (gg.ff) a
大事なことなのでもう1度言いますが、本当に本当に、くそいです。
Permalink | コメント(0) | トラックバック(0) | 09:30
