GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-21 09:02:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

bug fixes in biased generation ; example probs file in lib/src

Browse Source
This commit is contained in:
aarne
2010-01-26 21:49:00 +00:00
parent a463443cf5
commit a5a1d2bbe0
2 changed files with 39 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
lib/src/probs Normal file
View File

@@ -0,0 +1,30 @@
youPl_Pron 0.04
youPol_Pron 0.04
UttS 0.6
UttQS 0.2
UttImp 0.1
NoPConj 0.8
NoVoc 0.98
PredVP 0.9
DetCN 0.7
UsePron 0.2
SlashV2 0.8
UseV 0.4
ComplSlash 0.4
ComplVQ 0.02
ComplVS 0.02
ComplVA 0.02
DetQuant 0.8
ASimul 0.8
TFut 0.1
TCond 0.1
PPos 0.7

14
src/runtime/haskell/PGF/Generate.hs
View File

@@ -58,10 +58,13 @@ genRandomProb mprobs gen pgf ty@(DTyp _ cat _) =
d:ds2 = ds d:ds2 = ds
(f,args) = getf d fs (f,args) = getf d fs
(ts,k) = getts ds2 args (ts,k) = getts ds2 args
in (foldl EApp (EFun f) ts, k+1) in (foldl EApp f ts, k+1)
getf d fs = case mprobs of getf d fs = case mprobs of
Just _ -> hitRegion d [(p,(f,args)) | (p,(f,args)) <- fs] Just _ -> hitRegion d [(p,(f,args)) | (p,(f,args)) <- fs]
_ -> let lg = (length fs) in snd (fs !! (floor (d * fromIntegral lg))) _ -> let
lg = length fs
(f,v) = snd (fs !! (floor (d * fromIntegral lg)))
in (EFun f,v)
getts ds cats = case cats of getts ds cats = case cats of
c:cs -> let c:cs -> let
(t, k) = gett ds c (t, k) = gett ds c
@@ -77,8 +80,9 @@ genRandomProb mprobs gen pgf ty@(DTyp _ cat _) =
(f,ty) <- fs, (f,ty) <- fs,
let deflt = 1.0 / fromIntegral (length fs)] let deflt = 1.0 / fromIntegral (length fs)]
hitRegion :: Double -> [(Double,a)] -> a hitRegion :: Double -> [(Double,(CId,[a]))] -> (Expr,[a])
hitRegion d vs = case vs of hitRegion d vs = case vs of
(p1,v1):vs2 -> (p1,(f,v1)):vs2 -> if d < p1 then (EFun f, v1) else hitRegion (d-p1) vs2
if d < p1 then v1 else hitRegion d [(p+p1,v) | (p,v) <- vs2] _ -> (EMeta 9,[])