csp 1.3.1 → 1.4.0

raw patch · 4 files changed

+86/−3 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +0/−1
• csp.cabal +1/−1
• src/Control/Monad/CSP.hs +75/−0
• tests/test.hs +10/−1

@@ -45,7 +45,6 @@      ## Future - - Docs!  - Allow a randomized execution order for CSPs  - CSPs don't need to use IO internally. ST is enough.  - Constraint synthesis. Already facilitated by the fact that

@@ -1,5 +1,5 @@ Name:                csp-Version:             1.3.1+Version:             1.4.0 Description:         Constraint satisfaction problem (CSP) solvers License:             LGPL License-file:        LICENSE

@@ -9,6 +9,7 @@          mkDV,          constraint1,          constraint2,+         constraint3,          constraint,          -- * Solving CSPs          oneCSPSolution,@@ -184,6 +185,46 @@           yd <- (domain y)           return $ filter (\xe -> any (\ye -> f xe ye) yd) xd) +-- | Assert a trinary constraint with arc consistency.+constraint3 :: (a -> t1 -> t2 -> Bool) -> DV t a -> DV t t1 -> DV t t2 -> CSP r ()+constraint3 f x y z = do+  addConstraint x $+    restrictDomain y+      (\yd -> do+          xd <- (domain x)+          zd <- (domain z)+          return $ filter (\ye -> any (\xe -> any (\ze -> f xe ye ze) zd) xd) yd)+  addConstraint x $+    restrictDomain z+      (\zd -> do+          xd <- (domain x)+          yd <- (domain y)+          return $ filter (\ze -> any (\xe -> any (\ye -> f xe ye ze) yd) xd) zd)+  addConstraint y $+    restrictDomain x+      (\xd -> do+          yd <- (domain y)+          zd <- (domain z)+          return $ filter (\xe -> any (\ye -> any (\ze -> f xe ye ze) zd) yd) xd)+  addConstraint y $+    restrictDomain z+      (\zd -> do+          yd <- (domain y)+          xd <- (domain x)+          return $ filter (\ze -> any (\ye -> any (\xe -> f xe ye ze) xd) yd) zd)+  addConstraint z $+    restrictDomain x+      (\xd -> do+          yd <- (domain y)+          zd <- (domain z)+          return $ filter (\xe -> any (\ze -> any (\ye -> f xe ye ze) yd) zd) xd)+  addConstraint z $+    restrictDomain y+      (\yd -> do+          xd <- (domain x)+          zd <- (domain z)+          return $ filter (\ye -> any (\ze -> any (\xe -> f xe ye ze) xd) zd) yd)+ -- | Assert an n-ary constraint with arc consistency. One day this -- will allow for a heterogeneous list of variables, but at the moment -- they must all be of the same type.@@ -221,6 +262,40 @@       a' <- result a       b' <- result b       return (a', b')+instance (CSPResult a, CSPResult b, CSPResult c) => CSPResult (a,b,c) where+    type Result (a,b,c) = (Result a, Result b, Result c)+    result (a,b,c) = do+      a' <- result a+      b' <- result b+      c' <- result c+      return (a', b', c')+instance (CSPResult a, CSPResult b, CSPResult c, CSPResult d) => CSPResult (a,b,c,d) where+    type Result (a,b,c,d) = (Result a, Result b, Result c, Result d)+    result (a,b,c,d) = do+      a' <- result a+      b' <- result b+      c' <- result c+      d' <- result d+      return (a', b', c', d')+instance (CSPResult a, CSPResult b, CSPResult c, CSPResult d, CSPResult e) => CSPResult (a,b,c,d,e) where+    type Result (a,b,c,d,e) = (Result a, Result b, Result c, Result d, Result e)+    result (a,b,c,d,e) = do+      a' <- result a+      b' <- result b+      c' <- result c+      d' <- result d+      e' <- result e+      return (a', b', c', d', e')+instance (CSPResult a, CSPResult b, CSPResult c, CSPResult d, CSPResult e, CSPResult f) => CSPResult (a,b,c,d,e,f) where+    type Result (a,b,c,d,e,f) = (Result a, Result b, Result c, Result d, Result e, Result f)+    result (a,b,c,d,e,f) = do+      a' <- result a+      b' <- result b+      c' <- result c+      d' <- result d+      e' <- result e+      f' <- result f+      return (a', b', c', d', e', f') instance (CSPResult a) => CSPResult [a] where     type Result [a] = [Result a]     result = mapM result

@@ -19,7 +19,9 @@   , testCase "constraint2 same type" $     oneCSPSolution testC1 @?= (5,4)   , testCase "constraint2 different types" $-    oneCSPSolution testC2 @?= ("2",2)+    oneCSPSolution testC2 @?= ("2",2::Int)+  , testCase "constraint3 different types" $+    oneCSPSolution testC3 @?= ("2",2::Int,2)   , testCase "sudoku1" $     solveSudoku sudoku1 @?= [[4,8,3,9,2,1,6,5,7],[9,6,7,3,4,5,8,2,1],[2,5,1,8,7,6,4,9,3],[5,4,8,1,3,2,9,7,6],[7,2,9,5,6,4,1,3,8],[1,3,6,7,9,8,2,4,5],[3,7,2,6,8,9,5,1,4],[8,1,4,2,5,3,7,6,9],[6,9,5,4,1,7,3,8,2]]   , testCase "sudoku3" $@@ -47,6 +49,13 @@   b <- mkDV [3,2,7]   constraint2 (\a b -> read a == b) a b   return (a,b)++testC3 = do+  a <- mkDV ["1","2","3"]+  b <- mkDV [2::Int,3,4]+  c <- mkDV [2.0::Double,4,5]+  constraint3 (\a b c -> read a == b && read a == c) a b c+  return (a,b,c)  -- Project Euler problem 96