summaryrefslogtreecommitdiff
path: root/src/AI/Search/FiniteDomain/Int/Cell.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/AI/Search/FiniteDomain/Int/Cell.hs')
-rw-r--r--src/AI/Search/FiniteDomain/Int/Cell.hs45
1 files changed, 45 insertions, 0 deletions
diff --git a/src/AI/Search/FiniteDomain/Int/Cell.hs b/src/AI/Search/FiniteDomain/Int/Cell.hs
new file mode 100644
index 0000000..8f83997
--- /dev/null
+++ b/src/AI/Search/FiniteDomain/Int/Cell.hs
@@ -0,0 +1,45 @@
+-- This module exports some useful join functions for propagator cells.
+-- A join function describes how an old cell value is combined with a new one.
+-- See the package @propeller@ for details on the propagator implementation.
+module AI.Search.FiniteDomain.Int.Cell
+ ( domainJoin
+ , eqJoin
+ , mustHoldJoin
+ ) where
+
+-- domain
+import Numeric.Domain ( Domain, intersect, isSubsetOf )
+
+-- propeller
+import Data.Propagator.Change ( Change(..) )
+
+-- | Compares an old and a new domain of integer values to see if the new
+-- domain is a subset of the old domain (i.e., the cell has changed).
+--
+-- Never returns 'Incompatible'.
+domainJoin :: Domain Int -> Domain Int -> Change (Domain Int)
+domainJoin old new =
+ case intersect old new of
+ reduced | reduced `isSubsetOf` old -> Changed reduced
+ | otherwise -> Unchanged
+
+-- | Compares an old and a new value to see if there was a change.
+--
+-- Never returns 'Incompatible'.
+eqJoin :: Eq a => a -> a -> Change a
+eqJoin old new
+ | old == new = Unchanged
+ | otherwise = Changed new
+
+-- | Checks if a new cell value is ...
+--
+-- * 'True', then 'Unchanged' is returned, or
+-- * 'False', then 'Incompatible' is returned.
+--
+-- This can be used to represent conditions which must always hold
+-- (i.e., the cell value must always be 'True').
+--
+-- The old value of the cell is ignored. Never returns 'Changed'.
+mustHoldJoin :: a -> Bool -> Change b
+mustHoldJoin _ True = Unchanged
+mustHoldJoin _ False = Incompatible \ No newline at end of file