module Unscramble.Score ( ScoringSystem(..), score ) where import Data.Array ((!)) import Data.Maybe import Unscramble.Types score :: ScoringSystem -> Search -> [Coordinate] -> Int score Boggle _ = scoreBoggle score SWF s = scoreSWF s score WordWars s = scoreWordWars s scoreBoggle :: [Coordinate] -> Int scoreBoggle xs = case length xs of 3 -> 1 4 -> 1 5 -> 2 6 -> 3 7 -> 5 x | x >= 8 -> 11 _ -> 0 scoreWordWars :: Search -> [Coordinate] -> Int scoreWordWars (Grid _ cs,_) xs = sum . map (\x -> fromMaybe 0 $ lookup x scores) $ lets where lets = map (cs !) xs scores = [ ("a", 1), ("b", 4), ("c", 3), ("d", 2) , ("e", 1), ("f", 2), ("g", 3), ("h", 3) , ("i", 1), ("j", 6), ("k", 5), ("l", 2) , ("m", 4), ("n", 2), ("o", 1), ("p", 4) , ("qu", 8), ("r", 1), ("s", 1), ("t", 1) , ("u", 3), ("v", 4), ("w", 4), ("x", 8) , ("y", 2), ("z", 8) ] scoreSWF :: Search -> [Coordinate] -> Int scoreSWF (Grid _ gs, Multiplier dl dw tl tw) cs = if length cs == 2 then 1 else let dwm = case dw of Nothing -> id Just r -> if r `elem` cs then (*2) else id twm = case tw of Nothing -> id Just r -> if r `elem` cs then (*3) else id scoreOf n = dlm . tlm $ baseScore n where baseScore q = fromJust $ lookup (gs ! q) scores dlm = if n `elem` dl then (*2) else id tlm = if n `elem` tl then (*3) else id in (+ lengthBonus (length cs)) . dwm . twm . sum $ map scoreOf cs where scores = [ ("a", 1), ("b", 4), ("c", 4), ("d", 2) , ("e", 1), ("f", 4), ("g", 3), ("h", 3) , ("i", 1), ("j", 10), ("k", 5), ("l", 2) , ("m", 4), ("n", 2), ("o", 1), ("p", 4) , ("qu", 10), ("r", 1), ("s", 1), ("t", 1) , ("u", 2), ("v", 5), ("w", 4), ("x", 8) , ("y", 3), ("z", 10) ] lengthBonus 5 = 3 lengthBonus 6 = 6 lengthBonus 7 = 10 lengthBonus 8 = 15 lengthBonus 9 = 20 lengthBonus x | x >= 10 = 25 lengthBonus _ = 0