module Data.IFS.Algorithm (
defaultTermination,
ifs
) where
import Control.Arrow ( Arrow((&&&)) )
import Control.Monad.Trans.Class ( MonadTrans(lift) )
import Control.Monad.Trans.Reader
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Maybe ( fromJust )
import System.Random
import Data.IFS.Types
defaultTermination :: Int
-> Assignment
-> CSPMonad Solution (Maybe Solution)
defaultTermination :: Int -> Assignment -> CSPMonad Solution (Maybe Solution)
defaultTermination Int
iterations Assignment
currAssign = do
Variables
vars <- CSP Solution -> Variables
forall r. CSP r -> Variables
cspVariables (CSP Solution -> Variables)
-> ReaderT (CSP Solution) IO (CSP Solution)
-> ReaderT (CSP Solution) IO Variables
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (CSP Solution) IO (CSP Solution)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
case (Variables -> Int
IS.size Variables
vars Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Assignment -> Int
forall a. IntMap a -> Int
IM.size Assignment
currAssign, Int
iterations Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
25 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Variables -> Int
IS.size Variables
vars) of
(Bool
True, Bool
True) -> Maybe Solution -> CSPMonad Solution (Maybe Solution)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Solution
forall a. Maybe a
Nothing
(Bool
True, Bool
False) -> Maybe Solution -> CSPMonad Solution (Maybe Solution)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Solution -> CSPMonad Solution (Maybe Solution))
-> Maybe Solution -> CSPMonad Solution (Maybe Solution)
forall a b. (a -> b) -> a -> b
$ Solution -> Maybe Solution
forall a. a -> Maybe a
Just (Solution -> Maybe Solution) -> Solution -> Maybe Solution
forall a b. (a -> b) -> a -> b
$ Assignment -> Solution
Incomplete Assignment
currAssign
(Bool
False, Bool
_) -> Maybe Solution -> CSPMonad Solution (Maybe Solution)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Solution -> CSPMonad Solution (Maybe Solution))
-> Maybe Solution -> CSPMonad Solution (Maybe Solution)
forall a b. (a -> b) -> a -> b
$ Solution -> Maybe Solution
forall a. a -> Maybe a
Just (Solution -> Maybe Solution) -> Solution -> Maybe Solution
forall a b. (a -> b) -> a -> b
$ Assignment -> Solution
Complete Assignment
currAssign
getMostRestricted :: Variables
-> Domains
-> Constraints
-> IM.IntMap [Var]
getMostRestricted :: Variables -> Domains -> Constraints -> IntMap [Int]
getMostRestricted Variables
vars Domains
doms Constraints
cons =
([Int] -> [Int] -> [Int]) -> [(Int, [Int])] -> IntMap [Int]
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [Int])] -> IntMap [Int]) -> [(Int, [Int])] -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ ((Int -> (Int, [Int])) -> [Int] -> [(Int, [Int])])
-> [Int] -> (Int -> (Int, [Int])) -> [(Int, [Int])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> (Int, [Int])) -> [Int] -> [(Int, [Int])]
forall a b. (a -> b) -> [a] -> [b]
map (Variables -> [Int]
IS.toList Variables
vars) ((Int -> (Int, [Int])) -> [(Int, [Int])])
-> (Int -> (Int, [Int])) -> [(Int, [Int])]
forall a b. (a -> b) -> a -> b
$ \Int
var ->
(Variables -> Int
IS.size (Domains
doms Domains -> Int -> Variables
forall a. IntMap a -> Int -> a
IM.! Int
var) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Constraints -> Int
forall (t :: * -> *) a b.
(Foldable t, Num a) =>
Int -> t (Variables, b) -> a
countConnectedCons Int
var Constraints
cons, [Int
var])
where
countConnectedCons :: Int -> t (Variables, b) -> a
countConnectedCons Int
var = ((a -> (Variables, b) -> a) -> a -> t (Variables, b) -> a)
-> a -> (a -> (Variables, b) -> a) -> t (Variables, b) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> (Variables, b) -> a) -> a -> t (Variables, b) -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a
0 ((a -> (Variables, b) -> a) -> t (Variables, b) -> a)
-> (a -> (Variables, b) -> a) -> t (Variables, b) -> a
forall a b. (a -> b) -> a -> b
$ \a
conflicting (Variables
conVars, b
_) ->
if Int
var Int -> Variables -> Bool
`IS.member` Variables
conVars
then a
conflicting a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
else a
conflicting
selectVariable :: Int -> Assignment -> CSPMonad r Var
selectVariable :: Int -> Assignment -> CSPMonad r Int
selectVariable Int
iterations Assignment
currAssignment = do
MkCSP{Int
Constraints
Domains
Variables
Int -> Assignment -> CSPMonad r (Maybe r)
cspTermination :: forall r. CSP r -> Int -> Assignment -> CSPMonad r (Maybe r)
cspRandomCap :: forall r. CSP r -> Int
cspConstraints :: forall r. CSP r -> Constraints
cspDomains :: forall r. CSP r -> Domains
cspTermination :: Int -> Assignment -> CSPMonad r (Maybe r)
cspRandomCap :: Int
cspConstraints :: Constraints
cspVariables :: Variables
cspDomains :: Domains
cspVariables :: forall r. CSP r -> Variables
..} <- ReaderT (CSP r) IO (CSP r)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let unassigned :: Variables
unassigned = Variables
cspVariables Variables -> Variables -> Variables
IS.\\ [Int] -> Variables
IS.fromList (Assignment -> [Int]
forall a. IntMap a -> [Int]
IM.keys Assignment
currAssignment)
let restricted :: IntMap [Int]
restricted = Variables -> Domains -> Constraints -> IntMap [Int]
getMostRestricted Variables
unassigned Domains
cspDomains Constraints
cspConstraints
if Int
iterations Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cspRandomCap
then
let toChoseFrom :: [Int]
toChoseFrom = (Int, [Int]) -> [Int]
forall a b. (a, b) -> b
snd ((Int, [Int]) -> [Int]) -> (Int, [Int]) -> [Int]
forall a b. (a -> b) -> a -> b
$ IntMap [Int] -> (Int, [Int])
forall a. IntMap a -> (Int, a)
IM.findMin IntMap [Int]
restricted
in ([Int]
toChoseFrom [Int] -> Int -> Int
forall a. [a] -> Int -> a
!!) (Int -> Int) -> CSPMonad r Int -> CSPMonad r Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> CSPMonad r Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Int, Int) -> IO Int
forall a. Random a => (a, a) -> IO a
randomRIO (Int
0, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
toChoseFrom Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
else
let unassignedList :: [Int]
unassignedList = Variables -> [Int]
IS.toList Variables
unassigned
in ([Int]
unassignedList [Int] -> Int -> Int
forall a. [a] -> Int -> a
!!) (Int -> Int) -> CSPMonad r Int -> CSPMonad r Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> CSPMonad r Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Int, Int) -> IO Int
forall a. Random a => (a, a) -> IO a
randomRIO (Int
0, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
unassignedList Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
setValue :: Assignment
-> Var
-> CSPMonad r Assignment
setValue :: Assignment -> Int -> CSPMonad r Assignment
setValue Assignment
currAssign Int
var = do
(Domains
doms, Constraints
cons) <- (CSP r -> Domains
forall r. CSP r -> Domains
cspDomains (CSP r -> Domains)
-> (CSP r -> Constraints) -> CSP r -> (Domains, Constraints)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CSP r -> Constraints
forall r. CSP r -> Constraints
cspConstraints) (CSP r -> (Domains, Constraints))
-> ReaderT (CSP r) IO (CSP r)
-> ReaderT (CSP r) IO (Domains, Constraints)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (CSP r) IO (CSP r)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let domain :: Variables
domain = ((Int -> Bool) -> Variables -> Variables)
-> Variables -> (Int -> Bool) -> Variables
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Bool) -> Variables -> Variables
IS.filter (Maybe Variables -> Variables
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Variables -> Variables) -> Maybe Variables -> Variables
forall a b. (a -> b) -> a -> b
$ Int -> Domains -> Maybe Variables
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
var Domains
doms) ((Int -> Bool) -> Variables) -> (Int -> Bool) -> Variables
forall a b. (a -> b) -> a -> b
$ \Int
val ->
Assignment -> Constraints -> Integer
forall (t :: * -> *) a t a.
(Foldable t, Num a) =>
t -> t (a, t -> Bool) -> a
countConflicts (Int -> Int -> Assignment
forall a. Int -> a -> IntMap a
IM.singleton Int
var Int
val) Constraints
cons Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
if Variables -> Bool
IS.null Variables
domain
then Assignment -> CSPMonad r Assignment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assignment
currAssign
else do
let conflictMap :: IntMap [Assignment]
conflictMap = ([Assignment] -> [Assignment] -> [Assignment])
-> [(Int, [Assignment])] -> IntMap [Assignment]
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromListWith [Assignment] -> [Assignment] -> [Assignment]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [Assignment])] -> IntMap [Assignment])
-> [(Int, [Assignment])] -> IntMap [Assignment]
forall a b. (a -> b) -> a -> b
$ ((Int -> (Int, [Assignment])) -> [Int] -> [(Int, [Assignment])])
-> [Int] -> (Int -> (Int, [Assignment])) -> [(Int, [Assignment])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> (Int, [Assignment])) -> [Int] -> [(Int, [Assignment])]
forall a b. (a -> b) -> [a] -> [b]
map (Variables -> [Int]
IS.toList Variables
domain)
((Int -> (Int, [Assignment])) -> [(Int, [Assignment])])
-> (Int -> (Int, [Assignment])) -> [(Int, [Assignment])]
forall a b. (a -> b) -> a -> b
$ \Int
val ->
let assignment :: Assignment
assignment = Int -> Int -> Assignment -> Assignment
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
var Int
val Assignment
currAssign
in (Assignment -> Constraints -> Int
forall (t :: * -> *) a t a.
(Foldable t, Num a) =>
t -> t (a, t -> Bool) -> a
countConflicts Assignment
assignment Constraints
cons, [Assignment
assignment])
let cap :: Int
cap = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
0.1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Variables -> Int
IS.size Variables
domain)
let toChoseFrom :: [Assignment]
toChoseFrom = Int -> Int -> [Assignment] -> IntMap [Assignment] -> [Assignment]
getToChoseFrom Int
0 Int
cap [] IntMap [Assignment]
conflictMap
([Assignment]
toChoseFrom [Assignment] -> Int -> Assignment
forall a. [a] -> Int -> a
!!) (Int -> Assignment)
-> ReaderT (CSP r) IO Int -> CSPMonad r Assignment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> ReaderT (CSP r) IO Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Int, Int) -> IO Int
forall a. Random a => (a, a) -> IO a
randomRIO (Int
0, [Assignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Assignment]
toChoseFrom Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
where
countConflicts :: t -> t (a, t -> Bool) -> a
countConflicts t
assignment = ((a -> (a, t -> Bool) -> a) -> a -> t (a, t -> Bool) -> a)
-> a -> (a -> (a, t -> Bool) -> a) -> t (a, t -> Bool) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> (a, t -> Bool) -> a) -> a -> t (a, t -> Bool) -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl a
0 ((a -> (a, t -> Bool) -> a) -> t (a, t -> Bool) -> a)
-> (a -> (a, t -> Bool) -> a) -> t (a, t -> Bool) -> a
forall a b. (a -> b) -> a -> b
$
\a
conflicting (a
_, t -> Bool
constraintF) ->
if t -> Bool
constraintF t
assignment
then a
conflicting
else a
conflicting a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
getToChoseFrom :: Int
-> Int
-> [Assignment]
-> IM.IntMap [Assignment]
-> [Assignment]
getToChoseFrom :: Int -> Int -> [Assignment] -> IntMap [Assignment] -> [Assignment]
getToChoseFrom Int
n Int
cap [Assignment]
added IntMap [Assignment]
toAdd
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
cap = [Assignment]
added
| Bool
otherwise = let ((Int
_,[Assignment]
as), IntMap [Assignment]
toAdd') = IntMap [Assignment] -> ((Int, [Assignment]), IntMap [Assignment])
forall a. IntMap a -> ((Int, a), IntMap a)
IM.deleteFindMin IntMap [Assignment]
toAdd
in Int -> Int -> [Assignment] -> IntMap [Assignment] -> [Assignment]
getToChoseFrom (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Assignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Assignment]
as)
Int
cap
([Assignment]
added [Assignment] -> [Assignment] -> [Assignment]
forall a. [a] -> [a] -> [a]
++ [Assignment]
as)
IntMap [Assignment]
toAdd'
removeConflicts' :: Var
-> Assignment
-> (Assignment -> Bool)
-> IM.IntMap [Var]
-> Assignment
removeConflicts' :: Int
-> Assignment -> (Assignment -> Bool) -> IntMap [Int] -> Assignment
removeConflicts' Int
var Assignment
assign Assignment -> Bool
constraintF IntMap [Int]
toRemove
| Assignment -> Bool
constraintF Assignment
assign = Assignment
assign
| Bool
otherwise =
let
(Int
_, Int
x:[Int]
remaining) = IntMap [Int] -> (Int, [Int])
forall a. IntMap a -> (Int, a)
IM.findMax IntMap [Int]
toRemove
toRemove' :: IntMap [Int]
toRemove' = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
remaining
then ((Int, [Int]), IntMap [Int]) -> IntMap [Int]
forall a b. (a, b) -> b
snd (((Int, [Int]), IntMap [Int]) -> IntMap [Int])
-> ((Int, [Int]), IntMap [Int]) -> IntMap [Int]
forall a b. (a -> b) -> a -> b
$ IntMap [Int] -> ((Int, [Int]), IntMap [Int])
forall a. IntMap a -> ((Int, a), IntMap a)
IM.deleteFindMax IntMap [Int]
toRemove
else ([Int] -> Maybe [Int]) -> IntMap [Int] -> IntMap [Int]
forall a. (a -> Maybe a) -> IntMap a -> IntMap a
IM.updateMax (Maybe [Int] -> [Int] -> Maybe [Int]
forall a b. a -> b -> a
const (Maybe [Int] -> [Int] -> Maybe [Int])
-> Maybe [Int] -> [Int] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> Maybe [Int]
forall a. a -> Maybe a
Just [Int]
remaining) IntMap [Int]
toRemove
newAssign :: Assignment
newAssign = if Int
xInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
var then Assignment
assign else Int -> Assignment -> Assignment
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
x Assignment
assign
in Int
-> Assignment -> (Assignment -> Bool) -> IntMap [Int] -> Assignment
removeConflicts' Int
var Assignment
newAssign Assignment -> Bool
constraintF IntMap [Int]
toRemove'
removeConflicts :: Assignment
-> Var
-> CSPMonad r Assignment
removeConflicts :: Assignment -> Int -> CSPMonad r Assignment
removeConflicts Assignment
currAssignment Int
var = do
(Domains
doms, Constraints
cons) <- (CSP r -> Domains
forall r. CSP r -> Domains
cspDomains (CSP r -> Domains)
-> (CSP r -> Constraints) -> CSP r -> (Domains, Constraints)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& CSP r -> Constraints
forall r. CSP r -> Constraints
cspConstraints) (CSP r -> (Domains, Constraints))
-> ReaderT (CSP r) IO (CSP r)
-> ReaderT (CSP r) IO (Domains, Constraints)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (CSP r) IO (CSP r)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Assignment -> CSPMonad r Assignment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Assignment -> CSPMonad r Assignment)
-> Assignment -> CSPMonad r Assignment
forall a b. (a -> b) -> a -> b
$ ((Assignment -> (Variables, Assignment -> Bool) -> Assignment)
-> Constraints -> Assignment)
-> Constraints
-> (Assignment -> (Variables, Assignment -> Bool) -> Assignment)
-> Assignment
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Assignment -> (Variables, Assignment -> Bool) -> Assignment)
-> Assignment -> Constraints -> Assignment)
-> Assignment
-> (Assignment -> (Variables, Assignment -> Bool) -> Assignment)
-> Constraints
-> Assignment
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Assignment -> (Variables, Assignment -> Bool) -> Assignment)
-> Assignment -> Constraints -> Assignment
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Assignment
currAssignment) Constraints
cons ((Assignment -> (Variables, Assignment -> Bool) -> Assignment)
-> Assignment)
-> (Assignment -> (Variables, Assignment -> Bool) -> Assignment)
-> Assignment
forall a b. (a -> b) -> a -> b
$
\Assignment
assign (Variables
constraintVars, Assignment -> Bool
constraintF) ->
if Assignment -> Bool
constraintF Assignment
assign
then Assignment
assign
else Int
-> Assignment -> (Assignment -> Bool) -> IntMap [Int] -> Assignment
removeConflicts' Int
var Assignment
assign Assignment -> Bool
constraintF
(IntMap [Int] -> Assignment) -> IntMap [Int] -> Assignment
forall a b. (a -> b) -> a -> b
$ Variables -> Domains -> Constraints -> IntMap [Int]
getMostRestricted Variables
constraintVars Domains
doms Constraints
cons
getBest :: Assignment
-> Assignment
-> CSPMonad r Assignment
getBest :: Assignment -> Assignment -> CSPMonad r Assignment
getBest Assignment
newAssign Assignment
bestAssign =
case Assignment -> Int
forall a. IntMap a -> Int
IM.size Assignment
newAssign Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Assignment -> Int
forall a. IntMap a -> Int
IM.size Assignment
bestAssign of
Ordering
GT -> Assignment -> CSPMonad r Assignment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assignment
newAssign
Ordering
LT -> Assignment -> CSPMonad r Assignment
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assignment
bestAssign
Ordering
EQ -> do
Bool
useNew <- (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.5) (Double -> Bool)
-> ReaderT (CSP r) IO Double -> ReaderT (CSP r) IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO Double -> ReaderT (CSP r) IO Double
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO Double
forall a. Random a => IO a
randomIO :: CSPMonad r Double)
Assignment -> CSPMonad r Assignment
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Assignment -> CSPMonad r Assignment)
-> Assignment -> CSPMonad r Assignment
forall a b. (a -> b) -> a -> b
$ if Bool
useNew then Assignment
newAssign else Assignment
bestAssign
ifs' :: Int
-> Assignment
-> Assignment
-> CSPMonad r r
ifs' :: Int -> Assignment -> Assignment -> CSPMonad r r
ifs' Int
iterations Assignment
currAssign Assignment
bestAssign = do
Int -> Assignment -> CSPMonad r (Maybe r)
canContinue <- CSP r -> Int -> Assignment -> CSPMonad r (Maybe r)
forall r. CSP r -> Int -> Assignment -> CSPMonad r (Maybe r)
cspTermination (CSP r -> Int -> Assignment -> CSPMonad r (Maybe r))
-> ReaderT (CSP r) IO (CSP r)
-> ReaderT (CSP r) IO (Int -> Assignment -> CSPMonad r (Maybe r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (CSP r) IO (CSP r)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
Maybe r
continue <- Int -> Assignment -> CSPMonad r (Maybe r)
canContinue Int
iterations Assignment
bestAssign
case Maybe r
continue of
Maybe r
Nothing -> do
Int
var <- Int -> Assignment -> CSPMonad r Int
forall r. Int -> Assignment -> CSPMonad r Int
selectVariable Int
iterations Assignment
currAssign
Assignment
newAssignment <- Assignment -> Int -> CSPMonad r Assignment
forall r. Assignment -> Int -> CSPMonad r Assignment
setValue Assignment
currAssign Int
var
Assignment
conflictsRemoved <- Assignment -> Int -> CSPMonad r Assignment
forall r. Assignment -> Int -> CSPMonad r Assignment
removeConflicts Assignment
newAssignment Int
var
Assignment
nextAssignment <- Assignment -> Assignment -> CSPMonad r Assignment
forall r. Assignment -> Assignment -> CSPMonad r Assignment
getBest Assignment
conflictsRemoved Assignment
bestAssign
Int -> Assignment -> Assignment -> CSPMonad r r
forall r. Int -> Assignment -> Assignment -> CSPMonad r r
ifs' (Int
iterationsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Assignment
conflictsRemoved Assignment
nextAssignment
Just r
a -> r -> CSPMonad r r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
a
ifs :: CSP r
-> Assignment
-> IO r
ifs :: CSP r -> Assignment -> IO r
ifs CSP r
csp Assignment
startingAssignment =
ReaderT (CSP r) IO r -> CSP r -> IO r
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Int -> Assignment -> Assignment -> ReaderT (CSP r) IO r
forall r. Int -> Assignment -> Assignment -> CSPMonad r r
ifs' Int
0 Assignment
startingAssignment Assignment
startingAssignment) CSP r
csp