Constraint Programming in Haskell

Constraint Programming in Haskell
Melbourne Haskell Users Group
David Overton
29 October 2015

Table of Contents
1 Constraint programming
2 Constraint logic programming
3 Finite domain constraints
4 Constraint programming in Haskell
Basic equality and inequality
Arithmetic expressions
5 Conclusion

Constraint programming
Constraint programming is a declarative programming paradigm for solving constraint
satisfaction problems.
• A set of constraint variables over a domain, e.g. Booleans, integers, reals, finite
domain.
• A set of constraints between those variables.
• A solver to find solutions to the constraints, i.e. assignments of variables to values
in the domain such that all constraints are satisfied.
Applications: planning, scheduling, resource allocation, computer graphics, digital
circuit design, programming language analysis, . . .

Constraint logic programming
• Constraint programming and logic programming work well together.
• Many Prolog implementations have built in constraint solvers.
• Basic idea:
• add constraints to the constraint store
• constraint solver works behind the scenes to propagate constraints
• use Prolog’s backtracking search mechanism to generate solutions
• Advantages over pure logic programming:
• “constrain-and-generate” rather than “generate-and-test”
• constraint solver can greatly reduce the search space required compared to Prolog’s
built-in depth-ﬁrst-search
• much more powerful than relying on just uniﬁcation and backtracking

Finite domain constraints
• One of the most widely used varieties of constraint solver.
• Variables range over a ﬁnite domain of integers.
• Simple equality and inequality constraints: =, =, <, >, ≤, ≥
• Also simple arithmetic expressions: +, −, ×, abs

Arc consistency
Solver uses an arc consistency algorithm, e.g. AC-3
• Constraint store holds the set of constraints to be checked.
• For each constraint, the domains of the variables involved are checked to ensure
they are consistent with the contraint.
• Any values in the domains that break consistency are removed.
• If the domain of a variable changes then all other constraints involving that
variable are rechecked.
Example
x ∈ {1, 2, 3} ∧ y ∈ {1, 2, 3}
add constraint x < y
⇒ x ∈ {1, 2} ∧ y ∈ {2, 3}
add constraint y = 2
⇒ x ∈ {1} ∧ y ∈ {2}

Example: n queens in SWI-Prolog
n_queens(N, Qs) :-
length(Qs, N),
Qs ins 1..N,
safe_queens(Qs).
safe_queens([]).
safe_queens([Q|Qs]) :-
safe_queen(Qs, Q, 1),
safe_queens(Qs).
safe_queen([], _, _).
safe_queen([Q|Qs], Q0, D0) :-
Q0 #= Q,
abs(Q0 - Q) #= D0,
D1 #= D0 + 1,
safe_queen(Qs, Q0, D1).

Constraint programming in Haskell
How can we do something similar in Haskell? Use a monad!

Example: n queens in SWI-Prolog and Haskell
n_queens(N, Qs) :-
length(Qs, N),
Qs ins 1..N,
safe_queens(Qs).
safe_queens([]).
safe_queens([Q|Qs]) :-
safe_queen(Qs, Q, 1),
safe_queens(Qs).
safe_queen([], _, _).
safe_queen([Q|Qs], Q0, D0) :-
Q0 #= Q,
abs(Q0 - Q) #= D0,
D1 #= D0 + 1,
safe_queen(Qs, Q0, D1).
nQueens :: Int -> FD [FDExpr]
nQueens n = do
qs <- news n (1, n)
safeQueens qs
return qs
safeQueens :: [FDExpr] -> FDConstraint
safeQueens [] = return ()
safeQueens (q : qs) = do
safeQueen qs q 1
safeQueens qs
safeQueen :: [FDExpr] -> FDExpr -> FDExpr -> FDConstraint
safeQueen [] _ _ = return ()
safeQueen (q : qs) q0 d0 = do
q0 #= q
abs (q0 - q) #= d0
safeQueen qs q0 (d0 + 1)

• List monad provides backtracking / search / multiple solutions.
• Wrap it in a state monad transformer to keep track of the constraint store.
type FD a = StateT FDState [] a
type FDConstraint = FD ()
-- Run the monad to obtain a list of solutions.
runFD :: FD a -> [a]
runFD fd = evalStateT fd initState

