Improved gt; Karin C's examples.

lib/resource-0.6/swedish/MoreTest.gf

@@ -0,0 +1,93 @@
+abstract MoreTest = Structural ** {
+
+-- a random sample of lexicon to test resource grammar with
+
+fun
+Big, Happy, Small, Old, Young : AdjDeg ;
+Interested, Fresh : AdjDeg ;
+Slow, New, Own, Free : AdjDeg ;
+American, Finnish : Adj1 ;
+Married : Adj2 ; 
+
+Finale : N ;
+Man, Woman, Car, House, Light, Bar, Bottle, Wine : N ;
+DrinkS, Air, Glass, Letter, Fiance, Chair, Fever : N ;
+Seriousness, Book, Success, HomeBake, Golf : N ;
+Competition : N ;
+CinemaVisit : N ;
+Orientation : N ; --? vad det nu kan heta på engelska
+Idea : N ;
+
+-- Nomen med en-ställig funktion
+Mother, Uncle : Fun ;
+
+-- Nomen med två-ställig funktion
+Connection : Fun2 ;
+
+
+--Intransitiva verb
+Walk, Run : V ;
+Sleep : V ;	
+Rain : V ;
+Dance : V ;
+ArriveX : V ;
+Sail : V ;
+--Monotransitiva verb --som tar NP som objekt
+Send, Wait, Love, Drink, SwitchOn, SwitchOff : TV ;
+Hug, Rent, Surprise : TV ;
+MakeDo : TV ;
+Have : TV ;
+Like : TV ;
+Take : TV ;
+Buy : TV ;
+Build : TV ;
+--med prep
+Talk : TV ; -- prata med
+Trust  : TV ; -- lita på
+Start : TV ;
+Play : TV ;
+Win : TV ;
+Accustomize : V3 ;
+Remind : V3 ;
+Devote : V3 ;
+Steal : TV ;
+DeserveVV : VV ;
+
+--Ditransitiva verb
+Give, Prefer : V3 ;
+--(Pelle ger Fido till Lisa)
+--(Pelle ger Lisa Fido)
+
+Put : V3 ; --sätter Lisa i stolen
+--Direkt, indirekt objekt
+Give2 : V3 ;
+Envy : V3 ;
+-- två ppp som dir o indir obj
+Talk2 : V3 ; -- tala med ngn om ngt
+
+-- Verb med satskomplement 
+Say, Prove : VS ;
+
+
+Hope : VS ;
+
+Believe : VS ;
+Know : VS ; 
+--Seem : VS ;
+UseToVV : VV ;
+ShallVV : VV ;
+-- Partikelverb -- se TV
+
+
+--Adverb
+Well, Difficult, Always, ToNight, Now : AdV ;
+
+HaveVV : VV ;
+TryVV : VV;
+RefuseVV : VV;
+SeemVV : VV ;
+ContinueVV : VV;
+
+--Pronomen
+John, Mary, Liza, Charlie, Phido, Pelle, Anders: PN ;
+} ;

lib/resource-0.6/swedish/MoreTestSwe.gf

