module Dustme.Score where
import Data.Char (isSpace, toLower)
import Data.List (minimumBy, sortBy)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.Ord (comparing)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text, pack)
import qualified Data.Text as T
import Dustme.Types
import Prelude hiding ((!!))
import Safe
type Score = Int
type Position = Int
getIndices :: Text -> Map Char (Set Int)
getIndices =
snd . T.foldl'
(\(i::Int,dict) c ->
(i+1, Map.insertWith Set.union (toLower c) (Set.singleton i) dict))
(0, Map.empty)
matchComparison m1 m2 =
case compare (matchScore m1) (matchScore m2) of
EQ -> compare (matchStart m1) (matchStart m2)
x -> x
mkMatch :: Text -> ([Int], Int) -> Maybe Match
mkMatch _ ([],_) = Nothing
mkMatch t (xs,cost) = Just $ Match cost (head xs) (last xs) t
bestMatches :: Text -> Text -> [Match]
bestMatches t keys =
sortBy matchComparison
$ mapMaybe (mkMatch keys . (\(p,_) -> (reverse p, scorePath p)))
$ T.foldl' search [([],0)] t
where
dict = getIndices keys
initials :: Set Int
initials = Set.unions . map (Set.map (+1) . snd) . Map.toList
$ Map.filterWithKey (\k _ -> isSpace k) dict
scorePath :: [Int] -> Int
scorePath [] = 10000
scorePath [_] = 0
scorePath (x:y:xs)
| Set.member y initials = 1 + scorePath (y:xs)
| otherwise = x y + scorePath (y:xs)
search :: [([Int], Int)] -> Char -> [([Int], Int)]
search paths c =
concatMap
(\(path, earliest) ->
let next = Set.toList $ okPaths earliest continuations
in map (\j -> (j:path, j+1)) next
) paths
where continuations = fromMaybe Set.empty $ Map.lookup (toLower c) dict
okPaths :: Ord a => a -> Set a -> Set a
okPaths x xs = case Set.splitMember x xs of
(_,True,b) -> Set.insert x b
(_,_,b) -> b