module N3Unify where import "Observe" import "Utils" data Triple = Triple (Subject, Predicate, Object) | Rule Rule | TripleNil | Strext String deriving (Show, Eq) type Subject = Resource type Predicate = Resource type Object = Resource data Resource = URI String | Literal String | TripleSet TripleSet | Var Vare | ResNil deriving (Show,Eq) type TripleSet = [Triple] data Vare = UVar String | EVar String | GVar String | GEVar String deriving (Show,Eq) type DB = [TripleSet] type Query = [TripleSet] -- rules are numbered. This is done for memoization. type Rule= (Antecedents, Consequent, Int) type Antecedents = TripleSet type Consequent = Triple type Substitution = (Vare, Resource) type SubstitutionList = [Substitution] type Solution = [SubstitutionList] type Alternatives = [(TripleSet, SubstitutionList)] -- The array mainly used for tabling. Also for passing some parameters. tarr :: Array Int TripleSet -- all parameters are initially [TripleNil] tarr = array (1,510) [ (i,[TripleNil])| i <- [1 .. 510]] testApplySubstitutionToTriple = show (applySubstitutionToTriple tau7 sub1) applySubstitutionListToDB :: DB -> [Substitution] -> DB applySubstitutionListToDB [] sl = [] applySubstitutionListToDB (x:xs) sl = applySubstitutionListToTripleSet x sl: applySubstitutionListToDB xs sl applySubstitutionToTriple :: Triple -> Substitution -> Triple applySubstitutionToTriple (Triple (subject, predicate, object)) subst = Triple (applySubstitutionToResource subject subst, applySubstitutionToResource predicate subst, applySubstitutionToResource object subst) applySubstitutionToTriple (Rule(antecedents, consequent, i)) subst = Rule (applySubstitutionToTripleSet antecedents subst, applySubstitutionToTriple consequent subst, i) applySubstitutionListToTriple :: Triple -> [Substitution] -> Triple applySubstitutionListToTriple t [] = t applySubstitutionListToTriple t (x:xs) = applySubstitutionListToTriple (applySubstitutionToTriple t x) xs applySubstitutionToTripleSet :: TripleSet -> Substitution -> TripleSet applySubstitutionToTripleSet [] subst = [] applySubstitutionToTripleSet (x:xs) subst = (applySubstitutionToTriple x subst): (applySubstitutionToTripleSet xs subst) testApplySubstitutionListToTripleSet = show (applySubstitutionListToTripleSet (tauDB) [sub1, sub2, sub3]) applySubstitutionListToTripleSet :: TripleSet -> [Substitution] -> TripleSet applySubstitutionListToTripleSet [] [] = [] applySubstitutionListToTripleSet t [] = t applySubstitutionListToTripleSet [] sl = [] applySubstitutionListToTripleSet (x:xs) sl = applySubstitutionListToTriple x sl:applySubstitutionListToTripleSet xs sl testApplySubstitutionToResource = show (applySubstitutionToResource (TripleSet tauDB) sub1) applySubstitutionToResource :: Resource -> Substitution -> Resource applySubstitutionToResource (TripleSet tripleset) subst = TripleSet (applySubstitutionToTripleSet tripleset subst) applySubstitutionToResource (Var v) (t1, t2) | v == t1 = t2 | otherwise = Var v applySubstitutionToResource t s = t testUnifyTwoTripleSets = show (unifyTwoTripleSets tauQ tauDB) unifyTwoTripleSets :: TripleSet -> TripleSet -> Array Int TripleSet -> (Bool, Alternatives, Array Int TripleSet) unifyTwoTripleSets [] _ tarr = (True, [], tarr) unifyTwoTripleSets ts1 ts2 tarr -- all triples from the first set must match so alts1 and -- alts2 may not be empty. |bv1 && bv2 = (False, [], tarr) -- rules are treated separately |bv1 && bv3 = (True, [alt], tarr1) |bv2 && bv4 = (True, [alt1], tarr1) |bv1 && (not bv3) = (False, [], tarr) |bv2 && (not bv4) = (False, [], tarr) |bool = (True, alts, tarr) -- = error (show alts) |otherwise = (False, [], tarr) where alts = unifyNoRule ts1 ts2 bool = (not (alts == [])) bv1 = checkRule ts1 bv2 = checkRule ts2 checkRule [] = False checkRule (x:xs) |testRule x = True |otherwise = False testRule (Rule r) = True testRule t = False (bv3, _, _, alt, tarr1) = unifyTripleSetWithRule (False, ts2, ts1, ([], []), tarr) (bv4, _, _, alt1, tarr1) = unifyTripleSetWithRule (False, ts1, ts2, ([], []), tarr) type SubstitutionStack = [(Triple, [SubstitutionList], SubstitutionList)] testUnifyNoRule = show (unifyNoRule tsu1 tsu2) -- unify two triplesets where none contains a rule unifyNoRule :: TripleSet -> TripleSet -> Alternatives unifyNoRule [] _ = [] unifyNoRule _ [] = [] unifyNoRule ts1 ts2 = alts where -- alts = alts = [((applySubstitutionListToTripleSet ts1 a) ,a)|a <- sll] sll = solve ts1 ts2 [] [] solve [] ts2 stack substList -- = error ("notr " ++ show substList) = substList:backtrack ts2 stack solve (t:ts) ts2 stack substList |alts == [] = choose [] ts ts2 stack substList |otherwise = choose sll (ts) ts2 stack substList where triple = applySubstitutionListToTriple t substList res = unifyTripleWithTripleSet triple ts2 sll = [sls|(_, sls) <- alts] (bool,alts) = res choose [] ts ts2 stack substList = backtrack ts2 stack -- = error (show substList) choose (sl:sll) [] ts2 stack substList = solve [] ts2 stack1 substList1 -- = error ("no trips" ++ show substList) where substList1 = substList ++ sl stack1 = ([], sll, substList):stack choose (sl:sll) ts ts2 stack substList = solve ts ts2 stack1 substList1 where substList1 = substList ++ sl stack1 = (ts, sll, substList):stack backtrack ts2 [] = [] -- error "stack empty" backtrack ts2 ((ts,sll, sl):st) = choose sll ts ts2 st sl type Alternative = (TripleSet, SubstitutionList) -- call this function with bool = False unifyTripleSetWithRule :: (Bool, TripleSet, TripleSet, Alternative, Array Int TripleSet) -> (Bool, TripleSet, TripleSet, Alternative, Array Int TripleSet) unifyTripleSetWithRule (bool, [], _, _, tarr) = (False, [], [], ([],[]), tarr) unifyTripleSetWithRule (bool, (x:xs), (y:yx), alts, tarr) |bv1 = (True, [], [], (ts1 ++ ants ++ xs, sl1 ++ sl), tarr1) |otherwise = unifyTripleSetWithRule (False, xs, (y:yx), (x:ts1, sl1 ), tarr) where (bv1, alts1, tarr1) = unifyTwoTriples x y tarr (a:as) = alts1 (ts, sl) = a (ts1, sl1) = alts Rule (ants, con, _) = y testUnifyTripleWithTripleSet = show (unifyTripleWithTripleSet tau8 tauDB) unifyTripleWithTripleSet :: Triple -> TripleSet -> Array Int TripleSet -> (Bool, Alternatives, Array Int TripleSet) unifyTripleWithTripleSet t [] tarr = (True, [], tarr) unifyTripleWithTripleSet t ts = getResults t ts tarr where getResults t [] tarr = (False, [], tarr) getResults t (x:xs) tarr |bool = (bool1, alts1 ++ alts2, tarr2) |otherwise = (bool1, alts2, tarr2) where (bool, alts1, tarr1) = unifyTwoTriples t x tarr (bool1, alts2, tarr2) = getResults t xs tarr1 testUnifyTwoTriples = putStr(show alts) where (bool, alts, tarr) = unifyTwoTriples triple1 triple2 tarr -- type Alternatives = [(TripleSet, SubstitutionList)] unifyTwoTriples :: Triple -> Triple -> Array Int TripleSet -> (Bool, Alternatives, Array Int TripleSet) unifyTwoTriples (Triple(subject1, predicate1, object1)) triple2@(Triple(subject2, predicate2, object2) tarr) | bool1 && bool2 && bool3 = (True,[([triple2], subst1 ++ subst2 ++ subst3)], tarr) | otherwise = (False, [([triple2], [])], tarr) where (bool1, subst1) = unifyTwoResources subject1 subject2 (bool2, subst2) = unifyTwoResources predicate1 predicate2 (bool3, subst3) = unifyTwoResources object1 object2 unifyTwoTriples triple (Rule rule) tarr = unifyTripleWithRule triple rule tarr unifyTwoTriples (Rule rule) triple tarr = unifyTripleWithRule triple rule tarr unifyTwoTriples t1 t2 tarr = (False, [([triple2], [])] ,tarr) testUnifyTripleWithRule = show (unifyTripleWithRule tau8 r tarr ) where Rule r = rule -- type Alternatives = [(TripleSet, SubstitutionList)] unifyTripleWithRule :: Triple -> Rule -> Array Int TripleSet -> (Bool, Alternatives, TripleSet) unifyTripleWithRule triple r@(antecedents, consequent, _) tarr | bool = (True, [([Rule r], getSubstList alts)], tarr1) | otherwise = (False, [([triple], [])], tarr) where (bool, alts, tarr1) = unifyTwoTriples triple consequent tarr -- check whether variables from a triple are occuring in the antecedents. -- do not take into account level prefixes. -- This is to prevent looping with certain very general rules -- like transitivity rules. -- see if the goal unifies with one of the antecedents. loopCheck1 ants triple = bool where bool = foldr (||) False [compareForm t1 triple| t1 <- ants] compareForm (Triple(s1, p1, o1)) (Triple(s2, p2, o2)) = (compareRes s1 s2)&&(compareRes p1 p2)&&(compareRes o1 o2) compareRes (Var v1) (Var v2) = True compareRes t1 t2 |t1 == t2 = True |otherwise = False loopCheck ants triple = compareVars (getVarsFromTriple triple) varsa where Triple(s, p, o) = triple testVar (Var v) = True testVar r = False getVarsFromTriple (Triple(s, p, o)) = [v|v <- [getVarFromResource s, getVarFromResource p, getVarFromResource o], v /= ResNil] getVarFromResource r |testVar r = r |otherwise = ResNil varsa = concat [getVarsFromTriple t|t <- ants] compareVar v vl = foldr (||) False [compareResourcesVars v v1|v1 <- vl] compareVars vl1 vl = foldr (||) False [compareVar v vl|v <- vl1] unifyTwoResources :: Resource -> Resource -> (Bool, SubstitutionList) unifyTwoResources (Var v1) (Var v2) |v1 == v2 = (True, []) |otherwise = (True, [(v1, Var v2)]) unifyTwoResources (Var v1) r |varCheck (Var v1) r = (False, [(v1, r)]) |otherwise = (True, [(v1, r)]) unifyTwoResources r (Var v1) |varCheck (Var v1) r = (False, [(v1, r)]) |otherwise = (True, [(v1, r)]) unifyTwoResources (TripleSet t1) (TripleSet t2) = unifyTwoTerms t1 t2 unifyTwoResources resource1 resource2 |resource1 == resource2 = (True, []) |otherwise = (False, []) testVarCheck = show (varCheck (Var (UVar ":person")) (TripleSet tauDB)) testVarCheck1 = show (varCheck (Var (UVar ":test")) (TripleSet tauDB)) varCheck :: Resource -> Resource -> Bool varCheck (Var v) (TripleSet []) = False varCheck (Var v) (TripleSet (Triple(s, p, o):xs)) |(Var v) == s || (Var v) == p || (Var v) == o = True |otherwise = varCheck (Var v) (TripleSet xs) varCheck (Var v) (TripleSet (Rule (ants,con, _):xs)) = (varCheck (Var v) (TripleSet ants)) || (varCheck (Var v) (TripleSet [con])) varCheck (Var v) r = False unifyTwoTerms :: TripleSet -> TripleSet -> Array Int TripleSet -> (Bool, SubstitutionList, Array Int TripleSet) unifyTwoTerms [] t tarr = (False, [], tarr) unifyTwoTerms t [] tarr = (False, [], tarr) unifyTwoTerms t1 t2 tarr = (bool, getSubstList alts, tarr) where (bool, alts, tarr1) = unifyTwoTripleSets t1 t2 tarr getSubstList :: Alternatives -> SubstitutionList getSubstList [] = [] getSubstList (x:xs) = substL ++ getSubstList xs where (_, substL) = x testCheckGrounded = show (checkGrounded [tauDB]) checkGrounded :: [TripleSet] -> [TripleSet] checkGrounded [] = [] checkGrounded (x:xs) |x == [] = checkGrounded xs |ts == [] = checkGrounded xs |otherwise = ts:checkGrounded xs where ts = checkTripleSet x checkTripleSet [] = [] checkTripleSet (x:xs) |bv1 = checkTripleSet xs |otherwise = x:checkTripleSet xs where bv1 = (checkTriple x) == TripleNil checkTriple t@(Triple(subject, predicate, object)) |bv1 && bv2 && bv3 = TripleNil |otherwise = Triple(subject1, predicate1, object1) where bv1 = checkAtom subject bv2 = checkAtom predicate bv3 = checkAtom object checkAtom (URI s) = True checkAtom (Literal s) = True checkAtom ResNil = True checkAtom (TripleSet ts) = (checkTripleSet ts ) == [] checkAtom any = False subject1 = checkSet subject predicate1 = checkSet predicate1 object1 = checkSet object1 checkSet (TripleSet ts) = TripleSet (checkTripleSet ts) checkSet r = r checkTriple t = t -- compare two trees; strip the level indication of the vars -- this compares name, content and children -- compareTreesVars :: TripleSet -> TripleSet -> Bool compareTreesVars [] _ = True compareTreesVars (x:xs) ts2 = compareTreeVars x ts2 && compareTreesVars xs ts2 where compareTreeVars _ [] = True compareTreeVars TripleNil _ = False compareTreeVars t (y:ys) = compareTriplesVars t y && compareTreeVars t ys compareTriplesVars :: Triple -> Triple -> Bool compareTriplesVars (Rule (ants1, con1, _)) (Rule (ants2, con2, _)) = compareTreesVars ants1 ants2 && compareTriplesVars con1 con2 compareTriplesVars (Rule (ants, con, _)) t@(Triple (s1, p1, o1)) = compareTripleVars ants t compareTriplesVars t@(Triple (s1, p1, o1)) (Rule (ants, con, _)) = compareTripleVars ants t compareTriplesVars (Triple (s1, p1, o1)) (Triple (s2, p2, o2)) = compareResourcesVars s1 s2 && compareResourcesVars p1 p2 && compareResourcesVars o1 o2 compareTriplesVars t1 t2 = False compareTripleVars [] t = False compareTripleVars (x:xs) t |compareTriplesVars x t = True |otherwise = compareTripleVars xs t compareResourcesVars (Var v1) (Var v2) = getStringPart v1 == getStringPart v2 where getStringPart (UVar s) = third (parseUntilString s "$_$") getStringPart (EVar s) = third (parseUntilString s "$_$") getStringPart (GVar s) = third (parseUntilString s "$_$") getStringPart (GEVar s) = third (parseUntilString s "$_$") third (_, _, x) = x compareResourcesVars r1 r2 = r1 == r2 -- testdata triple1 = Triple(URI "subject", URI "predicate", URI "object") triple2 = Triple(Var(UVar "_sub"), URI "predicate", Var (UVar "_obj")) tsU2 = [tau1, tau2, tau3] tsU1 = [tau4, tau5] -- example unifyTwoTripleSets tu1 = Triple(Var (UVar "?v1 ?v1"), URI ":spouseIn gc:spouseIn", Var (UVar "?v2 ?v2")) tu2 = Triple(URI ":Frank :Frank", URI ":childIn gc:childIn", Var (UVar "?v2 ?v2")) tu3 = Triple(Var (UVar "?v1 ?v1"), URI ":childIn gc:childIn", Var (UVar "?v3 ?v3")) tu4 = Triple(Var (UVar "?v4 ?v4"), URI ":spouseIn gc:spouseIn", Var (UVar "?v3 ?v3")) tu5 = Triple(Var (UVar "?v4 ?v4"), URI ":sex gc:sex", URI ":M :M") tsu1 = [tu1, tu2, tu3, tu4] -- , tu5] tsu2 = [tu6, tu7, tu8, tu9, tu10, tu11, tu12, tu13, tu14, tu15, tu16, tu17] tu6 = Triple(URI ":Frank :Frank", URI ":childIn gc:childIn", URI ":Naudts_VanNoten :Naudts_VanNoten") tu7 = Triple(URI ":Frank :Frank", URI ":sex gc:sex", URI ":M :M") tu8 = Triple(URI ":Guido :Guido", URI ":spouseIn gc:spouseIn", URI ":Naudts_VanNoten :Naudts_VanNoten") tu9 = Triple(URI ":Guido :Guido", URI ":sex gc:sex", URI ":M :M") tu10 = Triple(URI ":Christine :Christine", URI ":spouseIn gc:spouseIn", URI ":Naudts_VanNoten :Naudts_VanNoten") tu11 = Triple(URI ":Christine :Christine", URI ":sex gc:sex", URI ":F :F") tu12 = Triple(URI ":Guido :Guido", URI ":childIn gc:childIn", URI ":Naudts_Huybrechs :Naudts_Huybrechs") tu13 = Triple(URI ":Guido :Guido", URI ":sex gc:sex", URI ":M :M") tu14 = Triple(URI ":Martha :Martha", URI ":spouseIn gc:spouseIn", URI ":Naudts_Huybrechs :Naudts_Huybrechs") tu15 = Triple(URI ":Martha :Martha", URI ":sex gc:sex", URI ":F :F") tu16 = Triple(URI ":Pol :Pol", URI ":spouseIn gc:spouseIn", URI ":Naudts_Huybrechs :Naudts_Huybrechs") tu17 = Triple(URI ":Pol :Pol", URI ":sex gc:sex", URI ":M :M") -- example authen.axiom.n3 and authen.lemma.n3 tau1 = Triple(URI " ", URI ":member :member", URI " ") tau2 = Triple(URI " ", URI ":w3cmember :w3cmember", URI " ") tau3 = Triple(URI " ", URI ":subscribed :subscribed", URI " ") tau4 = Triple(Var (UVar ":person :person"), URI ":member :member", Var (UVar ":institution :institution")) tau5 = Triple(Var (UVar ":institution :institution"), URI ":w3cmember :w3cmember", URI " ") tau6 = Triple(Var (UVar ":institution :institution"), URI ":subscribed :subscribed", Var (UVar ":mailinglist :mailinglist")) tau7 = Triple (Var (UVar ":person :person"), URI ":authenticated :authenticated", Var (UVar ":mailinglist :mailinglist")) ants = [tau4, tau5, tau6] cons = tau7 rule = Rule (ants, cons, 1) tau8 = Triple(Var (EVar "_:who _:who"), URI ":authenticated :authenticated", URI " ") tauQ = [tau8] tauDB = [tau1, tau2, tau3, rule] sub1 = (UVar ":person :person", URI " ") sub2 = (UVar ":mailinglist :mailinglist", URI " ") sub3 = (UVar ":institution :institution", URI " ") subList = [sub1, sub2, sub3]