Scoring.hs

{- |
Module      : Riichi.Scoring
Description : Functions for score calculation (yaku, han, fu)
License     : BSD-3-Clause
Maintainer  : surplussinewaves@gmail.com
-}
module Riichi.Scoring where

import ColourStrings
import Control.Monad (when)
import Control.Monad.Writer
import Data.Function ((&))
import Data.Map qualified as M
import Data.Maybe (fromMaybe)
import Data.Monoid (Sum (..))
import Riichi.Context
import Riichi.Meld
import Riichi.Tile
import Riichi.Yaku

-- | Type alias
type YakumanCount = Int

-- | Type alias
type Han = Sum Int

-- | Get the fu contributed by a meld (only pons and kans give fu)
getMeldFu :: Meld -> Fu
getMeldFu (Chi{}) = 0
getMeldFu (Pon (Numeric _ v _) True) = if v `elem` [1, 9] then 4 else 2
getMeldFu (Pon (Honour _ _) True) = 4
getMeldFu (Pon (Numeric _ v _) False) = if v `elem` [1, 9] then 8 else 4
getMeldFu (Pon (Honour _ _) False) = 8
getMeldFu (Kan (Numeric _ v _) True) = if v `elem` [1, 9] then 16 else 8
getMeldFu (Kan (Honour _ _) True) = 16
getMeldFu (Kan (Numeric _ v _) False) = if v `elem` [1, 9] then 32 else 16
getMeldFu (Kan (Honour _ _) False) = 32

-- | Get fu for a standard hand. Seven pairs and thirteen orphans, as ever, are handled separately
type Fu = Int

-- | Given the han and fu, together with dealer and tsumo info, return the score of a hand
getScore :: Han -> Fu -> Bool -> Bool -> Integer
getScore han fu dealer tsumo =
    if dealer
        then case han of
            _
                | han >= 13 -> 32000
                | han >= 5 -> fromMaybe 0 (M.lookup han manganToSanbaimanTableDealer)
                | otherwise ->
                    if tsumo
                        then fromMaybe 0 (M.lookup (han, fu) scoreTableTsumoDealer)
                        else fromMaybe 0 (M.lookup (han, fu) scoreTableRonDealer)
        else case han of
            _
                | han >= 13 -> 24000
                | han >= 5 -> fromMaybe 0 (M.lookup han manganToSanbaimanTableNonDealer)
                | otherwise ->
                    if tsumo
                        then fromMaybe 0 (M.lookup (han, fu) scoreTableTsumoNonDealer)
                        else fromMaybe 0 (M.lookup (han, fu) scoreTableRonNonDealer)

