diff --git a/src/GF/API.hs b/src/GF/API.hs index 7c708c933..15cccde51 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -23,6 +23,7 @@ import qualified Macros as M import TypeCheck import CMacros import Transfer +import qualified Generate as Gen import Option import Custom @@ -156,10 +157,21 @@ randomTreesIO opts gr n = do g = grammar gr mx = optIntOrN opts flagDepth 41 +generateTrees :: Options -> GFGrammar -> Int -> [Tree] +generateTrees opts gr n = + optIntOrAll opts flagNumber + [tr | t <- Gen.generateTrees gr' cat n, Ok tr <- [mkTr t]] + where + mkTr = annotate gr' . qualifTerm (absId gr) + gr' = grammar gr + cat = firstAbsCat opts gr + + speechGenerate :: Options -> String -> IO () speechGenerate opts str = do let lan = maybe "" (" --language" +++) $ getOptVal opts speechLanguage - system ("echo" +++ "\"" ++ str ++ "\" | festival --tts" ++ lan) + system ("flite" +++ "\" " ++ str ++ "\"") +--- system ("echo" +++ "\"" ++ str ++ "\" | festival --tts" ++ lan) return () optLinearizeTreeVal :: Options -> GFGrammar -> Tree -> String diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 2fdf6dabd..8a0152e10 100644 --- a/src/GF/Shell.hs +++ b/src/GF/Shell.hs @@ -54,6 +54,7 @@ data Command = | CParse | CTranslate Language Language | CGenerateRandom Int + | CGenerateTrees Int | CPutTerm | CWrapTerm Ident | CMorphoAnalyse @@ -187,6 +188,8 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of _ -> do ts <- randomTreesIO opts gro (optIntOrN opts flagNumber n) returnArg (ATrms ts) sa + CGenerateTrees n -> returnArg (ATrms $ generateTrees opts gro n) sa + CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro) . s2t) sa ----- CWrapTerm f -> changeArg (opTT2CommandArg (return . wrapByFun opts gro f)) sa diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs index 9a1185032..b4cd335a7 100644 --- a/src/GF/Shell/PShell.hs +++ b/src/GF/Shell/PShell.hs @@ -71,8 +71,8 @@ pCommand ws = case ws of "p" : s -> aString CParse s "t" : i:o: s -> aString (CTranslate (language i) (language o)) s "gr" : [] -> aUnit (CGenerateRandom 1) - "gt" : t -> aTerm (CGenerateRandom 1) t ---- "gr" : n : [] -> aUnit (CGenerateRandom (readIntArg n)) -- deprecated 12/5/2001 + "gr" : t -> aTerm (CGenerateRandom 1) t + "gt" : n : [] -> aUnit (CGenerateTrees (readIntArg n)) "pt" : s -> aTerm CPutTerm s ----- "wt" : f : s -> aTerm (CWrapTerm (string2id f)) s "ma" : s -> aString CMorphoAnalyse s diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs new file mode 100644 index 000000000..c39153308 --- /dev/null +++ b/src/GF/UseGrammar/Generate.hs @@ -0,0 +1,87 @@ +module Generate where + +import GFC +import LookAbs +import PrGrammar +import Macros + +import Operations +import 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 :: GFCGrammar -> Cat -> Int -> [Exp] +generateTrees gr cat n = map str2tr $ generate gr' cat' n where + gr' = gr2sgr gr + cat' = prt $ snd cat + +------------------------------------------ +-- translate grammar to simpler form and generated trees back + +gr2sgr :: GFCGrammar -> SGrammar +gr2sgr gr = [(trId f, ty') | (f,ty) <- funRulesOf gr, ty' <- trTy ty] where + trId = prt . snd + trTy ty = case catSkeleton ty of + Ok (mcs,mc) -> [(map trCat mcs, trCat mc)] + _ -> [] + trCat (m,c) = prt c --- + +-- str2tr :: STree -> Exp +str2tr (STr (f,ts)) = mkApp (trId f) (map str2tr ts) where + trId = cn . zIdent + +------------------------------------------ +-- do the main thing with a simpler data structure + +generate :: SGrammar -> SCat -> Int -> [STree] +generate gr cat i = [t | (c,t) <- gen 0 [], c == cat] where + + gen :: Int -> [(SCat,STree)] -> [(SCat,STree)] + gen n cts = if n==i then cts else + gen (n+1) (nub [(c,STr (f, xs)) | (f,(cs,c)) <- gr, xs <- args cs cts] ++ cts) + + args :: [SCat] -> [(SCat,STree)] -> [[STree]] + args cs cts = combinations [[t | (k,t) <- cts, k == c] | c <- cs] + + +type SGrammar = [SRule] +type SIdent = String +type SRule = (SFun,SType) +type SType = ([SCat],SCat) +type SCat = SIdent +type SFun = SIdent + +newtype STree = STr (SFun,[STree]) deriving (Show,Eq) + +------------------------------------------ +-- to test + +prSTree (STr (f,ts)) = f ++ concat (map pr1 ts) where + pr1 t@(STr (_,ts)) = ' ' : (if null ts then id else prParenth) (prSTree t) + +pSRule :: String -> SRule +pSRule s = case words s of + f : _ : cs -> (f,(init cs', last cs')) + where cs' = [cs !! i | i <- [0,2..length cs - 1]] + _ -> error $ "not a rule" +++ s + +exSgr = map pSRule [ + "Pred : NP -> VP -> S" + ,"Compl : TV -> NP -> VP" + ,"PredVV : VV -> VP -> VP" + ,"DefCN : CN -> NP" + ,"ModCN : AP -> CN -> CN" + ,"john : NP" + ,"walk : VP" + ,"love : TV" + ,"try : VV" + ,"girl : CN" + ,"big : AP" + ] diff --git a/src/HelpFile b/src/HelpFile index f1e4eb1fb..de06920aa 100644 --- a/src/HelpFile +++ b/src/HelpFile @@ -159,9 +159,16 @@ gr, generate_random: gr Tree? flags: -cat generate in this category -lang use the abstract syntax of this grammar - -number generate this number of trees + -number generate this number of trees (not impl. with Tree argument) -depth use this number of search steps at most +gt, generate_trees: gt Int + Generates all trees up to the given depth. + flags: + -cat generate in this category + -lang use the abstract syntax of this grammar + -number generate (at most) this number of trees + ma, morphologically_analyse: ma String Runs morphological analysis on each word in String and displays the results line by line. diff --git a/src/HelpFile.hs b/src/HelpFile.hs index a8abb739f..07ae033b8 100644 --- a/src/HelpFile.hs +++ b/src/HelpFile.hs @@ -172,9 +172,16 @@ txtHelpFile = "\n flags:" ++ "\n -cat generate in this category" ++ "\n -lang use the abstract syntax of this grammar" ++ - "\n -number generate this number of trees" ++ + "\n -number generate this number of trees (not impl. with Tree argument)" ++ "\n -depth use this number of search steps at most" ++ "\n" ++ + "\ngt, generate_trees: gt Int" ++ + "\n Generates all trees up to the given depth." ++ + "\n flags:" ++ + "\n -cat generate in this category" ++ + "\n -lang use the abstract syntax of this grammar" ++ + "\n -number generate (at most) this number of trees" ++ + "\n" ++ "\nma, morphologically_analyse: ma String" ++ "\n Runs morphological analysis on each word in String and displays" ++ "\n the results line by line." ++ diff --git a/src/Today.hs b/src/Today.hs index e642f3d0e..2377e1ccb 100644 --- a/src/Today.hs +++ b/src/Today.hs @@ -1 +1 @@ -module Today where today = "Fri Apr 30 14:27:30 CEST 2004" +module Today where today = "Fri Apr 30 18:14:29 CEST 2004"