QLearn (empty) → 0.1.0.0
raw patch · 4 files changed
+396/−0 lines, 4 filesdep +basedep +randomdep +vectorsetup-changed
Dependencies added: base, random, vector
Files
- LICENSE +20/−0
- QLearn.cabal +25/−0
- Setup.hs +2/−0
- src/Data/QLearn.hs +349/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Dhaivat Pandya++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.
+ QLearn.cabal view
@@ -0,0 +1,25 @@+-- Initial QLearn.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: QLearn+version: 0.1.0.0+synopsis: A library for fast, easy-to-use Q-learning.+-- description: +homepage: poincare.github.io/QLearn+license: MIT+license-file: LICENSE+author: Dhaivat Pandya+maintainer: dpandya@college.harvard.edu+-- copyright: +category: Data+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Data.QLearn+ -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <4.9, vector >=0.11 && <0.12, random >=1.1 && <1.2+ hs-source-dirs: src+ default-language: Haskell2010
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/QLearn.hs view
@@ -0,0 +1,349 @@+module Data.QLearn +( QLearner+, State(State, Stop)+, Action+, Reward+, Environment+, initQLearner+, initEnvironment+, moveLearner+, moveLearnerAndPrint+, testGrid+, possibleGrid+, executeGrid+, moveLearnerPrintRepeat+, gridFromList+) where+import qualified Data.Vector as V+import Numeric+import Data.List+import System.Random++-- | Data type specifying the parameters and Q table for a particular Q learner. qAlpha is the learning+-- rate associated with each iterative update. qGamma is the discount rate on rewards. qGrid is a matrix+-- (dimension number of states by number of actions) that specifies the Q(s,a) function learned by this+-- Q learner. qEpsilon is a function that maps from the number of iterations left to epsilon for the epsilon+-- greedy strategy (can return 1 uniformly if an epsilon greedy strategy is not wanted).+data QLearner = QLearner {qAlpha::Double, qGamma::Double, qEpsilon::(Int -> Double), + qGrid::V.Vector (V.Vector Double)} ++-- |Wrapper around Int, specifying a state index.+data State = State {getStateValue::Int} | Stop deriving (Show) ++-- |Wrapper around Int, specifying an action index.+data Action = Action {getActionValue::Int} ++-- |Wrapper around Double, specifying a reward value.+data Reward = Reward {getRewardValue::Double}++-- |Data type specifying the environment in which the Q learner operates. envExecute is the function+-- used to execute actions at a particular state, returning the new state and the award associated with+-- the state, action pair. envPossible returns the actions possible at any given+-- state.+data Environment = Environment {envExecute::(State -> Action -> (State, Reward)), + envPossible::(State -> [Action])} +++-- |Given alpha, gamma, the number of states and the maximum number of actions possible at any state, +-- returns a QLearner initialized with a zero Q-table. +initQLearner :: Double -> Double -> (Int -> Double) -> Int -> Int -> QLearner+initQLearner alpha gamma epsilon numStates numActions = + QLearner alpha gamma epsilon $ createZeroQ numStates numActions++-- |Given the envExecute and envPossible functions, constructs an Environment. This is purely for+-- for uniformity of the API. You are welcome to use the data type constructor "Environment" since+-- they are equivalent.+initEnvironment :: (State -> Action -> (State, Reward)) -> (State -> [Action]) -> Environment+initEnvironment execute possible = Environment execute possible ++unwrapExecute :: (State -> Action -> (State, Reward)) -> Int -> Int -> (Int, Double)+unwrapExecute execute state action = let execRet = execute (State state) (Action action)+ in (getStateValue $ fst execRet, getRewardValue $ snd execRet)++unwrapPossible :: (State -> [Action]) -> Int -> [Int] +unwrapPossible possible state = let possibRet = possible (State state)+ in map (\x -> getActionValue x) possibRet + +-- |Given an Environment, a Q learner and the state the Q Learner is on, returns the Q Learner with an updated Q table+-- and the new state of the Q learner within the Environment. Also takes the number of time steps left for the epsilon +-- computation.+moveLearner :: Int -> StdGen -> Environment -> QLearner -> State -> ((QLearner, State), StdGen)+moveLearner times g env qlearner Stop = ((qlearner, Stop), g) +moveLearner times g (Environment execute' possible') (QLearner alpha gamma epsilon qtable) (State s) =+ let epRet = checkEpsilon g epsilon times+ execute = unwrapExecute execute'+ possible = unwrapPossible possible'+ doRandom = fst $ epRet+ g' = snd $ epRet in+ if doRandom then let randRet = qRandomIter g execute possible s qtable+ iter = fst randRet+ g'' = snd randRet+ qtable' = fst iter+ state' = snd iter in+ ((QLearner alpha gamma epsilon qtable', State state'), g'') + else let iter = qLearnIter execute possible s qtable+ qtable' = fst iter+ state' = snd iter in+ ((QLearner alpha gamma epsilon qtable', State state'), g') ++-- |Same thing as "moveLearner" but prints out the Q table and the current state after moving the QLearner.+moveLearnerAndPrint :: Int -> StdGen -> Environment -> QLearner -> State -> IO ((QLearner, State), StdGen)+moveLearnerAndPrint times g env qlearner Stop = do + putStrLn "Stop state." + return ((qlearner, Stop), g)+moveLearnerAndPrint times g env qlearner state = do+ let iter = moveLearner times g env qlearner state+ g' = snd iter+ qlearner' = fst $ fst iter + state' = snd $ fst iter+ putStrLn $ (++) "Reached: " $ show state' + putStrLn $ prettyPrintQ $ qGrid qlearner'+ return ((qlearner', state'), g') ++-- |Repeatedly moves (i.e. moves the given number of times) the qLearner and prints the Q table +-- at every move until a stop state is encountered.+moveLearnerPrintRepeat :: Int -> StdGen -> Environment -> QLearner -> State -> IO ()+moveLearnerPrintRepeat _ _ _ _ Stop = putStrLn "Stopped repeating due to stop state."+moveLearnerPrintRepeat 0 g env qlearner state = putStrLn "Done." +moveLearnerPrintRepeat numTimes g env qlearner state = do+ moveRet <- moveLearnerAndPrint numTimes g env qlearner state + let g' = snd moveRet+ qlearner' = fst $ fst moveRet+ state' = snd $ fst moveRet+ moveLearnerPrintRepeat (numTimes - 1) g' env qlearner' state' ++-- |Returns the maximum number of characters needed to "show" an element from the given vector.+maxSpaceRow :: V.Vector Double -> Int+maxSpaceRow vec = if V.null vec + then 0+ else max (length $ showGFloat (Just 2) (V.head vec) "") (maxSpaceRow $ V.tail vec) ++-- |Returns the maximum number of characters needed to "show" an element in the 2D matrix given.+maxSpaceMat :: V.Vector (V.Vector Double) -> Int+maxSpaceMat mat = if V.null mat+ then 0+ else max (maxSpaceRow $ V.head mat) (maxSpaceMat $ V.tail mat)++-- |Internal function that pads strings with spaces in order to make sure that the string is of a certain length.+padSpaces :: Int -> String -> String+padSpaces space str = str ++ replicate (space - (length str)) ' ' ++-- |Internal function that does a pretty print for a row vector given the maximum space that the+-- row can take up in terms of the characters.+prettyPrintRow :: Int -> V.Vector Double -> String+prettyPrintRow space row = if V.null row+ then ""+ else (padSpaces space $ showGFloat (Just 2) (V.head row) "") ++ " " ++ (prettyPrintRow space $ V.tail row)++-- |Internal function that does a pretty print for the Q-table given the maximum space that the+-- a single element can take up in terms of characters.+prettyPrintQ' :: Int -> V.Vector (V.Vector Double) -> String+prettyPrintQ' space mat = if V.null mat+ then ""+ else (prettyPrintRow space $ V.head mat) ++ "\n" ++ (prettyPrintQ' space $ V.tail mat)++-- |Does a pretty print for the Q-table.+prettyPrintQ :: V.Vector (V.Vector Double) -> String+prettyPrintQ mat = let space = maxSpaceMat mat in prettyPrintQ' space mat+ +-- |Create a table for Q(s,a) values, each element representing the expected value of a give state and action+-- pair. Takes the number of possible states and the number of actions as arguments.+createZeroQ :: Int -> Int -> V.Vector (V.Vector Double) +createZeroQ s a = V.generate s (\n -> V.replicate a 0.0) ++updateQRow :: Int -> Double -> V.Vector Double -> V.Vector Double+updateQRow index value q_row = q_row V.// [(index, value)]++indexQ :: Int -> Int -> V.Vector (V.Vector Double) -> Double+indexQ s a q = q V.! s V.! a ++multIndex row (index:indices) = (row V.! index) : []++unwrapMaybe (Just a) = a+unwrapMaybe Nothing = 0++-- |Figures out the highest Q(s,a) action given a particular state and returns that action index.+maxAction :: (Int -> [Int]) -> Int -> V.Vector (V.Vector Double) -> Int+maxAction possible s q = let possibleActions = possible s+ possibleValues = map (\action -> q V.! s V.! action) possibleActions+ in possibleActions !! (unwrapMaybe $ elemIndex (maximum possibleValues) possibleValues) ++randomAction :: StdGen -> (Int -> [Int]) -> Int -> V.Vector (V.Vector Double) -> (Int, StdGen)+randomAction g possible s q = let possibleActions = possible s+ randomRet = randomR (0, length possibleActions - 1) g in+ (possibleActions !! (fst randomRet), snd randomRet) + +-- |Returns the largest Q(s,a) value given a particular state.+maxActionValue :: Int -> V.Vector (V.Vector Double) -> Double+maxActionValue s q = V.maximum (q V.! s)++-- |Updates the Q(s, a) value based on the previous value of Q(s, a) for a given value of s (the state at which an action was executed),+-- a (the action executed at that state), r (the reward attained given the state action pair), s' (the new state) and gamma (the discount+-- factor for the rewards). +updatedQ :: Int -> Int -> Double -> Int -> Double -> Double -> V.Vector (V.Vector Double) -> V.Vector (V.Vector Double) +updatedQ s a r s' gamma alpha q = q V.// [(s, updateQRow a updatedValue $ q V.! s)] where+ updatedValue = (indexQ s a q) + alpha * (r + gamma * (maxActionValue s' q) - (indexQ s a q)) ++createRewardTable :: Int -> Int -> V.Vector (V.Vector Double) +createRewardTable s a = V.generate s (\n -> V.replicate a 0.0) ++-- |Create an s x s grid consisting of rewards. Used for grid searches.+createGrid :: Int -> V.Vector (V.Vector Double)+createGrid s = createRewardTable s s++-- |Take a Q table, current state and return the new Q table along with the new state index. Takes a function+-- "execute" that takes a state, action pair and returns the reward and new state associated that state and action pair. +-- The argument "possible" is a function that gives us a list of actions that are possible at a particular state. For example,+-- we can't go off the grid when we're at the edge of a grid so such an action would not be part of the possible states.+-- TODO make params tunable+qLearnIter :: (Int -> Int -> (Int, Double)) -> (Int -> [Int]) -> Int -> V.Vector (V.Vector Double) -> (V.Vector (V.Vector Double), Int) +qLearnIter execute possible state q = let action = maxAction possible state q+ retExec = execute state action+ state' = fst retExec+ reward = snd retExec in (updatedQ state action reward state' 0.8 0.4 q, state')++qRandomIter :: StdGen -> (Int -> Int -> (Int, Double)) -> (Int -> [Int]) -> Int -> V.Vector (V.Vector Double) -> ((V.Vector (V.Vector Double), Int), StdGen)+qRandomIter g execute possible state q = let randomRet = randomAction g possible state q+ action = fst randomRet+ g' = snd randomRet+ retExec = execute state action+ reward = snd retExec+ state' = fst retExec in ((updatedQ state action reward state' 0.8 0.4 q, state'), g')++-- |Takes an integer the width and height of a 2D matrix and a linear index and converts it to a 2D index.+linearTo2D :: Int -> Int -> Int -> (Int, Int)+linearTo2D rows cols lin_index = (lin_index `div` cols, (lin_index `mod` cols)) ++-- |Takes a 2D coordinate and turns it into a linear coordinate.+twoDToLinear :: Int -> Int -> (Int, Int) -> Int +twoDToLinear rows cols (r, c) = (r * cols) + c++-- |Takes the number of rows, number of cols (in a grid), the currents state (specified as a linear index)+-- and an action to determine the next state' (also a linear index). The action can be one of the following:+-- 0: move up+-- 1: move down+-- 2: move left+-- 3: move right.+-- Note that this does not perform any bounds checking. In addition, if the action is invalid, a -1 state is returned.+applyGridAction :: Int -> Int -> Int -> Int -> Int+applyGridAction rows cols state 0 = let state2DIndex = linearTo2D rows cols state+ state2DIndex' = (fst state2DIndex - 1, (snd state2DIndex)) + in twoDToLinear rows cols state2DIndex'++applyGridAction rows cols state 1 = let state2DIndex = linearTo2D rows cols state+ state2DIndex' = (fst state2DIndex + 1, snd state2DIndex) + in twoDToLinear rows cols state2DIndex'++applyGridAction rows cols state 2 = let state2DIndex = linearTo2D rows cols state+ state2DIndex' = (fst state2DIndex, snd state2DIndex - 1) + in twoDToLinear rows cols state2DIndex'++applyGridAction rows cols state 3 = let state2DIndex = linearTo2D rows cols state+ state2DIndex' = (fst state2DIndex, snd state2DIndex + 1) + in twoDToLinear rows cols state2DIndex'++applyGridAction rows cols state _ = -1 ++-- |Takes a grid descirbing reward values (often from environments that look like grids), a state, an action+-- and returns the new state and new reward.+executeGrid :: V.Vector (V.Vector Double) -> State -> Action -> (State, Reward)+executeGrid grid (State state) (Action action) = let exRet = executeOnGrid grid state action+ in (State $ fst exRet, Reward $ snd exRet) + +-- |Takes a grid of reward values (i.e. each point in this grid is a state and each state has a reward associated with it)+-- and functions as an "execute" for qLearnIter. +executeOnGrid :: V.Vector (V.Vector Double) -> Int -> Int -> (Int, Double)+executeOnGrid grid state action = let rows = V.length $ grid+ cols = V.length $ (grid V.! 0) + coord = linearTo2D rows cols state+ reward = grid V.! (fst coord) V.! (snd coord) + state' = applyGridAction rows cols state action+ in (state', reward)++-- |Create a V.Vector (V.Vector Double) from a [[Double]]. Used to create grid-based environments for the agent.+gridFromList :: [[Double]] -> V.Vector (V.Vector Double)+gridFromList (list:[]) = V.fromList [V.fromList list]+gridFromList (list:lists) = V.cons (V.fromList list) (gridFromList lists) ++-- |A grid consisting of some number used primarily for examples. Here's what it looks like:+-- [[1.0,2.0,3.0,4.0],+-- [5.0,6.0,7.0,8.0],+-- [12.0,11.0,10.0,9.0],+-- [13.0,14.0,15.0,16.0]]+testGrid :: V.Vector (V.Vector Double) +testGrid = gridFromList [[1.0,2.0,3.0,4.0],+ [5.0,6.0,7.0,8.0],+ [12.0,11.0,10.0,9.0],+ [13.0,14.0,15.0,16.0]]++gridPossibleX i j rows cols+ | j <= 0 = [3]+ | j >= rows-1 = [2]+ | otherwise = [2,3]++gridPossibleY i j rows cols+ | i <= 0 = [1]+ | i >= cols-1 = [0]+ | otherwise = [0, 1] ++-- |A "envPossible" function for use in the Environment data type, specifically for environments+-- that look like grids.+possibleGrid :: V.Vector (V.Vector Double) -> State -> [Action] +possibleGrid grid (State state) = map (\x -> Action x) $ gridPossible grid state ++gridPossible :: V.Vector (V.Vector Double) -> Int -> [Int]+gridPossible grid state = let rows = V.length grid + cols = V.length $ (grid V.! 0)+ i = fst $ linearTo2D rows cols state+ j = snd $ linearTo2D rows cols state + in (gridPossibleX i j rows cols) ++ (gridPossibleY i j rows cols)++qPrint grid times s q = do+ putStrLn $ (++) "Original state: " $ show $ s+ let iter = qLearnIter (executeOnGrid grid) (gridPossible grid) s q + let qgrid = fst $ iter+ let state = snd $ iter+ putStrLn $ prettyPrintQ $ qgrid + putStrLn $ (++) "State: " $ show $ state+ qPrint grid (times - 1) state qgrid++checkEpsilon :: StdGen -> (Int -> Double) -> Int -> (Bool, StdGen)+checkEpsilon g epsilon times = let randRet = randomR (0, 1) g+ randVal = fst randRet + g' = snd randRet in+ if randVal < (epsilon times) then (True, g') else (False, g')++pick (x, y) v = if v then x else y++qEpsilonPrint :: StdGen -> (Int -> Double) -> V.Vector (V.Vector Double) -> Int -> Int -> V.Vector (V.Vector Double) -> IO () +qEpsilonPrint g epsilon grid 0 s q = putStrLn "Done!" +qEpsilonPrint g epsilon grid times s q = do+ let execute = executeOnGrid grid+ possible = gridPossible grid+ epRet = checkEpsilon g epsilon times+ doRandom = fst $ epRet+ g' = snd $ epRet in+ if doRandom + then do+ putStrLn "Doing a random action!"+ let randomRet = qRandomIter g' execute possible s q+ let iter = fst randomRet+ let g'' = snd randomRet+ let qgrid = fst $ iter+ let state = snd $ iter+ putStrLn $ prettyPrintQ $ qgrid+ putStrLn $ (++) "State: " $ show $ state+ qEpsilonPrint g'' epsilon grid (times - 1) state qgrid+ else do+ putStrLn "Doing a normal action"+ putStrLn $ (++) "Original state: " $ show $ s+ let iter = qLearnIter (executeOnGrid grid) (gridPossible grid) s q + let qgrid = fst $ iter+ let state = snd $ iter+ putStrLn $ prettyPrintQ $ qgrid + putStrLn $ (++) "State: " $ show $ state+ qEpsilonPrint g' epsilon grid (times - 1) state qgrid++epsilon :: Int -> Int -> Double +-- epsilon totalTimes timesLeft = 1.0/(fromIntegral $ (totalTimes - timesLeft))+epsilon totalTimes timesLeft = 1