cndict 0.1.1 → 0.2.0
raw patch · 4 files changed
+85/−14 lines, 4 filesdep ~basedep ~cassava
Dependency ranges changed: base, cassava
Files
- cndict.cabal +3/−3
- data/cedict_1_0_ts_utf-8_mdbg.txt too large to diff
- src/Data/Chinese/CCDict.hs +80/−9
- src/Data/Chinese/Frequency.hs +2/−2
cndict.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: cndict-version: 0.1.1+version: 0.2.0 synopsis: Chinese/Mandarin <-> English dictionary, Chinese lexer. -- description: license: PublicDomain@@ -26,13 +26,13 @@ library exposed-modules: Data.Chinese.CCDict, Data.Chinese.Pinyin, Data.Chinese.Frequency -- other-modules:- build-depends: base == 4.6.*,+ build-depends: base == 4.*, 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+ cassava >= 0.3.0.0 hs-source-dirs: src ghc-options: -Wall
data/cedict_1_0_ts_utf-8_mdbg.txt view
file too large to diff
src/Data/Chinese/CCDict.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} -- | Simplified Chinese <-> English dictionary with pinyin phonetics. module Data.Chinese.CCDict ( CCDict@@ -12,10 +13,11 @@ , tokenizer ) where -import Control.Monad (mplus)+import Control.Monad (mplus,guard) import Data.Char import Data.FileEmbed-import Data.List (foldl', nub)+import Data.List (foldl', nub, maximumBy)+import Data.Ord (comparing) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe@@ -27,6 +29,7 @@ import Prelude hiding (lookup) import Data.Chinese.Pinyin+import Data.Chinese.Frequency -------------------------------------------------- -- Dictionary@@ -36,7 +39,7 @@ data Entry = Entry { entryChinese :: Text , entryPinyin :: [Text]- , entryDefinition :: [Text]+ , entryDefinition :: [[Text]] } deriving ( Read, Show, Eq, Ord ) type CCDict = Map Char CCTrieEntry@@ -60,6 +63,16 @@ go [] (CCTrieEntry es _) = es go (x:xs) (CCTrieEntry es m) = (go xs =<< M.lookup x m) `mplus` es +lookupMatches :: Text -> CCDict -> Maybe [Entry]+lookupMatches key trie =+ case T.unpack key of+ [] -> Nothing+ (x:xs) -> fmap (go xs) (M.lookup x trie)+ where+ go [] (CCTrieEntry Nothing _) = []+ go [] (CCTrieEntry (Just e) _) = [e]+ go (x:xs) (CCTrieEntry Nothing m) = maybe [] (go xs) (M.lookup x m)+ go (x:xs) (CCTrieEntry (Just e) m) = e : maybe [] (go xs) (M.lookup x m) @@ -72,10 +85,22 @@ -- Interesting case: 他的话 tokenizes to [他,的话] by both google translate and -- MDGB. The correct tokenization is [他,的,话]. Not sure if it can be fixed without -- adding an entry for 他的 in the dictionary.--- FIXME: 多工作 should tokenize to [多,工作], not [多工,作]. -- TODO: Mark text inclosed in curly brackets as unknown words.+-- FIXME: 多工作 should tokenize to [多,工作]+-- FIXME: 不想 should tokenize to [不,想]+-- FIXME: 回电话 should tokenize to [回,电话]+-- FIXME: 不知道 should tokenize to [不,知道]+-- FIXME: 定时间 should tokenize to [定,时间]+-- FIXME: 这位子 should tokenize to [这,位子]+-- FIXME: 十分钟 should tokenize to [十,分钟]+-- FIXME: 有电梯 should tokenize to [有,电梯]+-- FIXME: 家中餐馆 should tokenize to [家,中餐馆]+-- FIXME: 那是 should tokenize to [那,是]+-- FIXME: 后生活 should tokenize to [后,生活]+-- FIXME: 不愿意 should tokenize to [不,愿意] -- | Break a string of simplified chinese down to a list of tokens. tokenizer :: CCDict -> Text -> [Token]+--tokenizer trie inp = maximumBy (comparing score) (tokenizerNondet trie inp) tokenizer trie inp = filter isValid $ go 0 inp inp where isValid (UnknownWord txt) = not (T.null txt)@@ -91,8 +116,55 @@ where unknown = UnknownWord $ T.take n unrecognied +tokenizer_tests :: Bool+tokenizer_tests = and+ [ flat (tokenizer ccDict input) == result+ | (input, result) <- cases ]+ where+ cases =+ [ ("多工作", ["多","工作"])+ , ("有电话", ["有","电话"]) ]+ flat tokens = [ entryChinese entry | KnownWord entry <- tokens ] +--tokenizerNondet :: CCDict -> Text -> [[Token]]+--tokenizerNondet trie inp = {- nub $ -} map compact $ go inp+-- where+-- compact (UnknownWord t1 : UnknownWord t2 : rest) = compact (UnknownWord (T.append t1 t2) : rest)+-- compact (x : xs) = x : compact xs+-- compact [] = []+-- isValid (UnknownWord txt) = not (T.null txt)+-- isValid _ = True+-- go txt | T.null txt = return []+-- go txt =+-- case lookupMatches txt ccDict of+-- Nothing -> do+-- rest <- go (T.drop 1 txt)+-- return (UnknownWord (T.take 1 txt) : rest)+-- Just es -> do+-- entry <- es+-- let len = T.length (entryChinese entry)+-- rest <- go (T.drop len txt)+-- return (KnownWord entry : rest)+-- --case lookupExact word trie of+-- -- Nothing -> do+-- -- guard (len == 1)+-- -- rest <- go (T.drop len txt)+-- -- return (UnknownWord word : rest)+-- -- Just es -> do+-- -- rest <- go (T.drop len txt)+-- -- return (KnownWord es : rest) +--score :: [Token] -> Double+--score = sum . map fn+-- where+-- fn UnknownWord{} = 0+-- fn (KnownWord entry) | T.length (entryChinese entry) == 1 = 0+-- fn (KnownWord entry) =+-- case M.lookup (entryChinese entry) subtlex of+-- Nothing -> 0+-- Just freq -> subtlexWMillion freq++ -------------------------------------------------- -- Dictionary trie @@ -108,8 +180,8 @@ joinEntry (Just e) Nothing = Just e joinEntry (Just e1) (Just e2) = Just Entry { entryChinese = entryChinese e1- , entryPinyin = entryPinyin e1 -- nub $ entryPinyin e1 ++ entryPinyin e2- , entryDefinition = nub $ entryDefinition e1 ++ entryDefinition e2 }+ , entryPinyin = entryPinyin e1 ++ entryPinyin e2+ , entryDefinition = entryDefinition e1 ++ entryDefinition e2 } unions :: [CCDict] -> CCDict unions = foldl' union M.empty@@ -128,9 +200,9 @@ parseLine line | "#" `T.isPrefixOf` line = Nothing parseLine line = Just Entry- { entryChinese = chinese+ { entryChinese = chinese , entryPinyin = [T.unwords $ map toToneMarks $ T.words $ T.tail $ T.init $ T.unwords (pinyin ++ [pin])]- , entryDefinition = splitDefinition (T.unwords english) }+ , entryDefinition = [splitDefinition (T.unwords english)] } where (_traditional : chinese : rest) = T.words line (pinyin, (pin : english)) = break (\word -> T.count "]" word > 0) rest@@ -148,4 +220,3 @@ ccDict = parse $ T.decodeUtf8 raw where raw = $(embedFile "data/cedict_1_0_ts_utf-8_mdbg.txt")-
src/Data/Chinese/Frequency.hs view
@@ -41,7 +41,7 @@ loadSubtlexEntries :: FilePath -> IO (Vector SubtlexEntry) loadSubtlexEntries path = do inp <- L.readFile path- case Csv.decodeWith (Csv.DecodeOptions 9) True inp of+ case Csv.decodeWith (Csv.DecodeOptions 9) HasHeader inp of Left msg -> error msg Right rows -> return rows @@ -60,7 +60,7 @@ subtlex :: SubtlexMap subtlex = mkSubtlexMap $- case Csv.decodeWith (Csv.DecodeOptions 9) True inp of+ case Csv.decodeWith (Csv.DecodeOptions 9) HasHeader inp of Left msg -> error msg Right rows -> rows where