monadiccp 0.7.4 → 0.7.5

raw patch · 10 files changed

+192/−18 lines, 10 filesnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Search/Combinator/Misc.hs +7/−6
• Control/Search/Combinator/Print.hs +1/−0
• README.md +11/−0
• README.txt +0/−7
• examples/Olympic.hs +51/−0
• examples/Ring.hs +30/−0
• examples/StressDomain.hs +23/−0
• examples/TryDemo.hs +19/−0
• examples/Zebra.hs +39/−0
• monadiccp.cabal +11/−5

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}  module Control.Search.Combinator.Misc (dbs, lds, bbmin) where @@ -18,10 +19,10 @@                      , evalState_  = ("lds_complete", Bool, const $ return true) : evalState_ super                      , pushLeftH   = \i -> pushLeft  super (i `onCommit` mkCopy i "lds")                      , pushRightH  = \i -> pushRight super (i `onCommit` mkUpdate i "lds" (\x -> x - 1)) >>= \stmt -> -						return $ IfThenElse -							   (tstate (old i) @-> "lds" @>= 0) +                                                return $ IfThenElse +                                                           (tstate (old i) @-> "lds" @>= 0)                                                             stmt-							   (abort i >>> (estate i @=> "lds_complete" <== false))+                                                           (abort i >>> (estate i @=> "lds_complete" <== false))                      , toString = "lds(" ++ show limit ++ "," ++ toString super ++ ")"                      , complete = \i -> return $ estate i @=> "lds_complete"                      }@@ -32,13 +33,13 @@ dbsLoop limit super = return $ commentEval $ super                      { treeState_  = entry ("depth_limit",Int,assign $ IVal limit) : treeState_ super                      , evalState_  = ("dbs_complete", Bool, const $ return true) : evalState_ super-		     , pushLeftH   = push pushLeft+                     , pushLeftH   = push pushLeft                      , pushRightH  = push pushRight                      , toString = "dbs(" ++ show limit ++ "," ++ toString super ++ ")"                      , complete = \i -> return $ estate i @=> "dbs_complete"                      }   where push dir = -	  \i -> dir super (i `onCommit` mkUpdate i "depth_limit" (\x -> x - 1)) >>= \stmt ->+          \i -> dir super (i `onCommit` mkUpdate i "depth_limit" (\x -> x - 1)) >>= \stmt ->                 return $ IfThenElse (tstate (old i) @-> "depth_limit" @>= 0)                                     stmt                                     ((estate i @=> "dbs_complete" <== false) >>> abort i)@@ -49,7 +50,7 @@   { treeState_  = entry ("tree_bound_version",Int,assign 0) : treeState_ super   , evalState_   = ("bound_version",Int,const $ return 0) : ("bound",Int,const $ return $ IVal maxBound) : evalState_ super   , returnH     = \i -> returnE super (i `onCommit`-			   let get = VHook (rp 0 (space i) ++ "->iv[VAR_" ++ var ++ "].min()")+                           let get = VHook (rp 0 (space i) ++ "->iv[VAR_" ++ var ++ "].min()")                            in  (Assign (estate i @=> "bound") get >>> inc (estate i @=> "bound_version")))    , bodyH = \i -> let set = Post (space i) (VHook (rp 0 (space i) ++ "->iv[VAR_" ++ var ++ "]") $< (estate i @=> "bound"))                               in  do r <- bodyE super i

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}  module Control.Search.Combinator.Print (prt,dbg) where 

