fdilke/pyrites
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

now fully computing the herbrand, maybe incorrectly

Browse Source
This commit is contained in:
Felix Dilke 2026-02-11 10:39:40 +00:00
parent d5beb57492
commit 872a9ee791
1 changed files with 23 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
haskell-experiments/src/Datalog/NaiveQE.hs
View File

@ -21,6 +21,9 @@ import Utility.Utility
import Control.Monad(guard) import Control.Monad(guard)
import Data.Set (Set) import Data.Set (Set)
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.Functor ((<&>))
import Data.List (nub)
import qualified Data.List.NonEmpty as List
data (DatalogDB db) => NaiveQE db = NaiveQE data (DatalogDB db) => NaiveQE db = NaiveQE
{ {
@ -68,20 +71,30 @@ computeHerbrand db =
foldr amalgamateRule newFacts (_rules relation) where foldr amalgamateRule newFacts (_rules relation) where
amalgamateRule :: RelationRule -> NewFacts -> NewFacts amalgamateRule :: RelationRule -> NewFacts -> NewFacts
amalgamateRule (RelationRule headVars bodyElements) newFacts = amalgamateRule (RelationRule headVars bodyElements) newFacts =
newFacts where if stillChanged then
(facts, changed) = newFacts (updatedFacts, True)
else newFacts
where
(facts, wasChanged) = newFacts
latestRelation = facts Map.! (_name relation)
knownTuples :: Set [Constant] = knownTuples :: Set [Constant] =
_tuples $ facts Map.! (_name relation) _tuples $ latestRelation
extraTuples = do extraTuples = do
varmap <- allMaps headVars (Set.toList $ allConstants db) varmap <- allMaps headVars (Set.toList $ allConstants db)
let tuple = (\name -> varmap Map.! name) <$> headVars let tuple = (\name -> varmap Map.! name) <$> headVars
guard $ not $ Set.member tuple knownTuples guard $ not $ Set.member tuple knownTuples
let twig :: Int -> Int -> Int let satisfied :: RuleBodyElement -> Bool
twig x y = x + y satisfied (RuleBodyElement subRelationId ruleElements) =
satisfied :: RuleBodyElement -> Bool let subRelation = facts Map.! subRelationId
satisfied (RuleBodyElement subRelationId ruleElements) = all (satisfiedSub (facts Map.! subRelationId)) ruleElements mappedTuple = ruleElements <&> \ruleElement ->
satisfiedSub :: Relation -> RuleElement -> Bool case ruleElement of
satisfiedSub subRelation ruleElement = True RuleElementConstant constant -> constant
RuleElementVariable index -> tuple !! index
in Set.member mappedTuple (_tuples subRelation)
guard $ all satisfied bodyElements guard $ all satisfied bodyElements
return varmap return tuple
stillChanged = wasChanged || (not (null extraTuples))
updatedTuples = Set.union knownTuples $ Set.fromList extraTuples
updatedFacts = Map.insert (_name relation) (
latestRelation { _tuples = updatedTuples }) facts