module Data.Kanji
(
AsKanji(..)
, Kanji(..)
, allKanji
, isKanji
, hasLevel
, Level(..)
, Rank(..)
, level
, levels
, isKanjiInLevel
, levelFromRank
, percentSpread
, levelDist
, averageLevel
, uniques
, kanjiDensity
, elementaryDen
, middleDen
, highDen
, adultDen
) where
import Control.Arrow hiding (second)
import Data.Bool (bool)
import Data.List (sort, group)
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import Lens.Micro
import Data.Kanji.Levels
import Data.Kanji.Types
allKanji :: [S.Set Kanji]
allKanji = map f ks
where f = foldr (\k s -> bool s (S.insert (Kanji k) s) $ isKanji k) mempty
ks = [tenth, ninth, eighth, seventh, sixth,
fifth, fourth, third, preSecond, second]
hasLevel :: Kanji -> Bool
hasLevel k = has _Just $ level k
kanjiDensity :: Int -> [Kanji] -> Float
kanjiDensity len ks = fromIntegral (length ks) / fromIntegral len
elementaryDen :: [(Rank,Float)] -> Float
elementaryDen dists = sum $ dists ^.. each . inRank [Five, Six ..]
middleDen :: [(Rank,Float)] -> Float
middleDen dists = sum $ dists ^.. each . inRank [Three, Four ..]
highDen :: [(Rank,Float)] -> Float
highDen dists = sum $ dists ^.. each . inRank [PreTwo, Three ..]
adultDen :: [(Rank,Float)] -> Float
adultDen dists = sum $ dists ^.. each . inRank [Two, PreTwo ..]
inRank :: [Rank] -> Traversal' (Rank,Float) Float
inRank rs f (r,n) | r `elem` rs = (r,) <$> f n
| otherwise = pure (r,n)
levels :: [Level]
levels = zipWith Level allKanji [Ten ..]
level :: Kanji -> Maybe Level
level = level' levels
where level' [] _ = Nothing
level' (q:qs) k | isKanjiInLevel q k = Just q
| otherwise = level' qs k
isKanjiInLevel :: Level -> Kanji -> Bool
isKanjiInLevel q k = S.member k $ _allKanji q
levelFromRank :: Rank -> Maybe Level
levelFromRank = levelFromRank' levels
where levelFromRank' [] _ = Nothing
levelFromRank' (q:qs) qn | _rank q == qn = Just q
| otherwise = levelFromRank' qs qn
averageLevel :: [Kanji] -> Float
averageLevel ks = average ranks
where ranks = ks ^.. each . to level . _Just . to _rank . to fromRank
average ns = sum ns / fromIntegral (length ns)
levelDist :: [Kanji] -> [(Rank,Float)]
levelDist ks = map toNumPercentPair $ group sortedRanks
where sortedRanks = sort $ ks ^.. each . to level . _Just . to _rank
toNumPercentPair qns = (head qns, length' qns / length' ks)
length' n = fromIntegral $ length n
percentSpread :: [Kanji] -> [(Kanji,Float)]
percentSpread ks = map getPercent kQuants
where getPercent (k,q) = (k, fromIntegral q / totalKanji)
kQuants = kanjiQuantities ks
totalKanji = fromIntegral $ foldl (\acc (_,q) -> q + acc) 0 kQuants
kanjiQuantities :: [Kanji] -> [(Kanji,Int)]
kanjiQuantities = map (head &&& length) . group . sort
uniques :: [Kanji] -> [(Rank,[Kanji])]
uniques = M.toList . S.foldl h M.empty . S.fromList
where h a k = maybe a (\l -> M.insertWith (++) (_rank l) [k] a) $ level k