diff --git a/cndict.cabal b/cndict.cabal --- a/cndict.cabal +++ b/cndict.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: cndict -version: 0.7.1 +version: 0.7.3 synopsis: Chinese/Mandarin <-> English dictionary, Chinese lexer. -- description: license: PublicDomain @@ -16,24 +16,21 @@ cabal-version: >=1.8 data-files: - data/cedict_1_0_ts_utf-8_mdbg.txt - data/dict.txt.big + data/dict.sorted source-repository head type: git location: git://github.com/Lemmih/cndict.git library - exposed-modules: Data.Chinese.CCDict, Data.Chinese.Pinyin, - Data.Chinese.Frequency, Data.Chinese.Segmentation + exposed-modules: Data.Chinese.CCDict, + Data.Chinese.Pinyin, + Data.Chinese.Segmentation other-modules: Paths_cndict build-depends: base == 4.*, text >= 0.11.0.0, - containers >= 0.5.0.0, - vector >= 0.10.0.0, bytestring >= 0.9.0.0, - cassava >= 0.3.0.0, - binary + array hs-source-dirs: src ghc-options: -Wall ghc-prof-options: -auto-all diff --git a/data/cedict_1_0_ts_utf-8_mdbg.txt b/data/cedict_1_0_ts_utf-8_mdbg.txt deleted file mode 100644 # file too large to diff: data/cedict_1_0_ts_utf-8_mdbg.txt diff --git a/data/dict.sorted b/data/dict.sorted new file mode 100644 # file too large to diff: data/dict.sorted diff --git a/data/dict.txt.big b/data/dict.txt.big deleted file mode 100644 # file too large to diff: data/dict.txt.big diff --git a/src/Data/Chinese/CCDict.hs b/src/Data/Chinese/CCDict.hs --- a/src/Data/Chinese/CCDict.hs +++ b/src/Data/Chinese/CCDict.hs @@ -3,307 +3,235 @@ {-# LANGUAGE OverloadedStrings #-} -- | Simplified Chinese <-> English dictionary with pinyin phonetics. module Data.Chinese.CCDict - ( CCDict + ( initiate , Entry(..) - , load - , parse - , lookup + , ppEntry + , entryVariants + , entrySimplified + , entryTraditional + , entryWordFrequency + , entryPinyin + , Variant(..) + , lookupMatch , lookupMatches - , ccDict ) where -import qualified Data.ByteString as B import Data.Char -import Data.IntMap (IntMap) -import qualified Data.IntMap.Strict as IntMap -import Data.List (foldl', maximumBy, nub) import Data.Maybe import Data.Ord 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 Paths_cndict import Prelude hiding (lookup) import System.IO.Unsafe (unsafePerformIO) -import Data.Tree -import qualified Data.Chinese.Frequency as Frequency -import Data.Chinese.Pinyin - -import Data.Chinese.Frequency hiding (lookup) - --------------------------------------------------- --- Dictionary +import qualified Data.Text.Internal as T +import qualified Data.Text.Array as T +import qualified Data.Array.Unboxed as U +import qualified Data.Text.Read as T +import Control.Exception (evaluate) +-- | Load DB into memory. Otherwise it happens when the DB +-- is first used. +initiate :: IO () +initiate = do + evaluate ccDict + return () --- | Dictionary entry -data Entry = Entry - { entrySimplified :: !Text - , entryTraditional :: !Text - , entryPinyin :: [Text] - , entryDefinition :: [[Text]] - } deriving ( Read, Show, Eq, Ord ) +data CCDict = CCDict !T.Array !Int (U.UArray Int Int) -type RawEntry = Text +mkCCDict :: Text -> CCDict +mkCCDict text@(T.Text arr _ len) = + CCDict arr len + (U.listArray (0,n-1) offsets) + where + ls = T.lines text + offsets = + [ offset + | T.Text _ offset _length <- ls ] + n = length ls --- entryPinyin :: Entry -> [Text] --- entryPinyin = map (T.unwords . map toToneMarks . T.words) . entryPinyinRaw +ccDict :: CCDict +ccDict = mkCCDict utfData + where + utfData = unsafePerformIO $ do + path <- getDataFileName "data/dict.sorted" + T.readFile path -type CCDict = IntMap CCTrieEntry -data CCTrieEntry - = CCTrieEntry {-# UNPACK #-} !RawEntry !CCDict - | CCTrieEntryEnd {-# UNPACK #-} !RawEntry - | CCTrieNoEntry !CCDict - deriving ( Show ) +ccDictNth :: Int -> CCDict -> Text +ccDictNth n (CCDict arr totalLen offsets) = + T.text arr offset len + where + lastIdx = snd (U.bounds offsets) + offset = offsets U.! n + len + | lastIdx == n = totalLen - offset - 1 + | otherwise = offsets U.! (n+1) - offset - 1 +bounds :: CCDict -> (Int, Int) +bounds (CCDict _ _ offsets) = U.bounds offsets --- instance Binary CCTrieEntry where --- put (CCTrieEntry entry rest) = put entry >> put rest --- get = CCTrieEntry <$> get <*> get +findPrefix :: CCDict -> Int -> Int -> Int -> Text -> Maybe (Int,Int) +findPrefix dict maxUpper lower upper key + | lower > upper = Nothing + | otherwise = + case compare (T.take len key) (T.take len val) of + LT -> findPrefix dict (middle-1) lower (middle-1) key + GT -> findPrefix dict maxUpper (middle+1) upper key + EQ -> + case compare (T.length key) (T.length val) of + GT -> findPrefix dict maxUpper (middle+1) upper key + _ -> Just $ fromMaybe (middle, maxUpper) $ + findPrefix dict maxUpper lower (middle-1) key + where + middle = (upper - lower) `div` 2 + lower + val = T.takeWhile (/='\t') $ ccDictNth middle dict + len = min (T.length val) (T.length key) --- | Load dictionary from file. -load :: FilePath -> IO CCDict -load path = parse `fmap` T.readFile path +lookupMatches :: Text -> Maybe [Entry] +lookupMatches key + | T.null key = Nothing +lookupMatches key = + if null entries + then Nothing + else Just entries + where + keys = tail $ T.inits key + entries = worker (bounds ccDict) keys + worker _ [] = [] + worker (lower, upper) (k:ks) = + case findPrefix ccDict upper lower upper k of + Nothing -> [] + Just (first, newUpper) -> + maybe id (:) (scrapeEntry ccDict first k) $ + worker (first, newUpper) ks --- | Load dictionary from unicode text. -parse :: Text -> CCDict -parse txt = fromList - [ (key, line) - | line <- T.lines txt - , Just entry <- [parseLine line] - , key <- nub [entrySimplified entry, entryTraditional entry] ] +lookupMatch :: Text -> Maybe Entry +lookupMatch key + | T.null key = Nothing + | otherwise = + case findPrefix ccDict upper lower upper key of + Nothing -> Nothing + Just (first, _newUpper) -> + scrapeEntry ccDict first key + where + (upper, lower) = bounds ccDict --- | O(n). Lookup dictionary entry for a string of simplified chinese. -lookup :: Text -> CCDict -> Maybe Entry -lookup key trie = - case map ord $ T.unpack key of +scrapeEntry :: CCDict -> Int -> Text -> Maybe Entry +scrapeEntry dict nth key = + case variants of [] -> Nothing - (x:xs) -> fmap parseRawEntry (go xs =<< IntMap.lookup x trie) - where - go _ (CCTrieEntryEnd es) = Just es - go [] (CCTrieEntry es _) = Just es - go [] (CCTrieNoEntry _) = Nothing - go (x:xs) (CCTrieEntry es m) = Just (fromMaybe es (go xs =<< IntMap.lookup x m)) - go (x:xs) (CCTrieNoEntry m) = (go xs =<< IntMap.lookup x m) - -lookupMatches :: Text -> CCDict -> Maybe [Entry] -lookupMatches key trie = - case map ord $ T.unpack key of - [] -> Nothing - (x:xs) -> - case fmap (map parseRawEntry . go xs) (IntMap.lookup x trie) of - Just [] -> Nothing - other -> other + (v:vs) -> Just (Entry v vs) where - go _ (CCTrieEntryEnd e) = [e] - go [] (CCTrieNoEntry _) = [] - go [] (CCTrieEntry e _) = [e] - go (x:xs) (CCTrieNoEntry m) = maybe [] (go xs) (IntMap.lookup x m) - go (x:xs) (CCTrieEntry e m) = e : maybe [] (go xs) (IntMap.lookup x m) - + variants = scrapeVariants dict nth key --- 点出发 --- [[点,出发],[点出,发]] --- 出发点 --- [[出发]] --- 穿上外套 --- This can be broken up in two ways: 穿 上外 套 and 穿上 外套 --- We want the second, more greedy tokenization. -lookupNonDet :: Text -> CCDict -> Maybe [[Entry]] -lookupNonDet key trie = do - entries <- lookupMatches key trie - let longest = maximumBy (comparing (T.length . entrySimplified)) entries +scrapeVariants :: CCDict -> Int -> Text -> [Variant] +scrapeVariants dict nth key + | nth > snd (bounds dict) = [] + | T.takeWhile (/='\t') raw == key = + parseVariant raw : scrapeVariants dict (nth+1) key + | otherwise = [] + where + raw = ccDictNth nth dict - if length entries == 1 - then return [entries] - else do - return $ whenEmpty [[longest]] $ maybe [] beGreedy $ sequence $ do - entry1 <- entries - case lookupMatches (T.drop (T.length (entrySimplified entry1)) key) trie of - Nothing -> return Nothing - Just entries2 -> do - entry2 <- entries2 - return $ Just (entry1, entry2) +parseVariant :: Text -> Variant +parseVariant line = + case T.splitOn "\t" line of + [chinese, count, pinyin, english] -> + mkVariant chinese chinese count pinyin english + [traditional, simplified, "T", count, pinyin, english] -> + mkVariant traditional simplified count pinyin english + [simplified, traditional, "S", count, pinyin, english] -> + mkVariant traditional simplified count pinyin english + _ -> error $ "invalid variant: " ++ T.unpack line where - filterCompact :: [[Entry]] -> [[Entry]] - filterCompact lst = - let mostCompact = minimum (map length lst) - in [ entries | entries <- lst, length entries == mostCompact ] - filterLongest :: [[Entry]] -> [[Entry]] - filterLongest lst = - let len = sum . map (T.length . entrySimplified) - longest = maximum (map len lst) - in [ entries | entries <- lst, len entries == longest ] - beGreedy :: [(Entry,Entry)] -> [[Entry]] - beGreedy lst = - let longestFirst = maximum (map (T.length . entrySimplified . fst) lst) - longest = maximum [ T.length (entrySimplified e1) + T.length (entrySimplified e2) - | (e1,e2) <- lst - , T.length (entrySimplified e1) < longestFirst ] - in filterCompact $ filterLongest $ nub $ - [ [e1,e2] - | (e1,e2) <- lst - , T.length (entrySimplified e1) < longest - , T.length (entrySimplified e1) + T.length (entrySimplified e2) /= 2 ] ++ - [ [e1] - | (e1,_) <- lst - , T.length (entrySimplified e1) == longest ] - whenEmpty lst [] = lst - whenEmpty _ lst = lst - -- step Nothing _ = [] - -- step (Just [x]) _ = return [x] - -- step (Just lst) fn = lst >>= fn - -- beGreedy lst = - -- let len = sum . map (T.length . entrySimplified) - -- longest = maximum (map len lst') - -- mostCompact = minimum (map length lst) - -- lst' = filter (\x -> length x == mostCompact) lst - -- in filter (\x -> len x == longest) lst' - -- toMaybe [] = Nothing - -- toMaybe lst = Just lst + mkVariant traditional simplified countStr pinyin english = Variant + { variantTraditional = traditional + , variantSimplified = simplified + , variantWordFrequency = count + , variantPinyin = pinyin + , variantDefinitions = splitDefinition english } + where + Right (count,_) = T.decimal countStr +--freqLookup_ :: FreqMap -> Text -> Maybe Int +--freqLookup_ freq key = worker (bounds freq) +-- where +-- worker (lower, upper) +-- | lower > upper = Nothing +-- worker (lower, upper) = +-- let middle = (upper - lower) `div` 2 + lower +-- val = freqNth middle freq +-- [word, countStr] = T.words val +-- Right (count,_) = T.decimal countStr +-- in case compare key word of +-- LT -> worker (lower, middle-1) +-- GT -> worker (middle+1, upper) +-- EQ -> Just count + -------------------------------------------------- --- Tokenizer +-- Dictionary --- 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. --- TODO: Mark text inclosed in curly brackets as unknown words. --- FIXME: 不想 should tokenize to [不,想] --- FIXME: 那是 should tokenize to [那,是] +-- | Dictionary entry +--data Entry = Entry +-- { entrySimplified :: !Text +-- , entryTraditional :: !Text +-- , entryPinyin :: [Text] +-- , entryDefinition :: [[Text]] +-- } deriving ( Read, Show, Eq, Ord ) +data Entry = Entry Variant [Variant] + deriving (Show, Read, Eq, Ord) +data Variant = Variant + { variantSimplified :: !Text + , variantTraditional :: !Text + , variantWordFrequency :: !Int + , variantPinyin :: !Text + , variantDefinitions :: [Text] + } deriving ( Read, Show, Eq, Ord ) --------------------------------------------------- --- Dictionary trie +entryVariants :: Entry -> [Variant] +entryVariants (Entry v vs) = v:vs --- union :: CCDict -> CCDict -> CCDict --- union = IntMap.unionWith joinTrie +dominantVariant :: Entry -> Variant +dominantVariant (Entry v vs) = + foldr dom v vs + where + dom v1 v2 + | variantWordFrequency v1 < variantWordFrequency v2 = + v2 + | otherwise = + v1 --- joinTrie newValue oldValue -joinTrie :: CCTrieEntry -> CCTrieEntry -> CCTrieEntry -joinTrie (CCTrieNoEntry t1) (CCTrieNoEntry t2) = CCTrieNoEntry (IntMap.unionWith joinTrie t1 t2) -joinTrie (CCTrieNoEntry t1) (CCTrieEntry e t2) = CCTrieEntry e (IntMap.unionWith joinTrie t1 t2) -joinTrie (CCTrieNoEntry t1) (CCTrieEntryEnd e) = CCTrieEntry e t1 -joinTrie (CCTrieEntry e t1) (CCTrieNoEntry t2) = CCTrieEntry e (IntMap.unionWith joinTrie t1 t2) -joinTrie (CCTrieEntry e1 t1) (CCTrieEntry e2 t2) = - CCTrieEntry (joinRawEntry e1 e2) (IntMap.unionWith joinTrie t1 t2) -joinTrie (CCTrieEntry e1 t2) (CCTrieEntryEnd e2) = CCTrieEntry (joinRawEntry e1 e2) t2 -joinTrie (CCTrieEntryEnd e) (CCTrieNoEntry t) = CCTrieEntry e t -joinTrie (CCTrieEntryEnd e1) (CCTrieEntry e2 t) = CCTrieEntry (joinRawEntry e1 e2) t -joinTrie (CCTrieEntryEnd e1) (CCTrieEntryEnd e2) = CCTrieEntryEnd (joinRawEntry e1 e2) +entrySimplified :: Entry -> Text +entrySimplified = variantSimplified . dominantVariant -joinRawEntry :: RawEntry -> RawEntry -> RawEntry -joinRawEntry e1 e2 = T.concat [e1, "\n", e2] +entryTraditional :: Entry -> Text +entryTraditional = variantTraditional . dominantVariant --- joinEntry newValue oldValue -joinEntry :: Entry -> Entry -> Entry -joinEntry e1 e2 = Entry - { -- The simplified characters must be identical - entrySimplified = entrySimplified e1 - -- 了 maps to two traditional characters: 了 and 瞭. - -- In these cases, choose the same as the simplified. - , entryTraditional = - if entryTraditional e1 == entrySimplified e1 || - entryTraditional e2 == entrySimplified e1 - then entrySimplified e1 - else entryTraditional e1 - , entryPinyin = entryPinyin e2 ++ entryPinyin e1 - , entryDefinition = entryDefinition e2 ++ entryDefinition e1 } +entryWordFrequency :: Entry -> Int +entryWordFrequency = variantWordFrequency . dominantVariant --- unions :: [CCDict] -> CCDict --- unions = foldl' union IntMap.empty +entryPinyin :: Entry -> [Text] +entryPinyin = map variantPinyin . entryVariants -fromList :: [(Text, RawEntry)] -> CCDict --- fromList = unions . map singleton -fromList = foldl' (flip insert) IntMap.empty +ppEntry :: Entry -> Text +ppEntry = T.intercalate "\n" . map ppVariant . entryVariants -insert :: (Text, RawEntry) -> CCDict -> CCDict -insert (key, entry) = go (T.unpack key) +ppVariant :: Variant -> Text +ppVariant (Variant simplified traditional frequency pinyin english) = + T.intercalate "\t" + [simplified, traditional, count, pinyin, english'] where - go :: [Char] -> CCDict -> CCDict - go [] _ = error "insert: Invalid entry." - go [x] t = - IntMap.insertWith joinTrie (ord x) (CCTrieEntryEnd entry) t - go (x:xs) t = - IntMap.alter (go' xs) (ord x) t - go' xs Nothing = Just $ CCTrieNoEntry (go xs IntMap.empty) - go' xs (Just trie) = Just $ - case trie of - CCTrieNoEntry t -> CCTrieNoEntry $ go xs t - CCTrieEntry e t -> CCTrieEntry e $ go xs t - CCTrieEntryEnd e -> CCTrieEntry e $ go xs IntMap.empty + count = T.pack $ show frequency + english' = T.intercalate "/" english --- singleton :: Entry -> CCDict --- singleton entry = go (T.unpack (entryChinese entry)) --- where --- go [] = error "singleton: Invalid entry." --- go [x] = IntMap.singleton (ord x) (CCTrieEntryEnd entry) --- go (x:xs) = IntMap.singleton (ord x) (CCTrieNoEntry (go xs)) -parseRawEntry :: Text -> Entry -parseRawEntry = foldr1 joinEntry . mapMaybe parseLine . T.lines - -parseLine :: Text -> Maybe Entry -parseLine line | "#" `T.isPrefixOf` line = Nothing -parseLine line = - Just Entry - { entrySimplified = simplified - , entryTraditional = traditional - , entryPinyin = [T.unwords $ map toToneMarks $ T.words pinyin] - , entryDefinition = [splitDefinition english] } - -- , entryPinyin = V.singleton $ T.unwords $ map toToneMarks $ T.words $ T.tail $ - -- T.init $ T.unwords (pinyin ++ [pin]) - -- , entryDefinition = V.singleton $ splitDefinition (T.unwords english) } - where - (traditional, line') = T.breakOn " " line - (simplified, line'') = T.breakOn " " (T.drop 1 line') - (pinyin_, english_) = T.breakOn "/" (T.drop 1 line'') - !english = english_ - !pinyin = T.dropAround (\c -> isSpace c || c == '[' || c == ']') pinyin_ - -- firstSep = breakOn " ", breakOn " ", breakOn "/" - -- (_traditional : chinese : rest) = T.words (T.copy line) - -- (pinyin, (pin : english)) = break (\word -> T.count "]" word > 0) rest - -- /first/second/third/ -> [first, second, third] splitDefinition :: Text -> [Text] splitDefinition = filter (not . T.null) . T.splitOn "/" . T.dropAround isSpace - - --------------------------------------------------- --- Embedded dictionary - -remove :: Text -> CCDict -> CCDict -remove = worker . map ord . T.unpack - where - worker [] dict = dict - worker (x:xs) dict = - IntMap.update (fn xs) x dict - fn xs (CCTrieNoEntry rest) = Just $ CCTrieNoEntry (worker xs rest) - fn [] CCTrieEntryEnd{} = Nothing - fn _ (CCTrieEntryEnd entry) = Just $ CCTrieEntryEnd entry - fn [] (CCTrieEntry _ rest) = Just $ CCTrieNoEntry rest - fn xs (CCTrieEntry e rest) = Just $ CCTrieEntry e (worker xs rest) - --- | Embedded dictionary. -ccDict :: CCDict -ccDict = - remove "得很" $ - remove "那是" $ remove "到了" $ - remove "里人" $ remove "多事" $ - remove "你我" $ remove "家的" $ - parse $ T.decodeUtf8 raw - where - -- raw = $(embedFile "data/cedict_1_0_ts_utf-8_mdbg.txt") - raw = unsafePerformIO $ do - path <- getDataFileName "data/cedict_1_0_ts_utf-8_mdbg.txt" - B.readFile path - --- ccDict' :: CCDict --- ccDict' = decode (BL.fromStrict raw) --- where --- raw = $(embedFile "data/cedict_1_0_ts_utf-8_mdbg.txt.binary") diff --git a/src/Data/Chinese/Frequency.hs b/src/Data/Chinese/Frequency.hs deleted file mode 100644 --- a/src/Data/Chinese/Frequency.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE BangPatterns #-} -module Data.Chinese.Frequency - ( FreqMap - , freqMap - ) where - -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import Data.Map (Map) -import qualified Data.Map.Strict as M -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import qualified Data.Text.Read as T -import Data.Text.Encoding -import Paths_cndict -import System.IO.Unsafe (unsafePerformIO) - -type FreqMap = Map Text Int - -freqMap :: FreqMap -freqMap = mkFreqMap rows - where - utfData = unsafePerformIO $ do - path <- getDataFileName "data/dict.txt.big" - T.readFile path - rows = T.lines utfData - -mkFreqMap :: [Text] -> FreqMap -mkFreqMap rows = M.fromListWith max - [ (word, count) - | (n,row) <- zip [0..] rows - , let [word,countStr,_type] = T.words row - Right (count,_) = T.decimal countStr - ] diff --git a/src/Data/Chinese/Segmentation.hs b/src/Data/Chinese/Segmentation.hs --- a/src/Data/Chinese/Segmentation.hs +++ b/src/Data/Chinese/Segmentation.hs @@ -2,20 +2,20 @@ module Data.Chinese.Segmentation ( Token(..) , Entry(..) + , entrySimplified + , entryTraditional + , entryPinyin + , tokenizer - , tokenizer_ , ppTokens , toTraditional , toSimplified ) where -import Data.Chinese.CCDict (Entry(..)) +import Data.Chinese.CCDict (Entry(..), entrySimplified, entryTraditional, entryWordFrequency, entryPinyin) import qualified Data.Chinese.CCDict as CC -import qualified Data.Chinese.Frequency as F import qualified Data.Text as T -import qualified Data.Map.Strict as M import Data.Text (Text) -import qualified Data.IntMap as IntMap import Data.List import Data.Maybe import Control.Monad @@ -29,14 +29,14 @@ -- [[A,AB],[B],[C]] -- [ [[A,B],[AB]] -- , [[C]] ] -splitText :: CC.CCDict -> Text -> [[Token]] -splitText dict txt = - [ case CC.lookupMatches offset dict of +splitText :: Text -> [[Token]] +splitText txt = + [ case CC.lookupMatches offset of Nothing -> [UnknownWord char] Just entries -> map KnownWord entries - | n <- [0..T.length txt-1] - , let offset = T.drop n txt - char = T.take 1 offset ] + | offset <- T.tails txt + , not (T.null offset) + , let char = T.take 1 offset ] -- [[A,AB],[B]] -> [ [[A,B],[AB]] ] -- [[A,AB],[BC],[C]] -> [[[A,BC],[AB,C]]] @@ -62,6 +62,22 @@ let maxLength = maximum (map tokenLength ts) in 1 + worker (max l maxLength - 1) tss +filterExceptions :: [[Token]] -> [[Token]] +filterExceptions lst = worker lst + where + worker (x:xs) = + let ws = [ entrySimplified e | KnownWord e <- x ] in + case ws `elem` exceptions of + False -> worker xs + True -> [x] + worker [] = lst + exceptions = + [["家", "中餐馆"] + ,["这", "位子"] + ,["十", "分钟"] + ,["一", "点钟"] + ,["合上", "书"]] + greedyGroups :: [[[Token]]] -> [[[Token]]] greedyGroups = map worker where @@ -69,7 +85,7 @@ filter (onlyWithLength (minimum $ map length tss) (maximum $ map (maximum.map tokenLength) tss)) tss onlyWithLength len tlen ts = - length ts == len && maximum (map tokenLength ts) == tlen + length ts == len -- && maximum (map tokenLength ts) == tlen tokenLength UnknownWord{} = 0 tokenLength (KnownWord e) = T.length (entrySimplified e) @@ -115,22 +131,21 @@ tokenScore UnknownWord{} = Nothing tokenScore (KnownWord e) -- | T.length (entrySimplified e) == 1 = Nothing - | otherwise = Just $ wordCount (entrySimplified e) + | otherwise = Just $ entryWordFrequency e -wordCount :: Text -> Int -wordCount txt = - case M.lookup txt F.freqMap of - Just n -> n - Nothing -> 0 {-minimum - [ M.findWithDefault 1 char F.freqMap - | char <- T.chunksOf 1 txt ]-} +--wordCount :: Text -> Int +--wordCount txt = +-- case F.wordFrequency txt of +-- Just n -> n +-- Nothing -> 0 {-minimum +-- [ M.findWithDefault 1 char F.freqMap +-- | char <- T.chunksOf 1 txt ]-} -- | Break a string of simplified chinese down to a list of tokens. tokenizer :: Text -> [Token] -tokenizer = tokenizer_ CC.ccDict - -tokenizer_ :: CC.CCDict -> Text -> [Token] -tokenizer_ dict = flattenGroups . greedyGroups . findGroups . splitText dict +tokenizer = + flattenGroups . greedyGroups . map filterExceptions . + findGroups . splitText _ppSegmentationTests = forM_ wrong $ \(txt, expected, got) -> do @@ -200,6 +215,7 @@ , ("我合上书准备离开", "我 合上 书 准备 离开") , ("他的话","他 的 话") + , ("你用什么方法学习","你 用 什么 方法 学习") ]