diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
| commit | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch) | |
| tree | 0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Data/Trie.hs | |
| parent | fe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff) | |
removed src for 2.9
Diffstat (limited to 'src/GF/Data/Trie.hs')
| -rw-r--r-- | src/GF/Data/Trie.hs | 129 |
1 files changed, 0 insertions, 129 deletions
diff --git a/src/GF/Data/Trie.hs b/src/GF/Data/Trie.hs deleted file mode 100644 index 9fb5daa27..000000000 --- a/src/GF/Data/Trie.hs +++ /dev/null @@ -1,129 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : Trie --- Maintainer : Markus Forsberg --- Stability : Obsolete --- Portability : Haskell 98 --- --- > CVS $Date: 2005/04/21 16:22:09 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.6 $ --- --- (Description of the module) ------------------------------------------------------------------------------ - -module GF.Data.Trie ( - tcompile, - collapse, - Trie, - trieLookup, - decompose, - Attr, - atW, atP, atWP - ) where - -import GF.Data.Map - ---- data Attr = W | P | WP deriving Eq -type Attr = Int - -atW, atP, atWP :: Attr -(atW,atP,atWP) = (0,1,2) - -newtype TrieT = TrieT ([(Char,TrieT)],[(Attr,String)]) - -newtype Trie = Trie (Map Char Trie, [(Attr,String)]) - -emptyTrie = TrieT ([],[]) - -optimize :: TrieT -> Trie -optimize (TrieT (xs,res)) = Trie ([(c,optimize t) | (c,t) <- xs] |->+ empty, - res) - -collapse :: Trie -> [(String,[(Attr,String)])] -collapse trie = collapse' trie [] - where collapse' (Trie (map,(x:xs))) s = if (isEmpty map) then [(reverse s,(x:xs))] - else (reverse s,(x:xs)): - concat [ collapse' trie (c:s) | (c,trie) <- flatten map] - collapse' (Trie (map,[])) s - = concat [ collapse' trie (c:s) | (c,trie) <- flatten map] - -tcompile :: [(String,[(Attr,String)])] -> Trie -tcompile xs = optimize $ build xs emptyTrie - -build :: [(String,[(Attr,String)])] -> TrieT -> TrieT -build [] trie = trie -build (x:xs) trie = build xs (insert x trie) - where - insert ([],ys) (TrieT (xs,res)) = TrieT (xs,ys ++ res) - insert ((s:ss),ys) (TrieT (xs,res)) - = case (span (\(s',_) -> s' /= s) xs) of - (xs,[]) -> TrieT (((s,(insert (ss,ys) emptyTrie)):xs),res) - (xs,(y,trie):zs) -> TrieT (xs ++ ((y,insert (ss,ys) trie):zs),res) - -trieLookup :: Trie -> String -> (String,[(Attr,String)]) -trieLookup trie s = apply trie s s - -apply :: Trie -> String -> String -> (String,[(Attr,String)]) -apply (Trie (_,res)) [] inp = (inp,res) -apply (Trie (map,_)) (s:ss) inp - = case map ! s of - Just trie -> apply trie ss inp - Nothing -> (inp,[]) - --- Composite analysis (Huet's unglue algorithm) --- only legaldecompositions are accepted. --- With legal means that the composite forms are ordered correctly --- with respect to the attributes W,P and WP. - --- Composite analysis - -testTrie = tcompile [("flick",[(atP,"P")]),("knopp",[(atW,"W")]),("flaggstångs",[(atWP,"WP")])] - -decompose :: Trie -> String -> [String] -decompose trie sentence = legal trie $ backtrack [(sentence,[])] trie - --- The function legal checks if the decomposition is in fact a possible one. - -legal :: Trie -> [String] -> [String] -legal _ [] = [] -legal trie input = if (test (map ((map fst).snd.(trieLookup trie)) input)) then input else [] - where - test [] = False - test [xs] = elem atW xs || elem atWP xs - test (xs:xss) = (elem atP xs || elem atWP xs) && test xss - -react :: String -> [String] -> [(String,[String])] -> String -> Trie -> Trie -> [String] -react input output back occ (Trie (arcs,res)) init = - case res of -- Accept = non-empty res. - [] -> continue back - _ -> let pushout = (occ:output) - in case input of - [] -> reverse $ map reverse pushout - _ -> let pushback = ((input,pushout):back) - in continue pushback - where continue cont = case input of - [] -> backtrack cont init - (l:rest) -> case arcs ! l of - Just trie -> - react rest output cont (l:occ) trie init - Nothing -> backtrack cont init - -backtrack :: [(String,[String])] -> Trie -> [String] -backtrack [] _ = [] -backtrack ((input,output):back) trie - = react input output back [] trie trie - -{- --- The function legal checks if the decomposition is in fact a possible one. -legal :: Trie -> [String] -> [String] -legal _ [] = [] -legal trie input - | test $ - map ((map fst).snd.(trieLookup trie)) input = input - | otherwise = [] - where -- test checks that the Attrs are in the correct order. - test [] = False -- This case should never happen. - test [xs] = elem W xs || elem WP xs - test (xs:xss) = (elem P xs || elem WP xs) && test xss --} |
