module Data.Kanji
(
Kanji
, kanji, _kanji
, allKanji
, isKanji
, Level(..)
, level
, percentSpread
, levelDist
, averageLevel
, uniques
, kanjiDensity
, elementaryDen
, middleDen
, highDen
, adultDen
) where
import Control.Arrow hiding (second)
import Data.Foldable (foldl', fold)
import Data.Kanji.Levels
import Data.Kanji.Types
import Data.List (sort, group)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes)
import Data.Semigroup ((<>))
import qualified Data.Set as S
allKanji :: M.Map Level (S.Set Kanji)
allKanji = M.fromList . zip [ Ten .. ] $ map (S.map Kanji) ks
where ks = [ tenth, ninth, eighth, seventh, sixth
, fifth, fourth, third, preSecond, second ]
allKanji' :: M.Map Kanji Level
allKanji' = M.fromList . S.toList . fold $ M.mapWithKey (\k v -> S.map (,k) v) allKanji
level :: Kanji -> Maybe Level
level k = M.lookup k allKanji'
kanjiDensity :: Int -> [Kanji] -> Float
kanjiDensity len ks = fromIntegral (length ks) / fromIntegral len
elementaryDen :: M.Map Level Float -> Float
elementaryDen m = M.foldl' (+) 0 . M.restrictKeys m $ S.fromList [ Five, Six .. ]
middleDen :: M.Map Level Float -> Float
middleDen m = M.foldl' (+) 0 . M.restrictKeys m $ S.fromList [ Three, Four .. ]
highDen :: M.Map Level Float -> Float
highDen m = M.foldl' (+) 0 . M.restrictKeys m $ S.fromList [ PreTwo, Three .. ]
adultDen :: M.Map Level Float -> Float
adultDen m = M.foldl' (+) 0 . M.restrictKeys m $ S.fromList [ Two, PreTwo .. ]
averageLevel :: [Kanji] -> Float
averageLevel ks = average . map numericLevel . catMaybes $ map level ks
where average ns = foldl' (+) 0 ns / fromIntegral (length ns)
levelDist :: [Kanji] -> M.Map Level Float
levelDist ks = M.fromList . map percentPair . group . sort . catMaybes $ map level ks
where percentPair qns = (head qns, fromIntegral (length qns) / totalKs)
totalKs = fromIntegral $ length ks
percentSpread :: [Kanji] -> M.Map Kanji Float
percentSpread ks = getPercent <$> kQuants
where getPercent q = fromIntegral q / totalKanji
kQuants = kanjiQuantities ks
totalKanji = fromIntegral $ M.foldl' (+) 0 kQuants
kanjiQuantities :: [Kanji] -> M.Map Kanji Int
kanjiQuantities = M.fromList . map (head &&& length) . group . sort
uniques :: [Kanji] -> M.Map Level (S.Set Kanji)
uniques = S.foldl' h M.empty . S.fromList
where h a k = maybe a (\l -> M.insertWith (<>) l (S.singleton k) a) $ level k