@@ -0,0 +1,164 @@
+--# -path=.:../abstract:../../prelude
+
+concrete MoreTestSwe of MoreTest = StructuralSwe ** open Prelude, SyntaxSwe in {
+
+flags startcat=Phr ; lexer=text ; unlexer=text ;
+
+-- a random sample from the lexicon
+
+lin
+--aFin, aFager, aGrund, aVid, aVaken, aKorkad,  aAbstrakt
+
+Big = stor_25 ;
+Small = liten_1146 ;
+Old = gammal_16 ;
+Young = ung_29 ;
+
+American = extAdjective (aFin "amerikansk") ;
+Finnish = extAdjective (aFin "finsk") ;
+Married = extAdjective (aAbstrakt "gift") ** {s2 = "med"} ;
+
+Happy = aFin "lycklig" ;
+Free = aFin "ledig" ;
+Slow = aFin "långsam" ;
+New = aVid "ny" ;
+Own = aVaken "eg" ;
+Fresh = aFin "frisk" ; 
+Interested = aGrund "intressera" ;
+
+
+--sApa, sBil sPojke, sNyckel sKam sSak , sVarelse , 
+--sNivå, sParti,sMuseum sRike sLik sRum sHus sPapper 
+--sNummer sKikare, sProgram
+Finale = extCommNoun NoMasc (sSak "final") ; 
+Idea = extCommNoun NoMasc (sBil "idé") ; 
+Orientation = extCommNoun NoMasc (sBil "orientering") ; 
+Air = extCommNoun NoMasc (sBil "luft") ;
+Golf = extCommNoun NoMasc (sBil "golf") ;
+Man = extCommNoun Masc man_1144 ;
+Bar = extCommNoun NoMasc (sSak "bar") ;
+DrinkS = extCommNoun NoMasc (sSak "drink") ;
+Book = extCommNoun NoMasc (sSak "bok") ; -- omljud?
+Bottle = extCommNoun NoMasc (sApa "flask") ;
+Letter = extCommNoun NoMasc (sHus "brev") ;
+Fiance = extCommNoun NoMasc (sNivå "fästmö") ;
+Woman = extCommNoun NoMasc (sApa "kvinn") ;
+Car = extCommNoun NoMasc (sBil "bil") ;
+House = extCommNoun NoMasc (sHus "hus") ;
+Glass = extCommNoun NoMasc (sHus "glas") ;
+Light = extCommNoun NoMasc (sHus "ljus") ;
+Wine = extCommNoun NoMasc (sParti "vin") ;
+Success = extCommNoun NoMasc (sBil "framgång") ;
+Seriousness = extCommNoun NoMasc (sHus "allvar") ;
+Chair = extCommNoun NoMasc (sBil "stol") ;
+Fever = extCommNoun NoMasc (sBil "feber") ;
+HomeBake = extCommNoun NoMasc (sBil "hembakt") ; --måste ändra sen
+Competition = extCommNoun NoMasc (sBil "tävling") ;
+CinemaVisit = extCommNoun NoMasc (sHus "biobesök") ;
+
+-- Nomen med en-ställig funktion
+Mother = mkFun (extCommNoun NoMasc mor_1) "till" ;
+Uncle = mkFun (extCommNoun Masc farbror_8) "till" ;
+
+-- Nomen med två-ställig funktion
+Connection = mkFun (extCommNoun NoMasc (sVarelse "förbindelse")) "från" ** 
+         {s3 = "till"} ;
+
+
+--vTala, vLeka vTyda vVända
+--vByta vGömma vHyra vTåla
+--vFinna
+
+-- Intransitiva verb
+Walk = extVerb Act gå_1174 ;
+Run = extVerb Act (vFinna "spring" "sprang" "sprung") ;
+Dance = extVerb Act (vTala "dans") ;
+Rain = extVerb Act (vTala "regn") ;
+Sleep = extVerb Act (vFinna "sov" "sov" "sov") ;
+Sail = extVerb Act (vTala "segl") ;
+
+--Monotransitiva verb
+Surprise = extTransVerb (vTala "överrask") [] ;
+Drink = extTransVerb (vFinna "drick" "drack" "druck") [] ;
+Love = extTransVerb (vTala "älsk") [] ;
+Send = extTransVerb (vTala "skick") [] ;
+Wait = extTransVerb (vTala "vänt") "på" ;
+Build = extTransVerb (vLeka "bygg") [] ;
+Buy = extTransVerb (vLeka "köp") [] ;
+Rent = extTransVerb (vHyra "hyr") [] ;
+MakeDo = extTransVerb (vHyra "gör") [] ; --Hack!
+Hug = extTransVerb (vTala "kram") [] ;
+Have = extTransVerb hava_1198 [] ;
+Like = extTransVerb (vTala "gill") [] ;
+Take = extTransVerb (vFinna "ta" "tog" "tag") [] ; --
+Start = extTransVerb (vTala "start") [] ;
+Play = extTransVerb (vTala "spel") [] ;
+Win = extTransVerb (vFinna "vinn" "vann" "vunn") [] ;
+
+--Bitransitiva verb
+Give2 = extTransVerb (vFinna "giv" "gav" "giv") [] ** {s3 = ""} ; -- ge
+Envy = extTransVerb (vTala "missunn") [] ** {s3 = ""} ; 
+
+--(Bi)transverb med obligatorisk pp
+Give = extTransVerb (vFinna "giv" "gav" "giv") [] ** {s3 = "till"} ; -- ge
+Accustomize = extTransVerb (vFinna "vänj" "vande" "van")  [] ** {s3 = "vid"} ; -- 
+Steal = extTransVerb (vHyra "stjäl") [] ; -- oh o hur ska detta böjas?
+
+Devote = extTransVerb (vTala "ägn")  [] ** {s3 = "åt"} ; -- 
+Remind = extTransVerb (vTåla "påminn")  [] ** {s3 = "om"} ; -- 
+
+Prefer = extTransVerb (vFinna "föredrag" "föredrog" "föredrag") [] ** {s3 = "framför"} ; --- föredra
+Put = extTransVerb (vFinna "sätt" "satte" "satt") [] ** {s3 = "i"} ; 
+Talk2 = extTransVerb (vTala "tal") ["med"] ** {s3 = "om"} ;
+
+
+-- Verb med satskomplement
+-- kan bara ta fullständiga satser, inledda med att?
+Say = extVerb Act (vLeka "säg") ;
+Prove = extVerb Act (vTala "bevis") ;
+
+
+Hope  = extVerb Pass(vTala "hopp") ;-- har ej deponens?
+Believe = extTransVerb (vTala "lit") "på" ;
+Know = extVerb Act (vTala "vet") ;
+
+-- Verb som tar infinitivt verb, "ha" tar emellertid supinum
+UseToVV = extVerb Act (vTala "bruk") ** {isAux = True} ;
+RefuseVV    = extVerb Act (vTala "vägr") ** {isAux = variants{False;True}} ;
+HaveVV    = extVerb Act (vHyra "har") ** {isAux = True} ; -- finns ju redan, måste kolla
+SeemVV = extVerb Act (vTala "verk")  ** {isAux = True};
+ShallVV = extVerb Act (vTala "skull")  ** {isAux = True};
+ContinueVV = extVerb Act (vFinna "fortsätt" "fortsatte" "fortsatt")  ** {isAux = variants{False;True}} ;
+DeserveVV = extVerb Act (vTala "förtjän")  ** {isAux = variants{False;True}} ;
+TryVV    = extVerb Act (vLeka "försök") ** {isAux = variants{False;True}} ;
+
+--Partikelverb
+SwitchOn = mkDirectVerb (extVerbPart Act (vFinna "sätt" "satte" "satt") "på") ;
+SwitchOff = mkDirectVerb (extVerbPart Act (vLeka "stäng") "av") ;
+ArriveX = extVerbPart Act (vFinna "komm" "kom" "kommit") "fram" ;
+
+-- Transitiva verb med obligatorisk pp
+Talk = extTransVerb (vTala "prat") "med" ;
+Trust = extTransVerb (vTala "lit") "på" ;
+
+--Adverb
+Always = advPre "alltid" ;
+Well = advPost "bra" ;
+Now = advPost "nu" ;
+Difficult = advPost "svårt" ;
+ToNight = advPost "ikväll" ;
+
+-- Pronomen
+John = mkProperName "Johan" Utr Masc ;
+Mary = mkProperName "Maria" Utr NoMasc ;
+Pelle = mkProperName "Pelle" Utr Masc ;
+Liza = mkProperName "Lisa" Utr NoMasc ;
+Phido = mkProperName "Fido" Utr NoMasc ;
+Charlie = mkProperName "Kalle" Utr Masc ;
+Anders = mkProperName "Anders" Utr Masc ;
+
+-- verbVara = extVerb Act vara_1200 ;
+-- verbHava = extVerb Act hava_1198 ;
+-- verbFinnas = mkVerb "finnas" "finns" "finns" ;
+
+} ;

