## Friday, 17 October 2008

### A CLP style command line interface for Overton's finite-domain contraint solver

Recently, David Overton presented the core of a finite-domain constraint solver written in Haskell. Trying to extend the solver, I soon noticed that the only way to look into the constraint store is to enumerate all solutions by means of the labeling function. Hence I developed some functions to display the constrained variables along with their domains. Before presenting these tools, I want to give an idea of what I am up to. Here is a sample session with the constraint-logic programming (CLP) system SICStus Prolog:

```| ?- X in 1..3, Y in 1..3, X #< Y.
X in 1..2,
Y in 2..3 ? ;
no

X in 1..3, Y in 1..3, X #< Y, labeling([leftmost], [X, Y]).
X = 1,
Y = 2 ? ;
X = 1,
Y = 3 ? ;
X = 2,
Y = 3 ? ;
no
```

In the first place, variables need to be named:

```data VarInfo s = VarInfo
{ varName :: String, delayedConstraints :: FD s (), values :: IntSet }
```

By default, variables are attributed with a name directly derived from their running numbers:

```-- Get a new FDVar
newVar :: [Int] -> FD s (FDVar s)
newVar domain = do
v <- nextVar
v `isOneOf` domain
return v
where
nextVar :: FD s (FDVar s)
nextVar = do
s <- get
let v = varSupply s
put \$ s { varSupply = FDVar (unFDVar v + 1) }
return v
isOneOf :: FDVar s -> [Int] -> FD s ()
x `isOneOf` domain=
modify \$ \s ->
let vm = varMap s
vi = VarInfo {
varName = "_" ++ show (unFDVar x),
delayedConstraints = return (),
values = IntSet.fromList domain}
in
s { varMap = Map.insert x vi vm }
```

Next is a function for adding a named variable to the constraint store:

```newNamedVar :: [Int] -> String -> FD s (FDVar s)
newNamedVar domain name = do
x <- newVar domain
nameVar x name
return x
where
nameVar :: FDVar s -> String -> FD s ()
nameVar x name =
modify \$ \s ->
let vm = varMap s
vi = vm ! x
in
s { varMap = Map.insert x (vi {varName = name}) vm }
```

For displaying variables, we will use Text.PrettyPrint:

```import qualified Text.PrettyPrint as PP
```

prettyDomain produces a document for printing the given variable's domain in set notation:

```prettyDomain :: VarInfo s -> PP.Doc
prettyDomain =
PP.braces . PP.hcat . PP.punctuate PP.comma . map PP.int .
IntSet.toAscList . values
```

prettyVars produces a document for printing the given variable's name followed by a colon and its domain:

```prettyVar :: VarInfo s -> PP.Doc
prettyVar vi =
PP.text (varName vi) PP.<> PP.colon PP.<+> prettyDomain vi
```

prettyStore retrieves the current state of computation by means of get, pretty prints its variables in order of their names, and joins the resulting documents into a single document:

```prettyStore :: FD s PP.Doc
prettyStore = do
s <- get
(return . PP.vcat . map prettyVar . List.sortBy ord .
map snd . Map.toList . varMap) s
where
ord :: VarInfo s -> VarInfo s -> Ordering
ord vi1 vi2 = compare (varName vi1) (varName vi2)
```

printStores executes prettyStore after the given FD monad, and renders the resulting documents to stdout:

```printStores :: (forall s . FD s a) -> IO ()
printStores fd =
(putStrLn . PP.render . PP.vcat . PP.punctuate newline . runFD)
(do fd; prettyStore)
where
newline :: PP.Doc
newline =  PP.text "\n"
```

To test printStores, we define setupProblem:

```setupProblem :: FD s [FDVar s]
setupP1 = do
x <- newNamedVar [1..3] "x"
y <- newNamedVar [1..3] "y"
( x .<. y)
return [x, y]
```

Without labeling, printStores prints the variables of the computation state produced by setupProblem:

```*Main> printStores (do vars <- setupProblem; return ())
x: {0,1,2}
y: {1,2,3}
```
Note how (.<.) already has reduced the domains of x and y.

When combined with labeling, printStores prints the three solutions to the problem stated by setupProblem:

```*Main> printStores (do vars <- setupProblem; labelling vars)
x: {1}
y: {2}

x: {1}
y: {3}

x: {2}
y: {3}
```

Finally, the function clp implements a CLP style command line interface:

```clp :: (forall s . FD s a) -> IO ()
clp fd = do
present (runFD (do fd; prettyStore))
where
present :: [PP.Doc] -> IO ()
present [] = do
putStrLn "no"
present (doc : docs) = do
putStr (PP.render doc)
putStr " ? "
""  -> putStrLn "yes"
"y" -> putStrLn "yes"
";" -> do present docs
"n" -> do present docs
_   -> do help; present (doc : docs)
help :: IO ()
help = do
putStrLn "   RET y     no more choices"
putStrLn "     ; n     more choices"
putStrLn "       h     print this information"
```

Here is a sample session:

```*Main> clp (do vars <- setupProblem; return ())
x: {1,2}
y: {2,3} ? h
RET y     no more choices
; n     more choices
h     print this information
x: {1,2}
y: {2,3} ? ;
no

*Main> clp (do vars <- setupProblem; labelling vars)
x: {1}
y: {2} ? ;
x: {1}
y: {3} ? ;
x: {2}
y: {3} ? ;
no
```