msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests 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 dd4c792e67
commit b206aa3464
1 changed files with 9 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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,[])