diff options
Diffstat (limited to 'treebanks/PennTreebank/training.hs')
| -rw-r--r-- | treebanks/PennTreebank/training.hs | 93 |
1 files changed, 34 insertions, 59 deletions
diff --git a/treebanks/PennTreebank/training.hs b/treebanks/PennTreebank/training.hs index 433e5852c..b3300c3df 100644 --- a/treebanks/PennTreebank/training.hs +++ b/treebanks/PennTreebank/training.hs @@ -3,32 +3,31 @@ import qualified Data.Map as Map import Data.Maybe import Data.List +grammar_name = "ParseEngAbs.pgf" + +treebank_name = "log4.txt" + +chunk_cats = map mkCId + ["A", "AP", "AdA", "AdV", "Adv", "CN", "Cl", "ClSlash", "Conj", "Det", + "IAdv", "IP", "N", "NP", "Num", "Ord", "Predet", "Prep", "Pron", "QS", + "Quant", "RP", "RS", "S", "Subj", "V", "V2", "VPS", "VS"] + main = do - pgf <- readPGF "ParseEngAbs.pgf" - ls <- fmap (filterExprs . zip [1..] . lines) $ readFile "log4.txt" + pgf <- readPGF grammar_name + ls <- fmap (filterExprs . zip [1..] . lines) $ readFile treebank_name putStrLn "" putStrLn ("trees: "++show (length ls)) - let stats = foldl' (collectStats pgf) + let (_,cat,_) = unType (startCat pgf) + stats = foldl' (collectStats pgf) (initStats pgf) - [(n,fromMaybe (error l) (readExpr (toQ l)),Just (mkCId "Phr"),Nothing) | (n,l) <- ls] + [(n,fromMaybe (error l) (readExpr (toQ l)),Just cat) | (n,l) <- ls] putStrLn ("coverage: "++show (coverage stats)) putStrLn ("Writing ParseEngAbs.probs...") - writeFile "ParseEngAbs.probs" (unlines [show f ++ "\t" ++ show p | (f,p) <- uprobs pgf stats]) - - putStrLn ("Writing ParseEngAbs2.probs...") - writeFile "ParseEngAbs2.probs" (unlines [show cat1 ++ "\t" ++ show cat2 ++ "\t" ++ show p | (cat1,cat2,p) <- mprobs pgf stats]) - - putStrLn ("Writing global.probs...") - writeFile "global.probs" (unlines [show f ++ "\t" ++ show p | (f,p) <- gprobs pgf stats]) - - putStrLn ("Writing categories.probs...") - writeFile "categories.probs" (unlines [show f ++ "\t" ++ show p | (f,p) <- cprobs pgf stats]) + writeFile "ParseEngAbs.probs" (unlines [show f ++ "\t" ++ show p | (f,p) <- probs pgf stats]) where toQ [] = [] - toQ ('[':cs) = let (xs,']':ys) = break (==']') cs - in toQ ('?' : ys) toQ ('?':cs) = 'Q' : toQ cs toQ (c:cs) = c : toQ cs @@ -42,31 +41,26 @@ initStats pgf = (Map.fromListWith (+) ([(f,1) | f <- functions pgf] ++ [(cat pgf f,1) | f <- functions pgf]) - ,Map.empty ,0 ) -collectStats pgf (ustats,bstats,count) (n,e,mb_cat1,mb_cat2) = +collectStats pgf (ustats,count) (n,e,mb_cat1) = case unApp e of Just (f,args) -> let fcat2 = cat2 pgf f n e - fcat = fromMaybe (cat2 pgf f n e) mb_cat1 + fcat = fromMaybe fcat2 mb_cat1 cf = fromMaybe 0 (Map.lookup f ustats) cc = fromMaybe 0 (Map.lookup fcat ustats) in if isJust mb_cat1 && f /= mkCId "Q" && fcat /= fcat2 then error (show n ++ ": " ++ showExpr [] e) else - cf `seq` cc `seq` bstats `seq` count `seq` + cf `seq` cc `seq` count `seq` foldl' (collectStats pgf) (Map.insert f (cf+1) (Map.insert fcat (cc+1) ustats) - ,(if null args - then Map.insertWith (+) (fcat,wildCId) 1 - else id) - (maybe bstats (\cat2 -> Map.insertWith (+) (cat2,fcat) 1 bstats) mb_cat2) ,count+1 ) - (zipWith3 (\e mb_cat1 mb_cat2 -> (n,e,mb_cat1,mb_cat2)) args (argCats f) (repeat (Just fcat))) + (zipWith (\e mb_cat1 -> (n,e,mb_cat1)) args (argCats f)) Nothing -> case unStr e of - Just _ -> (ustats,bstats,count+1) + Just _ -> (ustats,count+1) Nothing -> error ("collectStats ("++showExpr [] e++")") where argCats f = @@ -75,44 +69,25 @@ collectStats pgf (ustats,bstats,count) (n,e,mb_cat1,mb_cat2) = in map tyCat arg_tys Nothing -> repeat Nothing -coverage (ustats,bstats,count) = - let c = fromMaybe 0 (Map.lookup (mkCId "Q") ustats) - in (fromIntegral (count - c) / fromIntegral count) * 100 +coverage (stats,gcount) = + let c = fromMaybe 0 (Map.lookup (mkCId "Q") stats) + in (fromIntegral (gcount - c) / fromIntegral gcount) * 100 -uprobs pgf (ustats,bstats,count) = - [toProb f (cat pgf f) | f <- functions pgf] +probs pgf (stats,gcount) = + [toFProb f (cat pgf f) | f <- functions pgf] ++ + [toCProb c | c <- chunk_cats] where - toProb f cat = - let count = fromMaybe 0 (Map.lookup f ustats) - cat_mass = fromMaybe 0 (Map.lookup cat ustats) + toFProb f cat = + let count = fromMaybe 0 (Map.lookup f stats) + cat_mass = fromMaybe 0 (Map.lookup cat stats) in (f, fromIntegral count / fromIntegral cat_mass :: Double) -mprobs pgf (ustats,bstats,count) = - concat [toProb cat | cat <- categories pgf] - where - toProb cat = - let mass = sum [count | ((cat1,cat2),count) <- Map.toList bstats, cat1==cat] - cat_count = fromMaybe 0 (Map.lookup cat ustats) - fun_count = sum [fromMaybe 0 (Map.lookup f ustats) | f <- functionsByCat pgf cat] - in (cat,mkCId "*",if cat_count == 0 then 0 else fromIntegral (cat_count - fun_count) / fromIntegral cat_count) : - [(cat1,cat2,fromIntegral count / fromIntegral mass) - | ((cat1,cat2),count) <- Map.toList bstats, cat1==cat] - -gprobs pgf (ustats,bstats,count) = - sortBy (\x y -> compare (snd y) (snd x)) [toProb f | f <- functions pgf] - where - toProb f = - let fcount = fromMaybe 0 (Map.lookup f ustats) - in (f, fromIntegral fcount / fromIntegral count :: Double) - -cprobs pgf (ustats,bstats,count) = - sortBy (\x y -> compare (snd y) (snd x)) [toProb c | c <- categories pgf] - where - mass = sum [fromMaybe 0 (Map.lookup c ustats) | c <- categories pgf] + toCProb c = + let ccount = fromMaybe 0 (Map.lookup c stats) + in (c, fromIntegral ccount / fromIntegral chunk_mass :: Double) - toProb c = - let fcount = fromMaybe 0 (Map.lookup c ustats) - in (c, fromIntegral fcount / fromIntegral mass :: Double) + chunk_mass = + sum [fromMaybe 0 (Map.lookup c stats) | c <- chunk_cats] cat pgf f = case fmap unType (functionType pgf f) of |