DCFL 0.1.5.0 → 0.1.6.0

raw patch · 2 files changed

+70/−19 lines, 2 filesdep +paralleldep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: parallel

Dependency ranges changed: deepseq

API changes (from Hackage documentation)

Files

• DCFL.cabal +2/−2
• src/Data/DCFL.hs +68/−17

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.5.0+version:             0.1.6.0  -- A short (one-line) description of the package. synopsis:           Communication Free Learning-based constraint solver@@ -57,5 +57,5 @@   -- other-modules:             -- Other library packages from which modules are imported.-  build-depends:       base >=4.6 && <= 5.0, random >=1.0, HUnit >=1.2, deepseq ==1.4+  build-depends:       base >=4.6 && <= 5.0, random >=1.0, HUnit >=1.2, deepseq >=1.2, parallel >=3.0   ghc-options:         -Wall

@@ -5,7 +5,39 @@ -- Each process runs in parallel for every variable. -- Maintain a probability distribution for the variable -- Update it based on whether or not constraints are satisfied-module Data.DCFL where+module Data.DCFL (+  Distribution,+  Values,+  Variable,+  ConstraintEl,+  Solved,++  -- * Distributions+  initDistribution,+  cummDistribution,+  checkSolved,++  -- * Variables+  randomizeSingle,+  randomize,+  printVariables,++  -- * Constraints+  getConstraintsFor,+  justConstraints,++  -- * Solving+  -- ** Serial/Single Threaded+  solve,+  update,+  updateEach,+  updateEachTimes,++  -- ** Parallelized+  solveParallel,+  updateEachTimesParallel,+  updateEachParallel+) where import System.Random import Control.Parallel.Strategies import Control.DeepSeq@@ -19,8 +51,8 @@ -- |The integer values a 'Variable' can take on. data Values = Values [Integer] deriving Show --- |Each variable has a finite set of possible values, a value it holds--- at a given point and a probability distribution over the set of possible values.+-- |Each 'Variable' has a finite set of possible values, a value it holds+-- and a probability distribution over the set of possible values. data Variable = Variable {possible::[Int], valueIndex::Int,    distr::Distribution} deriving (Show) @@ -28,7 +60,7 @@   rnf (Variable possible valueIndex distr) = rnf (possible, valueIndex, distr)  -- |Each constraint function ([Int] -> Bool) is associated with a certain set of--- variables. 'ConstraintEl' represents this relationship for a constraint+-- variables. 'ConstraintEl' represents this relationship for a given constraint -- function. data ConstraintEl = ConstraintEl {variableIndices :: [Int],   constraint :: ([Int] -> Bool)}@@ -41,6 +73,7 @@     "Constraint " ++ (show variableIndices)  -- |Returns the number of finite values that a `Distribution` is over.+width :: Distribution -> Int width (Distribution p) = fromIntegral $ length p  -- |Constant, as defined in the research paper "Decentralized Constraint Satisfaction"@@ -48,6 +81,7 @@ b = 0.1 :: Double  -- |Internally called function.+oneIfEqual :: (Eq a) => a -> a -> Int oneIfEqual x val   | val == x = 1   | otherwise = 0@@ -62,17 +96,21 @@ -- @ --  'Distribution' [0.2, 0.2, 0.2, 0.2, 0.2]. -- @+initDistribution :: Int -> Distribution initDistribution width = Distribution $    replicateDouble width (1.0/(fromIntegral width))  -- |Adjust probability for the value which has just failed a constraint.-failureCurrProb width currValue = (1.0-b)*currValue+failureCurrProb :: Int -> Double -> Double+failureCurrProb _ currValue = (1.0-b)*currValue  -- |Adjust probability for values other than the one that just failed a constraint.-failureOtherProb width currValue = ((1.0-b)*currValue) + (b/(width-1.0))+failureOtherProb :: Int -> Double -> Double +failureOtherProb width currValue = ((1.0-b)*currValue) + (b/((fromIntegral $ width)-1.0))  -- |Adjust probability of taking on a value for a certain 'Variable' given that -- a constraint was just failed.+failureProb :: Int -> Int -> Double -> Int -> Double failureProb width valueIndex currValue currIndex   | valueIndex == currIndex = failureCurrProb width currValue   | otherwise = failureOtherProb width currValue@@ -81,28 +119,34 @@ -- If successful, then set the probability of the current value to 1.0 and the -- probability for every other value to 0.0.  -- Otherwise, update it with failureProb.+updateProb :: Distribution -> Int -> Bool -> Distribution updateProb dist@(Distribution p) valueIndex success   -- if successful, we update the distribution-  | success = Distribution $ map (\x -> oneIfEqual (snd x) valueIndex) $ zip p [0..]+  | success = Distribution $ +    map (\x -> fromIntegral $ oneIfEqual (snd x) valueIndex) $ zip p [0..]   | otherwise = Distribution $ map (\x ->      failureProb (width dist) valueIndex (fst x) (snd x)) $ zip p [0..]  -- |Same as 'updateProb', but rather than returning a 'Distribution', this function -- returns a 'Variable'.+updateVariableProb :: Variable -> Bool -> Variable updateVariableProb (Variable possib valIndex dist) success =    Variable possib valIndex $ updateProb dist valIndex success  -- |Internal iteration function used by 'cummDistribution'.+cummDistributionIter :: Distribution -> Int -> Double -> [Double] cummDistributionIter dist@(Distribution p) ind curr   | ind == length p = []   | otherwise = newCurr : (cummDistributionIter dist (ind + 1) (newCurr)) where     newCurr = curr + (p !! ind)  -- |Creates a cummulative 'Distribution' out of a given 'Distribution'.+cummDistribution :: Distribution -> Distribution cummDistribution dist@(Distribution p) = Distribution $ cummDistributionIter dist 0 0  -- |Given a cummulative 'Distribution', this function returns the where a random -- value should be "placed" within the 'Distribution'.+getValueIndex :: Distribution -> Double -> Int getValueIndex (Distribution p) randValue =    length $ takeWhile (\x -> randValue > (fst x)) $ zip p [0..] @@ -113,6 +157,7 @@   return x  -- |Randomize the value of a 'Variable'.+randomizeVariable :: Variable -> IO Variable randomizeVariable var@(Variable p v dist) = do   randVal <- randomNum   let newValIndex = getValueIndex (cummDistribution dist) randVal in@@ -128,6 +173,7 @@   foldr (&&) True $ map (\c -> evalConstraint c values) constraints  -- |Apply a function at only one index of a list. Internal function.+applyAt :: (a -> a) -> Int -> [a] -> [a] applyAt f index list =    map (\x -> if (snd x) == index then f (fst x)                                  else (fst x)) $ zip list [0..]@@ -139,6 +185,7 @@   [constraint | ConstraintEl [a, b] constraint <- constraintSet, ((a == n) || (b == n))]  -- |Get the constraint functions out of a list of 'ConstraintEl's.+justConstraints :: [ConstraintEl] -> [[Int] -> Bool] justConstraints = map constraint  -- |Get a list of values from a list of 'Variable's.@@ -151,9 +198,11 @@                                          else return $ (fst x)) $ zip variables [0..]  -- | Randomize all the variables in a list.+randomize :: [Variable] -> [IO Variable] randomize variables = map randomizeVariable variables  -- |Print variables.+printVariables :: [Variable] -> [IO ()] printVariables variables = do   map (putStrLn . show) variables @@ -197,10 +246,12 @@  -- |Checks if every probability in the distribution is either 0 or 1. If it is, -- then, all constraints have been satisfied.+checkDistrSolved :: Distribution -> Bool checkDistrSolved (Distribution probab) = all (\x -> x == 0.0 || x == 1.0) probab  -- |Check if the constraints have been solved by looking at the distributions -- of each 'Variable'.+checkSolved :: [Variable] -> Bool checkSolved [] = True checkSolved (var:vars)   | checkDistrSolved $ distr var = checkSolved vars@@ -208,7 +259,7 @@  -- |This is the moost important function within this library. Given a list of -- 'Variable' and a list of 'ConstraintEl', the library uses the Communcation Free Learning--- Algorithm to return a 'Solved' value. Note that the implementation is not parallelized./+-- Algorithm to return a 'Solved' value. See 'solveThreaded' for a parallelized implementation. solve :: [Variable] -> [ConstraintEl] -> IO Solved solve vars constraints = do   rvars <- updateEachTimes vars constraints 10@@ -226,25 +277,25 @@  -- |Updates each variable in the variable set a number of times and does each -- variable's update in a separate thread.-updateEachThreaded :: Int -> [Variable] -> [ConstraintEl] -> IO [Variable]-updateEachThreaded numThreads variables constraints = do+updateEachParallel :: [Variable] -> [ConstraintEl] -> IO [Variable]+updateEachParallel variables constraints = do   m <- sequence $ map (updateMapF variables constraints) [0..(length variables)]   -- evaluate the map in parallel   let mp = m `using` parList rdeepseq in return mp -updateEachTimesThreaded :: Int -> [Variable] -> [ConstraintEl] -> Int -> IO [Variable]-updateEachTimesThreaded numThreads variables constraints times+updateEachTimesParallel :: [Variable] -> [ConstraintEl] -> Int -> IO [Variable]+updateEachTimesParallel variables constraints times   | times == 0 = return variables   | otherwise = do-    rvars <- updateEachThreaded numThreads variables constraints-    updateEachTimesThreaded numThreads variables constraints (times - 1)+    rvars <- updateEachParallel variables constraints+    updateEachTimesParallel variables constraints (times - 1)  -- |Solve the constraint set in parallel using Haskell threads. In order for -- the solution to be parallelized, the program using DCFL must be compiled -- with GHC's '-threaded' option.-solveThreaded :: Int -> [Variable] -> [ConstraintEl] -> IO Solved-solveThreaded numThreads vars constraints = do-  rvars <- updateEachTimesThreaded numThreads vars constraints 10+solveParallel :: [Variable] -> [ConstraintEl] -> IO Solved+solveParallel vars constraints = do+  rvars <- updateEachTimesParallel vars constraints 10   if checkSolved rvars     then return $ Solved rvars 0     else do