diff --git a/Yaku.hs b/Yaku.hs new file mode 100644 index 0000000..5d483fe --- /dev/null +++ b/Yaku.hs @@ -0,0 +1,79 @@ +module Yaku where + +import Card (Card(..), Flower, Pack, size, contains, intersection, packOfCards) +import Data.Map (Map, empty, insert, unionWith) + +data Yaku = + Goko + | Shiko + | AmeShiko + | Sanko + | InoShikaCho + | Tane + | Akatan + | Aotan + | Tan + | Kasu + | TsukimiZake + | HanamiZake + | TsukiFuda + deriving (Eq, Ord, Show) +type Points = Int +type YakuFinder = Pack -> Maybe (Yaku, Points) +type Score = Map Yaku Points + +fixed :: (Yaku, Points) -> Pack -> YakuFinder +fixed points indicatorSet pack = if pack == indicatorSet then Just points else Nothing + +moreThan :: Int -> Yaku -> (Pack -> YakuFinder) +moreThan count yaku _ pack = + let n = size pack - count in + if n > 0 then Just (yaku, n) else Nothing + +lights :: [Card] +lights = [Crane, CampCurtain, FullMoon, RainMan, Phoenix] + +hikari :: Pack -> YakuFinder +hikari _ pack = rate (size 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 -> ([Card], Pack -> YakuFinder) +tsukiFuda flower = (map toEnum $ map (fromEnum flower * 4 +) [0..3], fixed (TsukiFuda, 8)) + +index :: ([Card], Pack -> YakuFinder) -> Map Card [YakuFinder] +index (cards, scorer) = + let pack = packOfCards cards in + foldl (\map card -> insert card [scorer pack . intersection pack] map) empty cards + +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] + +allYakus :: Map Card [YakuFinder] +allYakus = foldl (\map -> unionWith (++) map . index) empty [ + (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)) + ]