newtype FDVar = FDVar { _unwrapFDVar :: Int } deriving (Ord, Eq)
type VarSupply = FDVar
data Domain
= Set IntSet
| Range Int Int
data VarInfo = VarInfo { _delayedConstraints :: !FDConstraint
, _domain :: !Domain }
type VarMap = Map FDVar VarInfo
data FDState = FDState { _varSupply :: !VarSupply, _varMap :: !VarMap }
initState :: FDState
initState = FDState { _varSupply = FDVar 0, _varMap = Map.empty }

newVar :: ToDomain a => a -> FD FDVar
newVar d = do
v <- use varSupply
varSupply . unwrapFDVar += 1
let vi = initVarInfo & domain .~ toDomain d
varMap . at v ?= vi
return v
newVars :: ToDomain a => Int -> a -> FD [FDVar]
newVars n d = replicateM n (newVar d)

-- Look up the current domain of a variable.
lookup :: FDVar -> FD Domain
lookup x =
use $ varMap . ix x . domain
-- Update the domain of a variable and fire all delayed constraints
-- associated with that variable.
update :: FDVar -> Domain -> FDConstraint
update x i = do
vi <- use $ varMap . ix x
varMap . ix x . domain .= i
vi ^. delayedConstraints
-- Add a new constraint for a variable to the constraint store.
addConstraint :: FDVar -> FDConstraint -> FDConstraint
addConstraint x constraint =
varMap . ix x . delayedConstraints %= (>> constraint)

-- Useful helper function for adding binary constraints between FDVars.
type BinaryConstraint = FDVar -> FDVar -> FDConstraint
addBinaryConstraint :: BinaryConstraint -> BinaryConstraint
addBinaryConstraint f x y = do
let constraint = f x y
constraint
addConstraint x constraint
addConstraint y constraint
-- Constrain two variables to have the same value.
same :: FDVar -> FDVar -> FDConstraint
same = addBinaryConstraint $ x y -> do
xv <- lookup x
yv <- lookup y
let i = xv ‘intersection‘ yv
guard $ not $ Domain.null i
when (i /= xv) $ update x i
when (i /= yv) $ update y i

-- Constrain two variables to have different values.
different :: FDVar -> FDVar -> FDConstraint
different = addBinaryConstraint $ x y -> do
xv <- lookup x
yv <- lookup y
guard $ not (isSingleton xv) || not (isSingleton yv) || xv /= yv
when (isSingleton xv && xv ‘isSubsetOf‘ yv) $
update y (yv ‘difference‘ xv)
when (isSingleton yv && yv ‘isSubsetOf‘ xv) $
update x (xv ‘difference‘ yv)
-- Constrain a list of variables to all have different values.
varsAllDifferent :: [FDVar] -> FDConstraint
varsAllDifferent (x:xs) = do
mapM_ (different x) xs
varsAllDifferent xs
varsAllDifferent _ = return ()

Labelling
Labelling is used to obtain valid solutions for a set of variables. The embedded list
monad allows us to search for and return all possible solutions.
-- Label variables using a depth-first left-to-right search.
varsLabelling :: [FDVar] -> FD [Int]
varsLabelling = mapM label where
label var = do
vals <- lookup var
val <- lift $ elems vals
var ‘hasValue‘ val
return val

We now have enough to solve Sudoku!
sudoku :: [Int] -> [[Int]]
sudoku puzzle = runFD $ do
vars <- newVars 81 (1, 9)
zipWithM_ (x n -> when (n > 0) (x ‘hasValue‘ n)) vars puzzle
mapM_ varsAllDifferent (rows vars)
mapM_ varsAllDifferent (columns vars)
mapM_ varsAllDifferent (boxes vars)
varsLabelling vars
rows, columns, boxes :: [a] -> [[a]]
rows = chunk 9
columns = transpose . rows
boxes = concat . map (map concat . transpose) . chunk 3 . chunk 3 . chunk 3
chunk :: Int -> [a] -> [[a]]
chunk _ [] = []
chunk n xs = ys : chunk n zs where
(ys, zs) = splitAt n xs

