From b7c3a47e4ba386281c52a76e6c008295d0126dd1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Thorsten=20Wi=C3=9Fmann?= <uni@thorsten-wissmann.de>
Date: Mon, 13 Jan 2014 13:41:50 +0100
Subject: [PATCH] More helper functions
---
CoAlgLogics.ml | 22 +++++++++++++++++-----
CoAlgMisc.ml | 1 +
CoAlgMisc.mli | 1 +
3 files changed, 19 insertions(+), 5 deletions(-)
diff --git a/CoAlgLogics.ml b/CoAlgLogics.ml
index fb71722..965295f 100644
--- a/CoAlgLogics.ml
+++ b/CoAlgLogics.ml
@@ -187,18 +187,30 @@ let disjointAgents sort (a: CoAlgMisc.localFormula) (b: CoAlgMisc.localFormula)
Array.iter f la;
!res
+let compatible sort (a: bset) formula1 =
+ let res = ref (true) in
+ let f formula2 =
+ if not (disjointAgents sort formula1 formula2)
+ then res := false
+ else ()
+ in
+ bsetIter f a;
+ !res
(*
-let maxDisjoints (a: bset) : bset list =
+let maxDisjoints sort (a: bset) : bset list =
let f formula acc =
let g cc acc' =
- if (compatible cc formula)
- then new bset with formula and cc and then prepend it to acc'
+ if (compatible sort cc formula)
+ then let newcc = bsetCopy cc in
+ bsetAdd newcc formula;
+ (newcc)::acc'
+ else acc'
in
- List.fold acc g acc
+ List.fold_right acc g acc
in
bsetFold a f [bsetMake ()]
-*)
+ *)
(*
CoalitionLogic: tableau rules for satisfiability
diff --git a/CoAlgMisc.ml b/CoAlgMisc.ml
index 17dc05b..c3ec6e6 100644
--- a/CoAlgMisc.ml
+++ b/CoAlgMisc.ml
@@ -426,6 +426,7 @@ let bsetMake () = S.makeBS ()
let bsetAdd bs lf = S.addBSNoChk bs lf
let bsetMem bs lf = S.memBS bs lf
let bsetRem bs lf = S.remBS bs lf
+let bsetCopy bs = S.copyBS bs
let bsetFold fkt bs init = S.foldBS fkt bs init
let bsetIter fkt bset = S.iterBS fkt bset
let bsetAddTBox sort bs = S.unionBSNoChk bs !tboxTable.(sort)
diff --git a/CoAlgMisc.mli b/CoAlgMisc.mli
index bc4e22f..1958b4f 100644
--- a/CoAlgMisc.mli
+++ b/CoAlgMisc.mli
@@ -251,6 +251,7 @@ val bsetMem : bset -> localFormula -> bool
val bsetFold : (localFormula -> 'a -> 'a) -> bset -> 'a -> 'a
val bsetIter : (localFormula -> unit) -> bset -> unit
val bsetAddTBox : sort -> bset -> bset
+val bsetCopy : bset -> bset
val csetMake : unit -> cset
val csetAdd : cset -> atFormula -> unit
--
GitLab