Haskellでポーカー？
長いコードになりましたので続きから
import System.Random import Data.List import System.IO data Suit = Dia | Clover | Heart | Spade | Wild deriving (Show,Eq,Ord) data Card = NumCard Suit Rank | Joker deriving (Eq) instance Show Card where show (NumCard x y) = (show x)++" "++(show (fromEnum y)) show (Joker) = "Joker" instance Ord Card where compare (Joker) _ = GT compare _ (Joker) = LT compare (NumCard x y) (NumCard v w) | y == w = EQ | y < w = LT | otherwise = GT data PrizeR = PR Prize Rank deriving(Eq) instance Show PrizeR where show (PR x y) = show x data Rank = None | One | Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King deriving(Show,Eq,Ord,Enum,Bounded) type Hand = [Card] data Prize = High | OnePair | TwoPair | ThreeCards | Straight | Flush | FullHouse| FourCards | StraightFlush | RoyalStraightFlush | FiveCards deriving(Show,Eq,Ord,Enum) maxhand [] = NumCard Dia None maxhand (x:xs) = let y = maxhand xs in if x > y then x else y handstosetsuit ((NumCard a _):(NumCard b _):(NumCard c _):(NumCard d _):(NumCard e _):[]) = (a,b,c,d,e) handstosetsuit ((NumCard a _):(NumCard b _):(NumCard c _):(NumCard d _):(Joker):[]) = (a,b,c,d,Wild) handstosetnum ((NumCard _ a):(NumCard _ b):(NumCard _ c):(NumCard _ d):(NumCard _ e):[]) = (a,b,c,d,e) handstosetnum ((NumCard _ a):(NumCard _ b):(NumCard _ c):(NumCard _ d):(Joker):[]) = (a,b,c,d,None) countlist [] x = 0 countlist (x:xs) y = if x == y then 1 + countlist xs y else countlist xs y ismaxdup (a,b,c,d,e) = let maxdupi [] l = l maxdupi (x:xs) l = maxdupi (drop (countlist xs x) xs ) (max (1 + countlist xs x) l) in maxdupi (a:b:c:d:e:[]) 0 culcPrize card = let suitset = handstosetsuit card numset = handstosetnum card in if (isFiveCards numset) then PR FiveCards (ismaxnum numset) else if (isRoyalStraight numset) && (isFlush suitset) then PR RoyalStraightFlush (ismaxnum numset) else if (isStraight numset) && (isFlush suitset) then PR StraightFlush (ismaxnum numset) else if (isFourCards numset) then PR FourCards (ismaxnum numset) else if (isFullHouse numset) then PR FullHouse (ismaxnum numset) else if (isFlush suitset) then PR Flush (ismaxnum numset) else if (isStraight numset) then PR Straight (ismaxnums numset) else if (isThreeCards numset) then PR ThreeCards (ismaxnums numset) else if (isTwoPair numset) then PR TwoPair (ismaxnums numset) else if (isOnePair numset) then PR OnePair (ismaxnums numset) else PR High (ismaxnums numset) ismaxnums (_,_,_,a,b) = if b /= None then b else a isOnePair (a,b,c,d,None) = True isOnePair (a,b,c,d,e) = if (ismaxdup (a,b,c,d,e) == 2) then True else False isTwoPair (a,b,c,d,None) = a == b || b == c || c == d isTwoPair (a,b,c,d,e) = a == b && c == d || a == b && d == e || b == c && d == e isThreeCards (a,b,c,d,None) = if (ismaxdup (a,b,c,d,None) == 2) then True else False isThreeCards (a,b,c,d,e) = if (ismaxdup (a,b,c,d,e) == 3) then True else False isFourCards (a,b,c,d,None) = if (ismaxdup (a,b,c,d,None)) == 3 then True else False isFourCards (a,b,c,d,e) = if (ismaxdup (a,b,c,d,e)) == 4 then True else False isFullHouse (a,b,c,d,None) = a == b && c == d isFullHouse (a,b,c,d,e) = (a == b && b == c && d == e) || (a == b && c == d && d == e) isFlush (a,b,c,d,Wild) = a == b && b == c && c == d isFlush (a,b,c,d,e) = a == b && b == c && c == d && d == e isStraight (a,b,c,d,None) = if d <= Three then False else (pred d == c && pred c == b && pred b == a) || (pred (pred d) == c && pred c == b && pred b == a) || (pred d == c && pred (pred c) == b && pred b == a )|| (pred d == c && pred c == b && pred (pred b) == a ) isStraight (a,b,c,d,e) = pred e == d && pred d == c && pred c == b && pred b == a isFiveCards (a,b,c,d,None) = a == b && b == c && c == d isFiveCards (a,b,c,d,e) = a == b && b == c && c == d && d == e isRoyalStraight (One,Ten,Jack,Queen,None) = True isRoyalStraight (One,Ten,Jack,King,None) = True isRoyalStraight (One,Ten,Queen,King,None) = True isRoyalStraight (One,Jack,Queen,King,None) = True isRoyalStraight (Ten,Jack,Queen,King,None) = True isRoyalStraight (One,Ten,Jack,Queen,King) = True isRoyalStraight _ = False ismaxnum (a,b,c,d,e) = if a == One then a else e elemdS [] _ = [] elemdS (x:xs) s = if x <= s then (x:(elemdS xs s)) else elemdS xs s elemuS [] _ = [] elemuS (x:xs) s = if x > s then (x:(elemuS xs s)) else elemuS xs s suitsort [] = [] suitsort (x:xs) = suitsort((elemdS xs x))++[x]++suitsort((elemuS xs x)) deck = (Joker):[NumCard x y | x <- [Dia,Clover,Heart,Spade] , y <- [(One)..(King)]] randM f = do x <- randomRIO (0,f) :: IO Int return x remD _ [] = [] remD 0 (y:ys) = ys remD x (y:ys) = y:(remD (x-1) ys) distribute5i d xs = if length xs == 5 then return xs else do x <- randM (52-(length xs)) distribute5i (remD x d) ((d !! x ):xs) distribute5 = do xs <- distribute5i deck ([]) return (suitsort xs) repeatpoker s x = do y <- distribute5 let (PR pr _) = culcPrize y if pr == s then do print x print y else repeatpoker s (x+1) main = do repeatpoker (RoyalStraightFlush) 0
実行例
$ ./poker 56274 [Spade 1,Spade 11,Spade 12,Spade 13,Joker] $ ./poker 50725 [Dia 10,Dia 11,Dia 12,Dia 13,Joker] $ ./poker 173559 [Heart 1,Heart 10,Heart 11,Heart 13,Joker]
ポーカーといいつつ上のコードはロイヤルストレートフラッシュが出るまでカードを混ぜて5枚ひくのを繰り返すプログラムになってます。mainをちょっと改変すれば5枚ひいて役を表示するものにできます。
ここで作ったSuitやらCardやらの型はトランプゲームを作る機会があれば再利用できそうです。けれども、Jokerは数値としてみるかスートとしてみるか、スート数値のセットと同列に見るかなど、なかなか扱いに困りました。結果、スートもカードも数値にもジョーカーの場所を作りました。数値だけ見たいときやスートだけ見たいときにジョーカー特有の場所があると便利です。もっとうまい実装がありそうですが。
カードのデータをとって役の条件を満たすかどうかを判定する関数の実装がなかなか辛かったです...。うまい方法が思い浮かばなかったので、引数のソートを前提にして虱潰しのようなことを書いています。
Haskellの型クラスや型、インスタンスやI/Oモナドなどいろいろなことがこれを通して学べました。
いきあたりばったりで長いコード書くとコーディングのセンスが試されてるような感じがします。
