diff --git a/KoiKoi.hs b/KoiKoi.hs index b16c33c..c261b7f 100644 --- a/KoiKoi.hs +++ b/KoiKoi.hs @@ -1,8 +1,9 @@ +{-# LANGUAGE NamedFieldPuns #-} module KoiKoi where import CCard -import Data.Bits (popCount, (.&.), shift, testBit) -import Data.Map (Map, empty, insert, unionWith) +import Data.Bits (popCount, (.|.), (.&.), shift, xor) +import Data.Map (Map, empty, insert, unionWith, (!)) data Yaku = Goko @@ -18,14 +19,15 @@ data Yaku = | TsukimiZake | HanamiZake | TsukiFuda - deriving (Show) + deriving (Eq, Ord, Show) type Points = Int -type Score = Pack -> Maybe (Yaku, Points) +type YakuFinder = Pack -> Maybe (Yaku, Points) +type Score = Map Yaku Points data Player = Player { hand :: Pack , captured :: Pack - , scored :: Map Yaku Points + , scored :: Score } data State = State { @@ -36,39 +38,57 @@ data State = State { , turn :: Bool } -has :: Pack -> (Yaku, Points) -> (Pack, Score) -has pack points = - (pack, \p -> if p == pack then Just points else Nothing) +fixed :: (Yaku, Points) -> Pack -> YakuFinder +fixed points indicatorSet pack = if pack == indicatorSet then Just points else Nothing -moreThan :: Int -> Pack -> Yaku -> (Pack, Score) -moreThan count pack yaku = - (pack, (\n -> if n > 0 then Just (yaku, n) else Nothing) . ($count) . (-) . popCount) +moreThan :: Int -> Yaku -> (Pack -> YakuFinder) +moreThan count yaku _ = + (\n -> if n > 0 then Just (yaku, n) else Nothing) . ($count) . (-) . popCount -hikari :: (Pack, Score) -hikari = (lights, \p -> rate (popCount p) (p `contains` RainMan)) +lights :: [Card] +lights = [Crane, CampCurtain, FullMoon, RainMan, Phoenix] + +hikari :: Pack -> YakuFinder +hikari _ pack = rate (popCount pack) (pack `contains` RainMan) where rate 5 _ = Just (Goko, 10) rate 4 hasRainMan = if hasRainMan then Just (AmeShiko, 7) else Just (Shiko, 8) rate n hasRainMan = if not hasRainMan && n > 2 then Just (Sanko, 5) else Nothing -tsukiFuda :: Flower -> (Pack, Score) -tsukiFuda flower = has (0xf `shift` (fromEnum flower * 4)) (TsukiFuda, 8) +tsukiFuda :: Flower -> ([Card], Pack -> YakuFinder) +tsukiFuda flower = (map toEnum $ map (fromEnum flower * 4 +) [0..3], fixed (TsukiFuda, 8)) -index :: (Pack, Score) -> Map Card [Score] -index (pack, score) = - foldl (\map card -> - if testBit pack $ fromEnum card then insert card [score . (.&.) pack] map else map - ) empty cards +index :: ([Card], Pack -> YakuFinder) -> Map Card [YakuFinder] +index (cards, scorer) = + let pack = packOfCards cards in + foldl (\map card -> insert card [scorer pack . (.&.) pack] map) empty cards -yakus :: Map Card [Score] +inoshikacho :: [Card] +inoshikacho = [Butterflies, Boar, Deer] + +animals :: [Card] +animals = [BushWarbler, Cuckoo, EightPlankBridge, Geese, SakeCup, Swallow] ++ inoshikacho + +blue :: [Card] +blue = [PeonyBlue, ChrysanthemumBlue, MapleBlue] + +poetry :: [Card] +poetry = [PinePoetry, PlumPoetry, CherryPoetry] + +ribbons = [WisteriaRed, IrisRed, BushCloverRed, WillowRed] ++ blue ++ poetry + +plain :: [Card] +plain = (foldl (++) [] [map toEnum [4*i, 4*i+1] | i <- [0..10]]) ++ Lightning : [Paulownia0 .. Sand] + +yakus :: Map Card [YakuFinder] yakus = foldl (\map -> unionWith (++) map . index) empty [ - hikari - , has inoshikacho (InoShikaCho, 5) - , moreThan 4 animals Tane - , has poetry (Akatan, 5) - , has blue (Aotan, 5) - , moreThan 4 ribbons Tan - , moreThan 9 plain Kasu - , has (set [SakeCup, FullMoon]) (TsukimiZake, 5) - , has (set [SakeCup, CampCurtain]) (HanamiZake, 5) + (lights, hikari) + , (inoshikacho, fixed (InoShikaCho, 5)) + , (animals, moreThan 4 Tane) + , (poetry, fixed (Akatan, 5)) + , (blue, fixed (Aotan, 5)) + , (ribbons, moreThan 4 Tan) + , (plain, moreThan 9 Kasu) + , ([SakeCup, FullMoon], fixed (TsukimiZake, 5)) + , ([SakeCup, CampCurtain], fixed (HanamiZake, 5)) ]