{- - Monadic Constraint Programming - http://www.cs.kuleuven.be/~toms/Haskell/ - Tom Schrijvers -} module Language.CP.Main where import Language.CP.ComposableTransformers import Language.CP.FD import Language.CP.FDSugar import List (tails) import Language.CP.SearchTree hiding (label) import System (getArgs) -------------------------------------------------------------------------------- -- MAIN FUNCTIONS -------------------------------------------------------------------------------- main = main1 main1 = getArgs >>= print . solve dfs it . nqueens . read . head main2 = getArgs >>= print . solve dfs (nb 100 :- db 25 :- bb newBound) . nqueens . read . head main3 = getArgs >>= print . solve dfs (db 9) . nqueens . read . head main4 = do (n1:_) <- getArgs let n = read n1 loop 1 n where loop i n | i > n = return () | otherwise = do -- print . (\(i,l) -> (i,not $ Prelude.null l)) . solve dfs (it :- fs :- ra 13 :- ld l) . nqueens $ i print . (\(i,l) -> (i, {- not $ Prelude.null-} l)) . restart dfs (map db [3..10]) . nqueens $ i -- print . (\(i,l) -> (i, {- not $ Prelude.null-} l)) . restartOpt dfs (replicate 10 fs) . nqueens $ i loop (i+1) n main5 = getArgs >>= loop 1 . read . head where loop i n | i > n = return () | otherwise = do print . (\(i,l) -> (i,minimum l)) . solve dfs (ld 5 :- bb newBoundBis) . gmodel $ i loop (i+1) n -------------------------------------------------------------------------------- -- PATH MODEL -------------------------------------------------------------------------------- gmodel n = NewVar $ \_ -> path 1 n 0 path :: Int -> Int -> Int -> Tree FD Int path x y d = if x == y then Return d else disj [ Label (fd_objective >>= \o -> return (o @> (d+d' - 1) /\ (path z y (d+d')))) | (z,d') <- edge x ] edge i | i < 20 = [ (i+1,4), (i+2,1) ] | otherwise = [] -------------------------------------------------------------------------------- -- N QUEENS MODEL -------------------------------------------------------------------------------- nqueens n = exist n $ \queens -> queens `allin` (1,n) /\ alldifferent queens /\ diagonals queens /\ -- enumerate ({- middleout -} endsout queens) /\ -- enumerate (middleout queens) /\ enumerate (queens) /\ assignments queens allin queens range = conj [q `in_domain` range | q <- queens ] alldifferent :: [ FD_Term ] -> Tree FD () alldifferent queens = conj [ qi @\= qj | qi:qjs <- tails queens , qj <- qjs ] diagonals queens = conj [ qi @\== (qj @+ d) /\ qj @\== (qi @+ d) | qi:qjs <- tails queens , (qj,d) <- zip qjs [1..] ]