cndict (empty) → 0.1.0
raw patch · 8 files changed
+302/−0 lines, 8 filesdep +basedep +bytestringdep +cassavasetup-changed
Dependencies added: base, bytestring, cassava, containers, file-embed, text, vector
Files
- LICENSE +1/−0
- Setup.hs +2/−0
- cndict.cabal +38/−0
- data/SUBTLEX_CH_131210_CE.utf8 too large to diff
- data/cedict_1_0_ts_utf-8_mdbg.txt too large to diff
- src/Data/Chinese/CCDict.hs +140/−0
- src/Data/Chinese/Frequency.hs +63/−0
- src/Data/Chinese/Pinyin.hs +58/−0
+ LICENSE view
@@ -0,0 +1,1 @@+Public Domain
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cndict.cabal view
@@ -0,0 +1,38 @@+-- Initial cndict.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: cndict+version: 0.1.0+synopsis: Chinese/Mandarin <-> English dictionary, Chinese lexer.+-- description:+license: PublicDomain+license-file: LICENSE+author: Lemmih <lemmih@gmail.com>+maintainer: Lemmih <lemmih@gmail.com>+homepage: https://github.com/Lemmih/cndict+-- copyright:+category: Natural Language Processing+build-type: Simple+cabal-version: >=1.8++data-files:+ data/SUBTLEX_CH_131210_CE.utf8+ data/cedict_1_0_ts_utf-8_mdbg.txt++source-repository head+ type: git+ location: git://github.com/Lemmih/cndict.git++library+ exposed-modules: Data.Chinese.CCDict, Data.Chinese.Pinyin, Data.Chinese.Frequency+ -- other-modules:+ build-depends: base == 4.6.*,+ text >= 0.11.0.0,+ file-embed >= 0.0.4.9,+ containers >= 0.5.0.0,+ vector >= 0.10.0.0,+ bytestring >= 0.9.0.0,+ cassava >= 0.2.0.0+ hs-source-dirs: src+ ghc-options: -Wall+
+ data/SUBTLEX_CH_131210_CE.utf8 view
file too large to diff
+ data/cedict_1_0_ts_utf-8_mdbg.txt view
file too large to diff
+ src/Data/Chinese/CCDict.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+-- | Simplified Chinese <-> English dictionary with pinyin phonetics.+module Data.Chinese.CCDict+ ( CCDict+ , Entry(..)+ , load+ , parse+ , lookup+ , ccDict+ , Token(..)+ , tokenizer+ ) where++import Data.Char+import Data.FileEmbed+import Data.List (foldl', nub)+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T++import Prelude hiding (lookup)++import Data.Chinese.Pinyin++--------------------------------------------------+-- Dictionary+++-- | Dictionary entry+data Entry = Entry+ { entryChinese :: Text+ , entryPinyin :: [Text]+ , entryDefinition :: [Text]+ } deriving ( Read, Show, Eq, Ord )++type CCDict = Map Char CCTrieEntry+data CCTrieEntry = CCTrieEntry (Maybe Entry) CCDict++-- | Load dictionary from file.+load :: FilePath -> IO CCDict+load path = parse `fmap` T.readFile path++-- | Load dictionary from unicode text.+parse :: Text -> CCDict+parse txt = fromList [ entry | Just entry <- map parseLine (T.lines txt) ]++-- | O(n). Lookup dictionary entry for a string of simplified chinese.+lookup :: Text -> CCDict -> Maybe Entry+lookup key trie =+ case T.unpack key of+ [] -> Nothing+ (x:xs) -> go xs =<< M.lookup x trie+ where+ go [] (CCTrieEntry es _) = es+ go (x:xs) (CCTrieEntry es m) = maybe es (go xs) (M.lookup x m)+++--------------------------------------------------+-- Tokenizer++data Token = KnownWord Entry | UnknownWord Text+ deriving ( Read, Show, Eq, Ord )++-- | Break a string of simplified chinese down to a list of tokens.+tokenizer :: CCDict -> Text -> [Token]+tokenizer trie inp = filter isValid $ go 0 inp inp+ where+ isValid (UnknownWord txt) = not (T.null txt)+ isValid _ = True+ go n unrecognied txt+ | T.null txt = [ unknown ]+ | otherwise =+ case lookup txt trie of+ Nothing -> go (n+1) unrecognied (T.drop 1 txt)+ Just es ->+ let rest = T.drop (T.length (entryChinese es)) txt in+ unknown : KnownWord es : go 0 rest rest+ where+ unknown = UnknownWord $ T.take n unrecognied++++--------------------------------------------------+-- Dictionary trie++union :: CCDict -> CCDict -> CCDict+union = M.unionWith join+ where+ join (CCTrieEntry e1 t1) (CCTrieEntry e2 t2) =+ CCTrieEntry (joinEntry e1 e2) (M.unionWith join t1 t2)++joinEntry :: Maybe Entry -> Maybe Entry -> Maybe Entry+joinEntry Nothing Nothing = Nothing+joinEntry Nothing (Just e) = Just e+joinEntry (Just e) Nothing = Just e+joinEntry (Just e1) (Just e2) = Just Entry+ { entryChinese = entryChinese e1+ , entryPinyin = nub $ entryPinyin e1 ++ entryPinyin e2+ , entryDefinition = nub $ entryDefinition e1 ++ entryDefinition e2 }++unions :: [CCDict] -> CCDict+unions = foldl' union M.empty++fromList :: [Entry] -> CCDict+fromList = unions . map singleton++singleton :: Entry -> CCDict+singleton entry = go (T.unpack (entryChinese entry))+ where+ go [] = error "singleton: Invalid entry."+ go [x] = M.singleton x (CCTrieEntry (Just entry) M.empty)+ go (x:xs) = M.singleton x (CCTrieEntry Nothing (go xs))++parseLine :: Text -> Maybe Entry+parseLine line | "#" `T.isPrefixOf` line = Nothing+parseLine line =+ Just Entry+ { entryChinese = chinese+ , entryPinyin = map toToneMarks $ T.words $ T.tail $ T.init $ T.unwords (pinyin ++ [pin])+ , entryDefinition = [T.unwords english] }+ where+ (_traditional : chinese : rest) = T.words line+ (pinyin, (pin : english)) = break (\word -> T.count "]" word > 0) rest++++--------------------------------------------------+-- Embedded dictionary++-- | Embedded dictionary.+ccDict :: CCDict+ccDict = parse $ T.decodeUtf8 raw+ where+ raw = $(embedFile "data/cedict_1_0_ts_utf-8_mdbg.txt")+
+ src/Data/Chinese/Frequency.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Data.Chinese.Frequency+ ( SubtlexMap+ , SubtlexEntry(..)+ , subtlex+ ) where++import Control.Applicative+import qualified Data.ByteString.Lazy as L+import Data.Csv as Csv+import Data.FileEmbed+import Data.Map (Map)+import qualified Data.Map as M+import Data.Text (Text)+import qualified Data.Text as T+import Data.Vector (Vector)+import qualified Data.Vector as V++import Data.Chinese.Pinyin++type SubtlexMap = Map Text SubtlexEntry++data SubtlexEntry = SubtlexEntry+ { subtlexWord :: T.Text+ , subtlexPinyin :: [T.Text]+ , subtlexWCount :: Int+ , subtlexWMillion :: Double+ , subtlexEnglish :: T.Text+ } deriving ( Show )++instance FromRecord SubtlexEntry where+ parseRecord rec = SubtlexEntry+ <$> index rec 0+ <*> fmap (map toToneMarks . T.splitOn "/") (index rec 2)+ <*> index rec 4+ <*> index rec 5 <*> index rec 14++loadSubtlexEntries :: FilePath -> IO (Vector SubtlexEntry)+loadSubtlexEntries path = do+ inp <- L.readFile path+ case Csv.decodeWith (Csv.DecodeOptions 9) True inp of+ Left msg -> error msg+ Right rows -> return rows++mkSubtlexMap :: Vector SubtlexEntry -> SubtlexMap+mkSubtlexMap rows = M.fromList [ (subtlexWord row, row) | row <- V.toList rows ]+++++++------------------------------------------------------------+-- Embedded files++subtlex :: SubtlexMap+subtlex = mkSubtlexMap $+ case Csv.decodeWith (Csv.DecodeOptions 9) True inp of+ Left msg -> error msg+ Right rows -> rows+ where+ inp = L.fromStrict $(embedFile "data/SUBTLEX_CH_131210_CE.utf8")
+ src/Data/Chinese/Pinyin.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternGuards #-}+module Data.Chinese.Pinyin+ ( toToneMarks+ , fromToneMarks+ ) where++import Data.Char+import Data.List+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T++toToneMarks :: Text -> Text+toToneMarks = modToneNumber toTonal++fromToneMarks :: Text -> Text+fromToneMarks = undefined++modToneNumber :: (Int -> Char -> Char) -> Text -> Text+modToneNumber fn txt+ | T.null txt || not (isDigit (T.last txt)) = txt+ | Just n <- T.findIndex (`elem` "ae") txt' = modify n+ | Just n <- findStrIndex "ou" txt' = modify n+ | Just n <- findSecondVowel txt' = modify n+ | Just n <- T.findIndex (`elem` "aoeiu") txt' = modify n+ | otherwise = txt+ where+ tone = digitToInt (T.last txt)+ modify n = T.pack [ if n==i then fn tone c else c | (i,c) <- zip [0..] (T.unpack txt') ]+ txt' = T.init txt++findSecondVowel :: Text -> Maybe Int+findSecondVowel = listToMaybe . drop 1 . findIndices isVowel . T.unpack+ where+ isVowel = (`elem` "aoeiu")++findStrIndex :: Text -> Text -> Maybe Int+findStrIndex key = worker 0+ where+ worker n line+ | T.null line = Nothing+ | key `T.isPrefixOf` line = Just n+ | otherwise = worker (n+1) (T.drop 1 line)++toTonal :: Int -> Char -> Char+toTonal n key =+ case Prelude.lookup key lst of+ Nothing -> key+ Just tones -> tones !! (n-1)+ where+ lst =+ [ ('a', "āáǎàa")+ , ('o', "ōóǒòo")+ , ('e', "ēéěèe")+ , ('i', "īíǐìi")+ , ('u', "ūúǔùu") ]+