-- | Form the string describing the yaku, given a yaku context
formYakuString :: YakuContext -> String
formYakuString yakuContext@YakuContext{yakuHandContext = handContext@HandContext{riichi = riichiContext, dora}} =
    let hanWriter :: Writer String () = do
            when (isRiichi riichiContext) $ tell $ toCyan "\t1 Han: Riichi\n"
            when (isIppatsu riichiContext) $ tell $ toCyan "\t1 Han: Ippatsu\n"
            when (isMenzenTsumo yakuContext) $ tell $ toCyan "\t1 Han: Fully concealed hand\n"
            when (isChiitoitsu yakuContext) $ tell $ toCyan "\t2 Han: Seven pairs\n"
            when (isPinfu yakuContext) $ tell $ toCyan "\t1 Han: Pinfu\n"
            when (isTanyao yakuContext) $ tell $ toCyan "\t1 Han: All simples\n"
            when (isHaku yakuContext) $ tell $ toCyan "\t1 Han: Haku (White Dragon)\n"
            when (isHatsu yakuContext) $ tell $ toCyan "\t1 Han: Hatsu (Green Dragon)\n"
            when (isChun yakuContext) $ tell $ toCyan "\t1 Han: Chun (Red Dragon)\n"
            when (isSeatWind yakuContext) $ tell $ toCyan "\t1 Han: Seat wind\n"
            when (isRoundWind yakuContext) $ tell $ toCyan "\t1 Han: Round wind\n"
            when (isSanshokuDoujun yakuContext) $ tell $ toCyan "\t2 Han: Mixed triple sequence (-1 Han if open)\n"
            when (isSanshokuDoukou yakuContext) $ tell $ toCyan "\t2 Han: Triple triplets\n"
            when (isSanankou yakuContext) $ tell $ toCyan "\t2 Han: Three concealed triplets\n"
            when (isChinitsu yakuContext) $ tell $ toCyan "\t6 Han: Full flush (-1 Han if open)\n"
            when (isHonitsu yakuContext) $ tell $ toCyan "\t3 Han: Half flush (-1 Han if open)\n"
            when (isToitoi yakuContext) $ tell $ toCyan "\t2 Han: All triplets\n"
            when (isIttsuu yakuContext) $ tell $ toCyan "\t2 Han: Pure straight (-1 Han if open)\n"
            when (isSankantsu yakuContext) $ tell $ toCyan "\t2 Han: Three kans\n"
            when (isShousangen yakuContext) $ tell $ toCyan "\t2 Han: Little three dragons\n"
            when (isRyanpeikou yakuContext) $ tell $ toCyan "\t3 Han: Twice pure double sequence (Closed only)\n"
            when (isIipeikou yakuContext) $ tell $ toCyan "\t1 Han: Pure double sequence (Closed only)\n"
            when (isJunchan yakuContext) $ tell $ toCyan "\t3 Han: Fully outside hand (-1 Han if open)\n"
            when (isHonroutou yakuContext) $ tell $ toCyan "\t2 Han: All terminals and honours\n"
            when (isChanta yakuContext) $ tell $ toCyan "\t2 Han: Half outside hand (-1 Han if open)\n"
            when (dora > 0) $ tell $ toCyan ("\t" ++ show dora ++ " Han: Dora\n")
        (_, string) = runWriter hanWriter
     in string

-- | Get the han specified by a yaku context
getYakuHan :: YakuContext -> Han
getYakuHan yakuContext@YakuContext{yakuHandContext = handContext@HandContext{riichi = riichiContext, dora}} =
    let
        closedBonus = if isClosed handContext then 1 else 0
        hanWriter :: Writer Han () = do
            when (isRiichi riichiContext) $ tell 1
            when (isIppatsu riichiContext) $ tell 1
            when (isMenzenTsumo yakuContext) $ tell 1
            when (isChiitoitsu yakuContext) $ tell 2
            when (isPinfu yakuContext) $ tell 1
            when (isTanyao yakuContext) $ tell 1
            when (isHaku yakuContext) $ tell 1
            when (isHatsu yakuContext) $ tell 1
            when (isChun yakuContext) $ tell 1
            when (isSeatWind yakuContext) $ tell 1
            when (isRoundWind yakuContext) $ tell 1
            when (isSanshokuDoujun yakuContext) $ tell $ 1 + closedBonus
            when (isSanshokuDoukou yakuContext) $ tell 2
            when (isSanankou yakuContext) $ tell 2
            when (isChinitsu yakuContext) $ tell $ 5 + closedBonus
            when (isHonitsu yakuContext) $ tell $ 2 + closedBonus
            when (isToitoi yakuContext) $ tell 2
            when (isIttsuu yakuContext) $ tell $ 1 + closedBonus
            when (isSankantsu yakuContext) $ tell 2
            when (isShousangen yakuContext) $ tell 2
            when (isRyanpeikou yakuContext) $ tell $ 3 * closedBonus
            when (isIipeikou yakuContext) $ tell closedBonus
            when (isJunchan yakuContext) $ tell $ 2 + closedBonus
            when (isHonroutou yakuContext) $ tell 2
            when (isChanta yakuContext) $ tell $ 1 + closedBonus
            tell $ Sum dora
        (_, han) = runWriter hanWriter
     in
        han

