module Data.Kanji
(
AsKanji(..)
, Kanji(..)
, allKanji
, isKanji
, hasLevel
, kanjiDensity
, elementaryKanjiDensity
, percentSpread
, Level(..)
, Rank(..)
, level
, levels
, isKanjiInLevel
, levelDist
, levelFromRank
, averageLevel
) where
import Data.List (sort, group)
import qualified Data.Set as S
import Lens.Micro
import Data.Kanji.Level.EighthQ
import Data.Kanji.Level.FifthQ
import Data.Kanji.Level.FourthQ
import Data.Kanji.Level.NinthQ
import Data.Kanji.Level.PreSecondQ
import Data.Kanji.Level.SecondQ
import Data.Kanji.Level.SeventhQ
import Data.Kanji.Level.SixthQ
import Data.Kanji.Level.TenthQ
import Data.Kanji.Level.ThirdQ
import Data.Kanji.Types
allKanji :: [[Kanji]]
allKanji = map asKanji ks
where ks = [tenthQ, ninthQ, eighthQ, seventhQ, sixthQ,
fifthQ, fourthQ, thirdQ, preSecondQ, secondQ]
hasLevel :: Kanji -> Bool
hasLevel k = has _Just $ level k
kanjiDensity :: AsKanji a => a -> [Kanji] -> Float
kanjiDensity orig ks = fromIntegral (length ks) / len orig
elementaryKanjiDensity :: [Kanji] -> Float
elementaryKanjiDensity ks = foldl (\acc (_,p) -> acc + p) 0 elementaryQs
where elementaryQs = filter (\(qn,_) -> qn `elem` [Five, Six ..]) dists
dists = levelDist ks
makeLevel :: [Kanji] -> Rank -> Level
makeLevel ks n = Level (S.fromDistinctAscList ks) n
levels :: [Level]
levels = map f $ zip allKanji [Ten ..]
where f (ks,n) = makeLevel ks n
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 (\ks -> (head ks, length ks)) . group . sort