mdp (empty) → 0.1.0.0
raw patch · 19 files changed
+1459/−0 lines, 19 filesdep +HTFdep +HUnitdep +QuickChecksetup-changed
Dependencies added: HTF, HUnit, QuickCheck, base, containers, vector
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- mdp.cabal +86/−0
- src/Algorithms/MDP.hs +227/−0
- src/Algorithms/MDP/CTMDP.hs +145/−0
- src/Algorithms/MDP/Examples.hs +137/−0
- src/Algorithms/MDP/Examples/Ex_3_1.hs +46/−0
- src/Algorithms/MDP/Examples/Ex_3_2.hs +10/−0
- src/Algorithms/MDP/Examples/MM1.hs +167/−0
- src/Algorithms/MDP/ValueIteration.hs +169/−0
- src/run-ex-3-1-relative.hs +23/−0
- src/run-ex-3-1.hs +22/−0
- src/run-ex-3-2.hs +24/−0
- src/run-mm1.hs +60/−0
- testsuite/tests/Algorithms/MDP/Ex_3_1_RelativeTest.hs +123/−0
- testsuite/tests/Algorithms/MDP/Ex_3_1_Test.hs +68/−0
- testsuite/tests/Algorithms/MDP/Ex_3_2_Test.hs +31/−0
- testsuite/tests/Algorithms/MDP/Ex_MM1_Test.hs +86/−0
- testsuite/tests/TestMain.hs +12/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2015-2016 Patrick Steele++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mdp.cabal view
@@ -0,0 +1,86 @@+-- Initial mdp.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/++name: mdp+version: 0.1.0.0+synopsis: Tools for solving Markov Decision Processes.+description: + A library for formulating and solving Markov decision problems.++ We currently only solve infinite horizon problems. We handle+ discounted and undiscounted problems, and can solve continuous- and+ discrete-time problems.++license: MIT+license-file: LICENSE+author: Patrick Steele+maintainer: prs233@cornell.edu+ copyright: Copyright (c) 2015-2016 Patrick Steele+category: Algorithms, Math+build-type: Simple+cabal-version: >=1.8++-- We have to help cabal sdist find imported test files+extra-source-files:+ testsuite/tests/Algorithms/MDP/Ex_3_1_Test.hs+ testsuite/tests/Algorithms/MDP/Ex_3_1_RelativeTest.hs+ testsuite/tests/Algorithms/MDP/Ex_3_2_Test.hs+ testsuite/tests/Algorithms/MDP/Ex_MM1_Test.hs++Library+ Build-Depends: base ==4.8.*+ , containers+ , vector ==0.11.*+ Exposed-modules: Algorithms.MDP+ , Algorithms.MDP.ValueIteration,+ Algorithms.MDP.CTMDP+ , Algorithms.MDP.Examples.Ex_3_1+ , Algorithms.MDP.Examples.Ex_3_2+ , Algorithms.MDP.Examples.MM1+ , Algorithms.MDP.Examples+ ghc-options: -Wall -fforce-recomp+ hs-source-dirs: src++executable ex-3-1+ main-is: run-ex-3-1.hs+ build-depends: base ==4.8.*+ , containers+ , vector ==0.11.*+ hs-source-dirs: src++executable ex-3-1-relative+ main-is: run-ex-3-1-relative.hs+ build-depends: base ==4.8.*+ , containers+ , vector ==0.11.*+ hs-source-dirs: src++executable ex-3-2+ main-is: run-ex-3-2.hs+ build-depends: base ==4.8.*+ , containers+ , vector ==0.11.*+ hs-source-dirs: src++executable mm1+ main-is: run-mm1.hs+ build-depends: base ==4.8.*+ , containers+ , vector ==0.11.*+ hs-source-dirs: src+ ghc-options: -Wall+ +test-suite TestMain+ hs-source-dirs: testsuite/tests/, src/+ main-is: TestMain.hs+ type: exitcode-stdio-1.0+ build-depends: base >= 4 && < 5+ , HTF == 0.13.*+ , QuickCheck >=2.8.1+ , containers+ , HUnit+ , vector ==0.11.*++source-repository head+ type: git+ location: https://github.com/prsteele/mdp.git
+ src/Algorithms/MDP.hs view
@@ -0,0 +1,227 @@+-- |+-- Module : Algorithms.MDP+-- Copyright : Patrick Steele 2015+-- License : MIT (see the LICENSE file)+-- Maintainer : prs233@cornell.edu+--+-- Algorithms and data structures for expressing and solving Markov+-- decision processes (MDPs).+--+-- See the following for references on the algorithms implemented,+-- along with general terminology.+--+-- * \"Dynamic Programmand and Optimal Control, Vol. II\", by Dimitri+-- P. Bertsekas, Athena Scientific, Belmont, Massachusetts.+--+-- * \"Stochastic Dynamic Programming and the Control of Queueing+-- Systems\", by Linn I. Sennott, A Wiley- Interscience Publication,+-- New York.+--+-- The module "Algorithms.MDP.Examples" contains implementations of+-- several example problems from these texts.+--+-- To actually solve an MDP, use (for example) the+-- 'Algorithms.MDP.ValueIteration.valueIteration' function from the+-- "Algorithms.MDP.ValueIteration" module.+module Algorithms.MDP+ ( -- * Markov decision processes+ MDP (..)+ , mkDiscountedMDP+ , mkUndiscountedMDP+ -- * Types+ , Transitions+ , Costs+ , ActionSet+ , CF+ , CFBounds (..)+ -- * Utility functions+ , cost+ , action+ , optimalityGap+ -- * Validation+ , verifyStochastic+ , MDPError (..)+ ) where++import qualified Data.Vector as V+import Data.Maybe++-- | A type representing an action- and state-dependent probablity+-- vector.+type Transitions a b t = b -> a -> a -> t++-- | A type representing an action- and state-dependent cost.+type Costs a b t = b -> a -> t++-- | A type representing the allowed actions in a state.+type ActionSet a b = a -> [b]++-- | A cost function is a vector containing (state, action, cost)+-- triples. Each triple describes the cost of taking the action in+-- that state.+type CF a b t = V.Vector (a, b, t)++-- | Get the cost associated with a state.+--+-- This function is only defined over the state values passed in to+-- the original MDP.+cost :: (Eq a) => a -> CF a b t -> t+cost s cf = + let+ (_, _, c) = fromMaybe err (V.find (\(s', _, _) -> s == s') cf)+ err = error "Unknown state in function \"cost\""+ in+ c++-- | Get the action associated with a state.+--+-- This function is only defined over the state values passed in to+-- the original MDP.+action :: (Eq a) => a -> CF a b t -> b+action s cf =+ let+ (_, ac, _) = fromMaybe err (V.find (\(s', _, _) -> s == s') cf)+ err = error "Unknown state in function \"action\""+ in+ ac++-- | A cost function with error bounds. The cost in a (state, action,+-- cost) triple is guaranteed to be in the range [cost + lb, cost + ub]+data CFBounds a b t = CFBounds+ { _CF :: CF a b t+ , _lb :: t+ , _ub :: t+ }++-- | Compute the optimality gap associated with a CFBounds.+--+-- This error is absolute, not relative.+optimalityGap :: (Num t) => CFBounds a b t -> t+optimalityGap (CFBounds _ lb ub) = ub - lb++-- | A Markov decision process.+--+-- An MDP consists of a state space, an action space, state- and+-- action-dependent costs, and state- and action-dependent transition+-- probabilities. The goal is to compute a policy -- a mapping from+-- states to actions -- which minimizes the total discounted cost of+-- the problem, assuming a given discount factor in the range (0, 1].+--+-- Here the type variable 'a' represents the type of the states, 'b'+-- represents the type of the actions, and 't' represents the numeric+-- type used in computations. Generally choosing 't' to be a Double is+-- fine, although there is no reason a higher-precision type cannot be+-- used.+--+-- This type should not be constructed directly; use the+-- 'mkDiscountedMDP' or 'mkUndiscountedMDP' constructors instead.+data MDP a b t = MDP+ { _states :: V.Vector a+ , _actions :: V.Vector b+ , _costs :: V.Vector (V.Vector t)+ , _trans :: V.Vector (V.Vector (V.Vector t))+ , _discount :: t+ , _actionSet :: V.Vector (V.Vector Int)+ }++-- | Creates a discounted MDP.+mkDiscountedMDP :: (Eq b) =>+ [a] -- ^ The state space+ -> [b] -- ^ The action space+ -> Transitions a b t -- ^ The transition probabilities+ -> Costs a b t -- ^ The action-dependent costs+ -> ActionSet a b -- ^ The state-dependent actions+ -> t -- ^ The discount factor+ -> MDP a b t -- ^ The resulting DiscountedMDP+mkDiscountedMDP states actions trans costs actionSet discount =+ let+ _states = V.fromList states+ _actions = V.fromList actions+ mkProbAS a s = V.fromList $ map (trans a s) states+ mkProbA a = V.fromList $ map (mkProbAS a) states+ mkCostA a = V.fromList $ map (costs a) states++ _costs = V.fromList $ map mkCostA actions+ _trans = V.fromList $ map mkProbA actions++ actionPairs = zip [0..] actions+ actionSet' st = V.fromList $ map fst $ filter ((`elem` acs) . snd) actionPairs+ where+ acs = actionSet st+ + _actionSet = V.fromList $ map actionSet' states+ in+ MDP+ { _states = _states+ , _actions = _actions+ , _costs = _costs+ , _trans = _trans+ , _discount = discount+ , _actionSet = _actionSet+ }++-- | Creates an undiscounted MDP.+mkUndiscountedMDP :: (Eq b, Num t) =>+ [a] -- ^ The state space+ -> [b] -- ^ The action space+ -> Transitions a b t -- ^ The transition probabilities+ -> Costs a b t -- ^ The action-dependent costs+ -> ActionSet a b -- ^ The state-dependent actions+ -> MDP a b t -- ^ The resulting DiscountedMDP+mkUndiscountedMDP states actions trans costs actionSet =+ mkDiscountedMDP states actions trans costs actionSet 1++-- | An error describing the ways an MDP can be poorly-defined.+--+-- An MDP can be poorly defined by having negative transition+-- probabilities, or having the total probability associated with a+-- state and action exceeding one.+data MDPError a b t = MDPError+ { _negativeProbability :: [(b, a, a, t)]+ , _notOneProbability :: [(b, a, t)]+ }+ deriving (Show)++-- | Returns the non-stochastic (action, state) pairs in an 'MDP'.+--+-- An (action, state) pair is not stochastic if any transitions out of+-- the state occur with negative probability, or if the total+-- probability all possible transitions is not 1 (within the given+-- tolerance).++-- | Verifies that the MDP is stochastic.+--+-- An MDP is stochastic if all transition probabilities are+-- non-negative, and the total sum of transitions out of a state under+-- a legal action sum to one.+--+-- We verify sums to within the given tolerance.+verifyStochastic :: (Ord t, Num t) => MDP a b t -> t -> Either (MDPError a b t) ()+verifyStochastic mdp tol =+ let+ states = V.toList . V.indexed . _states $ mdp+ actions = V.toList . V.indexed . _actions $ mdp+ trans = _trans mdp+ actionSet = _actionSet mdp++ nonNegTriples = [(ac, s, t, trans V.! acIndex V.! sIndex V.! tIndex)+ | (acIndex, ac) <- actions+ , (sIndex, s) <- states+ , (tIndex, t) <- states+ , acIndex `V.elem` (actionSet V.! sIndex)+ , trans V.! acIndex V.! sIndex V.! tIndex < 0]+ + totalProb acIndex sIndex = sum (trans V.! acIndex V.! sIndex)+ badSumPairs = [(ac, s, totalProb acIndex sIndex) + | (acIndex, ac) <- actions+ , (sIndex, s) <- states+ , acIndex `V.elem` (actionSet V.! sIndex)+ , abs (1 - totalProb acIndex sIndex) > tol+ ]+ in+ case (null nonNegTriples, null badSumPairs) of+ (True, True) -> Right ()+ _ -> Left MDPError+ { _negativeProbability = nonNegTriples+ , _notOneProbability = badSumPairs+ }
+ src/Algorithms/MDP/CTMDP.hs view
@@ -0,0 +1,145 @@+-- | A continuous-time Markov decision process (CTMDP) is an MDP where+-- transitions between states take a random amount of time. Each+-- transition time is assumed to be exponentially distributed with an+-- action- and state-dependent transition rate.+--+-- The record accessors of the 'CTMDP' type conflict with those of the+-- 'MDP' type, so either import only the 'mkCTMDP' and 'uniformize'+-- functions or import this module qualified.+module Algorithms.MDP.CTMDP+ ( CTMDP (..)+ , mkCTMDP+ , Rates+ , uniformize+ ) where++import qualified Data.Vector as V++import Algorithms.MDP (MDP(MDP))+import Algorithms.MDP hiding (MDP (..))++-- | A Continuous-time Markov decision process.+--+-- A CTMDP is a continuous-time analog of an MDP. In a CTMDP each+-- stage takes a variable amount of time. Each stage lasts an+-- expontially distributed amount of time characterized by a state-+-- and action-dependent rate parameter. Instead of simply having costs+-- associated with a state and an action, the costs of a CTMDP are+-- broken up into fixed and rate costs. Fixed costs are incured as an+-- action are chosen, while rate costs are paid for the duration of+-- the stage.+--+-- Here the type variable 'a' represents the type of the states, 'b'+-- represents the type of the actions, and 't' represents the numeric+-- type used in computations. Generally choosing 't' to be a Double is+-- fine, although there is no reason a higher-precision type cannot be+-- used.+--+-- This type should not be constructed directly; use the 'mkCTMDP'+-- constructor instead.+data CTMDP a b t = CTMDP+ { _states :: V.Vector a+ , _actions :: V.Vector b+ , _fixedCosts :: V.Vector (V.Vector t)+ , _rateCosts :: V.Vector (V.Vector t)+ , _rates :: V.Vector (V.Vector t)+ , _trans :: V.Vector (V.Vector (V.Vector t))+ , _discount :: t+ , _actionSet :: V.Vector (V.Vector Int)+ }++-- | A function mapping an action and a state to a transition rate.+type Rates a b t = b -> a -> t++-- | Create a CTMDP.+mkCTMDP :: (Eq b) =>+ [a] -- ^ The state space+ -> [b] -- ^ The action space+ -> Transitions a b t -- ^ The transition probabilities+ -> Rates a b t -- ^ The transition rates+ -> Costs a b t -- ^ The action-dependent fixed costs+ -> Costs a b t -- ^ The action-dependent rate costs+ -> ActionSet a b -- ^ The state-dependent actions+ -> t -- ^ The discount factor in (0, 1]+ -> CTMDP a b t -- ^ The resulting CTMDP+mkCTMDP states actions trans rates fixedCost rateCost actionSet discount =+ let+ _states = V.fromList states+ _actions = V.fromList actions+ _states' = V.fromList [0..length states - 1]+ _actions' = V.fromList [0..length actions - 1]++ mkCostVecFor cf ac = V.fromList $ map (cf ac) states+ _fixedCosts = V.fromList $ map (mkCostVecFor fixedCost) actions+ _rateCosts = V.fromList $ map (mkCostVecFor rateCost) actions++ mkProbAS a s = V.fromList $ map (trans a s) states+ mkProbA a = V.fromList $ map (mkProbAS a) states+ _trans = V.fromList $ map mkProbA actions++ mkTransVec ac = V.fromList $ map (rates ac) states+ _rates = V.fromList $ map mkTransVec actions++ actionPairs = zip [0..] actions+ actionSet' st = V.fromList $ map fst $ filter ((`elem` acs) . snd) actionPairs+ where+ acs = actionSet st+ + _actionSet = V.fromList $ map actionSet' states+ in+ CTMDP+ { _states = _states+ , _actions = _actions+ , _fixedCosts = _fixedCosts+ , _rateCosts = _rateCosts+ , _rates = _rates+ , _trans = _trans+ , _discount = discount+ , _actionSet = _actionSet+ }++-- | Convert a CTMDP into an MDP.+uniformize :: (Ord t, Fractional t) => CTMDP a b t -> MDP a b t+uniformize ctmdc =+ let+ states = _states ctmdc+ actions = _actions ctmdc+ trans = _trans ctmdc+ rateCosts = _rateCosts ctmdc+ fixedCosts = _fixedCosts ctmdc+ rates = _rates ctmdc+ actionSet = _actionSet ctmdc+ discount = _discount ctmdc++ nStates = length states+ nActions = length actions++ -- The fastest transition rate+ nu = maximum (fmap maximum rates)++ -- The discount factor for the continuous-time problem+ beta = nu * (1 / discount - 1)++ -- We rescale the probabilities by increasing the probability of a+ -- self-transition+ rescaleProb ac s v = V.imap (\t z -> newP t z) v+ where+ newP t z = if s == t+ then (nu - r + z * r) / (beta + nu)+ else r * z / (beta + nu)+ r = rates V.! ac V.! s+ + trans' = V.imap (\a vv -> V.imap (\s v -> rescaleProb a s v) vv) trans++ -- We create costs that combine fixed and rate costs+ costFor ac s = nu * ((beta + r) * f + rc) / (beta + nu)+ where+ f = fixedCosts V.! ac V.! s+ rc = rateCosts V.! ac V.! s+ r = rates V.! ac V.! s++ costs' = V.generate nActions (\ac -> V.generate nStates (costFor ac))++ discount' = nu / (beta + nu)+ in+ MDP states actions costs' trans' discount' actionSet
+ src/Algorithms/MDP/Examples.hs view
@@ -0,0 +1,137 @@+{- | This module shows how to solve several example problems using this+library.+-}+module Algorithms.MDP.Examples (+ -- * A discounted problem+ {- | We consider the problem defined in+"Algorithms.MDP.Examples.Ex_3_1"; this example comes from Bersekas+p. 22.++We will solve this problem using regular value iteration. Having+constructed the MDP, we can do this using the 'valueIteration'+function.++@+import Algorithms.MDP.Examples.Ex_3_1+import Algorithms.MDP.ValueIteration++iterations :: [CF State Control Double]+iterations = valueIteration mdp+@++The iterates returned contain estimates of the cost of being at each+state. To see the costs of the state A over the first 10 iterations,+we could do++@+estimates :: [Double]+estimates = map (cost A) (take 10 iterations)+@+-}+ -- * A discounted problem with error bounds+ {- | We consider the same example as above, but this time we use+relative value iteration to compute error bounds on the costs. This+will allow us to use fewer iterations to obtain an accurate cost+estimate.++Since we have already defined the problem, we do this via the+'relativeValueIteration' function.++@+import Algorithms.MDP.Examples.Ex_3_1+import Algorithms.MDP.ValueIteration++iterations :: [CFBounds State Control Double]+iterations = relativeValueIteration mdp+@++The iterates returned contain estimates of the cost of being at each+state, along with associated error bounds. To see the costs of the+state A over the first 10 iterations adjusted for the error bounds, we+could do++@+estimate state (CFBounds cf lb ub) = (z + lb, z + ub)+ where+ z = cost state cf++estimates :: [(Double, Double)]+estimates = map (estimate A) (take 10 iterations)+@++Note that the lower- and upper-bounds returned in the first iteration+are always +/-Infinity, and so it can be useful to consider only the+tail of the iterations.+-}+ -- * An average cost problem+ {- | We consider the problem defined in+"Algorithms.MDP.Examples.Ex_3_2"; this example comes from Bersekas+p. 210.++Here we are interested in computing the long-run average cost of an+undiscounted MDP. For this we use the+'undiscountedRelativeValueIteration' function.++@+import Algorithms.MDP.Examples.Ex_3_2+import Algorithms.MDP.ValueIteration++iterations :: [CFBounds State Control Double]+iterations = undiscountedRelativeValueIteration mdp+@++We can compute cost estimates in the same fashion as above.++@+estimate state (CFBounds cf lb ub) = (lb, ub)++estimates :: [(Double, Double)]+estimates = map (estimate A) (take 10 iterations)+@++It is important to note that in this problem the cost function+returned in each 'CFBounds' object is not to be interpreted as a+vector of costs, but rather as a differential cost vector; however,+the estimates above retrain the same interpretation.++-}+ -- * A continuous-time undiscounted problem+ {- | We now consider a family of problems described by Sennot p. 248.++Here we are interested in first converting a CTMDP to an MDP via+uniformization, and then computing the long-run average cost of the+optimal policy.++To begin, we construct one of the scenarios provided (each scenario is+just an instance of the problem with certain parameters). We then+convert the scenario to an MDP using the 'uniformize' function.++@+import Algorithms.MDP.Examples.MM1+import Algorithms.MDP.CTMDP+import Algorithms.MDP.ValueIteration++scenario :: CTMDP State Action Double+scenario = mkInstance scenario1++mdp :: MDP State Action Double+mdp = uniformize scenario+@++As above, we can use the 'undiscountedRelativeValueIteration'+function to compute cost estimates.++@+iterations :: [CFBounds State Action Double]+iterations = undiscountedRelativeValueIteration mdp++estimate state (CFBounds _ lb ub) = (lb, ub)++estimates :: [(Double, Double)]+estimates = map (estimate A) (take 10 iterations)+@+-}+ ) where++import Algorithms.MDP.ValueIteration()+import Algorithms.MDP.CTMDP()
+ src/Algorithms/MDP/Examples/Ex_3_1.hs view
@@ -0,0 +1,46 @@+-- | The problem described by Bertsekas p. 22.+module Algorithms.MDP.Examples.Ex_3_1 where++import Algorithms.MDP++-- | There are two distinct states+data State = A | B+ deriving (Show, Ord, Eq)++-- | There are two distinct actions we can take in each state+data Control = U1 | U2+ deriving (Show, Ord, Eq)++-- | The transition matrix+transition :: Control -> State -> State -> Double+transition U1 A A = 3 / 4+transition U1 A B = 1 / 4+transition U1 B A = 3 / 4+transition U1 B B = 1 / 4+transition U2 A A = 1 / 4+transition U2 A B = 3 / 4+transition U2 B A = 1 / 4+transition U2 B B = 3 / 4++-- | The costs associated with each state and action+costs :: Control -> State -> Double+costs U1 A = 2+costs U2 A = 1 / 2+costs U1 B = 1+costs U2 B = 3++-- | The discount factor+alpha :: Double+alpha = 9 / 10++-- | The available states+states :: [State]+states = [A, B]++-- | The available actions+controls :: [Control]+controls = [U1, U2]++-- | The MDP representing the problem.+mdp :: MDP State Control Double+mdp = mkDiscountedMDP states controls transition costs (\_ -> controls) alpha
+ src/Algorithms/MDP/Examples/Ex_3_2.hs view
@@ -0,0 +1,10 @@+-- | The problem described by Bertsekas p. 210.+module Algorithms.MDP.Examples.Ex_3_2 where++import Algorithms.MDP.Examples.Ex_3_1 hiding (mdp)++import Algorithms.MDP++-- | The MDP representing the problem.+mdp :: MDP State Control Double+mdp = mkUndiscountedMDP states controls transition costs (\_ -> controls)
+ src/Algorithms/MDP/Examples/MM1.hs view
@@ -0,0 +1,167 @@+-- | We model an M/M/1 queue, i.e. a single-server queue with Poisson+-- arrivals and service times.+--+-- See "Stochastic Dynamic Programming and the Control of Queueing+-- Systems", Linn I. Sennot,, p. 242 for details.+module Algorithms.MDP.Examples.MM1 where++import qualified Algorithms.MDP.CTMDP as CTMDP++-- | A description of an MDP.+data Scenario = Scenario+ { _arrivalRate :: Double+ , _serviceRates :: [Double]+ , _serviceCosts :: [Double]+ , _holdingCosts :: Int -> Double+ , _maxWaiting :: Int+ , _scenarioCost :: Double+ }++-- | The state space is the count of customers in the queue.+newtype State = State Int+ deriving (Show, Eq)++-- | There are a number of services we can provide each customer, and+-- if there are no customers we do nothing.+data Action = NullAction+ | Action Int+ deriving (Show, Eq)++-- | Generate an MDP from a Scenario.+mkInstance :: Scenario -> CTMDP.CTMDP State Action Double+mkInstance scenario =+ let+ -- (State i) represents i customers waiting in the queue.+ states = map State [0..(_maxWaiting scenario)]++ -- (Action i) represents serving a customer with the ith service+ -- profile, while the NullAction represents what we do in the+ -- empty queue (wait).+ actions = NullAction : map Action [0..length (_serviceRates scenario) - 1]++ -- All actions but the null action have an associated cost+ rateCost (Action ac) (State i) = hc + sc+ where+ hc = _holdingCosts scenario i+ sc = _serviceCosts scenario !! ac+ rateCost NullAction _ = 0++ -- There can always be an arrival, and if we don't take the null+ -- action there can be a departure.+ rates (Action ac) _ = _arrivalRate scenario + _serviceRates scenario !! ac+ rates NullAction _ = _arrivalRate scenario++ -- There are no fixed costs.+ fixedCost _ _= 0++ -- We can only take the null action in state 0, and can take any+ -- other action in all other states.+ actionSet (State 0) = [NullAction]+ actionSet _ = (tail actions)++ -- If we take the null action, we wait for an arrival. Otherwise,+ -- we can increase or decrease the length of the queue by 1.+ --+ -- Note that since we cannot transition about the maximum state,+ -- we instead allow a self-transition.+ trans NullAction (State 0) (State 1) = 1+ trans NullAction _ _ = 0+ trans (Action ac) (State i) (State j) + | j == i + 1 = lambda / (lambda + a)+ | j == i && i == maxN = lambda / (lambda + a)+ | j == i - 1 = a / (lambda + a)+ | otherwise = 0+ where+ maxN = _maxWaiting scenario+ lambda = _arrivalRate scenario+ a = _serviceRates scenario !! ac+ in+ CTMDP.mkCTMDP states actions trans rates fixedCost rateCost actionSet 1.0++-- | A specific scenario.+scenario1 :: Scenario+scenario1 = Scenario+ { _arrivalRate = 3+ , _serviceRates = [2, 4, 8]+ , _serviceCosts = [9, 13, 21]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 48+ , _scenarioCost = 8.475+ }++-- | A specific scenario.+scenario2 :: Scenario+scenario2 = Scenario+ { _arrivalRate = 2.0+ , _serviceRates = [1, 4, 7]+ , _serviceCosts = [1, 50, 500]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 84+ , _scenarioCost = 21.091+ }+ +-- | A specific scenario.+scenario3 :: Scenario+scenario3 = Scenario+ { _arrivalRate = 2.0+ , _serviceRates = [1, 4, 7]+ , _serviceCosts = [1, 50, 150]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 84+ , _scenarioCost = 21.091+ }++-- | A specific scenario.+scenario4 :: Scenario+scenario4 = Scenario+ { _arrivalRate = 2.0+ , _serviceRates = [1, 4, 7]+ , _serviceCosts = [1, 50, 100]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 84+ , _scenarioCost = 21.971+ }++-- | A specific scenario.+scenario5 :: Scenario+scenario5 = Scenario+ { _arrivalRate = 2.0+ , _serviceRates = [5.0, 5.5, 5.8]+ , _serviceCosts = [0, 10, 100]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 84+ , _scenarioCost = 17.043+ }++-- | A specific scenario.+scenario6 :: Scenario+scenario6 = Scenario+ { _arrivalRate = 5.0+ , _serviceRates = [5.1, 5.3, 6.0]+ , _serviceCosts = [0, 10, 25]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 84+ , _scenarioCost = 15.193+ }++-- | A specific scenario.+scenario7 :: Scenario+scenario7 = Scenario+ { _arrivalRate = 10.0+ , _serviceRates = [10.2, 10.6, 12]+ , _serviceCosts = [0, 10, 25]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 84+ , _scenarioCost = 15.193+ }++-- | A specific scenario.+scenario8 :: Scenario+scenario8 = Scenario+ { _arrivalRate = 20.0+ , _serviceRates = [24, 27, 30]+ , _serviceCosts = [1, 1.5, 5.0]+ , _holdingCosts = \i -> fromIntegral i+ , _maxWaiting = 84+ , _scenarioCost = 3.902+ }
+ src/Algorithms/MDP/ValueIteration.hs view
@@ -0,0 +1,169 @@+-- | This module provides several flavors of the value iteration+-- algorithm for solving MDPs.+module Algorithms.MDP.ValueIteration+ ( -- * Value iteration algorithms+ valueIteration+ , relativeValueIteration+ , undiscountedRelativeValueIteration+ -- * Helper functions for value iteration+ , valueIterate+ , relativeValueIterate+ , undiscountedRVI+ ) where++import qualified Data.Vector as V++import Algorithms.MDP++-- | Compute the inner product between two vectors.+inner :: (Num t) => V.Vector t -> V.Vector t -> t+inner u v = V.sum (V.zipWith (*) u v)++-- | Compute an infinite sequence of estimates of cost functions+-- converging to the true cost function.+--+-- This method should only be used on discounted MDPs (e.g. an MDP+-- with a discount factor less than one).+valueIteration ::+ (Ord t, Num t) => + MDP a b t -- ^ The MDP to solve+ -> [CF a b t] -- ^ An converging sequence of cost functions+valueIteration mdp =+ let+ states = _states mdp+ actions = _actions mdp++ zero = V.map (\s -> (s, V.head actions, 0)) states+ in+ iterate (valueIterate mdp) zero++-- | Computes the next estimate of the cost function.+valueIterate :: (Ord t, Num t) => + MDP a b t -- ^ The MDP to solve+ -> CF a b t -- ^ The current cost function estimate+ -> CF a b t -- ^ The next cost function estimate+valueIterate mdp cf = V.imap (choiceFor mdp cf) (_states mdp)++-- | Finds the action that minimizes the one-step payoff using the+-- given cost function.+choiceFor :: (Ord t, Num t) =>+ MDP a b t -- ^ The MDP we are solving+ -> CF a b t -- ^ The current cost function+ -> Int -- ^ The state for which we choose an action+ -> a -- ^ The state for which we choose an action+ -> (a, b, t) -- ^ The choice of action and associated cost+choiceFor mdp cf sIndex s =+ let++ actions = V.fromList [(_actions mdp) V.! ac' | ac' <- V.toList ((_actionSet mdp) V.! sIndex)]+ + cmp (_, x) (_, y) = compare x y+ costs = V.map (costForAction mdp cf sIndex) (_actionSet mdp V.! sIndex)+ pairs = V.zip actions costs+ (ac, c) = V.minimumBy cmp pairs+ in+ (s, ac, c)++-- | Computes the cost implied by choosing an action in the given+-- state.+costForAction :: (Num t) => + MDP a b t -- ^ The MDP we are solving.+ -> CF a b t -- ^ The current cost function.+ -> Int -- ^ The index of the state.+ -> Int -- ^ The index of the action.+ -> t -- ^ The estimated cost.+costForAction mdp cf sIndex ac =+ let+ alpha = _discount mdp+ fixedCost = (_costs mdp) V.! ac V.! sIndex+ transCost = inner (_trans mdp V.! ac V.! sIndex) (V.map (\(_, _, c) -> c) cf)+ in+ fixedCost + alpha * transCost++-- | An implementation of value iteration that computes monotonic+-- error bounds.+--+-- The error bounds provided at each iteration are additive in each+-- state. That is, given a cost estimate 'c' for a given state and+-- lower and upper bounds 'lb' and 'ub', the true cost is guaranteed+-- to be in the interval [c + lb, c + ub].+relativeValueIteration ::+ (Read t, Ord t, Fractional t) => + MDP a b t -- ^ The MDP to solve+ -> [CFBounds a b t] -- ^ A converging sequence of cost functions.+relativeValueIteration mdp =+ let+ states = _states mdp+ actions = _actions mdp++ zero = V.map (\s -> (s, V.head actions, 0)) states++ cf = CFBounds zero (read "-Infinity") (read "Infinity")+ in+ iterate (relativeValueIterate mdp) cf++-- | Computes the next estimate of the cost function and associated+-- error bounds.+relativeValueIterate ::+ (Ord t, Fractional t) => + MDP a b t + -> CFBounds a b t + -> CFBounds a b t+relativeValueIterate mdp (CFBounds cf _ _) =+ let+ alpha = _discount mdp+ cf' = valueIterate mdp cf+ (lb, ub) = (V.minimum diffs, V.maximum diffs)+ where+ diffs = V.zipWith (\(_, _, a) (_, _, b) -> a - b) cf' cf+ scale = alpha / (1 - alpha)+ in + CFBounds+ { _CF = cf'+ , _lb = scale * lb+ , _ub = scale * ub+ }++-- | Relative value iteration for undiscounted MDPs.+undiscountedRelativeValueIteration ::+ (Ord t, Fractional t, Read t) =>+ MDP a b t -- ^ The MDP to solve+ -> [CFBounds a b t] -- ^ A converging sequence of cost functions+undiscountedRelativeValueIteration mdp =+ let+ states = _states mdp+ actions = _actions mdp++ trans = _trans mdp+ update s v = V.imap (\i z -> tau * z + if i == s then (1 - tau) else 0) v++ trans' = V.map (\vv -> V.imap (\s v -> update s v) vv) trans++ tau = 0.5+ mdp' = mdp {_trans = trans'}+ zeroV = V.map (\s -> (s, V.head actions, 0)) states+ zero = CFBounds zeroV (read "-Infinity") (read "Infinity")+ distinguished = 0+ in+ iterate (undiscountedRVI mdp' distinguished) zero++-- | Performs a single iterate of relative value iteration for the+-- undiscounted problem.+undiscountedRVI :: (Ord t, Fractional t) =>+ MDP a b t+ -> Int+ -> CFBounds a b t+ -> CFBounds a b t+undiscountedRVI mdp distinguished (CFBounds h _ _) =+ let+ th = valueIterate mdp h+ (_, _, distinguishedCost) = th V.! distinguished++ th' = V.map (\(s, ac, z) -> (s, ac, z - distinguishedCost)) th++ (lb, ub) = (V.minimum diffs, V.maximum diffs)+ where+ diffs = V.zipWith (\(_, _, a) (_, _, b) -> a - b) th h++ in+ CFBounds th' lb ub
+ src/run-ex-3-1-relative.hs view
@@ -0,0 +1,23 @@+import Algorithms.MDP.Examples.Ex_3_1+import Algorithms.MDP+import Algorithms.MDP.ValueIteration++import qualified Data.Vector as V++converging :: Double + -> (CF State Control Double, CF State Control Double) + -> Bool+converging tol (cf, cf') = abs (x - y) > tol+ where+ x = (\(_, _, c) -> c) (cf V.! 0)+ y = (\(_, _, c) -> c) (cf' V.! 0)++iterations = relativeValueIteration mdp++main = do+ mapM_ (putStrLn . showAll) $ take 100 iterations+ where+ costs (CFBounds cf _ _) = V.map (\(_, _, c) -> c) cf+ actions (CFBounds cf _ _) = V.map (\(_, a, _) -> a) cf+ bounds (CFBounds _ lb ub) = [lb, ub]+ showAll cf = unwords [show (costs cf), show (bounds cf), show (actions cf)]
+ src/run-ex-3-1.hs view
@@ -0,0 +1,22 @@+import Algorithms.MDP.Examples.Ex_3_1+import Algorithms.MDP+import Algorithms.MDP.ValueIteration++import qualified Data.Vector as V++converging :: Double + -> (CF State Control Double, CF State Control Double) + -> Bool+converging tol (cf, cf') = abs (x - y) > tol+ where+ x = (\(_, _, c) -> c) (cf V.! 0)+ y = (\(_, _, c) -> c) (cf' V.! 0)++iterations = valueIteration mdp++main = do+ mapM_ (putStrLn . showAll) $ take 100 iterations+ where+ showCosts cf = V.map (\(_, _, c) -> c) cf+ showActions cf = V.map (\(_, a, _) -> a) cf+ showAll cf = show (showCosts cf) ++ " " ++ show (showActions cf)
+ src/run-ex-3-2.hs view
@@ -0,0 +1,24 @@+import Data.Maybe (fromJust)+import qualified Data.Vector as V++import Algorithms.MDP.Examples.Ex_3_1 hiding (mdp, cost)+import Algorithms.MDP.Examples.Ex_3_2+import Algorithms.MDP+import Algorithms.MDP.ValueIteration++iterations = undiscountedRelativeValueIteration mdp+pairs = zip iterations (tail iterations)++-- | Takes elements from a list while each adjacent pair of elements+-- satisfies the given predicate.+takeWhile2 :: (a -> a -> Bool) -> [a] -> [a]+takeWhile2 _ [] = []+takeWhile2 p as = map fst $ takeWhile (uncurry p) (zip as (tail as))++distinguished = A++showAll (CFBounds h lb ub) = unwords [show h, show lb, show ub]++main = do+ mapM_ (putStrLn . showAll) $ take 11 iterations+
+ src/run-mm1.hs view
@@ -0,0 +1,60 @@+import Text.Printf+import Control.Monad++import Algorithms.MDP+import Algorithms.MDP.CTMDP+import Algorithms.MDP.ValueIteration+import Algorithms.MDP.Examples.MM1++printErrors :: MDP State Action Double -> Double -> IO ()+printErrors mdp tol = case verifyStochastic mdp tol of+ Left er -> do+ mapM_ (putStrLn . show) (_negativeProbability er)+ mapM_ (putStrLn . show) (_notOneProbability er)+ Right _ -> return ()++names :: [String]+names =+ [ "Scenario 1"+ , "Scenario 2"+ , "Scenario 3"+ ]++scenarios :: [MDP State Action Double]+scenarios = + [ uniformize (mkInstance scenario1)+ , uniformize (mkInstance scenario2)+ , uniformize (mkInstance scenario3)+ ]++costs :: [Double]+costs =+ [ 8.475+ , 21.091+ , 21.091+ ]++gap :: (Num t) => CFBounds a b t -> t+gap (CFBounds _ lb ub) = ub - lb++solution :: Double -> MDP State Action Double -> CFBounds State Action Double+solution tol =+ head . dropWhile ((> tol) . gap) . undiscountedRelativeValueIteration++printSolution :: MDP State Action Double -> Double -> Double -> IO ()+printSolution scenario tol c =+ let+ (CFBounds _ lb ub) = solution tol scenario+ result = if lb <= c && c <= ub+ then printf " %.3f in [%.3f, %.3f]" c lb ub+ else printf " %.3f not in [%.3f, %.3f]" c lb ub+ in+ putStrLn result++main :: IO ()+main = do+ forM_ (zip3 names scenarios costs) $ \(name, scenario, c) ->+ do+ putStrLn name+ printErrors scenario 1e-5+ printSolution scenario 1e-3 c
+ testsuite/tests/Algorithms/MDP/Ex_3_1_RelativeTest.hs view
@@ -0,0 +1,123 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++-- | This module tests the standard value iteration algorithm for+-- discounted problems by comparing its iterations to known iterations+-- from "Dynamic Programming and Optimal Control", Dimitri+-- P. Bertsekas, p. 23.+module Algorithms.MDP.Ex_3_1_RelativeTest where++import Test.Framework++import Algorithms.MDP.Ex_3_1_Test (correctValuesA, correctValuesB, almostEqual)+import Algorithms.MDP.Examples.Ex_3_1+import Algorithms.MDP+import Algorithms.MDP.ValueIteration++lowerValuesA :: [Double]+lowerValuesA =+ [ read "-Infinity"+ , 5.000+ , 6.350+ , 6.856+ , 7.129+ , 7.232+ , 7.287+ , 7.308+ , 7.319+ , 7.324+ , 7.326+ , 7.327+ , 7.327+ , 7.327+ , 7.328+ , 7.328+ ]++upperValuesA :: [Double]+upperValuesA =+ [ read "Infinity"+ , 9.500+ , 8.375+ , 7.767+ , 7.540+ , 7.417+ , 7.371+ , 7.345+ , 7.336+ , 7.331+ , 7.329+ , 7.328+ , 7.328+ , 7.328+ , 7.328+ , 7.328+ ]++lowerValuesB :: [Double]+lowerValuesB =+ [ read "-Infinity"+ , 5.500+ , 6.625+ , 7.232+ , 7.460+ , 7.583+ , 7.629+ , 7.654+ , 7.663+ , 7.669+ , 7.671+ , 7.672+ , 7.672+ , 7.672+ , 7.672+ , 7.672+ ]++upperValuesB :: [Double]+upperValuesB =+ [ read "Infinity"+ , 10.000+ , 8.650+ , 8.144+ , 7.870+ , 7.768+ , 7.712+ , 7.692+ , 7.680+ , 7.676+ , 7.674+ , 7.673+ , 7.673+ , 7.673+ , 7.672+ , 7.672+ ]++iterations = take 16 (relativeValueIteration mdp)++lower s (CFBounds cf lb _) = lb + cost s cf+upper s (CFBounds cf _ ub) = ub + cost s cf++actualValuesA = map (cost A . _CF) iterations+actualValuesB = map (cost B . _CF) iterations++actualLowerA = map (lower A) iterations+actualUpperA = map (upper A) iterations+actualLowerB = map (lower B) iterations+actualUpperB = map (upper B) iterations++badActualA = filter (not . almostEqual 1e-3) $ zip actualValuesA correctValuesA+badActualB = filter (not . almostEqual 1e-3) $ zip actualValuesB correctValuesB++badLBA = filter (not . almostEqual 1e-3) $ zip actualLowerA lowerValuesA+badUBA = filter (not . almostEqual 1e-3) $ zip actualUpperA upperValuesA+badLBB = filter (not . almostEqual 1e-3) $ zip actualLowerB lowerValuesB+badUBB = filter (not . almostEqual 1e-3) $ zip actualUpperB upperValuesB++test_AValues = assertBoolVerbose (unlines (map show badActualA)) (null badActualA)+test_BValues = assertBoolVerbose (unlines (map show badActualB)) (null badActualB)+test_LBA = assertBoolVerbose (unlines (map show badLBA)) (null badLBA)+test_UBA = assertBoolVerbose (unlines (map show badUBA)) (null badUBA)+test_LBB = assertBoolVerbose (unlines (map show badLBB)) (null badLBB)+test_UBB = assertBoolVerbose (unlines (map show badUBB)) (null badUBB)+
+ testsuite/tests/Algorithms/MDP/Ex_3_1_Test.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++-- | This module tests the standard value iteration algorithm for+-- discounted problems by comparing its iterations to known iterations+-- from "Dynamic Programming and Optimal Control", Dimitri+-- P. Bertsekas, p. 23.+module Algorithms.MDP.Ex_3_1_Test where++import Test.Framework++import Algorithms.MDP.Examples.Ex_3_1+import Algorithms.MDP+import Algorithms.MDP.ValueIteration++almostEqual eps (x, y) | x == y = True+ | otherwise = abs (x - y) <= eps++iterations = take 16 (valueIteration mdp)++correctValuesA =+ [ 0+ , 0.5+ , 1.287+ , 1.844+ , 2.414+ , 2.896+ , 3.343+ , 3.740+ , 4.099+ , 4.422+ , 4.713+ , 4.974+ , 5.209+ , 5.421+ , 5.612+ , 5.783+ ]++correctValuesB =+ [ 0+ , 1+ , 1.562+ , 2.220+ , 2.745+ , 3.247+ , 3.686+ , 4.086+ , 4.444+ , 4.767+ , 5.057+ , 5.319+ , 5.554+ , 5.766+ , 5.957+ , 6.128+ ]++actualValuesA = map (cost A) iterations+actualValuesB = map (cost B) iterations++pairsA = zip actualValuesA correctValuesA+pairsB = zip actualValuesB correctValuesB++badPairsA = filter (not . almostEqual 1e-3) pairsA+badPairsB = filter (not . almostEqual 1e-3) pairsB++test_AValues = assertBoolVerbose (unlines (map show badPairsA)) (null badPairsA)+test_BValues = assertBoolVerbose (unlines (map show badPairsB)) (null badPairsB)
+ testsuite/tests/Algorithms/MDP/Ex_3_2_Test.hs view
@@ -0,0 +1,31 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++-- | This module tests the undiscountedRelativeValueIteration function+-- for undiscounted problems by comparing its tierations to known+-- iteratinos from "Dynamic Programming and Optimal Control", Dimitri+-- P. Bertsekas, p. 210.+--+-- We actually implement a slightly different technique to solve this+-- problem than is reported in Bertsekas; however, our solutions+-- should converge to the same value. Thus we simply ensure that the+-- error bounds we report properly contain the solution reported by+-- Bertsekas.+module Algorithms.MDP.Ex_3_2_Test where++import Test.Framework++import Algorithms.MDP+import Algorithms.MDP.ValueIteration+import Algorithms.MDP.Examples.Ex_3_2++value = 0.750++iterations = take 11 (undiscountedRelativeValueIteration mdp)++estimate (CFBounds _ lb ub) = (lb, ub)++proper (lb, ub) = lb <= value && value <= ub++badPairs = filter (not . proper) (map estimate iterations)++test_values = assertBoolVerbose (unlines (map show badPairs)) (null badPairs)
+ testsuite/tests/Algorithms/MDP/Ex_MM1_Test.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++-- | Tests for the problems discussed in section 10.4 of "Stochastic+-- Dynamic Programming and the Control of Queueing Systems", Linn+-- Sennot.+module Algorithms.MDP.Ex_MM1_Test where++import Test.Framework++import Algorithms.MDP+import Algorithms.MDP.CTMDP+import Algorithms.MDP.ValueIteration+import Algorithms.MDP.Examples.MM1++costOf (CFBounds _ lb ub) = (lb + ub) / 2++gap :: (Num t) => CFBounds a b t -> t+gap (CFBounds _ lb ub) = ub - lb++solution :: Double -> MDP State Action Double -> CFBounds State Action Double+solution tol =+ head . dropWhile ((> tol) . gap) . undiscountedRelativeValueIteration++test_scenario1Cost = assertBoolVerbose msg (abs (c - cc) < 1e3) + where+ ctmdp = uniformize (mkInstance scenario1)+ sol = solution (1e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario1+ msg = unwords [show c, "/=", show cc]++test_scenario2Cost = assertBoolVerbose msg (abs (c - cc) < 2e3) + where+ ctmdp = uniformize (mkInstance scenario2)+ sol = solution (2e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario2+ msg = unwords [show c, "/=", show cc]++test_scenario3Cost = assertBoolVerbose msg (abs (c - cc) < 3e3) + where+ ctmdp = uniformize (mkInstance scenario3)+ sol = solution (3e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario3+ msg = unwords [show c, "/=", show cc]++test_scenario4Cost = assertBoolVerbose msg (abs (c - cc) < 4e3) + where+ ctmdp = uniformize (mkInstance scenario4)+ sol = solution (4e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario4+ msg = unwords [show c, "/=", show cc]++test_scenario5Cost = assertBoolVerbose msg (abs (c - cc) < 5e3) + where+ ctmdp = uniformize (mkInstance scenario5)+ sol = solution (5e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario5+ msg = unwords [show c, "/=", show cc]++test_scenario6Cost = assertBoolVerbose msg (abs (c - cc) < 6e3) + where+ ctmdp = uniformize (mkInstance scenario6)+ sol = solution (6e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario6+ msg = unwords [show c, "/=", show cc]++test_scenario7Cost = assertBoolVerbose msg (abs (c - cc) < 7e3) + where+ ctmdp = uniformize (mkInstance scenario7)+ sol = solution (7e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario7+ msg = unwords [show c, "/=", show cc]++test_scenario8Cost = assertBoolVerbose msg (abs (c - cc) < 8e3) + where+ ctmdp = uniformize (mkInstance scenario8)+ sol = solution (8e-4) ctmdp+ c = costOf sol+ cc = _scenarioCost scenario8+ msg = unwords [show c, "/=", show cc]
+ testsuite/tests/TestMain.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Main where++import Test.Framework++import {-@ HTF_TESTS @-} Algorithms.MDP.Ex_3_1_Test+import {-@ HTF_TESTS @-} Algorithms.MDP.Ex_3_1_RelativeTest+import {-@ HTF_TESTS @-} Algorithms.MDP.Ex_3_2_Test+import {-@ HTF_TESTS @-} Algorithms.MDP.Ex_MM1_Test++main = htfMain htf_importedTests