-- | Form the string describing the yakumans of a yakuman context
formYakumanString :: YakumanContext -> String
formYakumanString yakumanContext =
    let
        yakumanWriter :: Writer String () = do
            when (isSuuankou yakumanContext) $ tell $ toMagenta "\tYakuman: Four Concealed Triplets\n"
            when (isSuukantsu yakumanContext) $ tell $ toMagenta "\tYakuman: Four Kans\n"
            when (isDaisangen yakumanContext) $ tell $ toMagenta "\tYakuman: Big Four Dragons\n"
            when (isShousuushii yakumanContext) $ tell $ toMagenta "\tYakuman: Little Winds\n"
            when (isTsuuiisou yakumanContext) $ tell $ toMagenta "\tYakuman: All Honours\n"
            when (isChinroutou yakumanContext) $ tell $ toMagenta "\tYakuman: All Terminals\n"
            when (isRyuuiisou yakumanContext) $ tell $ toMagenta "\tYakuman: All Green\n"
            when (isChuurenPoutou yakumanContext) $ tell $ toMagenta "\tYakuman: Nine Gates\n"
            when (isDaisuushii yakumanContext) $ tell $ toMagenta "\tDouble Yakuman: Big Winds\n"
            when (isKokushiMusou yakumanContext) $ tell $ toMagenta "\tYakuman: Thirteen Orphans\n"
        (_, string) = runWriter yakumanWriter
     in
        string

-- | Count the yakumans in a yakuman context
getYakumanCount :: YakumanContext -> YakumanCount
getYakumanCount yakumanContext =
    let
        yakumanWriter :: Writer (Sum Int) () = do
            when (isSuuankou yakumanContext) $ tell 1
            when (isSuukantsu yakumanContext) $ tell 1
            when (isDaisangen yakumanContext) $ tell 1
            when (isShousuushii yakumanContext) $ tell 1
            when (isTsuuiisou yakumanContext) $ tell 1
            when (isChinroutou yakumanContext) $ tell 1
            when (isRyuuiisou yakumanContext) $ tell 1
            when (isChuurenPoutou yakumanContext) $ tell 1
            when (isDaisuushii yakumanContext) $ tell 2
            when (isKokushiMusou yakumanContext) $ tell 1
        (_, yakumans) = runWriter yakumanWriter
     in
        getSum yakumans

-- | For the string for a general context. Works fo yaku and yakuman.
formContextString :: Context -> String
formContextString (Context _ _ (Left yakuContext)) = formYakuString yakuContext
formContextString (Context _ _ (Right yakumanContext)) = formYakumanString yakumanContext

-- | Get the han or yakumans of a context
getContextHanOrYakumans :: Context -> Either Han YakumanCount
getContextHanOrYakumans (Context _ _ (Left yakuContext)) = Left $ getYakuHan yakuContext
getContextHanOrYakumans (Context _ _ (Right yakumanContext)) = Right $ getYakumanCount yakumanContext

-- | Get the open and closed han, or yakumans, of a context
getContextHansOrYakumans :: Context -> Either (Han, Han) YakumanCount
getContextHansOrYakumans (Context _ _ (Left yakuContext@YakuContext{yakuHandContext = handContext})) =
    Left
        ( getYakuHan yakuContext{yakuHandContext = closeHandContext handContext}
        , getYakuHan yakuContext{yakuHandContext = openHandContext handContext}
        )
getContextHansOrYakumans (Context _ _ (Right yakumanContext)) = Right $ getYakumanCount yakumanContext

-- | Get the fu of an interpreted hand, given some context about the hand
getFu :: InterpretedHand -> HandContext -> Fu
getFu (Pair tile, melds) c =
    let
        sw = seatWind $ wind c
        rw = roundWind $ wind c
        goodWait = not $ isRyanmanWait (wait c) || isShanponWait (wait c)
        tsumo = isTsumo c
        closure = isClosed c
        meldsFu = melds & map getMeldFu & sum
        waitFu = if goodWait then 2 else 0
        yakuhaiFu =
            (if tile & isDragon then 2 else 0)
                + (if tile == Honour (Wind rw) 0 then 2 else 0)
                + (if tile == Honour (Wind sw) 0 then 2 else 0)
        ronClosedFu = if not tsumo && closure then 10 else 0
        tsumoFu = if tsumo then 2 else 0
     in
        roundUp (20 + meldsFu + waitFu + yakuhaiFu + ronClosedFu + tsumoFu)
  where
    roundUp n = last ([170, 160 .. 10] & filter (>= n))