src/GF/API.hs

@@ -157,15 +157,16 @@ randomTreesIO opts gr n = do
    g   = grammar gr
    mx  = optIntOrN opts flagDepth 41
 
-generateTrees :: Options -> GFGrammar -> Int -> [Tree]
-generateTrees opts gr n =
+generateTrees :: Options -> GFGrammar -> [Tree]
+generateTrees opts gr =
   optIntOrAll opts flagNumber  
-    [tr | t <- Gen.generateTrees gr' cat n, Ok tr <- [mkTr t]]
+    [tr | t <- Gen.generateTrees gr' cat dpt mn, Ok tr <- [mkTr t]]
   where
     mkTr = annotate gr' . qualifTerm (absId gr) 
     gr' = grammar gr
     cat = firstAbsCat opts gr
-
+    dpt = maybe 3 id $ getOptInt opts flagDepth
+    mn  = getOptInt opts flagAlts
 
 speechGenerate :: Options -> String -> IO ()
 speechGenerate opts str = do

src/GF/Infra/Option.hs

@@ -221,7 +221,8 @@ flagYes = oArg "yes"
 flagNo  = oArg "no"
 
 -- integer flags
-flagDepth = aOpt "depth"
+flagDepth  = aOpt "depth"
+flagAlts   = aOpt "alts"
 flagLength = aOpt "length"
 flagNumber = aOpt "number"
 

src/GF/Shell.hs

@@ -53,8 +53,8 @@ data Command =
  | CLinearize [()] ---- parameters
  | CParse
  | CTranslate Language Language
- | CGenerateRandom Int
- | CGenerateTrees Int
+ | CGenerateRandom
+ | CGenerateTrees
  | CPutTerm
  | CWrapTerm Ident
  | CMorphoAnalyse
@@ -174,7 +174,7 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
   CTranslate il ol -> do
     let a' = opST2CommandArg (optParseArgErr opts (sgr il)) a
     returnArg (opTS2CommandArg (optLinearizeTreeVal opts (sgr ol)) a') sa
-  CGenerateRandom n -> do
+  CGenerateRandom -> do
     let 
       a' = case a of
         ASTrm _ -> s2t a
@@ -186,9 +186,9 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = case comm of
               Ok trm' -> returnArg (ATrms [loc2tree trm']) sa
               Bad s   -> returnArg (AError s) sa
       _ -> do
-        ts <- randomTreesIO opts gro (optIntOrN opts flagNumber n)
+        ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
         returnArg (ATrms ts) sa
-  CGenerateTrees n -> returnArg (ATrms $ generateTrees opts gro n) sa
+  CGenerateTrees -> returnArg (ATrms $ generateTrees opts gro) sa
 
 
   CPutTerm -> changeArg (opTT2CommandArg (optTermCommand opts gro) . s2t) sa

src/GF/Shell/PShell.hs

@@ -70,9 +70,9 @@ 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)
-  "gr" : t      -> aTerm   (CGenerateRandom 1) t
-  "gt" : n : [] -> aUnit   (CGenerateTrees (readIntArg n))
+  "gr" : []     -> aUnit   CGenerateRandom
+  "gr" : t      -> aTerm   CGenerateRandom t
+  "gt" : []     -> aUnit   CGenerateTrees
   "pt" : s      -> aTerm   CPutTerm s
 -----  "wt" : f : s  -> aTerm   (CWrapTerm (string2id f)) s
   "ma" : s      -> aString CMorphoAnalyse s

