92 lines
3.0 KiB
Haskell
92 lines
3.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module AI (
|
|
move
|
|
) where
|
|
|
|
import Data.List (sortOn)
|
|
import Data.Map ((!))
|
|
import Data.Ord (Down(..))
|
|
import Data.Set (Set, member)
|
|
import qualified Data.Set as Set (fromList, intersection, unions)
|
|
import Hanafuda (
|
|
Card(..), Flower(..), Pack
|
|
, cardsOf, cardsOfPack, contains, empty,flower, packOfCards, sameMonth, size, union
|
|
)
|
|
import Hanafuda.Player (Player(..), Players(..))
|
|
import Hanafuda.KoiKoi (GameBlueprint(..), Move(..), PlayerID, Step(..), Score)
|
|
import Hanafuda.Message (PublicGame)
|
|
|
|
move :: PlayerID -> PublicGame -> Move
|
|
|
|
move me (Game {step = ToPlay, month, players = Players p, river}) =
|
|
case getAvailableCards myHand (cardsOfPack river) of
|
|
[] -> Play $ worstFor month (p ! (nextPlayer $ p ! me)) myHand
|
|
available ->
|
|
let riverCard = bestFor month (p ! me) available in
|
|
let matchingCards = cardsOfPack . sameMonth riverCard . hand $ p ! me in
|
|
capture (bestFor month (p ! me) matchingCards) riverCard river
|
|
where
|
|
myHand = cardsOfPack . hand $ p ! me
|
|
|
|
move me (Game {step = Turned card, month, players = Players p, river}) =
|
|
Choose . bestFor month (p ! me) . cardsOfPack $ sameMonth card river
|
|
|
|
move me (Game {players = Players p}) = KoiKoi $ hand (p ! me) /= empty
|
|
|
|
capture :: Card -> Card -> Pack -> Move
|
|
capture card caught river =
|
|
if size (sameMonth card river) == 1
|
|
then Play card
|
|
else Capture (card, caught)
|
|
|
|
getAvailableCards :: [Card] -> [Card] -> [Card]
|
|
getAvailableCards hand =
|
|
filter ((`member` flowersInHand) . flower)
|
|
where
|
|
flowersInHand = Set.fromList $ flower <$> hand
|
|
|
|
choose :: Ord a => (Card -> a) -> [Card] -> Card
|
|
choose sortCriterion = head . sortOn sortCriterion
|
|
|
|
bestFor :: Flower -> Player Score -> [Card] -> Card
|
|
bestFor monthFlower player = choose (Down . rank monthFlower player)
|
|
|
|
worstFor :: Flower -> Player Score -> [Card] -> Card
|
|
worstFor monthFlower player = choose (rank monthFlower player)
|
|
|
|
rank :: Flower -> Player Score -> Card -> Int
|
|
rank monthFlower _ card
|
|
| isTrueLight card = 5
|
|
| card == RainMan = 2
|
|
| isSpecialRibbon card = 4
|
|
| isRibbon card = 3
|
|
| isSpecialAnimal card = 4
|
|
| isAnimal card = 3
|
|
| isMonthly monthFlower card = 4
|
|
| otherwise = 1
|
|
|
|
isTrueLight :: Card -> Bool
|
|
isTrueLight = (packOfCards [Crane, CampCurtain, FullMoon, Phoenix] `contains`)
|
|
|
|
isSpecialRibbon :: Card -> Bool
|
|
isSpecialRibbon = ((aotan `union` akatan) `contains`)
|
|
where
|
|
aotan = packOfCards [PeonyBlue, ChrysanthemumBlue, MapleBlue]
|
|
akatan = packOfCards [PinePoetry, PlumPoetry, CherryPoetry]
|
|
|
|
isRibbon :: Card -> Bool
|
|
isRibbon card = isSpecialRibbon card || packOfCards other `contains` card
|
|
where
|
|
other = [WisteriaRed, IrisRed, BushCloverRed, WillowRed]
|
|
|
|
isSpecialAnimal :: Card -> Bool
|
|
isSpecialAnimal = (packOfCards [Butterflies, Boar, SakeCup, Deer] `contains`)
|
|
|
|
isAnimal :: Card -> Bool
|
|
isAnimal card = (isSpecialAnimal card) || (packOfCards other `contains` card)
|
|
where
|
|
other = [BushWarbler, Cuckoo, EightPlankBridge, Geese, Swallow]
|
|
|
|
isMonthly :: Flower -> Card -> Bool
|
|
isMonthly monthFlower = (cardsOf monthFlower `contains`)
|