-- | Get the fu for a context.
getContextFu :: Context -> Fu
getContextFu (Context (Just ih) handContext _) = getFu ih handContext
getContextFu (Context Nothing handContext _) = 25

-- | Score table hashmap for tsumo + dealer. 4 han and below.
scoreTableTsumoDealer :: M.Map (Han, Fu) Integer
scoreTableTsumoDealer =
    M.fromList
        [ ((1, 20), 1200)
        , ((1, 30), 1500)
        , ((1, 40), 2100)
        , ((1, 50), 2400)
        , ((1, 60), 3000)
        , ((1, 70), 3600)
        , ((1, 80), 3900)
        , ((1, 90), 4500)
        , ((1, 100), 4800)
        , ((1, 110), 5400)
        , ((2, 20), 2100)
        , ((2, 30), 3000)
        , ((2, 40), 3900)
        , ((2, 50), 4800)
        , ((2, 60), 6000)
        , ((2, 70), 6900)
        , ((2, 80), 7800)
        , ((2, 90), 8700)
        , ((2, 100), 9600)
        , ((2, 110), 10800)
        , ((3, 20), 3900)
        , ((3, 25), 4800)
        , ((3, 30), 6000)
        , ((3, 40), 7800)
        , ((3, 50), 9600)
        , ((3, 60), 11700)
        , ((3, 70), 12000)
        , ((3, 80), 12000)
        , ((3, 90), 12000)
        , ((3, 100), 12000)
        , ((3, 110), 12000)
        , ((4, 20), 7800)
        , ((4, 25), 9600)
        , ((4, 30), 11700)
        , ((4, 40), 12000)
        , ((4, 50), 12000)
        , ((4, 60), 12000)
        , ((4, 70), 12000)
        , ((4, 80), 12000)
        , ((4, 90), 12000)
        , ((4, 100), 12000)
        , ((4, 110), 12000)
        ]

-- | Score table hashmap for ron + dealer. 4 han and below.
scoreTableRonDealer :: M.Map (Han, Fu) Integer
scoreTableRonDealer =
    M.fromList
        [ ((1, 30), 1500)
        , ((1, 40), 2000)
        , ((1, 50), 2400)
        , ((1, 60), 2900)
        , ((1, 70), 3400)
        , ((1, 80), 3900)
        , ((1, 90), 4400)
        , ((1, 100), 4800)
        , ((1, 110), 5300)
        , ((2, 25), 2400)
        , ((2, 30), 2900)
        , ((2, 40), 3900)
        , ((2, 50), 4800)
        , ((2, 60), 5800)
        , ((2, 70), 6800)
        , ((2, 80), 7700)
        , ((2, 90), 8700)
        , ((2, 100), 9600)
        , ((2, 110), 10600)
        , ((3, 25), 4800)
        , ((3, 30), 5800)
        , ((3, 40), 7700)
        , ((3, 50), 9600)
        , ((3, 60), 11600)
        , ((3, 70), 12000)
        , ((3, 80), 12000)
        , ((3, 90), 12000)
        , ((3, 100), 12000)
        , ((3, 110), 12000)
        , ((4, 25), 9600)
        , ((4, 30), 11600)
        , ((4, 40), 12000)
        , ((4, 50), 12000)
        , ((4, 60), 12000)
        , ((4, 70), 12000)
        , ((4, 80), 12000)
        , ((4, 90), 12000)
        , ((4, 100), 12000)
        , ((4, 110), 12000)
        ]