src/GF/UseGrammar/Generate.hs

@@ -17,8 +17,8 @@ import List
 
 -- 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
+-- generateTrees :: GFCGrammar -> Cat -> Int -> Maybe Int -> [Exp]
+generateTrees gr cat n mn = map str2tr $ generate gr' cat' n mn where
   gr' = gr2sgr gr
   cat' = prt $ snd cat
 
@@ -39,17 +39,22 @@ str2tr (STr (f,ts)) = mkApp (trId f) (map str2tr ts) where
 
 ------------------------------------------
 -- 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)
 
-generate :: SGrammar -> SCat -> Int -> [STree]
-generate gr cat i = [t | (c,t) <- gen 0 [], c == cat] where
+
+generate :: SGrammar -> SCat -> Int -> Maybe Int -> [STree]
+generate gr cat i mn = [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]
+  args cs cts = combinations [constr [t | (k,t) <- cts, k == c] | c <- cs]
 
+  constr = maybe id take mn
 
 type SGrammar = [SRule]
 type SIdent = String

src/HelpFile

@@ -162,9 +162,12 @@ gr, generate_random: gr Tree?
       -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.
+gt, generate_trees: gt
+      Generates all trees up to a given depth. If the depth is large,
+      a small -alts is recommended
   flags:
+      -depth   generate to this depth (default 3)
+      -alts    take this number of alternatives at each branch (default unlimited)
       -cat     generate in this category
       -lang    use the abstract syntax of this grammar
       -number  generate (at most) this number of trees

src/HelpFile.hs

@@ -175,9 +175,12 @@ txtHelpFile =
   "\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." ++
+  "\ngt, generate_trees: gt" ++
+  "\n      Generates all trees up to a given depth. If the depth is large," ++
+  "\n      a small -alts is recommended" ++
   "\n  flags:" ++
+  "\n      -depth   generate to this depth (default 3)" ++
+  "\n      -alts    take this number of alternatives at each branch (default unlimited)" ++
   "\n      -cat     generate in this category" ++
   "\n      -lang    use the abstract syntax of this grammar" ++
   "\n      -number  generate (at most) this number of trees" ++

src/Today.hs

@@ -1 +1 @@
-module Today where today = "Fri Apr 30 18:14:29 CEST 2004"
+module Today where today = "Fri Apr 30 21:40:30 CEST 2004"