Arithemtic expressions
• So far we have seen how to declare contraint variables and deﬁne simple equality
constraints between them.
• We also want to be able to write constraints involving simple arithmetic
expressions.

data FDExpr
= Int !Int
| Var !FDVar
| Plus !FDExpr !FDExpr
| Minus !FDExpr !FDExpr
| Times !FDExpr !FDExpr
| Negate !FDExpr
| Abs !FDExpr
| Signum !FDExpr
-- Num instance allows us to use the usual arithmetic operators
-- and integer literals
instance Num FDExpr where
(+) = Plus
(-) = Minus
(*) = Times
negate = Negate
abs = Abs
signum = Signum
fromInteger = Int . fromInteger

-- Define new variables and return as expressions
new :: ToDomain a => a -> FD FDExpr
new d = newVar d <&> Var
news :: ToDomain a => Int -> a -> FD [FDExpr]
news n d = replicateM n $ new d
-- Interpret an FDExpr and return an FDVar representing it
interpret :: FDExpr -> FD FDVar
interpret (Var v) = return v
interpret (Int i) = newVar [i]
interpret (Plus e0 e1) = interpretBinary (+) e0 e1
interpret (Minus e0 e1) = interpretBinary (-) e0 e1
interpret (Times e0 e1) = interpretBinary (*) e0 e1
interpret (Negate e) = interpretUnary negate e
interpret (Abs e) = interpretUnary abs e
interpret (Signum e) = interpretUnary signum e

interpretBinary :: (Int -> Int -> Int) -> FDExpr -> FDExpr -> FD FDVar
interpretBinary op e0 e1 = do
v0 <- interpret e0
v1 <- interpret e1
d0 <- lookup v0
d1 <- lookup v1
v <- newVar [n0 ‘op‘ n1 | n0 <- elems d0, n1 <- elems d1]
let pc = constrainBinary (n n0 n1 -> n == n0 ‘op‘ n1) v v0 v1
nc0 = constrainBinary (n0 n n1 -> n == n0 ‘op‘ n1) v0 v v1
nc1 = constrainBinary (n1 n n0 -> n == n0 ‘op‘ n1) v1 v v0
addConstraint v0 $ pc >> nc1
addConstraint v1 $ pc >> nc0
addConstraint v $ nc0 >> nc1
return v
constrainBinary :: (Int -> Int -> Int -> Bool) -> FDVar -> FDVar -> FDVar -> FDConstraint
constrainBinary pred v v0 v1 = do
d <- lookup v
d0 <- lookup v0
d1 <- lookup v1
let d’ = toDomain [n | n <- elems d, n0 <- elems d0, n1 <- elems d1, pred n n0 n1]
guard $ not $ Domain.null d’
when (d’ /= d) $ update v d’

infix 4 #=
(#=) :: FDExpr -> FDExpr -> FDConstraint
a #= b = do
v0 <- interpret a
v1 <- interpret b
v0 ‘different‘ v1
allDifferent :: [FDExpr] -> FDConstraint
allDifferent = varsAllDifferent <=< mapM interpret
labelling :: [FDExpr] -> FD [Int]
labelling = varsLabelling <=< mapM interpret

SEND
+ MORE
-------
MONEY
sendMoreMoney = runFD $ do
vars@[s, e, n, d, m, o, r, y] <- news 8 (0, 9)
s #= 0
m #= 0
allDifferent vars
1000 * s + 100 * e + 10 * n + d
+ 1000 * m + 100 * o + 10 * r + e
#== 10000 * m + 1000 * o + 100 * n + 10 * e + y
labelling vars

Consclusion
• Haskell can do constraint logic programming – all you need is monads.
• Advantages of Haskell
• Awesomeness of Haskell.
• Type safety.
• Leverage libraries, such as monad combinators, in a very natural way.
• Disadvantages
• Not full Prolog, e.g. missing uniﬁcation between terms, multi-moded predicates.
• Some Prolog implementations have very powerful and eﬃcient built-in solvers, which
Haskell can’t use.
Github repository: https://github.com/dmoverton/finite-domain

Constraint Programming in Haskell

More Related Content

What's hot (20)

Viewers also liked (11)

Similar to Constraint Programming in Haskell (20)

Recently uploaded (20)

Constraint Programming in Haskell