mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-15 15:59:32 -06:00
117 lines
3.6 KiB
Haskell
117 lines
3.6 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- Module : Generate
|
|
-- Maintainer : AR
|
|
-- Stability : (stable)
|
|
-- Portability : (portable)
|
|
--
|
|
-- > CVS $Date: 2005/10/12 12:38:30 $
|
|
-- > CVS $Author: aarne $
|
|
-- > CVS $Revision: 1.16 $
|
|
--
|
|
-- Generate all trees of given category and depth. AR 30\/4\/2004
|
|
--
|
|
-- (c) Aarne Ranta 2004 under GNU GPL
|
|
--
|
|
-- Purpose: to generate corpora. We use simple types and don't
|
|
-- guarantee the correctness of bindings\/dependences.
|
|
-----------------------------------------------------------------------------
|
|
|
|
module GF.UseGrammar.Generate (generateTrees,generateAll) where
|
|
|
|
import GF.Canon.GFC
|
|
import GF.Grammar.LookAbs
|
|
import GF.Grammar.PrGrammar
|
|
import GF.Grammar.Macros
|
|
import GF.Grammar.Values
|
|
import GF.Grammar.Grammar (Cat)
|
|
import GF.Grammar.SGrammar
|
|
import GF.Data.Operations
|
|
import GF.Data.Zipper
|
|
import GF.Infra.Option
|
|
import Data.List
|
|
|
|
-- Generate all trees of given category and depth. AR 30/4/2004
|
|
-- (c) Aarne Ranta 2004 under GNU GPL
|
|
--
|
|
-- Purpose: to generate corpora. We use simple types and don't
|
|
-- guarantee the correctness of bindings/dependences.
|
|
|
|
|
|
-- | the main function takes an abstract syntax and returns a list of trees
|
|
generateTrees ::
|
|
Options -> GFCGrammar -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp]
|
|
generateTrees opts gr cat n mn mt = map str2tr $ generate gr' opts cat' n mn mt'
|
|
where
|
|
gr' = gr2sgr opts emptyProbs gr
|
|
cat' = prt $ snd cat
|
|
mt' = maybe Nothing (return . tr2str) mt
|
|
--- ifm = oElem withMetas opts
|
|
ifm = oElem showOld opts
|
|
|
|
generateAll :: Options -> (Exp -> IO ()) -> GFCGrammar -> Cat -> IO ()
|
|
generateAll opts io gr cat = mapM_ (io . str2tr) $ num $ gen cat'
|
|
where
|
|
num = optIntOrAll opts flagNumber
|
|
gr' = gr2sgr opts emptyProbs gr
|
|
cat' = prt $ snd cat
|
|
gen c = generate gr' opts c 10 Nothing Nothing
|
|
|
|
|
|
|
|
------------------------------------------
|
|
-- do the main thing with a simpler data structure
|
|
-- the first Int gives tree depth, the second constrains subtrees
|
|
-- chosen for each branch. A small number, such as 2, is a good choice
|
|
-- if the depth is large (more than 3)
|
|
-- If a tree is given as argument, generation concerns its metavariables.
|
|
|
|
generate :: SGrammar -> Options -> SCat -> Int -> Maybe Int -> Maybe STree -> [STree]
|
|
generate gr opts cat i mn mt = case mt of
|
|
Nothing -> gen opts cat
|
|
Just t -> genM t
|
|
where
|
|
--- now use ifm to choose between two algorithms
|
|
gen opts cat
|
|
| oElem (iOpt "mem") opts = concat $ errVal [] $ lookupTree id cat $ allTrees -- -old
|
|
| oElem (iOpt "nonub") opts = concatMap (\i -> gener i cat) [0..i-1] -- some duplicates
|
|
| otherwise = nub $ concatMap (\i -> gener i cat) [0..i-1] -- new
|
|
|
|
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 -- NO!
|
|
]
|
|
|
|
allTrees = genAll i
|
|
|
|
-- dynamic generation
|
|
genAll :: Int -> BinTree SCat [[STree]]
|
|
genAll i = iter i genNext (mapTree (\ (c,_) -> (c,[[]])) gr)
|
|
|
|
iter 0 f tr = tr
|
|
iter n f tr = iter (n-1) f (f tr)
|
|
|
|
genNext tr = mapTree (genNew tr) tr
|
|
|
|
genNew tr (cat,ts) = let size = length ts in
|
|
(cat, [SApp (f, xs) |
|
|
(f,(cs,_)) <- funs cat,
|
|
xs <- combinations (map look cs),
|
|
let fxs = SApp (f, xs),
|
|
depth fxs == size]
|
|
: ts)
|
|
where
|
|
look c = concat $ errVal [] $ lookupTree id c tr
|
|
|
|
funs cat = maybe id take mn $ errVal [] $ lookupTree id cat gr
|
|
|
|
genM t = case t of
|
|
SApp (f,ts) -> [SApp (f,ts') | ts' <- combinations (map genM ts)]
|
|
SMeta k -> gen opts k
|
|
_ -> [t]
|