@@ -0,0 +1,11 @@+monadiccp [![Build Status](https://secure.travis-ci.org/neothemachine/monadiccp.png?branch=master)](http://travis-ci.org/neothemachine/monadiccp)+=========+++Acknowledgments+---------------++- Thanks to Chris Mears for a patch to get+  the package to compile against GHC 7.4.1.+- Thanks to Nicholas Tung for a patch to get+  the package to compile against GHC 7.2.2.

@@ -1,7 +0,0 @@-ACKNOWLEDGMENTS-================--- Thanks to Chris Mears for a patch to get-  the package to compile against GHC 7.4.1.-- Thanks to Nicholas Tung for a patch to get-  the package to compile against GHC 7.2.2.

@@ -0,0 +1,51 @@+{-+%   File   : olympic.pl+%   Author : Neng-Fa ZHOU+%   Date   : 1993+%   Purpose: solve a puzzle taken from Olympic Arithmetic Contest+/***********************************************************************+   Given ten variables with the following configuration:++               X7   X8   X9   X10++                  X4   X5   X6++                     X2   X1             ++                        X1++  We already know that X1 is equal to 3 and want to assign each variable+  with a different integer from {1,2,...,10} such that for any three+  variables +                      Xi   Xj++                         Xk+  the following constraint is satisfied:++                    |Xi-Xj| = Xk+***********************************************************************/+-}+++import Control.CP.FD.Example.Example+import Control.CP.FD.FD+import Control.CP.FD.Expr+import Control.CP.SearchTree++main = example_main_void model++model :: FDSolver solver => Tree (FDWrapper solver) [Expr (FDTerm solver)]+model = +  exist 10 $ \list@[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] +		    -> list `allin` (1,10) /\ +                       allDiff list        /\ +		       x1 @= 3             /\ +    		       minus x2 x3 x1 	   /\+                       minus x4 x5 x2 	   /\+                       minus x5 x6 x3 	   /\+                       minus x7 x8 x4 	   /\+    		       minus x8 x9 x5 	   /\+    		       minus x9 x10 x6     /\+		       return list++minus x1 x2 x3 = (abs (x1-x2)) @= x3

@@ -0,0 +1,30 @@+import Control.CP.FD.Example.Example+import Control.CP.FD.FD+import Control.CP.FD.Expr+import Control.CP.SearchTree++import List (tails)+import Data.Map (toList)++main = example_main_single model++-- generate a disjunction producing a list of variables, consisting of alr+-- prefixed by up to maxlen new variables+varexist :: FDSolver solver => Int -> [FDExpr solver] -> Tree (FDWrapper solver) [FDExpr solver]+varexist maxlen alr = +  if maxlen==0+  then return alr+  else return alr \/ (exists $ \x -> varexist (maxlen-1) (x:alr))++-- constr list i = (if (i < (length list)-2) then v2 @= v0 * v1 - i else true) /\ v0 @: (-10,10)+constr list i = 2*v1 @= 2*v2 - v0 /\ +                v0 @: (-10,10)+   where v0 = list !! i+         v1 = list !! ((i+1) `mod` (length list))+         v2 = list !! ((i+2) `mod` (length list))++model :: FDSolver solver => Int -> Tree (FDWrapper solver) [FDExpr solver]+model n = exists $ \x -> +          do list <- varexist n [x]+             conj $ [ constr list i | i <- [0..(length list)-1] ]+             return list

@@ -0,0 +1,23 @@+import List (transpose)++import Control.CP.FD.Example.Example+import Control.CP.FD.FD+import Control.CP.FD.Expr+import Control.CP.SearchTree++main = example_main_single model++cutAt p l = case (splitAt p l) of+  (l,[]) -> [l]+  (b,r) -> b:(cutAt p r)+mexist r c = exist (r*c) $ \list -> return $ cutAt c list+lsum v l = (foldl1 (+) l) @= v+diag bc ic m = map (\x -> (m!!x)!!(bc+ic*x)) [0..(length m)-1]++model :: FDSolver solver => Int -> Tree (FDWrapper solver) [FDExpr solver]+model n = exist 5 $ \l -> do+  allin l (0,5*n)+  let forvar v = conj $ map (\p -> conj $ map (\j -> v @/= 5*j+p) [0..(cte (5*n))]) [0,2,4]+  conj $ map forvar $ reverse l+  conj $ map (\j -> conj $ map (\v -> v @>= cte (5*j) /\ v @<= cte (5*(j+5*(n `div` 2)))) $ reverse l) [0..5*(n `div` 2)]+  return l

@@ -0,0 +1,19 @@+{- + - 	Monadic Constraint Programming+ - 	http://www.cs.kuleuven.be/~toms/Haskell/+ - 	Tom Schrijvers & Pieter Wuille+ -}++import Control.CP.FD.Example.Example+import Control.CP.FD.FD+import Control.CP.FD.Expr+import Control.CP.SearchTree++main = example_main_void model++model :: FDSolver solver => Tree (FDWrapper solver) [FDExpr solver]+model = exist 2 $ \[a,b] -> a @: (1,5) /\+			   b @: (0,4) /\+			   a - b @= 1 /\+			   (a @= 2 \/ a @= 3 \/ a @= 4) /\+			   return [a,b]

@@ -0,0 +1,39 @@+import Control.CP.FD.Example.Example+import Control.CP.FD.FD+import Control.CP.FD.Expr+import Control.CP.SearchTree++main = example_main_void model++model :: FDSolver solver => Tree (FDWrapper solver) [FDExpr solver]+model = +  exist 5 $ \ns@[n1,n2,n3,n4,n5] -> +  exist 5 $ \cs@[c1,c2,c3,c4,c5] -> +  exist 5 $ \ps@[p1,p2,p3,p4,p5] -> +  exist 5 $ \as@[a1,a2,a3,a4,a5] -> +  exist 5 $ \ds@[d1,d2,d3,d4,d5] -> +    let vars = ns ++ cs ++ ps ++ as ++ ds in+    vars `allin` (1,5) /\+    allDiff ns /\+    allDiff cs /\+    allDiff ps /\+    allDiff as /\+    allDiff ds /\+    n1 @= c2   /\+    n2 @= a1   /\+    n3 @= p1   /\+    n4 @= d3   /\+    n5 @= 1    /\+    d5 @= 3    /\+    p3 @= d1   /\+    c1 @= d4   /\+    p5 @= a4   /\+    p2 @= c3   /\+    c1 @= c5+1 /\+    plusorminus a3 p4 1 /\+    plusorminus a5 p2 1 /\+    plusorminus n5 c4 1 /\+    return vars ++plusorminus x y c =+  x @= y+c \/ x @= y-c

@@ -1,20 +1,26 @@ Name:			monadiccp-Version:		0.7.4+Version:		0.7.5 Description:		Monadic Constraint Programming framework License:		BSD3 License-file:		LICENSE Author:			Tom Schrijvers, Pieter Wuille-Maintainer:		tom.schrijvers@ugent.be+Maintainer:		maik.riechert@arcor.de
 Build-Type:		Simple Category:		control Synopsis:		Constraint Programming Homepage:		http://users.ugent.be/~tschrijv/MCP/-Bug-reports:		http://trac.haskell.org/monadiccp/+Bug-reports:		https://github.com/neothemachine/monadiccp/issues Cabal-Version:		>=1.6 Extra-Source-Files: 	examples/*.hs lib/*.cpp lib/*.h-Data-Files:		README.txt+Data-Files:		README.md --- examples/Alpha.hs examples/Grocery.hs examples/MagicSquare.hs examples/Olympic.hs examples/Partition.hs examples/Queens.hs examples/Ring.hs examples/StressDomain.hs examples/TryDemo.hs examples/Zebra.hs+tested-with:     
+                 GHC==7.4.1,
+                 GHC==7.6.2
++source-repository head+  type:      git+  location:  git://github.com/neothemachine/monadiccp.git  Flag RuntimeGecode     Description:	Include the RuntimeSolver and SearchSolver for Gecode. Requires a working Gecode 3.1 installation.