summaryrefslogtreecommitdiff
path: root/src/GF/Data/Trie.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/Data/Trie.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/Data/Trie.hs')
-rw-r--r--src/GF/Data/Trie.hs129
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
--}