{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE Trustworthy #-} module SolarmanTriplestore where import Prelude hiding ((*>)) import Getts import Data.List as List import qualified Data.Set as Set import AGParser2 import TypeAg2 import Control.Monad import Debug.Trace import qualified LocalData as Local --change between remoteData and localData --dataStore = Local.localData dataStore = remoteData -- selects database endpoint_uri = "http://speechweb2.cs.uwindsor.ca/sparql" namespace_uri = "http://solarman.richard.myweb.cs.uwindsor.ca#" remoteData = SPARQL endpoint_uri namespace_uri --copied from gangster_v4: utility functions for making lists unique subset s t = (s \\ t) == [] makeset x = Set.toList $ Set.fromList x --copied from gangster_v4: combinators termor tmph1 tmph2 ents = liftM List.nub $ liftM2 (++) (tmph1 ents) (tmph2 ents) --TODO: MERGE IMAGES PROPER termand tmph1 tmph2 ents = do t1 <- tmph1 ents t2 <- tmph2 ents if t1 /= [] && t2 /= [] then return $ List.nub $ t1 ++ t2 else return [] --May need to be changed to intersection? Don't think so: can't remove anything from nub (t1++t2) because all things are relevant to either t1 or t2 --TODO: MERGE IMAGES PROPER (or do termphrases always preserve ents) intersect_entevimages eei1 eei2 = [(subj2, evs2) | (subj1, evs1) <- eei1, (subj2, evs2) <- eei2, subj1 == subj2] that = nounand nounand = liftM2 intersect_entevimages nounor' s t = List.nub(s ++ t) nounor = liftM2 nounor' {-a' nph vbph = length (intersect nph vbph) /= 0-} a = liftM2 intersect_entevimages any' = a the = a some = a an = a every' nph vbph | subset (map fst nph) (map fst vbph) = intersect_entevimages nph vbph | otherwise = [] every = liftM2 every' {- TODO: no' nph vbph = length (intersect nph vbph) == 0 no = liftM2 no' -} {- TODO: none' nph vbph = no nph vbph none = liftM2 none' -} one' nph vbph | length (res) == 1 = res | otherwise = [] where res = intersect_entevimages nph vbph one = liftM2 one' two' nph vbph | length (res) == 2 = res | otherwise = [] where res = intersect_entevimages nph vbph two = liftM2 two' --which nph vbph = if result /= [] then result else "none." -- where result = unwords $ intersect nph vbph which nph vbph = do nph_ <- nph vbph_ <- vbph let result = unwords $ map fst $ intersect_entevimages nph_ vbph_ return $ if result /= [] then result else "none." how_many' nph vbph = show $ length (intersect_entevimages nph vbph) how_many = liftM2 how_many' who = which ((get_members dataStore "person") `nounor` (get_members dataStore "science_team")) --New what' nph = if result /= [] then result else "nothing." where result = unwords $ map fst nph what = liftM what' with :: (IO Image -> IO Image) -> ([String], IO Image -> IO Image) with tmph = (["with_implement"], tmph) by tmph = (["subject"], tmph) at tmph = (["location"], tmph) in' tmph = (["location", "year"], make_pnoun $ show tmph) make_pnoun noun = liftM $ make_pnoun' noun make_pnoun' noun image = [(subj, evs) | (subj, evs) <- image, subj == noun] --New for new new semantics --TODO: Handle case where nothing is in props (return none) make_prop_termphrase prop nph = do list <- nph props <- mapM (\(_,y) -> getts_inverse dataStore prop y >>= \loc -> return (map fst loc)) list let finalList = unwords $ List.nub $ concat props return $ if finalList /= [] then finalList else "nothing." where' = make_prop_termphrase "location" when' = make_prop_termphrase "year" how' = make_prop_termphrase "with_implement" whatobj = make_prop_termphrase "object" --end of copied from gangster_v4 {- sun = get_members dataStore ("sun") planet = get_members dataStore ("planet") moon = get_members dataStore ("moon") person = get_members dataStore ("person") thing = get_members dataStore ("thing") telescope = get_members dataStore ("telescope") science_team = get_members dataStore ("science_team") spacecraft = get_members dataStore ("spacecraft") place = get_members dataStore ("place") atmospheric = get_members dataStore ("atmospheric") blue = get_members dataStore ("blue") depressed = get_members dataStore ("depressed") solid = get_members dataStore ("solid") brown = get_members dataStore ("brown") gaseous = get_members dataStore ("gaseous") green = get_members dataStore ("green") red = get_members dataStore ("red") ringed = get_members dataStore ("ringed") vacuumous = get_members dataStore ("vacuumous") exists = thing spin = get_members dataStore ("spin") -} {- discover_intrans = get_subjs_of_event_type dataStore ("discover_ev") orbit_intrans = get_subjs_of_event_type dataStore ("orbit_ev") -} {-discover = make_relation "discover_ev" discovered = discover orbit = make_relation "orbit_ev" orbited = orbit-} --For prepositional phrases {-discover' = make_relation "discover_ev" discovered' = discover' orbit' = make_relation "orbit_ev" orbited' = orbit'-} {-hall = make_pnoun "hall" phobos = make_pnoun "phobos" mars = make_pnoun "mars" refractor_telescope_1 = make_pnoun "refractor_telescope_1" -} make_relation ev_type tmph = make_filtered_relation dataStore ev_type [(["object"],tmph)] {-make_inverted_relation :: (TripleStore m) => m -> String -> (IO [String] -> IO Bool) -> IO [String] make_inverted_relation ev_data rel tmph = do images <- make_image ev_data rel "object" objPairs <- filterM (\(_, evs) -> tmph $ liftM concat $ mapM (\ev -> getts_3 ev_data (ev, "subject", "?")) evs) images return $ map fst objPairs-} --Prepositional filtering --filter_ev takes a list of ([String], IO [String] -> IO Bool) where the [String] is the list of identifiers corresponding --to the data the preposition predicate needs to evaluate (e.g., for location predicates the list will contain "location", {-filter_ev :: (TripleStore m) => m -> [([String], IO [String] -> IO Bool)] -> Event -> IO Bool filter_ev ev_data [] ev = return True filter_ev ev_data ((names,pred):list) ev = do relevant_list <- mapM (\name -> getts_3 ev_data (ev, name, "?")) names res <- pred $ return $ concat relevant_list if res then filter_ev ev_data list ev else return False-} --Modified filter_ev to accommodate predicates like every, one, two, etc... --The difference is that it concatenates the data the preposition predicate needs to evaluate across all events and --applies the preposition predicate to that, so that all data is available to the predicate rather than just the subset --given by a specific event --TODO: new filter_Ev {-filter_ev :: (TripleStore m) => m -> [([String], IO Image -> IO Image)] -> [Event] -> IO Bool filter_ev _ [] _ = return True filter_ev ev_data ((names,pred):list) evs = do relevant_list <- mapM (\name -> getts_inverse ev_data name evs) names res <- pred $ return $ concat $ relevant_list if res /= [] then filter_ev ev_data list evs else return False-} --new filter_ev: Handles prepositional phrases (IN TESTING) filter_ev :: (TripleStore m) => m -> [([String], IO Image -> IO Image)] -> [Event] -> IO Bool filter_ev _ [] _ = return True filter_ev ev_data ((names,pred):list) evs = do relevant_list <- mapM (\name -> getts_inverse ev_data name evs) names res <- pred $ return $ concat $ relevant_list --NEW: Merge all events in predicate result for new query. Result will be a subset of evs. let relevant_evs = List.nub $ concatMap snd res if res /= [] then filter_ev ev_data list relevant_evs else return False {-make_filtered_relation :: (TripleStore m) => m -> String -> (IO [String] -> IO Bool) -> [([String], IO [String] -> IO Bool)] -> IO [String] make_filtered_relation ev_data rel tmph preps = do images <- make_image ev_data rel "subject" subPairs <- filterM (\(_, evs) -> do filtEvents <- filterM (filter_ev ev_data preps) evs tmph $ liftM concat $ mapM (\ev -> getts_3 ev_data (ev, "object", "?")) filtEvents) images return $ map fst subPairs-} --Modified version of make_filtered_relation to accomodate new filter_ev make_filtered_relation :: (TripleStore m) => m -> String -> [([String], IO Image -> IO Image)] -> IO Image make_filtered_relation ev_data rel preps = do images <- make_image ev_data rel "subject" filterM (\(_, evs) -> filter_ev ev_data preps evs) images {-make_inverted_filtered_relation :: (TripleStore m) => m -> String -> [([String], IO [String] -> IO Bool)] -> IO [String] make_inverted_filtered_relation ev_data rel preps = do images <- make_image ev_data rel "object" objPairs <- filterM (\(_, evs) -> anyM (filter_ev ev_data preps) evs) images return $ map fst objPairs where anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool anyM pred lst = foldM (\x y -> pred y >>= \res -> return $ x || res) False lst -} --Modified version of make_inverted_filtered_relation to accomodate new filter_ev make_inverted_filtered_relation :: (TripleStore m) => m -> String -> [([String], IO Image -> IO Image)] -> IO Image make_inverted_filtered_relation ev_data rel preps = do images <- make_image ev_data rel "object" filterM (\(_, evs) -> filter_ev ev_data preps evs) images --Copied from old solarman: yesno' x = if x /= [] then "yes." else "no" yesno = liftM yesno' does = yesno did = yesno do' = yesno was = yesno is = yesno were = yesno are = yesno --TODO: is this proper? sand s1 s2 = do r1 <- s1 r2 <- s2 return $ if r1 /= [] && r2 /= [] then List.nub $ r1 ++ r2 else [] {- ||----------------------------------------------------------------------------- || BASIC INTERPRETERS ||----------------------------------------------------------------------------- -} pnoun = pre_processed Pnoun cnoun = pre_processed Cnoun adj = pre_processed Adj det = pre_processed Det intransvb = pre_processed Intransvb transvb = pre_processed Transvb linkingvb = pre_processed Linkingvb relpron = pre_processed Relpron termphjoin = pre_processed Termphjoin verbphjoin = pre_processed Verbphjoin nounjoin = pre_processed Nounjoin indefpron = pre_processed Indefpron {- terminator = uninterpreted (SPECIAL_SYMBOL_TERM ".") $orelse uninterpreted (SPECIAL_SYMBOL_TERM "?") $orelse uninterpreted (SPECIAL_SYMBOL_TERM "\n") -} sentjoin = pre_processed Sentjoin quest1 = pre_processed Quest1 quest2 = pre_processed Quest2 quest3 = pre_processed Quest3 quest4a = pre_processed Quest4a quest4b = pre_processed Quest4b quest5 = pre_processed Quest5 quest6 = pre_processed Quest6 --NEW FOR PREPOSITIONAL PHRASES prep = pre_processed Prepn year = pre_processed Year pre_processed key = let formAlts altTerminals = memoize key (altTerminals) formTerminal [x] = x formTerminal (x:xs) = x <|> formTerminal xs list_of_ters = [ terminal (term a) z | (a,b,z) <- dictionary , b == key] in formAlts (formTerminal list_of_ters) meaning_of p dInp key = let dInput = words dInp appParser = unState (p T0 [] ((1,[]), dInput) ([],[])) [] upperBound = (length dInput) + 1 in formFinal key upperBound (snd $ appParser) meaning_of_ p dInp key = let dInput = words dInp appParser = unState (p T0 [] ((1,[]), dInput) ([],[])) [] upperBound = (length dInput) + 1 in (snd $ appParser) formAtts key ePoint t = concat $ concat $ concat $ concat [[[[ val1 |(id1,val1)<-synAtts] |(((st,inAtt2),(end,synAtts)), ts)<-rs, st == 1 && end == ePoint] |((i,inAt1),((cs,ct),rs)) <- sr ] |(s,sr) <- t, s == key ] formFinal key ePoint t = concat $ concat $ concat $ concat [[[[ val1 |(id1,val1)<-synAtts] |(((st,inAtt2),(end,synAtts)), ts)<-rs, st == 1 && end == ePoint] |((i,inAt1),((cs,ct),rs)) <- sr ] |(s,sr) <- t, s == key ] {- test p = unState (p ((1,[]),input) ([],[])) [] main = do putStr $ render80 $ formatAtts Question $ snd $ test (question T0 []) type Start1 = (Int, InsAttVals) type Start = ((Int,InsAttVals), [String]) type End = (Int, InsAttVals) type Atts = [AttValue] -- [(AttType, AttValue)] type InsAttVals = [(Instance, Atts)] ,[(Start1,(Context,Result))] type Mtable = [(MemoL ) ] type Result = [((Start1, End),[Tree MemoL])] ||----------------------------------------------------------------------------- || THE ATTRIBUTE GRAMMAR ||----------------------------------------------------------------------------- -} -- public = | ; snouncla = memoize Snouncla (parser (nt cnoun S3) [rule_s NOUNCLA_VAL OF LHS ISEQUALTO copy [synthesized NOUNCLA_VAL OF S3]] <|> parser (nt adjs S1 *> nt cnoun S2) [rule_s NOUNCLA_VAL OF LHS ISEQUALTO intrsct1 [synthesized ADJ_VAL OF S1, synthesized NOUNCLA_VAL OF S2]] ) ------------------------------------------------------------------------------- -- public = | ; relnouncla = memoize Relnouncla (parser (nt snouncla S1 *> nt relpron S2 *> nt joinvbph S3) [rule_s NOUNCLA_VAL OF LHS ISEQUALTO apply_middle1[synthesized NOUNCLA_VAL OF S1, synthesized RELPRON_VAL OF S2, synthesized VERBPH_VAL OF S3]] <|> parser (nt snouncla S4) [rule_s NOUNCLA_VAL OF LHS ISEQUALTO copy [synthesized NOUNCLA_VAL OF S4]] ) ---------------------------------------------------------------------------- -- public = | | ; nouncla = memoize Nouncla (parser (nt relnouncla S1 *> nt nounjoin S2 *> nt nouncla S3) [rule_s NOUNCLA_VAL OF LHS ISEQUALTO apply_middle2 [synthesized NOUNCLA_VAL OF S1, synthesized NOUNJOIN_VAL OF S2, synthesized NOUNCLA_VAL OF S3]] <|> parser (nt relnouncla S1 *> nt relpron S2 *> nt linkingvb S3 *> nt nouncla S4) --Does this make sense? Allows us to ask "which moon that was discovered by hall that is moon orbits mars" [rule_s NOUNCLA_VAL OF LHS ISEQUALTO apply_middle3 [synthesized NOUNCLA_VAL OF S1, synthesized RELPRON_VAL OF S2, synthesized NOUNCLA_VAL OF S4]] <|> parser (nt relnouncla S1) [rule_s NOUNCLA_VAL OF LHS ISEQUALTO copy [synthesized NOUNCLA_VAL OF S1]] ) ------------------------------------------------------------------------------ -- public = | ; adjs = memoize Adjs (parser (nt adj S1 *> nt adjs S2) [rule_s ADJ_VAL OF LHS ISEQUALTO intrsct2 [synthesized ADJ_VAL OF S1, synthesized ADJ_VAL OF S2]] <|> parser (nt adj S3) [rule_s ADJ_VAL OF LHS ISEQUALTO copy [synthesized ADJ_VAL OF S3]] ) ------------------------------------------------------------------------------ -- public = | ; detph = memoize Detph (parser (nt indefpron S3) [rule_s TERMPH_VAL OF LHS ISEQUALTO copy [synthesized TERMPH_VAL OF S3]] <|> parser (nt det S1 *> nt nouncla S2) [rule_s TERMPH_VAL OF LHS ISEQUALTO applydet [synthesized DET_VAL OF S1, synthesized NOUNCLA_VAL OF S2]] ) ---------------------------------------------------------------------------------- {- public = | | | | | ; -} transvbph = memoize Transvbph (parser (nt transvb S1) --"discovered" [rule_s VERBPH_VAL OF LHS ISEQUALTO applytransvb_no_tmph [synthesized VERB_VAL OF S1]] <|> parser (nt transvb S1 *> nt preps S2) --"discovered in..." [rule_s VERBPH_VAL OF LHS ISEQUALTO applytransvb_no_tmph [synthesized VERB_VAL OF S1, synthesized PREP_VAL OF S2]] <|> parser (nt transvb S1 *> nt jointermph S2) --"discovered phobos (and blah and blah and blah)" [rule_s VERBPH_VAL OF LHS ISEQUALTO applytransvbprep [synthesized VERB_VAL OF S1, synthesized TERMPH_VAL OF S2]] <|> parser (nt transvb S1 *> nt jointermph S2 *> nt preps S3) --"discovered phobos in..." [rule_s VERBPH_VAL OF LHS ISEQUALTO applytransvbprep [synthesized VERB_VAL OF S1, synthesized TERMPH_VAL OF S2, synthesized PREP_VAL OF S3]] <|> parser (nt linkingvb S1 *> nt transvb S2) --"was discovered" [rule_s VERBPH_VAL OF LHS ISEQUALTO drop3rdprep [synthesized LINKINGVB_VAL OF S1, synthesized VERB_VAL OF S2]] <|> parser (nt linkingvb S1 *> nt transvb S2 *> nt preps S3) --"was discovered by hall in..." [rule_s VERBPH_VAL OF LHS ISEQUALTO drop3rdprep [synthesized LINKINGVB_VAL OF S1, synthesized VERB_VAL OF S2, synthesized PREP_VAL OF S3]] <|> parser (nt linkingvb S1 *> nt jointermph S2 *> nt transvb S3) --"was phobos discovered" [rule_s VERBPH_VAL OF LHS ISEQUALTO apply_quest_transvb_passive [synthesized LINKINGVB_VAL OF S1, synthesized TERMPH_VAL OF S2, synthesized VERB_VAL OF S3]] <|> parser (nt linkingvb S1 *> nt jointermph S2 *> nt transvb S3 *> nt preps S4) --"was phobos discovered in..." [rule_s VERBPH_VAL OF LHS ISEQUALTO apply_quest_transvb_passive [synthesized LINKINGVB_VAL OF S1, synthesized TERMPH_VAL OF S2, synthesized VERB_VAL OF S3, synthesized PREP_VAL OF S4]] ) ---------------------------------------------------------------------------------- --NEW FOR PREPOSITIONAL PHRASES -- public = | ; preps = memoize Preps (parser (nt prepph S1) [rule_s PREP_VAL OF LHS ISEQUALTO applyprep [synthesized PREPPH_VAL OF S1]] <|> parser (nt prepph S1 *> nt preps S2) [rule_s PREP_VAL OF LHS ISEQUALTO applypreps [synthesized PREPPH_VAL OF S1, synthesized PREP_VAL OF S2]] ) -- public = ; prepph = memoize Prepph (parser (nt prep S1 *> nt jointermph S2) [rule_s PREPPH_VAL OF LHS ISEQUALTO applyprepph [synthesized PREPN_VAL OF S1, synthesized TERMPH_VAL OF S2]] ) ---------------------------------------------------------------------------------- -- public = | | ; verbph = memoize Verbph ( parser (nt transvbph S4) [rule_s VERBPH_VAL OF LHS ISEQUALTO copy [synthesized VERBPH_VAL OF S4]] <|> parser (nt intransvb S5) [rule_s VERBPH_VAL OF LHS ISEQUALTO copy [synthesized VERBPH_VAL OF S5]] <|> parser (nt linkingvb S1 *> nt det S2 *> nt nouncla S3) [rule_s VERBPH_VAL OF LHS ISEQUALTO applyvbph [synthesized NOUNCLA_VAL OF S3]] ) ------------------------------------------------------------------------------------ -- public = | | ; termph = memoize Termph ( parser (nt pnoun S1) [rule_s TERMPH_VAL OF LHS ISEQUALTO copy [synthesized TERMPH_VAL OF S1]] <|> parser (nt detph S2) [rule_s TERMPH_VAL OF LHS ISEQUALTO copy [synthesized TERMPH_VAL OF S2]] <|> parser (nt year S3) [rule_s TERMPH_VAL OF LHS ISEQUALTO applyyear [synthesized YEAR_VAL OF S3]] ) ------------------------------------------------------------------------------------ -- public = | ; jointermph = memoize Jointermph ( {- parser (nt jointermph S1 *> nt termphjoin S2 *> nt termph S3) [rule_s TERMPH_VAL OF LHS ISEQUALTO appjoin1 [synthesized TERMPH_VAL OF S1, synthesized TERMPHJOIN_VAL OF S2, synthesized TERMPH_VAL OF S3]] <|> -} parser (nt jointermph S1 *> nt termphjoin S2 *> nt jointermph S3) --"hall and galileo discovered...?" [rule_s TERMPH_VAL OF LHS ISEQUALTO appjoin1 [synthesized TERMPH_VAL OF S1, synthesized TERMPHJOIN_VAL OF S2, synthesized TERMPH_VAL OF S3]] <|> parser (nt termph S4) [rule_s TERMPH_VAL OF LHS ISEQUALTO copy [synthesized TERMPH_VAL OF S4]] ) ------------------------------------------------------------------------------------ -- public = | ; joinvbph = memoize Joinvbph ( parser (nt verbph S1 *> nt verbphjoin S2 *> nt joinvbph S3) [rule_s VERBPH_VAL OF LHS ISEQUALTO appjoin2 [synthesized VERBPH_VAL OF S1, synthesized VBPHJOIN_VAL OF S2, synthesized VERBPH_VAL OF S3]] <|> parser (nt verbph S4) [rule_s VERBPH_VAL OF LHS ISEQUALTO copy [synthesized VERBPH_VAL OF S4]] ) --------------------------------------------------------------------------- -- public = ; sent = memoize Sent ( parser (nt jointermph S1 *> nt joinvbph S2) [rule_s SENT_VAL OF LHS ISEQUALTO apply_termphrase [synthesized TERMPH_VAL OF S1, synthesized VERBPH_VAL OF S2]] ) -- **************************************************************************** -- -- public = ; two_sent = memoize Two_sent ( parser (nt sent S1 *> nt sentjoin S2 *> nt sent S3) [rule_s SENT_VAL OF LHS ISEQUALTO sent_val_comp [synthesized SENT_VAL OF S1, synthesized SENTJOIN_VAL OF S2, synthesized SENT_VAL OF S3]] ) ------------------------------------------------------------------------------------ {- public = | | | | | | | | | ; -} question = memoize Question ( parser (nt quest1 S1 *> nt sent S2 ) [rule_s QUEST_VAL OF LHS ISEQUALTO ans1 [synthesized QUEST1_VAL OF S1, synthesized SENT_VAL OF S2]] <|> parser (nt quest6 S1 *> nt quest1 S2 *> nt sent S3 ) [rule_s QUEST_VAL OF LHS ISEQUALTO ans5 [synthesized QUEST2_VAL OF S1, synthesized QUEST1_VAL OF S2, synthesized SENT_VAL OF S3]] <|> parser (nt quest5 S1 *> nt quest1 S2 *> nt sent S3 ) [rule_s QUEST_VAL OF LHS ISEQUALTO ans5 [synthesized QUEST2_VAL OF S1, synthesized QUEST1_VAL OF S2, synthesized SENT_VAL OF S3]] <|> parser (nt quest2 S1 *> nt joinvbph S2) [rule_s QUEST_VAL OF LHS ISEQUALTO ans2 [synthesized QUEST2_VAL OF S1, synthesized VERBPH_VAL OF S2]] <|> parser (nt quest5 S1 *> nt joinvbph S2) [rule_s QUEST_VAL OF LHS ISEQUALTO ans2 [synthesized QUEST2_VAL OF S1, synthesized VERBPH_VAL OF S2]] <|> parser (nt quest3 S1 *> nt nouncla S2 *> nt joinvbph S3) [rule_s QUEST_VAL OF LHS ISEQUALTO ans3 [synthesized QUEST3_VAL OF S1, synthesized NOUNCLA_VAL OF S2, synthesized VERBPH_VAL OF S3]] <|> parser (nt quest4 S1 *> nt nouncla S2 *> nt joinvbph S3) [rule_s QUEST_VAL OF LHS ISEQUALTO ans3 [synthesized QUEST3_VAL OF S1, synthesized NOUNCLA_VAL OF S2, synthesized VERBPH_VAL OF S3]] <|> parser (nt two_sent S1) [rule_s QUEST_VAL OF LHS ISEQUALTO truefalse [synthesized SENT_VAL OF S1]] <|> parser (nt sent S1) [rule_s QUEST_VAL OF LHS ISEQUALTO truefalse [synthesized SENT_VAL OF S1]] ) -- public = ; quest4 = memoize Quest4 ( parser (nt quest4a S1 *> nt quest4b S2) [rule_s QUEST3_VAL OF LHS ISEQUALTO copy [synthesized QUEST3_VAL OF S1]] ) --------------------------------------------------------------------------------- query = memoize Query ( parser (nt question S1) -- *> nt terminator S2) [rule_s QUEST_VAL OF LHS ISEQUALTO copy [synthesized QUEST_VAL OF S1]] ) {- || ----------------------------------------------------------------------------- || THE SEMANTICS - PART I : The attribute evaluation functions ||----------------------------------------------------------------------------- applyBiOp [e1,op,e2] = \atts -> VAL ((getAtts getB_OP atts op ) (getAtts getAVAL atts e1 ) (getAtts getAVAL atts e2)) -} -- getAtts f (y,i) x = f (head (x y i)) -- copy [b] = \(atts,i) -> head (b atts i) intrsct1 [x, y] = \atts -> NOUNCLA_VAL (liftM2 intersect_entevimages (getAtts getAVALS atts x) (getAtts getAVALS atts y)) intrsct2 [x, y] = \atts -> ADJ_VAL (liftM2 intersect_entevimages (getAtts getAVALS atts x) (getAtts getAVALS atts y)) applydet [x, y] = \atts -> TERMPH_VAL $ (getAtts getDVAL atts x) (getAtts getAVALS atts y) --make_trans_vb is very similar to make_relation. getBR must mean "get binary relation" --getTVAL must mean "get predicate" i.e. what would be "phobos" in "discover phobos" --Changed to get rid of make_trans_vb, since the getBR attribute was changed to not --be a binary relation but instead a function that make_relation would give --I.e., the kind of function that make_trans_vb would have generated, since they were --nearly identical --NEW FOR PREPOSITIONAL PHRASES applytransvbprep [x,y,z] atts = VERBPH_VAL $ make_filtered_relation dataStore reln ((["object"],predicate):preps) where reln = getAtts getBR atts x predicate = getAtts getTVAL atts y preps = getAtts getPREPVAL atts z applytransvbprep [x,y] atts = VERBPH_VAL $ make_filtered_relation dataStore reln [(["object"],predicate)] where reln = getAtts getBR atts x predicate = getAtts getTVAL atts y applytransvb_no_tmph [x,y] atts = VERBPH_VAL $ make_filtered_relation dataStore reln preps where reln = getAtts getBR atts x preps = getAtts getPREPVAL atts y applytransvb_no_tmph [x] atts = VERBPH_VAL $ make_filtered_relation dataStore reln [] where reln = getAtts getBR atts x --TODO: modify grammar so you can't ask "what was phobos discover", or if you can, make the answer sensible (e.g. hall, not phobos) apply_quest_transvb_passive (x2:x3:x4:xs) atts = VERBPH_VAL $ termph $ make_inverted_filtered_relation dataStore reln preps where linkingvb = getAtts getLINKVAL atts x2 termph = getAtts getTVAL atts x3 reln = getAtts getBR atts x4 preps = case xs of [] -> [] (x5:_) -> getAtts getPREPVAL atts x5 applyprepph [x, y] = \atts -> PREPPH_VAL $ let prep_names = getAtts getPREPNVAL atts x termph = getAtts getTVAL atts y in (prep_names, termph) applyprep [x] = \atts -> PREP_VAL $ [(getAtts getPREPPHVAL atts x)] --[(["with_implement"], a telescope)] applypreps [x, y] = \atts -> PREP_VAL $ (getAtts getPREPPHVAL atts x):(getAtts getPREPVAL atts y) applyyear [x] = \atts -> TERMPH_VAL $ make_pnoun $ show $ getAtts getYEARVAL atts x --END PREPOSITIONAL PHRASES applyvbph [z] = \atts -> VERBPH_VAL (getAtts getAVALS atts z) appjoin1 [x, y, z] = \atts -> TERMPH_VAL $ (getAtts getTJVAL atts y) (getAtts getTVAL atts x) (getAtts getTVAL atts z) appjoin2 [x, y, z] = \atts -> VERBPH_VAL ((getAtts getVJVAL atts y) (getAtts getAVALS atts x) (getAtts getAVALS atts z)) apply_middle1 [x, y, z] = \atts -> NOUNCLA_VAL ((getAtts getRELVAL atts y) (getAtts getAVALS atts x) (getAtts getAVALS atts z)) apply_middle2 [x, y, z] = \atts -> NOUNCLA_VAL ((getAtts getNJVAL atts y) (getAtts getAVALS atts x) (getAtts getAVALS atts z)) apply_middle3 [x, y, z] = \atts -> NOUNCLA_VAL ((getAtts getRELVAL atts y) (getAtts getAVALS atts x) (getAtts getAVALS atts z)) -- Think "a orbited by b" vs "b orbits a" {-drop3rd [w, x, y, z] = \atts -> VERBPH_VAL $ let reln = getAtts getBR atts x in let predicate = getAtts getTVAL atts z in make_inverted_relation dataStore reln predicate-} --NEW FOR PREPOSITIONAL PHRASES drop3rdprep (w:x:xs) atts = VERBPH_VAL $ make_inverted_filtered_relation dataStore reln preps where reln = getAtts getBR atts x preps = case xs of [] -> [] (p:ps) -> getAtts getPREPVAL atts p --END PREPOSITIONAL PHRASES apply_termphrase [x, y] = \atts -> SENT_VAL ((getAtts getTVAL atts x) (getAtts getAVALS atts y)) sent_val_comp [s1, f, s2] = \atts -> SENT_VAL ((getAtts getSJVAL atts f) (getAtts getSV atts s1) (getAtts getSV atts s2)) ans1 [x, y] = \atts -> QUEST_VAL ((getAtts getQU1VAL atts x) (getAtts getSV atts y) ) ans2 [x, y] = \atts -> QUEST_VAL ((getAtts getQU2VAL atts x) (getAtts getAVALS atts y)) ans3 [x, y, z] = \atts -> QUEST_VAL ((getAtts getQU3VAL atts x) (getAtts getAVALS atts y) (getAtts getAVALS atts z)) ans5 [x, y, z] = \atts -> QUEST_VAL ((getAtts getQU2VAL atts x) (getAtts getSV atts z)) truefalse [x] = \atts -> QUEST_VAL $ do bool <- (getAtts getSV atts x) return $ if bool /= [] then "true." else "false." {- ||----------------------------------------------------------------------------- || THE SEMANTICS - PART II : Functions used to obtain objects denoted by || proper nouns, verbs, etc. ||----------------------------------------------------------------------------- || FUNCTION USED TO DEFINE OBJECTS ASSOCIATED WITH PROPER NOUNS -} --test_wrt e s = e `elem` s -- FUNCTION USED TO DEFINE MEANINGS OF VERBS IN TERMS OF RELATIONS --make_trans_vb rel p = [x | (x, image_x) <- collect rel, p image_x] -- Similar to make_relation {- TERMINALS IN JSGF FORM = with | in | at | by; = discover | discovers | discovered | orbit | orbited | orbits; = anyone | anything | anybody | someone | something | somebody | everyone | everything | everybody; = where | when | how; = many; = and; = is | was | are | were; = and | or; = and | or; = which | what; = the | a | one | an | some | any | every | all | two; = and | or; = what; = exist | exists | spin | spins; -} dictionary = [ ("thing", Cnoun, [NOUNCLA_VAL $ get_members dataStore "thing"]), ("things", Cnoun, [NOUNCLA_VAL $ get_members dataStore "thing"]), ("planets", Cnoun, [NOUNCLA_VAL $ get_members dataStore "planet"]), ("planet", Cnoun, [NOUNCLA_VAL $ get_members dataStore "planet"]), ("person", Cnoun, [NOUNCLA_VAL $ get_members dataStore "person"]), ("sun", Cnoun, [NOUNCLA_VAL $ get_members dataStore "sun"]), ("moon", Cnoun, [NOUNCLA_VAL $ get_members dataStore "moon"]), ("moons", Cnoun, [NOUNCLA_VAL $ get_members dataStore "moon"]), ("satellite", Cnoun, [NOUNCLA_VAL $ get_members dataStore "moon"]), ("satellites", Cnoun, [NOUNCLA_VAL $ get_members dataStore "moon"]), ("atmospheric", Adj, [ADJ_VAL $ get_members dataStore "atmospheric"]), ("blue", Adj, [ADJ_VAL $ get_members dataStore "blue"]), ("solid", Adj, [ADJ_VAL $ get_members dataStore "solid"]), ("brown", Adj, [ADJ_VAL $ get_members dataStore "brown"]), ("gaseous", Adj, [ADJ_VAL $ get_members dataStore "gaseous"]), ("green", Adj, [ADJ_VAL $ get_members dataStore "green"]), ("red", Adj, [ADJ_VAL $ get_members dataStore "red"]), ("ringed", Adj, [ADJ_VAL $ get_members dataStore "ringed"]), ("vacuumous", Adj, [ADJ_VAL $ get_members dataStore "vacuumous"]), ("exist", Intransvb, [VERBPH_VAL $ get_members dataStore "thing"]), ("exists", Intransvb, [VERBPH_VAL $ get_members dataStore "thing"]), ("spin", Intransvb, [VERBPH_VAL $ get_members dataStore "spin"]), ("spins", Intransvb, [VERBPH_VAL $ get_members dataStore "spin"]), ("the", Det, [DET_VAL $ the]), ("a", Det, [DET_VAL $ a]), ("one", Det, [DET_VAL $ one]), ("an", Det, [DET_VAL $ a]), ("some", Det, [DET_VAL $ a]), ("any", Det, [DET_VAL $ a]), --("no", Det, [DET_VAL $ no]), ("every", Det, [DET_VAL $ every]), ("all", Det, [DET_VAL $ every]), ("two", Det, [DET_VAL $ two]), ("bernard", Pnoun, [TERMPH_VAL $ make_pnoun "bernard"]), ("bond", Pnoun, [TERMPH_VAL $ make_pnoun "bond"]), ("venus", Pnoun, [TERMPH_VAL $ make_pnoun "venus"]), ("cassini", Pnoun, [TERMPH_VAL $ make_pnoun "cassini"]), ("dollfus", Pnoun, [TERMPH_VAL $ make_pnoun "dollfus"]), --("fouuntain", Pnoun, [TERMPH_VAL $ make_pnoun "Fouuntain"]), ("galileo", Pnoun, [TERMPH_VAL $ make_pnoun "galileo"]), ("hall", Pnoun, [TERMPH_VAL $ make_pnoun "hall"]), ("herschel", Pnoun, [TERMPH_VAL $ make_pnoun "herschel"]), ("huygens", Pnoun, [TERMPH_VAL $ make_pnoun "huygens"]), ("kowal", Pnoun, [TERMPH_VAL $ make_pnoun "kowal"]), ("kuiper", Pnoun, [TERMPH_VAL $ make_pnoun "kuiper"]), ("larsen", Pnoun, [TERMPH_VAL $ make_pnoun "larsen"]), ("lassell", Pnoun, [TERMPH_VAL $ make_pnoun "lassell"]), ("melotte", Pnoun, [TERMPH_VAL $ make_pnoun "melotte"]), ("nicholson", Pnoun, [TERMPH_VAL $ make_pnoun "nicholson"]), ("perrine", Pnoun, [TERMPH_VAL $ make_pnoun "perrine"]), ("pickering", Pnoun, [TERMPH_VAL $ make_pnoun "pickering"]), ("almathea", Pnoun, [TERMPH_VAL $ make_pnoun "almathea"]), ("ariel", Pnoun, [TERMPH_VAL $ make_pnoun "ariel"]), ("callisto", Pnoun, [TERMPH_VAL $ make_pnoun "callisto"]), ("charon", Pnoun, [TERMPH_VAL $ make_pnoun "charon"]), ("deimos", Pnoun, [TERMPH_VAL $ make_pnoun "deimos"]), ("dione", Pnoun, [TERMPH_VAL $ make_pnoun "dione"]), ("earth", Pnoun, [TERMPH_VAL $ make_pnoun "earth"]), ("enceladus", Pnoun, [TERMPH_VAL $ make_pnoun "enceladus"]), ("europa", Pnoun, [TERMPH_VAL $ make_pnoun "europa"]), ("ganymede", Pnoun, [TERMPH_VAL $ make_pnoun "ganymede"]), ("hyperion", Pnoun, [TERMPH_VAL $ make_pnoun "hyperion"]), ("iapetus", Pnoun, [TERMPH_VAL $ make_pnoun "iapetus"]), ("io", Pnoun, [TERMPH_VAL $ make_pnoun "io"]), ("janus", Pnoun, [TERMPH_VAL $ make_pnoun "janus"]), ("jupiter", Pnoun, [TERMPH_VAL $ make_pnoun "jupiter"]), ("jupitereighth", Pnoun, [TERMPH_VAL $ make_pnoun "jupitereighth"]), ("jupitereleventh", Pnoun, [TERMPH_VAL $ make_pnoun "jupitereleventh"]), ("jupiterfourteenth", Pnoun, [TERMPH_VAL $ make_pnoun "jupiterfourteenth"]), ("jupiterninth", Pnoun, [TERMPH_VAL $ make_pnoun "jupiterninth"]), ("jupiterseventh", Pnoun, [TERMPH_VAL $ make_pnoun "jupiterseventh"]), ("jupitersixth", Pnoun, [TERMPH_VAL $ make_pnoun "jupitersixth"]), ("jupitertenth", Pnoun, [TERMPH_VAL $ make_pnoun "jupitertenth"]), ("jupiterthirteenth", Pnoun, [TERMPH_VAL $ make_pnoun "jupiterthirteenth"]), ("jupitertwelfth", Pnoun, [TERMPH_VAL $ make_pnoun "jupitertwelfth"]), ("luna", Pnoun, [TERMPH_VAL $ make_pnoun "luna"]), ("mars", Pnoun, [TERMPH_VAL $ make_pnoun "mars"]), ("mercury", Pnoun, [TERMPH_VAL $ make_pnoun "mercury"]), ("mimas", Pnoun, [TERMPH_VAL $ make_pnoun "mimas"]), ("miranda", Pnoun, [TERMPH_VAL $ make_pnoun "miranda"]), ("neptune", Pnoun, [TERMPH_VAL $ make_pnoun "neptune"]), ("nereid", Pnoun, [TERMPH_VAL $ make_pnoun "nereid"]), ("oberon", Pnoun, [TERMPH_VAL $ make_pnoun "oberon"]), ("phobos", Pnoun, [TERMPH_VAL $ make_pnoun "phobos"]), ("phoebe", Pnoun, [TERMPH_VAL $ make_pnoun "phoebe"]), ("pluto", Pnoun, [TERMPH_VAL $ make_pnoun "pluto"]), ("rhea", Pnoun, [TERMPH_VAL $ make_pnoun "rhea"]), ("saturn", Pnoun, [TERMPH_VAL $ make_pnoun "saturn"]), ("saturnfirst", Pnoun, [TERMPH_VAL $ make_pnoun "saturnfirst"]), ("sol", Pnoun, [TERMPH_VAL $ make_pnoun "sol"]), ("tethys", Pnoun, [TERMPH_VAL $ make_pnoun "tethys"]), ("titan", Pnoun, [TERMPH_VAL $ make_pnoun "titan"]), ("titania", Pnoun, [TERMPH_VAL $ make_pnoun "titania"]), ("triton", Pnoun, [TERMPH_VAL $ make_pnoun "triton"]), ("umbriel", Pnoun, [TERMPH_VAL $ make_pnoun "umbriel"]), ("uranus", Pnoun, [TERMPH_VAL $ make_pnoun "uranus"]), ("venus", Pnoun, [TERMPH_VAL $ make_pnoun "venus"]), ("discover", Transvb, [VERB_VAL ("discover_ev")]), ("discovers", Transvb, [VERB_VAL ("discover_ev")]), ("discovered", Transvb, [VERB_VAL ("discover_ev")]), ("orbit", Transvb, [VERB_VAL ("orbit_ev")]), ("orbited", Transvb, [VERB_VAL ("orbit_ev")]), ("orbits", Transvb, [VERB_VAL ("orbit_ev")]), ("is", Linkingvb, [LINKINGVB_VAL id]), ("was", Linkingvb, [LINKINGVB_VAL id]), ("are", Linkingvb, [LINKINGVB_VAL id]), ("were", Linkingvb, [LINKINGVB_VAL id]), ("that", Relpron, [RELPRON_VAL $ that]), ("who", Relpron, [RELPRON_VAL $ that]), ("which", Relpron, [RELPRON_VAL $ that]), ("and", Verbphjoin,[VBPHJOIN_VAL $ nounand]), ("or", Verbphjoin,[VBPHJOIN_VAL $ nounor]), ("and", Nounjoin, [NOUNJOIN_VAL $ nounand]), ("or", Nounjoin, [NOUNJOIN_VAL $ nounor]), ("and", Termphjoin,[TERMPHJOIN_VAL termand]), ("or", Termphjoin,[TERMPHJOIN_VAL termor]), ("and", Sentjoin, [SENTJOIN_VAL $ sand]), ("does", Quest1, [QUEST1_VAL $ yesno]), ("did", Quest1 , [QUEST1_VAL $ yesno]), ("do", Quest1, [QUEST1_VAL $ yesno]), ("is", Quest1, [QUEST1_VAL $ yesno]), ("was", Quest1, [QUEST1_VAL $ yesno]), ("are", Quest1, [QUEST1_VAL $ yesno]), ("were", Quest1, [QUEST1_VAL $ yesno]), ("what", Quest2, [QUEST2_VAL $ what]), ("who", Quest2, [QUEST2_VAL $ who]), ("what", Quest6, [QUEST2_VAL $ whatobj]), ("where", Quest5, [QUEST2_VAL $ where']), ("when", Quest5, [QUEST2_VAL $ when']), ("how", Quest5, [QUEST2_VAL $ how']), ("which", Quest3, [QUEST3_VAL which]), ("what", Quest3, [QUEST3_VAL which]), ("how", Quest4a, [QUEST3_VAL $ how_many]), ("many", Quest4b, [QUEST3_VAL $ how_many]), ("human", Cnoun, meaning_of nouncla "person" Nouncla), ("discoverer", Cnoun, [NOUNCLA_VAL $ get_subjs_of_event_type dataStore "discover_ev"]), ("discoverers", Cnoun, [NOUNCLA_VAL $ get_subjs_of_event_type dataStore "discover_ev"]), ("humans", Cnoun, meaning_of nouncla "person" Nouncla), ("people", Cnoun, meaning_of nouncla "person" Nouncla), --("orbit", Intransvb, [VERBPH_VAL $ get_subjs_of_event_type dataStore "orbit_ev"]), --("orbits", Intransvb, [VERBPH_VAL $ get_subjs_of_event_type dataStore "orbit_ev"]), ("anyone", Indefpron,meaning_of detph "a person" Detph), ("anything", Indefpron,meaning_of detph "a thing" Detph), ("anybody", Indefpron,meaning_of detph "a person" Detph), ("someone", Indefpron,meaning_of detph "a person" Detph), ("something", Indefpron,meaning_of detph "a thing" Detph), ("somebody", Indefpron,meaning_of detph "a person" Detph), ("everyone", Indefpron,meaning_of detph "every person" Detph), ("everything", Indefpron,meaning_of detph "every thing" Detph), ("everybody", Indefpron,meaning_of detph "every person" Detph), --("nobody", Indefpron,meaning_of detph "no person" Detph), --("noone", Indefpron,meaning_of detph "no person" Detph), --Begin prepositional stuff-- ("with", Prepn, [PREPN_VAL ["with_implement"]]), ("in", Prepn, [PREPN_VAL ["location","year"]]), ("at", Prepn, [PREPN_VAL ["location"]]), ("by", Prepn, [PREPN_VAL ["subject"]]), --Begin telescope stuff-- ("telescope", Cnoun, [NOUNCLA_VAL $ get_members dataStore "telescope"]), ("telescopes", Cnoun, [NOUNCLA_VAL $ get_members dataStore "telescope"]), ("cassegrain_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "cassegrain_telescope"]), ("hooker_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "hooker_telescope"]), ("schmidt_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "schmidt_telescope"]), ("subaru_reflector_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "subaru_reflector_telescope"]), ("canada-france-hawaii_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "canada-france-hawaii_telescope"]), ("aerial_telescope_1", Pnoun,[TERMPH_VAL $ make_pnoun "aerial_telescope_1"]), ("bruce_astrograph", Pnoun,[TERMPH_VAL $ make_pnoun "bruce_astrograph"]), ("telescope_1", Pnoun,[TERMPH_VAL $ make_pnoun "telescope_1"]), ("hale_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "hale_telescope"]), ("hubble_space_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "hubble_space_telescope"]), ("blanco_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "blanco_telescope"]), ("crossley_reflector_telescope", Pnoun,[TERMPH_VAL $ make_pnoun "crossley_reflector_telescope"]), ("refractor_telescope_1", Pnoun,[TERMPH_VAL $ make_pnoun "refractor_telescope_1"]), ("refractor_telescope_2", Pnoun,[TERMPH_VAL $ make_pnoun "refractor_telescope_2"]), ("refractor_telescope_3", Pnoun,[TERMPH_VAL $ make_pnoun "refractor_telescope_3"]), ("refractor_telescope_4", Pnoun,[TERMPH_VAL $ make_pnoun "refractor_telescope_4"]), ("reflector_telescope_1", Pnoun,[TERMPH_VAL $ make_pnoun "reflector_telescope_1"]), ("reflector_telescope_2", Pnoun,[TERMPH_VAL $ make_pnoun "reflector_telescope_2"]), ("reflector_telescope_3", Pnoun,[TERMPH_VAL $ make_pnoun "reflector_telescope_3"]), ("reflector_telescope_4", Pnoun,[TERMPH_VAL $ make_pnoun "reflector_telescope_4"]), ("ground_based_telescope_1", Pnoun,[TERMPH_VAL $ make_pnoun "ground_based_telescope_1"]), ("ground_based_telescope_2", Pnoun,[TERMPH_VAL $ make_pnoun "ground_based_telescope_2"]), ("ground_based_telescope_3", Pnoun,[TERMPH_VAL $ make_pnoun "ground_based_telescope_3"]), ("galilean_telescope_1", Pnoun,[TERMPH_VAL $ make_pnoun "galilean_telescope_1"]), --Begin science team stuff ("team", Cnoun, [NOUNCLA_VAL $ get_members dataStore "science_team"]), ("teams", Cnoun, [NOUNCLA_VAL $ get_members dataStore "science_team"]), ("voyager_science_team", Pnoun,[TERMPH_VAL $ make_pnoun "voyager_science_team"]), ("cassini_imaging_science_team", Pnoun,[TERMPH_VAL $ make_pnoun "cassini_imaging_science_team"]), ("science_team_1", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_1"]), ("science_team_2", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_2"]), ("science_team_3", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_3"]), ("science_team_4", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_4"]), ("science_team_5", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_5"]), ("science_team_6", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_6"]), ("science_team_7", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_7"]), ("science_team_8", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_8"]), ("science_team_9", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_9"]), ("science_team_10", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_10"]), ("science_team_11", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_11"]), ("science_team_12", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_12"]), ("science_team_13", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_13"]), ("science_team_14", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_14"]), ("science_team_15", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_15"]), ("science_team_16", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_16"]), ("science_team_17", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_17"]), ("science_team_18", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_18"]), ("science_team_19", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_19"]), ("science_team_20", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_20"]), ("science_team_21", Pnoun,[TERMPH_VAL $ make_pnoun "science_team_21"]), --Begin new people stuff-- ("larson", Pnoun, [TERMPH_VAL $ make_pnoun "larson"]), ("fountain", Pnoun, [TERMPH_VAL $ make_pnoun "fountain"]), ("scotti", Pnoun, [TERMPH_VAL $ make_pnoun "scotti"]), ("spahr", Pnoun, [TERMPH_VAL $ make_pnoun "spahr"]), ("mcmillan", Pnoun, [TERMPH_VAL $ make_pnoun "mcmillan"]), ("montani", Pnoun, [TERMPH_VAL $ make_pnoun "montani"]), ("gleason", Pnoun, [TERMPH_VAL $ make_pnoun "gleason"]), ("gehrels", Pnoun, [TERMPH_VAL $ make_pnoun "gehrels"]), ("roemer", Pnoun, [TERMPH_VAL $ make_pnoun "roemer"]), ("sheppard", Pnoun, [TERMPH_VAL $ make_pnoun "sheppard"]), ("jewitt", Pnoun, [TERMPH_VAL $ make_pnoun "jewitt"]), ("fernandez", Pnoun, [TERMPH_VAL $ make_pnoun "fernandez"]), ("magnier", Pnoun, [TERMPH_VAL $ make_pnoun "magnier"]), ("kleyna", Pnoun, [TERMPH_VAL $ make_pnoun "kleyna"]), ("gladman", Pnoun, [TERMPH_VAL $ make_pnoun "gladman"]), ("kavelaars", Pnoun, [TERMPH_VAL $ make_pnoun "kavelaars"]), ("petit", Pnoun, [TERMPH_VAL $ make_pnoun "petit"]), ("allen", Pnoun, [TERMPH_VAL $ make_pnoun "allen"]), ("laques", Pnoun, [TERMPH_VAL $ make_pnoun "laques"]), ("lecacheux", Pnoun, [TERMPH_VAL $ make_pnoun "lecacheux"]), ("smith", Pnoun, [TERMPH_VAL $ make_pnoun "smith"]), ("reitsema", Pnoun, [TERMPH_VAL $ make_pnoun "reitsema"]), ("pascu", Pnoun, [TERMPH_VAL $ make_pnoun "pascu"]), ("seidelmann", Pnoun, [TERMPH_VAL $ make_pnoun "seidelmann"]), ("baum", Pnoun, [TERMPH_VAL $ make_pnoun "baum"]), ("currie", Pnoun, [TERMPH_VAL $ make_pnoun "currie"]), ("showalter", Pnoun, [TERMPH_VAL $ make_pnoun "showalter"]), ("scholl", Pnoun, [TERMPH_VAL $ make_pnoun "scholl"]), ("holman", Pnoun, [TERMPH_VAL $ make_pnoun "holman"]), ("marsden", Pnoun, [TERMPH_VAL $ make_pnoun "marsden"]), ("burns", Pnoun, [TERMPH_VAL $ make_pnoun "burns"]), ("milisavljevic", Pnoun, [TERMPH_VAL $ make_pnoun "milisavljevic"]), ("grav", Pnoun, [TERMPH_VAL $ make_pnoun "grav"]), ("karkoschka", Pnoun, [TERMPH_VAL $ make_pnoun "karkoschka"]), ("lissauer", Pnoun, [TERMPH_VAL $ make_pnoun "lissauer"]), ("fraser", Pnoun, [TERMPH_VAL $ make_pnoun "fraser"]), ("christy", Pnoun, [TERMPH_VAL $ make_pnoun "christy"]), ("weaver", Pnoun, [TERMPH_VAL $ make_pnoun "weaver"]), ("stern", Pnoun, [TERMPH_VAL $ make_pnoun "stern"]), ("mutchler", Pnoun, [TERMPH_VAL $ make_pnoun "mutchler"]), ("steffl", Pnoun, [TERMPH_VAL $ make_pnoun "steffl"]), ("buie", Pnoun, [TERMPH_VAL $ make_pnoun "buie"]), ("merline", Pnoun, [TERMPH_VAL $ make_pnoun "merline"]), ("spencer", Pnoun, [TERMPH_VAL $ make_pnoun "spencer"]), ("young_e_f", Pnoun, [TERMPH_VAL $ make_pnoun "young_e_f"]), ("young_l_a", Pnoun, [TERMPH_VAL $ make_pnoun "young_l_a"]), ("hamilton", Pnoun, [TERMPH_VAL $ make_pnoun "hamilton"]), ("soummer", Pnoun, [TERMPH_VAL $ make_pnoun "soummer"]), ("throop", Pnoun, [TERMPH_VAL $ make_pnoun "throop"]), --Begin new spacecraft stuff-- ("spacecraft", Cnoun, [NOUNCLA_VAL $ get_members dataStore "spacecraft"]), ("spacecrafts", Cnoun, [NOUNCLA_VAL $ get_members dataStore "spacecraft"]), ("voyager_1", Pnoun, [TERMPH_VAL $ make_pnoun "voyager_1"]), ("voyager_2", Pnoun, [TERMPH_VAL $ make_pnoun "voyager_2"]), ("cassini", Pnoun, [TERMPH_VAL $ make_pnoun "voyager_2"]), --Begin new places stuff-- ("place", Cnoun, [NOUNCLA_VAL $ get_members dataStore "place"]), ("places", Cnoun, [NOUNCLA_VAL $ get_members dataStore "place"]), ("mt_hopkins", Pnoun, [TERMPH_VAL $ make_pnoun "mt_hopkins"]), ("fort_davis", Pnoun, [TERMPH_VAL $ make_pnoun "fort_davis"]), ("cerro_tololo", Pnoun, [TERMPH_VAL $ make_pnoun "cerro_tololo"]), ("us_naval_observatory", Pnoun, [TERMPH_VAL $ make_pnoun "us_naval_observatory"]), ("padua", Pnoun, [TERMPH_VAL $ make_pnoun "padua"]), ("mt_hamilton", Pnoun, [TERMPH_VAL $ make_pnoun "mt_hamilton"]), ("greenwich", Pnoun, [TERMPH_VAL $ make_pnoun "greenwich"]), ("mt_wilson", Pnoun, [TERMPH_VAL $ make_pnoun "mt_wilson"]), ("mt_palomar", Pnoun, [TERMPH_VAL $ make_pnoun "mt_palomar"]), ("kitt_peak", Pnoun, [TERMPH_VAL $ make_pnoun "kitt_peak"]), ("mauna_kea", Pnoun, [TERMPH_VAL $ make_pnoun "mauna_kea"]), ("slough", Pnoun, [TERMPH_VAL $ make_pnoun "slough"]), ("paris", Pnoun, [TERMPH_VAL $ make_pnoun "paris"]), ("the_hague", Pnoun, [TERMPH_VAL $ make_pnoun "the_hague"]), ("cambridge", Pnoun, [TERMPH_VAL $ make_pnoun "cambridge"]), ("liverpool", Pnoun, [TERMPH_VAL $ make_pnoun "liverpool"]), ("arequipa", Pnoun, [TERMPH_VAL $ make_pnoun "arequipa"]), ("pic_du_midi", Pnoun, [TERMPH_VAL $ make_pnoun "pic_du_midi"]), ("flagstaff", Pnoun, [TERMPH_VAL $ make_pnoun "flagstaff"]), ("la_silla", Pnoun, [TERMPH_VAL $ make_pnoun "la_silla"]), --Begin new moons stuff-- ("himalia", Pnoun, [TERMPH_VAL $ make_pnoun "himalia"]), ("elara", Pnoun, [TERMPH_VAL $ make_pnoun "elara"]), ("pasiphae", Pnoun, [TERMPH_VAL $ make_pnoun "pasiphae"]), ("sinope", Pnoun, [TERMPH_VAL $ make_pnoun "sinope"]), ("lysithea", Pnoun, [TERMPH_VAL $ make_pnoun "lysithea"]), ("carme", Pnoun, [TERMPH_VAL $ make_pnoun "carme"]), ("ananke", Pnoun, [TERMPH_VAL $ make_pnoun "ananke"]), ("leda", Pnoun, [TERMPH_VAL $ make_pnoun "leda"]), ("thebe", Pnoun, [TERMPH_VAL $ make_pnoun "thebe"]), ("adrastea", Pnoun, [TERMPH_VAL $ make_pnoun "adrastea"]), ("metis", Pnoun, [TERMPH_VAL $ make_pnoun "metis"]), ("callirrhoe", Pnoun, [TERMPH_VAL $ make_pnoun "callirrhoe"]), ("themisto", Pnoun, [TERMPH_VAL $ make_pnoun "themisto"]), ("megaclite", Pnoun, [TERMPH_VAL $ make_pnoun "megaclite"]), ("taygete", Pnoun, [TERMPH_VAL $ make_pnoun "taygete"]), ("chaldene", Pnoun, [TERMPH_VAL $ make_pnoun "chaldene"]), ("harpalyke", Pnoun, [TERMPH_VAL $ make_pnoun "harpalyke"]), ("kalyke", Pnoun, [TERMPH_VAL $ make_pnoun "kalyke"]), ("iocaste", Pnoun, [TERMPH_VAL $ make_pnoun "iocaste"]), ("erinome", Pnoun, [TERMPH_VAL $ make_pnoun "erinome"]), ("isonoe", Pnoun, [TERMPH_VAL $ make_pnoun "isonoe"]), ("praxidike", Pnoun, [TERMPH_VAL $ make_pnoun "praxidike"]), ("autonoe", Pnoun, [TERMPH_VAL $ make_pnoun "autonoe"]), ("thyone", Pnoun, [TERMPH_VAL $ make_pnoun "thyone"]), ("hermippe", Pnoun, [TERMPH_VAL $ make_pnoun "hermippe"]), ("aitne", Pnoun, [TERMPH_VAL $ make_pnoun "aitne"]), ("eurydome", Pnoun, [TERMPH_VAL $ make_pnoun "eurydome"]), ("euanthe", Pnoun, [TERMPH_VAL $ make_pnoun "euanthe"]), ("euporie", Pnoun, [TERMPH_VAL $ make_pnoun "euporie"]), ("orthosie", Pnoun, [TERMPH_VAL $ make_pnoun "orthosie"]), ("sponde", Pnoun, [TERMPH_VAL $ make_pnoun "sponde"]), ("kale", Pnoun, [TERMPH_VAL $ make_pnoun "kale"]), ("pasithee", Pnoun, [TERMPH_VAL $ make_pnoun "pasithee"]), ("hegemone", Pnoun, [TERMPH_VAL $ make_pnoun "hegemone"]), ("mneme", Pnoun, [TERMPH_VAL $ make_pnoun "mneme"]), ("aoede", Pnoun, [TERMPH_VAL $ make_pnoun "aoede"]), ("thelxinoe", Pnoun, [TERMPH_VAL $ make_pnoun "thelxinoe"]), ("arche", Pnoun, [TERMPH_VAL $ make_pnoun "arche"]), ("kallichore", Pnoun, [TERMPH_VAL $ make_pnoun "kallichore"]), ("helike", Pnoun, [TERMPH_VAL $ make_pnoun "helike"]), ("carpo", Pnoun, [TERMPH_VAL $ make_pnoun "carpo"]), ("eukelade", Pnoun, [TERMPH_VAL $ make_pnoun "eukelade"]), ("cyllene", Pnoun, [TERMPH_VAL $ make_pnoun "cyllene"]), ("kore", Pnoun, [TERMPH_VAL $ make_pnoun "kore"]), ("herse", Pnoun, [TERMPH_VAL $ make_pnoun "herse"]), ("epimetheus", Pnoun, [TERMPH_VAL $ make_pnoun "epimetheus"]), ("helene", Pnoun, [TERMPH_VAL $ make_pnoun "helene"]), ("telesto", Pnoun, [TERMPH_VAL $ make_pnoun "telesto"]), ("calypso", Pnoun, [TERMPH_VAL $ make_pnoun "calypso"]), ("atlas", Pnoun, [TERMPH_VAL $ make_pnoun "atlas"]), ("prometheus", Pnoun, [TERMPH_VAL $ make_pnoun "prometheus"]), ("pandora", Pnoun, [TERMPH_VAL $ make_pnoun "pandora"]), ("pan", Pnoun, [TERMPH_VAL $ make_pnoun "pan"]), ("ymir", Pnoun, [TERMPH_VAL $ make_pnoun "ymir"]), ("paaliaq", Pnoun, [TERMPH_VAL $ make_pnoun "paaliaq"]), ("tarvos", Pnoun, [TERMPH_VAL $ make_pnoun "tarvos"]), ("ijiraq", Pnoun, [TERMPH_VAL $ make_pnoun "ijiraq"]), ("suttungr", Pnoun, [TERMPH_VAL $ make_pnoun "suttungr"]), ("kiviuq", Pnoun, [TERMPH_VAL $ make_pnoun "kiviuq"]), ("mundilfari", Pnoun, [TERMPH_VAL $ make_pnoun "mundilfari"]), ("albiorix", Pnoun, [TERMPH_VAL $ make_pnoun "albiorix"]), ("skathi", Pnoun, [TERMPH_VAL $ make_pnoun "skathi"]), ("erriapus", Pnoun, [TERMPH_VAL $ make_pnoun "erriapus"]), ("siarnaq", Pnoun, [TERMPH_VAL $ make_pnoun "siarnaq"]), ("thrymr", Pnoun, [TERMPH_VAL $ make_pnoun "thrymr"]), ("narvi", Pnoun, [TERMPH_VAL $ make_pnoun "narvi"]), ("methone", Pnoun, [TERMPH_VAL $ make_pnoun "methone"]), ("pallene", Pnoun, [TERMPH_VAL $ make_pnoun "pallene"]), ("polydeuces", Pnoun, [TERMPH_VAL $ make_pnoun "polydeuces"]), ("daphnis", Pnoun, [TERMPH_VAL $ make_pnoun "daphnis"]), ("aegir", Pnoun, [TERMPH_VAL $ make_pnoun "aegir"]), ("bebhionn", Pnoun, [TERMPH_VAL $ make_pnoun "bebhionn"]), ("bergelmir", Pnoun, [TERMPH_VAL $ make_pnoun "bergelmir"]), ("bestla", Pnoun, [TERMPH_VAL $ make_pnoun "bestla"]), ("farbauti", Pnoun, [TERMPH_VAL $ make_pnoun "farbauti"]), ("fenrir", Pnoun, [TERMPH_VAL $ make_pnoun "fenrir"]), ("fornjot", Pnoun, [TERMPH_VAL $ make_pnoun "fornjot"]), ("hati", Pnoun, [TERMPH_VAL $ make_pnoun "hati"]), ("hyrrokkin", Pnoun, [TERMPH_VAL $ make_pnoun "hyrrokkin"]), ("kari", Pnoun, [TERMPH_VAL $ make_pnoun "kari"]), ("loge", Pnoun, [TERMPH_VAL $ make_pnoun "loge"]), ("skoll", Pnoun, [TERMPH_VAL $ make_pnoun "skoll"]), ("surtur", Pnoun, [TERMPH_VAL $ make_pnoun "surtur"]), ("anthe", Pnoun, [TERMPH_VAL $ make_pnoun "anthe"]), ("jarnsaxa", Pnoun, [TERMPH_VAL $ make_pnoun "jarnsaxa"]), ("greip", Pnoun, [TERMPH_VAL $ make_pnoun "greip"]), ("tarqeq", Pnoun, [TERMPH_VAL $ make_pnoun "tarqeq"]), ("aegaeon", Pnoun, [TERMPH_VAL $ make_pnoun "aegaeon"]), ("cordelia", Pnoun, [TERMPH_VAL $ make_pnoun "cordelia"]), ("ophelia", Pnoun, [TERMPH_VAL $ make_pnoun "ophelia"]), ("bianca", Pnoun, [TERMPH_VAL $ make_pnoun "bianca"]), ("cressida", Pnoun, [TERMPH_VAL $ make_pnoun "cressida"]), ("desdemona", Pnoun, [TERMPH_VAL $ make_pnoun "desdemona"]), ("juliet", Pnoun, [TERMPH_VAL $ make_pnoun "juliet"]), ("portia", Pnoun, [TERMPH_VAL $ make_pnoun "portia"]), ("rosalind", Pnoun, [TERMPH_VAL $ make_pnoun "rosalind"]), ("belinda", Pnoun, [TERMPH_VAL $ make_pnoun "belinda"]), ("puck", Pnoun, [TERMPH_VAL $ make_pnoun "puck"]), ("caliban", Pnoun, [TERMPH_VAL $ make_pnoun "caliban"]), ("sycorax", Pnoun, [TERMPH_VAL $ make_pnoun "sycorax"]), ("prospero", Pnoun, [TERMPH_VAL $ make_pnoun "prospero"]), ("setebos", Pnoun, [TERMPH_VAL $ make_pnoun "setebos"]), ("stephano", Pnoun, [TERMPH_VAL $ make_pnoun "stephano"]), ("trinculo", Pnoun, [TERMPH_VAL $ make_pnoun "trinculo"]), ("francisco", Pnoun, [TERMPH_VAL $ make_pnoun "francisco"]), ("margaret", Pnoun, [TERMPH_VAL $ make_pnoun "margaret"]), ("ferdinand", Pnoun, [TERMPH_VAL $ make_pnoun "ferdinand"]), ("perdita", Pnoun, [TERMPH_VAL $ make_pnoun "perdita"]), ("mab", Pnoun, [TERMPH_VAL $ make_pnoun "mab"]), ("cupid", Pnoun, [TERMPH_VAL $ make_pnoun "cupid"]), ("triton", Pnoun, [TERMPH_VAL $ make_pnoun "triton"]), ("naiad", Pnoun, [TERMPH_VAL $ make_pnoun "naiad"]), ("thalassa", Pnoun, [TERMPH_VAL $ make_pnoun "thalassa"]), ("despina", Pnoun, [TERMPH_VAL $ make_pnoun "despina"]), ("galatea", Pnoun, [TERMPH_VAL $ make_pnoun "galatea"]), ("larissa", Pnoun, [TERMPH_VAL $ make_pnoun "larissa"]), ("proteus", Pnoun, [TERMPH_VAL $ make_pnoun "proteus"]), ("halimede", Pnoun, [TERMPH_VAL $ make_pnoun "halimede"]), ("psamathe", Pnoun, [TERMPH_VAL $ make_pnoun "psamathe"]), ("sao", Pnoun, [TERMPH_VAL $ make_pnoun "sao"]), ("laomedeia", Pnoun, [TERMPH_VAL $ make_pnoun "laomedeia"]), ("neso", Pnoun, [TERMPH_VAL $ make_pnoun "neso"]), ("nix", Pnoun, [TERMPH_VAL $ make_pnoun "nix"]), ("hydra", Pnoun, [TERMPH_VAL $ make_pnoun "hydra"]), ("kerberos", Pnoun, [TERMPH_VAL $ make_pnoun "kerberos"]), ("styx", Pnoun, [TERMPH_VAL $ make_pnoun "styx"]) ] ++ list_of_years {-Major hack: Since the basic unit that the parser understands is strings (not characters), we have to manually add all years that we can query into the dictionary... That is, we can't make the parser understand "1984" and "1245" by having it recognize four numbers, instead it must recognize the entire string of numbers at once as a terminal (i.e., "1984" would be a terminal, not a non-terminal composed of "1", "9", "8", and "4"). Therefore, all possible strings must be added to the dictionary so that the parser can match them. **this might need to be altered** -} list_of_years = map (\n -> (show n, Year, [YEAR_VAL n])) $ concat [[1000 + x, 2000 + x] | x <- [0..999]] --test1 p p_ inp = do putStr $ render80 $ format{-Atts p_-} $ snd $ unState (p T0 [] ((1,[]),words inp) ([],[])) [] test p input = unState (p ((1,[]),input) ([],[])) [] parse i = formatAttsFinalAlt Question ((length (words i))+1) $ snd $ test (question T0 []) (words i) findStart st ((s,ss):rest) | s == st = [(s,ss)] | otherwise = findStart st rest findStart st [] = [] input = words i1 i1 = "which moons that were discovered by hall orbit mars" -- OK i2 = "who discovered a moon that orbits mars" -- OK i3 = "did hall discover every moon that orbits mars" -- OK i4 = "how many moons were discovered by hall and kuiper" -- OK i5 = "how many moons were discovered by hall or kuiper" -- OK i6 = "every moon was discovered by a person" -- OK i7 = "which planets are orbited by a moon that was discovered by galileo" -- OK i8 = "which moons were discovered by nobody" -- OK i9 = "is every planet orbited by a moon" -- Broken in original too i10 = "which planets are orbited by two moons" -- OK i11 = "who was the discoverer of phobos" -- Broken in original too i12 = "hall discovered a moon that orbits mars" -- OK i13 = "which moons that orbit mars were discovered by hall" -- OK i14 = "every moon orbits every planet" -- OK i15 = "every planet is orbited by a moon" -- OK i16 = "a planet is orbited by a moon" -- OK i17 = "does phobos orbit mars" -- OK -- i18 = "did hall discover deimos or phobos and miranda" -- Broken in original too i19 = "did hall discover deimos or phobos and miranda or deimos and deimos" -- Broken in original too