Implement KoiKoi's yakus

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))
+  ]