XSaiga 1.4.0.0 → 1.4.0.1
raw patch · 3 files changed
+63/−25 lines, 3 files
Files
- XSaiga.cabal +1/−1
- XSaiga/Getts.hs +58/−20
- XSaiga/SolarmanTriplestore.hs +4/−4
XSaiga.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: XSaiga -version: 1.4.0.0 +version: 1.4.0.1 synopsis: An implementation of a polynomial-time top-down parser suitable for NLP -- description: homepage: http://hafiz.myweb.cs.uwindsor.ca/proHome.html
XSaiga/Getts.hs view
@@ -3,16 +3,22 @@ {-# LANGUAGE NoMonomorphismRestriction #-} module XSaiga.Getts where-import Data.List+import Data.List as List import Control.Monad import Debug.Trace +--For slow collect+import qualified Data.Map.Strict as Map+ --For endpoint query import Data.RDF hiding (triple, Triple) import Database.HSparql.Connection import Database.HSparql.QueryGenerator import Data.Text hiding (head, concat, map, zip, drop, length) +--For caching name lookup+import qualified Network.Socket as Net+ import qualified Data.Map as M import Data.IORef import System.IO.Unsafe@@ -38,7 +44,7 @@ pairs <- liftM concat $ mapM (\ev -> do ents <- getts_3 ev_data (ev, entity_type,"?") return $ zip ents (repeat ev)) evs- return $ condense $ sortFirst pairs+ return $ collect pairs --getts_members returns getts_members :: m -> String -> IO Image@@ -61,7 +67,24 @@ getts_3 ev_data (a, b, "?") = return [z | (x,y,z) <- ev_data, a == x, b == y] data SPARQLBackend = SPARQL String String deriving (Ord, Eq)- ++endpointTable :: IORef (M.Map String String)+{-# NOINLINE endpointTable #-}+endpointTable = unsafePerformIO $ newIORef M.empty++lookupEndpoint :: String -> IO String+lookupEndpoint url = do+ m <- readIORef endpointTable+ case M.lookup (url) m of+ Nothing -> Net.getAddrInfo Nothing (Just $ getServer url) (Just "http") >>=+ \x -> (writeIORef endpointTable (M.insert url (newURL (showAddress x) (getURLPath url)) m) >> return (newURL (showAddress x) (getURLPath url)))+ Just res -> return res+ where+ getServer = List.takeWhile (\x -> '/' /= x) . drop 7+ showAddress = show . Net.addrAddress . head+ getURLPath xs = drop (7 + (length $ getServer xs)) xs+ newURL server path = "http://" ++ server ++ path+ --the String in this instance is to be the endpoint that you wish to query instance TripleStore SPARQLBackend where --getts_1 = getts_1''@@ -71,7 +94,8 @@ where getts_1' :: (t, Text, Text) -> IO [[BindingValue]] getts_1' (a, b, c) = do- (Just s) <- selectQuery endpoint getts_1_query+ resolvedEndpoint <- lookupEndpoint endpoint+ (Just s) <- selectQuery resolvedEndpoint getts_1_query return s where getts_1_query = do @@ -86,7 +110,8 @@ where getts_2' :: (Text, Text, Text) -> IO [[BindingValue]] getts_2' (a, b, c) = do- (Just s) <- selectQuery endpoint getts_2_query + resolvedEndpoint <- lookupEndpoint endpoint+ (Just s) <- selectQuery resolvedEndpoint getts_2_query return s where getts_2_query = do @@ -101,7 +126,8 @@ where getts_3' :: (Text, Text, Text) -> IO [[BindingValue]] getts_3' (a, b, c) = do- (Just s) <- selectQuery endpoint getts_3_query + resolvedEndpoint <- lookupEndpoint endpoint+ (Just s) <- selectQuery resolvedEndpoint getts_3_query return s where getts_3_query = do @@ -113,7 +139,8 @@ getts_image = memoIO''' getts_image''' where getts_image''' (SPARQL endpoint namespace_uri) ev_type en_type = do- m <- selectQuery endpoint query+ resolvedEndpoint <- lookupEndpoint endpoint+ m <- selectQuery resolvedEndpoint query case m of (Just res) -> return $ condense $ map (\[x, y] -> (removeUri namespace_uri $ deconstruct x, removeUri namespace_uri $ deconstruct y)) res Nothing -> return []@@ -133,7 +160,8 @@ getts_inverse = memoIO'' getts_inverse'' where getts_inverse'' (SPARQL endpoint namespace_uri) en_type evs = do- m <- selectQuery endpoint query+ resolvedEndpoint <- lookupEndpoint endpoint+ m <- selectQuery resolvedEndpoint query case m of (Just res) -> return $ condense $ map (\[x, y] -> (removeUri namespace_uri $ deconstruct x, removeUri namespace_uri $ deconstruct y)) res Nothing -> return []@@ -143,8 +171,9 @@ subj <- var ev <- var triple ev (sol .:. (pack en_type)) subj- filterExpr $ regex ev $ (pack $ Data.List.intercalate "|" (map (++ "$") evs))+ filterExpr $ regex ev $ (pack $ List.intercalate "|" (map (++ "$") evs)) --Data.List.foldr1 Database.HSparql.QueryGenerator.union $ map (\ev -> triple (sol .:. pack(ev)) (sol .:. pack("subject")) subj) evs -- UNION nesting problem+ orderNext subj distinct return SelectQuery { queryVars = [subj,ev] } @@ -154,7 +183,8 @@ --getts_members = getts_members' where getts_members' (SPARQL endpoint namespace_uri) set = do- m <- selectQuery endpoint query+ resolvedEndpoint <- lookupEndpoint endpoint+ m <- selectQuery resolvedEndpoint query case m of (Just res) -> return $ condense $ map (\[x, y] -> (removeUri namespace_uri $ deconstruct x, removeUri namespace_uri $ deconstruct y)) res Nothing -> return []@@ -189,6 +219,7 @@ memotable :: IORef (M.Map (SPARQLBackend,(String,String,String)) [String])+{-# NOINLINE memotable #-} memotable = unsafePerformIO $ newIORef M.empty memoIO ::(SPARQLBackend -> (String, String, String) -> IO [String]) -> SPARQLBackend -> (String, String, String) -> IO [String]@@ -199,6 +230,7 @@ Just r -> return r memotable' :: IORef (M.Map (SPARQLBackend,String) Image)+{-# NOINLINE memotable' #-} memotable' = unsafePerformIO $ newIORef M.empty memoIO' ::(SPARQLBackend -> (String) -> IO Image) -> SPARQLBackend -> (String) -> IO Image@@ -209,6 +241,7 @@ Just r -> return r memotable'' :: IORef (M.Map (SPARQLBackend,String,[String]) Image)+{-# NOINLINE memotable'' #-} memotable'' = unsafePerformIO $ newIORef M.empty memoIO'' ::(SPARQLBackend -> String -> [String] -> IO Image) -> SPARQLBackend -> String -> [String] -> IO Image@@ -219,6 +252,7 @@ Just r -> return r memotable''' :: IORef (M.Map (SPARQLBackend,String,String) Image)+{-# NOINLINE memotable''' #-} memotable''' = unsafePerformIO $ newIORef M.empty memoIO''' ::(SPARQLBackend -> String -> String -> IO Image) -> SPARQLBackend -> String -> String -> IO Image@@ -253,21 +287,25 @@ -} --Faster collect: runs in n lg n time-collect = condense . sortFirst- +--collect = condense . sortFirst+collect = Map.toList . Map.fromListWith (++) . map (\(x, y) -> (x, [y]))+ --condense computes the image under a sorted relation --condense runs in O(n) time and is lazy, also is lazy in the list computed in each tuple --TODO: Use Map.toList/fromList to simplify? Benchmark. --In particular: Should unstableSortBy be used?-condense :: (Eq a, Ord a) => [(a, a)] -> [(a, [a])]-condense [] = []-condense ((x,y):t) = (x, y:a):(condense r)- where - (a, r) = findall x t- findall x [] = ([], [])- findall x list@((t,y):ts) | x /= t = ([], list)- findall x ((t,y):ts) | x == t = let (a2, t2) = (findall x ts) in (y:a2, t2)+--condense :: (Eq a, Ord a) => [(a, a)] -> [(a, [a])]+--condense [] = []+--condense ((x,y):t) = (x, y:a):(condense r)+-- where +-- (a, r) = findall x t+-- findall x [] = ([], [])+-- findall x list@((t,y):ts) | x /= t = ([], list)+-- findall x ((t,y):ts) | x == t = let (a2, t2) = (findall x ts) in (y:a2, t2) +condense = map (\list -> (fst $ head list, map snd list)) . List.groupBy cmp+ where+ cmp x y = (fst x) == (fst y) --make_image accepts an event type as input, determines all subjects for --all events of that type, and computes the image under the relation
XSaiga/SolarmanTriplestore.hs view
@@ -969,10 +969,10 @@ ("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]), + --AMBIGUOUS: how was phobos discovered ("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]),