From 126753651ab43502d68c1685657ea002fa1c5a81 Mon Sep 17 00:00:00 2001 From: aarne Date: Fri, 30 Apr 2004 19:52:34 +0000 Subject: [PATCH] Improved gt; Karin C's examples. --- lib/resource-0.6/swedish/MoreTest.gf | 93 ++++++++++++++ lib/resource-0.6/swedish/MoreTestSwe.gf | 164 ++++++++++++++++++++++++ src/GF/API.hs | 9 +- src/GF/Infra/Option.hs | 3 +- src/GF/Shell.hs | 10 +- src/GF/Shell/PShell.hs | 6 +- src/GF/UseGrammar/Generate.hs | 15 ++- src/HelpFile | 7 +- src/HelpFile.hs | 7 +- src/Today.hs | 2 +- 10 files changed, 293 insertions(+), 23 deletions(-) create mode 100644 lib/resource-0.6/swedish/MoreTest.gf create mode 100644 lib/resource-0.6/swedish/MoreTestSwe.gf diff --git a/lib/resource-0.6/swedish/MoreTest.gf b/lib/resource-0.6/swedish/MoreTest.gf new file mode 100644 index 000000000..71fca9829 --- /dev/null +++ b/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 ; +} ; \ No newline at end of file diff --git a/lib/resource-0.6/swedish/MoreTestSwe.gf b/lib/resource-0.6/swedish/MoreTestSwe.gf new file mode 100644 index 000000000..c4bd8e755 --- /dev/null +++ b/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" ; + +} ; \ No newline at end of file diff --git a/src/GF/API.hs b/src/GF/API.hs index 15cccde51..49d7fd5a2 100644 --- a/src/GF/API.hs +++ b/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 diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index abfb44e5a..7e273025f 100644 --- a/src/GF/Infra/Option.hs +++ b/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" diff --git a/src/GF/Shell.hs b/src/GF/Shell.hs index 8a0152e10..66a073ebc 100644 --- a/src/GF/Shell.hs +++ b/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 diff --git a/src/GF/Shell/PShell.hs b/src/GF/Shell/PShell.hs index b4cd335a7..befdb8ea2 100644 --- a/src/GF/Shell/PShell.hs +++ b/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 diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs index c39153308..9f8fb66d1 100644 --- a/src/GF/UseGrammar/Generate.hs +++ b/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 diff --git a/src/HelpFile b/src/HelpFile index de06920aa..513c6add0 100644 --- a/src/HelpFile +++ b/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 diff --git a/src/HelpFile.hs b/src/HelpFile.hs index 07ae033b8..085f244f5 100644 --- a/src/HelpFile.hs +++ b/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" ++ diff --git a/src/Today.hs b/src/Today.hs index 2377e1ccb..85bc90114 100644 --- a/src/Today.hs +++ b/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"