-- | Score table hashmap for tsumo + non-dealer. 4 han and below.
scoreTableTsumoNonDealer :: M.Map (Han, Fu) Integer
scoreTableTsumoNonDealer =
    M.fromList
        [ ((1, 20), 800)
        , ((1, 30), 1100)
        , ((1, 40), 1500)
        , ((1, 50), 1600)
        , ((1, 60), 2000)
        , ((1, 70), 2400)
        , ((1, 80), 2700)
        , ((1, 90), 3100)
        , ((1, 100), 3200)
        , ((1, 110), 3600)
        , ((2, 20), 1500)
        , ((2, 30), 2000)
        , ((2, 40), 2700)
        , ((2, 50), 3200)
        , ((2, 60), 4000)
        , ((2, 70), 4700)
        , ((2, 80), 5200)
        , ((2, 90), 5900)
        , ((2, 100), 6400)
        , ((2, 110), 7200)
        , ((3, 20), 2700)
        , ((3, 25), 3200)
        , ((3, 30), 4000)
        , ((3, 40), 5200)
        , ((3, 50), 6400)
        , ((3, 60), 7900)
        , ((3, 70), 8000)
        , ((3, 80), 8000)
        , ((3, 90), 8000)
        , ((3, 100), 8000)
        , ((3, 110), 8000)
        , ((4, 20), 5200)
        , ((4, 25), 6400)
        , ((4, 30), 7900)
        , ((4, 40), 8000)
        , ((4, 50), 8000)
        , ((4, 60), 8000)
        , ((4, 70), 8000)
        , ((4, 80), 8000)
        , ((4, 90), 8000)
        , ((4, 100), 8000)
        , ((4, 110), 8000)
        ]

-- | Score table hashmap for ron + non-dealer. 4 han and below.
scoreTableRonNonDealer :: M.Map (Han, Fu) Integer
scoreTableRonNonDealer =
    M.fromList
        [ ((1, 30), 1000)
        , ((1, 40), 1300)
        , ((1, 50), 1600)
        , ((1, 60), 2000)
        , ((1, 70), 2300)
        , ((1, 80), 2600)
        , ((1, 90), 2900)
        , ((1, 100), 3200)
        , ((1, 110), 3600)
        , ((2, 25), 1600)
        , ((2, 30), 2000)
        , ((2, 40), 2600)
        , ((2, 50), 3200)
        , ((2, 60), 3900)
        , ((2, 70), 4500)
        , ((2, 80), 5200)
        , ((2, 90), 5800)
        , ((2, 100), 6400)
        , ((2, 110), 7100)
        , ((3, 25), 3200)
        , ((3, 30), 3900)
        , ((3, 40), 5200)
        , ((3, 50), 6400)
        , ((3, 60), 7700)
        , ((3, 70), 8000)
        , ((3, 80), 8000)
        , ((3, 90), 8000)
        , ((3, 100), 8000)
        , ((3, 110), 8000)
        , ((4, 25), 6400)
        , ((4, 30), 7700)
        , ((4, 40), 8000)
        , ((4, 50), 8000)
        , ((4, 60), 8000)
        , ((4, 70), 8000)
        , ((4, 80), 8000)
        , ((4, 90), 8000)
        , ((4, 100), 8000)
        , ((4, 110), 8000)
        ]

-- | Score table for 5 han and up. Dealer
manganToSanbaimanTableDealer :: M.Map Han Integer
manganToSanbaimanTableDealer =
    M.fromList
        [ (5, 12000)
        , (6, 18000)
        , (7, 18000)
        , (8, 24000)
        , (9, 24000)
        , (10, 24000)
        , (11, 36000)
        , (12, 36000)
        ]

-- | Score table for 5 han and up. Non-dealer
manganToSanbaimanTableNonDealer :: M.Map Han Integer
manganToSanbaimanTableNonDealer =
    M.fromList
        [ (5, 8000)
        , (6, 12000)
        , (7, 12000)
        , (8, 16000)
        , (9, 16000)
        , (10, 16000)
        , (11, 24000)
        , (12, 24000)
        ]

-- | Get the name for a 5+ han hand
hanFuToHandName :: Han -> Fu -> String
hanFuToHandName 3 fu = if fu >= 70 then "Mangan" else ""
hanFuToHandName 4 fu = if fu >= 40 then "Mangan" else ""
hanFuToHandName 5 _ = "Mangan"
hanFuToHandName 6 _ = "Haneman"
hanFuToHandName 7 _ = "Haneman"
hanFuToHandName 8 _ = "Baiman"
hanFuToHandName 9 _ = "Baiman"
hanFuToHandName 10 _ = "Baiman"
hanFuToHandName 11 _ = "Sanbaiman"
hanFuToHandName 12 _ = "Sanbaiman"
hanFuToHandName n _ = if n >= 13 then "Counted Yakuman" else ""