Improved generation algorithm (old with -old, all with -all (-lin))

This commit is contained in:
aarne
2006-08-15 19:59:10 +00:00
parent 6ee69593f0
commit 28245481a7
2 changed files with 25 additions and 12 deletions

View File

@@ -305,8 +305,12 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
returnArg (ATrms ts) sa returnArg (ATrms ts) sa
CGenerateTrees | oElem showAll opts -> do CGenerateTrees | oElem showAll opts -> do
let cat = firstAbsCat opts gro let
justOutput opts (generateAll opts (putStrLn . prt_) cgr cat) sa cat = firstAbsCat opts gro
outp
| oElem (iOpt "lin") opts = optLinearizeTreeVal opts gro . term2tree gro
| otherwise = prt_
justOutput opts (generateAll opts (putStrLn . outp) cgr cat) sa
CGenerateTrees -> do CGenerateTrees -> do
let let
a' = case a of a' = case a of

View File

@@ -39,24 +39,22 @@ import Data.List
-- | the main function takes an abstract syntax and returns a list of trees -- | the main function takes an abstract syntax and returns a list of trees
generateTrees :: Options -> GFCGrammar -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp] generateTrees ::
Options -> GFCGrammar -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
generateTrees opts gr cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt' generateTrees opts gr cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt'
where where
gr' = gr2sgr opts emptyProbs gr gr' = gr2sgr opts emptyProbs gr
cat' = prt $ snd cat cat' = prt $ snd cat
mt' = maybe Nothing (return . tr2str) mt mt' = maybe Nothing (return . tr2str) mt
ifm = oElem withMetas opts --- ifm = oElem withMetas opts
ifm = oElem showOld opts
generateAll :: Options -> (Exp -> IO ()) -> GFCGrammar -> Cat -> IO () generateAll :: Options -> (Exp -> IO ()) -> GFCGrammar -> Cat -> IO ()
generateAll opts io gr cat = mapM_ (io . str2tr) $ gen cat' generateAll opts io gr cat = mapM_ (io . str2tr) $ gen cat'
where where
gr' = gr2sgr opts emptyProbs gr gr' = gr2sgr opts emptyProbs gr
cat' = prt $ snd cat cat' = prt $ snd cat
gen c = [SApp (f, xs) | gen c = generate gr' False c 10 Nothing Nothing
(f,(cs,_)) <- funs c,
xs <- combinations (map gen cs)
]
funs c = errVal [] $ lookupTree id c gr'
@@ -69,11 +67,22 @@ generateAll opts io gr cat = mapM_ (io . str2tr) $ gen cat'
generate :: SGrammar -> Bool -> SCat -> Int -> Maybe Int -> Maybe STree -> [STree] generate :: SGrammar -> Bool -> SCat -> Int -> Maybe Int -> Maybe STree -> [STree]
generate gr ifm cat i mn mt = case mt of generate gr ifm cat i mn mt = case mt of
Nothing -> gen cat Nothing -> gen ifm cat
Just t -> genM t Just t -> genM t
where where
--- now use ifm to choose between two algorithms
gen True cat = concat $ errVal [] $ lookupTree id cat $ allTrees -- -old
gen _ cat = nub $ concatMap (\i -> gener i cat) [0..i-1] -- new
gen cat = concat $ errVal [] $ lookupTree id cat $ allTrees gener 0 c = [SApp (f, []) | (f,([],_)) <- funs c]
gener i c = [
tr |
(f,(cs,_)) <- funs c,
let alts = map (gener (i-1)) cs,
ts <- combinations alts,
let tr = SApp (f, ts)
-- depth tr >= i
]
allTrees = genAll i allTrees = genAll i
@@ -100,5 +109,5 @@ generate gr ifm cat i mn mt = case mt of
genM t = case t of genM t = case t of
SApp (f,ts) -> [SApp (f,ts') | ts' <- combinations (map genM ts)] SApp (f,ts) -> [SApp (f,ts') | ts' <- combinations (map genM ts)]
SMeta k -> gen k SMeta k -> gen ifm k
_ -> [t] _ -> [t]