ポーカーの役判定
Posted feedbacks - Haskell
ストレートの判定がなかなかきれいにまとまりませんね。ソートしておいて隣り合う数の差で判断してみましたが……うーん。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | import Data.List as List
hand :: String -> (String, Bool)
hand cards =
(case kinds of
[1, 4] -> "Four of a kind"
[2, 3] -> "Full house"
[1, 1, 3] -> "Three of a kind"
[1, 2, 2] -> "Two pair"
[1, 1, 1, 2] -> "One pair"
otherwise ->
case rdiff of
[1, 1, 1, 1] | head ranks == 10 && isFlush -> "Royal"
| True -> "Straight"
[1, 1, 1, 9] -> "Straight"
otherwise -> "No pair"
, isFlush)
where suits = List.nub [cards !! n | n <- [0,2..8]]
isFlush = length suits == 1
ranks = List.sort [rankToInt $ cards !! n | n <- [1,3..9]]
rankToInt r = case List.elemIndex r "23456789TJQKA" of Just n -> n+2
kinds = List.sort $ map length $ List.group ranks
rdiff = zipWith (-) (tail ranks) ranks
main = mapM test ["SQSJSASKST", "D9D7D6D5D8", "C2D2S2H3H2", "C2D3S2H3H2",
"S9S4S8STSJ", "C4H7D5S6H3", "S6H6C5DQC6", "S6HQC5DQC6",
"S6H4C5DQC6" ,"SJSQSKSAC2"]
where test s = putStrLn (s ++ " => " ++ (showHand $ hand s))
showHand ("No pair", True) = "Flush"
showHand (s, True) = s ++ " flush"
showHand (s, False) = s
|
data使いたがりなhaskellコード。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | import System
import List(sort,group,elemIndex)
import Maybe(fromJust)
data Card = Card {suits::Suits,rank::Int} deriving Show
data Suits = S | D | H | C deriving (Read,Eq,Show)
data Hand = RF | STF | FK | FH | F | ST | TK | TP | OP | NO
read_cards :: String -> [Card]
read_cards str = map read_card $ split_2 str
where
read_card [s,r] = Card (read [s])
(fromJust (elemIndex r "DD23456789TJQKA"))
split_2 [] = []
split_2 list = let (hd,rest) = splitAt 2 list in hd : split_2 rest
instance Show Hand where
show h = case h of
RF -> "Royal flush"
STF -> "Straight flush"
FK -> "Four of a kind"
FH -> "Full House"
F -> "Flush"
ST -> "Straight"
TK -> "Three of a kind"
TP -> "Two pair"
OP -> "One pair"
NO -> "No pair"
hand :: [Card] -> Hand
hand cards
| check_st && check_flush && head rank_seq == 10 = RF
| check_st && check_flush = STF
| max_group == 4 = FK
| sort group_count == [2,3] = FH
| check_flush = F
| check_st = ST
| max_group == 3 = TK
| pair_count == 2 = TP
| pair_count == 1 = OP
| otherwise = NO
where
rank_seq = sort $ map rank cards
groups = group rank_seq
group_count = map length groups
max_group = foldl1 max group_count
pair_count = length (filter (\l->length l == 2) groups)
check_flush = all (\c->suits c==suits (head cards)) cards
check_st = normal || rank_seq == [2,3,4,5,14]
where
normal = and $ zipWith (\a b->a-b == head rank_seq) rank_seq [0..]
main = getArgs >>= print . hand . read_cards . head
-- Test
test = zip testlist (map (hand .read_cards) testlist)
testlist = ["SQSJSASKST",
"D9D7D6D5D8",
"C2D2S2H3H2",
"C2D3S2H3H2",
"S9S4S8STSJ",
"C4H7D5S6H3",
"S6H6C5DQC6",
"S6HQC5DQC6",
"S6H4C5DQC6",
"SJSQSKSAC2"]
|
結構綺麗にかけたんじゃないかと自負しています。
パターンマッチ様々です。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | import List
import Maybe
import System.Environment
card str= map (\(x:y:_)-> (x,rankInt y)) $ every 2 str
testData = "SQSJSASKST"
allRank = "_A23456789TJQK"
rankInt char = fromJust (elemIndex char allRank)
every n xs = unfoldr f xs
where
f [] = Nothing
f cs = Just (splitAt n cs)
isRoyal xs = xs == [1,10,11,12,13]
isStraight xs = (zipWith (-) (tail xs) xs) == [1,1,1,1]
same xs = reverse $ sort $ map (\x-> length $ filter (\a-> x == a) xs) (nub xs)
isFlush xs = nub xs == [head xs]
cardAnalysis xs = let ranks = sort $ map snd xs
suits = map fst xs
royal = isRoyal ranks
straight = isStraight ranks
sameRanks = same ranks
flush = isFlush suits
-- in (flush,royal,straight,sameRanks)
in hand flush royal straight sameRanks
hand True True False _ = "Royal flush"
hand True False True _ = "Straight flush"
hand _ _ _ (4:_) = "Four of a kind"
hand _ _ _ (3:2:_) = "Full house"
hand True _ _ _ = "Flush"
hand _ _ True _ = "Straight"
hand _ True _ _ = "Straight"
hand _ _ _ (3:_) = "Three of a kind"
hand _ _ _ (2:2:_) = "Two Pair"
hand _ _ _ (2:_) = "One Pair"
hand _ _ _ _ = "No Pair"
main = do args <- getArgs
putStrLn $ cardAnalysis $ card $ head args
|
Lost_dogです。もうあと出しじゃんけんすぎるんですが、みなさんの知恵と涙を結集して書き上げました。
特に#8152のtaninswさんのコードが綺麗だったので、ベースにさせていただきました。ポーカーの役は特に規則性がないので、こうやってベタ書きするのが分かりやすいですね。。
Sample Input 1
SQSJSASKST D9D7D6D5D8 C2D2S2H3H2 C2D3S2H3H2 S9S4S8STSJ C4H7D5S6H3 S6H6C5DQC6 S6HQC5DQC6 S6H4C5DQC6 SJSQSKSAC2
Sample Output 1
Royal flush Straight flush Four of a kind Full house Flush Straight Three of a kind Two Pair One Pair No Pair
.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | import List
main = interact $ unlines.map (hand.readCard).lines
data Card = Card { suit::Char , rank::Int }
readCard :: String -> [Card]
readCard [] = []
readCard (s:r:cs) = Card s r' : readCard cs
where Just r' = r`elemIndex`"0A23456789TJQK"
isRoyal :: [Card] -> Bool
isRoyal = ([]==).(\\[1,10,11,12,13]).map rank
isFlush :: [Card] -> Bool
isFlush = (1==).length.group.map suit
isStraight :: [Card] -> Bool
isStraight cs = (1==) $ length $ group $ zipWith (-) (tail ds) ds
where ds = sort $ map rank cs
groups :: [Card] -> [Int]
groups = sortBy (flip compare).map length.group.sort.map rank
hand :: [Card] -> String
hand cs = hand' (isFlush cs) (isRoyal cs) (isStraight cs) (groups cs)
where hand' True True True _ = "Royal straight flush"
hand' True True _ _ = "Royal flush"
hand' True _ True _ = "Straight flush"
hand' _ _ _ (4:_) = "Four of a kind"
hand' _ _ _ (3:2:_) = "Full house"
hand' True _ _ _ = "Flush"
hand' _ _ True _ = "Straight"
hand' _ True _ _ = "Straight"
hand' _ _ _ (3:_) = "Three of a kind"
hand' _ _ _ (2:2:_) = "Two Pair"
hand' _ _ _ (2:_) = "One Pair"
hand' _ _ _ _ = "No Pair"
|
xsd
#4978()
Rating6/10=0.60
引数に手札を与えると、ポーカーの役を表示するプログラムを作ってください。
条件：
実行例：
see: ポーカー - Wikipedia
1 reply [ reply ]