summaryrefslogtreecommitdiff
path: root/treebanks/PennTreebank/Dependencies.hs
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@gmail.com>2013-03-21 13:39:24 +0000
committerkr.angelov <kr.angelov@gmail.com>2013-03-21 13:39:24 +0000
commitd1866472ebcb4223b0343b0a81903c9fdfee1ef7 (patch)
treeb2fd1815d01dadd2e93a68066a2a549683529298 /treebanks/PennTreebank/Dependencies.hs
parentc6e4db8f4ae94608459d3963acdb8dd9479c89f7 (diff)
added configuration file which defines the heads for all syntactic functions in ParseEng
Diffstat (limited to 'treebanks/PennTreebank/Dependencies.hs')
-rw-r--r--treebanks/PennTreebank/Dependencies.hs37
1 files changed, 37 insertions, 0 deletions
diff --git a/treebanks/PennTreebank/Dependencies.hs b/treebanks/PennTreebank/Dependencies.hs
new file mode 100644
index 000000000..d785507b3
--- /dev/null
+++ b/treebanks/PennTreebank/Dependencies.hs
@@ -0,0 +1,37 @@
+module Dependencies where
+
+import PGF
+import qualified Data.Map as Map
+import Data.Maybe as Maybe
+
+type HeadTable = Map.Map CId [CId]
+
+readHeadTable :: FilePath -> IO HeadTable
+readHeadTable fpath = do
+ ls <- fmap lines $ readFile fpath
+ return (Map.fromList [(head ws, tail ws) | l <- ls, let ws = map mkCId (words l), not (null ws)])
+
+getDependencies :: HeadTable -> Expr -> (CId,[(CId,CId)])
+getDependencies tbl e =
+ case unApp e of
+ Just (f,es)
+ | null es -> (f,[])
+ | f == mkCId "MkSymb" -> (f,[])
+ | otherwise -> case Map.lookup f tbl of
+ Just cs -> let xs = zipWith (\c e -> (c,getDependencies tbl e)) cs es
+ hes = [he | (c,he) <- xs, c == c_head]
+ (h,deps) = head hes
+ in if length hes /= 1
+ then error ("there must be exactly one head in "++showExpr [] e)
+ else (h,concat (deps:[(h,m):deps | (c,(m,deps)) <- xs, c == c_mod]))
+ Nothing -> error ("there is no head defined for function "++showCId f)
+ Nothing -> error ("this is not a function application: "++showExpr [] e)
+
+c_head = mkCId "head"
+c_mod = mkCId "mod"
+
+test = do
+ t <- readHeadTable "ParseEngAbs.heads"
+ es <- fmap (concatMap (maybeToList . readExpr) . lines) $ readFile "wsj.full"
+ let deps = Map.fromListWith (+) [(d,1) | e <- es, d <- snd (getDependencies t e)]
+ writeFile "deps" (unlines (map show (Map.toList deps)))