diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright (c) 2016, Sergey Mironov
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Sergey Mironov nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+main = defaultMain
+
diff --git a/examples/Main.hs b/examples/Main.hs
new file mode 100644
--- /dev/null
+++ b/examples/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import Examples.Ch4_GridWorld
+
+main = do
+  gw_iter_all gw_d
diff --git a/rl-satton.cabal b/rl-satton.cabal
new file mode 100644
--- /dev/null
+++ b/rl-satton.cabal
@@ -0,0 +1,103 @@
+name:                rl-satton
+version:             0.1.0
+author:              Sergey Mironov
+maintainer:          grrwlf@gmail.com
+category:            Machine Learning
+license:             BSD3
+license-file:        LICENSE
+build-type:          Simple
+cabal-version:       >=1.10
+copyright:           Copyright (c) 2016, Sergey Mironov
+homepage:            https://github.com/grwlf/rl
+synopsis:            Collection of Reinforcement Learning algorithms
+description:
+  rl-satton provides implementation of algorithms, described in the
+  'Reinforcement Learing: An Introduction' book by Richard S. Satton and Andrew
+  G. Barto. In particular, TD(0), TD(lambda), Q-learing are implemented.
+  Code readability was placed above performance.
+
+library
+  default-language: Haskell2010
+  hs-source-dirs:   src
+  exposed-modules:
+    RL.DP
+    RL.MC
+    RL.TD
+    RL.TDl
+    RL.Imports
+    RL.Types
+    RL.Utils
+    Graphics.TinyPlot
+    Control.Monad.Rnd
+
+  default-extensions:
+    LambdaCase,
+    NondecreasingIndentation,
+    Rank2Types,
+    ViewPatterns,
+    ScopedTypeVariables,
+    FlexibleInstances,
+    FlexibleContexts,
+    DataKinds,
+    RecordWildCards,
+    MultiParamTypeClasses,
+    FunctionalDependencies,
+    TemplateHaskell,
+    QuasiQuotes,
+    KindSignatures,
+    TupleSections,
+    DeriveGeneric
+
+  build-depends:
+    base >=4.8 && <4.9,
+    containers,
+    mtl,
+    MonadRandom,
+    transformers,
+    monad-loops,
+    lens,
+    random,
+    heredocs,
+    process,
+    filepath,
+    mersenne-random-pure64,
+    stm,
+    pretty-show,
+    time,
+    directory,
+    text,
+    hashable,
+    binary,
+    deepseq,
+    free,
+    unordered-containers
+
+executable example
+  default-language: Haskell2010
+  hs-source-dirs:   examples
+  main-is:          Main.hs
+  build-depends:    base >=4.8 && <4.9,
+                    rl-satton,
+                    containers,
+                    unordered-containers,
+                    mtl
+
+  default-extensions:
+    LambdaCase,
+    NondecreasingIndentation,
+    Rank2Types,
+    ViewPatterns,
+    ScopedTypeVariables,
+    FlexibleInstances,
+    FlexibleContexts,
+    DataKinds,
+    RecordWildCards,
+    MultiParamTypeClasses,
+    FunctionalDependencies,
+    TemplateHaskell,
+    QuasiQuotes,
+    KindSignatures,
+    TupleSections,
+    DeriveGeneric
+
+
diff --git a/src/Control/Monad/Rnd.hs b/src/Control/Monad/Rnd.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Rnd.hs
@@ -0,0 +1,93 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Control.Monad.Rnd where
+
+import Control.Monad.Identity
+import Control.Monad.State.Strict
+import Control.Monad.Free
+import Control.Monad.Trans.Free
+import Control.Monad.Trans.Free.Church as Church
+import Control.Break
+import System.Random
+-- import Imports
+
+class (Monad m, RandomGen g) => MonadRnd g m | m -> g where
+  roll :: (g -> (a,g)) -> m a
+  getGen :: m g
+  putGen :: g -> m ()
+
+getRndR :: (MonadRnd g m, Random a) => (a,a) -> m a
+getRndR = roll . randomR
+
+newtype RndT g m a = RndT { unRndT :: StateT g m a }
+    deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, MonadFix)
+
+runRnd :: RndT g Identity a -> g -> (a,g)
+runRnd r g = runIdentity $ runStateT (unRndT r) g
+
+runRndT :: RndT g m a -> g -> m (a,g)
+runRndT r g = runStateT (unRndT r) g
+
+evalRndT :: (Monad m) => RndT g m a -> g -> m a
+evalRndT r g = fst <$> runRndT r g
+
+evalRndT_ r g = evalRndT r g  >> return ()
+
+instance (Monad m, RandomGen g) => MonadRnd g (RndT g m) where
+  getGen = RndT get
+  putGen = RndT .  put
+  roll f = RndT $ do
+    g <- get
+    (a,g') <- pure (f g)
+    put g'
+    return a
+
+rollM :: (MonadRnd g m) => (g -> m (a, g)) -> m a
+rollM mf = do
+  g <- getGen
+  (a,g') <- mf g
+  putGen g'
+  return a
+
+instance (MonadRnd g m) => MonadRnd g (StateT s m) where
+  getGen = lift getGen
+  putGen = lift . putGen
+  roll = lift . roll
+
+instance (MonadRnd g m) => MonadRnd g (Break r m) where
+  getGen = lift getGen
+  putGen = lift . putGen
+  roll = lift . roll
+
+instance (Functor f, MonadRnd g m) => MonadRnd g (FreeT f m) where
+  getGen = lift getGen
+  putGen = lift . putGen
+  roll = lift . roll
+
+instance (Functor f, MonadRnd g m) => MonadRnd g (FT f m) where
+  getGen = lift getGen
+  putGen = lift . putGen
+  roll = lift . roll
+
+-- | Extracted from MonadRandom AS-IS
+-- Sample a random value from a weighted list.  The total weight of all
+-- elements must not be 0.
+fromList :: (MonadRnd g m) => [(a,Rational)] -> m a
+fromList [] = error "MonadRnd.fromList called with empty list"
+fromList [(x,_)] = return x
+fromList xs = do
+  -- TODO: Do we want to be able to use floats as weights?
+  -- TODO: Better error message if weights sum to 0.
+  let s = (fromRational (sum (map snd xs))) :: Double -- total weight
+      cs = scanl1 (\(_,q) (y,s') -> (y, s'+q)) xs       -- cumulative weight
+  p <- liftM toRational $ getRndR (0.0,s)
+  return . fst . head $ dropWhile (\(_,q) -> q < p) cs
+
+-- | Sample a value from a uniform distribution of a list of elements.
+uniform :: (MonadRnd g m) => [a] -> m a
+uniform = Control.Monad.Rnd.fromList . fmap (flip (,) 1)
+
diff --git a/src/Graphics/TinyPlot.hs b/src/Graphics/TinyPlot.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/TinyPlot.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Graphics.TinyPlot where
+
+import Control.Applicative
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.Trans
+import Control.Exception
+import Data.Char
+import System.IO
+import System.Process
+import System.FilePath
+import Text.Heredoc
+import Text.Printf
+
+data PlotData = PlotData {
+    ps_filename :: String
+  , ps_handle :: Handle
+  } deriving(Show)
+
+newData :: FilePath -> IO PlotData
+newData ((-<.> ".dat") -> filename) = PlotData filename <$> openFile filename WriteMode
+
+pushData :: (MonadIO m, Fractional num, Real num) => PlotData -> num -> num -> m ()
+pushData PlotData{..} (fromRational . toRational -> x :: Double) (fromRational . toRational -> y :: Double) = liftIO $ do
+  hPutStrLn ps_handle (show x ++ "\t" ++ show y) >> hFlush ps_handle
+
+dat :: PlotData -> String
+dat PlotData{..} = printf "\"%s\"" ps_filename
+
+
+data Plot = Plot {
+  pl_handle :: ProcessHandle
+}
+
+spawnPlot :: String -> String -> IO Plot
+spawnPlot ((-<.> ".gnuplot") -> name) plot =
+  Plot <$> do
+    writeFile name plot *> spawnProcess "gnuplot" [name]
+
+withPlot :: String -> String -> IO a -> IO a
+withPlot ((-<.> ".gnuplot") -> name) plot h = do
+  writeFile name plot
+  p <- spawnProcess "gnuplot" [name]
+  r <- h `finally` terminateProcess p
+  return r
+
+
+test = do
+  d <- newData "plot.dat"
+
+  spawnPlot "plot1" [heredoc|
+    set xrange [0:20]
+    set yrange [0:400]
+    done = 0
+    bind all 'd' 'done = 1'
+    while(!done) {
+      plot ${dat d} using 1:2 with lines
+      pause 1
+    }
+  |]
+
+  forM_ [0..100] $ \i@(fromInteger -> r) -> do
+    when (i`mod`10 == 0) $ do
+      threadDelay (10^6)
+    pushData d r (r*r  / 3.2)
+
diff --git a/src/RL/DP.hs b/src/RL/DP.hs
new file mode 100644
--- /dev/null
+++ b/src/RL/DP.hs
@@ -0,0 +1,244 @@
+module RL.DP where
+
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Set as Set
+import Prelude hiding(break)
+
+import RL.Imports
+
+-- | Probability [0..1]
+type Probability = Rational
+
+-- | Policy
+type P s a = HashMap s (Set (a,Probability))
+
+type V s num = HashMap s num
+
+-- FIXME: handle missing states case
+diffV :: (Eq s, Hashable s, Num num) => V s num -> V s num -> num
+diffV tgt src = sum (HashMap.intersectionWith (\a b -> abs (a - b)) tgt src)
+
+-- FIXME: Convert to fold-like style eventially
+-- | Dynamic Programming Problem. Parameters have the following meaning: @num@ -
+-- Type of Numbers; @pr@ - the problem; @s@ - State; @a@ - Action
+class (Ord s, Ord a, Fractional num, Ord num, Hashable s) =>
+    DP_Problem pr s a num | pr -> s, pr -> a, pr -> num where
+  dp_states :: pr -> Set s
+  dp_actions :: pr -> s -> Set a
+  dp_transitions :: pr -> s -> a -> Set (s, Probability)
+  dp_reward :: pr -> s -> a -> s -> num
+  -- FIXME: think about splitting terminal and non-terminal states
+  dp_terminal_states :: pr -> Set s
+
+action :: (DP_Problem pr s a num) => pr -> P s a -> s -> Set (a,Probability)
+action pr p s = p HashMap.! s
+
+initV :: (DP_Problem pr s a num)
+  => pr -> num -> V s num
+initV pr num =  HashMap.fromList $ map (\s -> (s,num)) (Set.toList $ dp_states pr)
+
+-- | For given state, probabilities for all possible action should sum up to 1
+invariant_probable_actions :: (DP_Problem pr s a num, Show s, Show a) => pr -> Bool
+invariant_probable_actions pr =
+  flip all (dp_states pr) $ \s ->
+    flip all (dp_actions pr s) $ \a ->
+      case sum (map snd (Set.toList (dp_transitions pr s a))) of
+        1 -> True
+        x -> error $ "Total probability of state " ++ show s ++ " action " ++ show a ++ " sum up to " ++ show x
+
+-- | No action leads to unlisted state
+invariant_closed_transition :: (DP_Problem pr s a num, Show s, Show a) => pr -> Bool
+invariant_closed_transition pr =
+  flip all (dp_states pr) $ \s ->
+    flip all (dp_actions pr s) $ \a ->
+      flip all (dp_transitions pr s a) $ \(s',p) ->
+        case (Set.member s' (dp_states pr)) of
+          True -> True
+          False -> error $ "State " ++ show s ++ ", action " ++ show a ++ " lead to invalid state " ++ show s'
+
+-- | Terminal states are dead ends and non-terminal states are not
+invariant_no_dead_states :: (DP_Problem pr s a num, Show s, Show a) => pr -> Bool
+invariant_no_dead_states pr =
+  flip all (dp_states pr) $ \s ->
+    case (member s (dp_terminal_states pr), Set.null (dp_actions pr s)) of
+      (True,True) -> True
+      (True,False) -> error $ "Terminal state " ++ show s ++ " is not dead end"
+      (False,False) -> True
+      (False,True) -> error $ "State " ++ show s ++ " is dead end"
+
+-- Terminals are valid states
+invariant_terminal :: (DP_Problem pr s a num, Show s, Show a) => pr -> Bool
+invariant_terminal pr =
+  flip all (dp_terminal_states pr) $ \st ->
+    case Set.member st (dp_states pr) of
+      True -> True
+      False -> error $ "State " ++ show st ++ " is not a valid state"
+
+-- Policy returns valid actions
+invariant_policy_actions :: (DP_Problem pr s a num, Ord a, Show s, Show a) => P s a -> pr -> Bool
+invariant_policy_actions p pr =
+  flip all (dp_states pr) $ \s ->
+    flip all (action pr p s) $ \(a, prob) ->
+      case Set.member a (dp_actions pr s) of
+        True -> True
+        False -> error $ "Policy from state " ++ show s ++ " leads to invalid action " ++ show a
+
+-- Policy return valid probabilities
+invariant_policy_prob :: (DP_Problem pr s a num, Ord a, Show s, Show a) => P s a -> pr -> Bool
+invariant_policy_prob p pr =
+  flip all (dp_states pr) $ \s ->
+    let
+      as = Set.toList (action pr p s)
+    in
+    case sum $ map snd as of
+      1 -> True
+      0 | null as -> True
+      x -> error $ "Policy state " ++ show s ++ " probabilities sum up to " ++ show x
+
+invariant :: (DP_Problem pr s a num, Show s, Show a, Ord a) => pr -> Bool
+invariant pr = all ($ pr) [
+    invariant_probable_actions
+  , invariant_closed_transition
+  , invariant_terminal
+  , invariant_policy_actions (uniformPolicy pr)
+  , invariant_policy_prob (uniformPolicy pr)
+  , invariant_no_dead_states
+  ]
+
+policy_eq :: (Eq a, DP_Problem pr s a num) => pr -> P s a -> P s a -> Bool
+policy_eq pr p1 p2 = all (\s -> (action pr p1 s) == (action pr p2 s)) (dp_states pr)
+
+
+uniformPolicy :: (Ord a, DP_Problem pr s a num) => pr -> P s a
+uniformPolicy pr =
+  HashMap.fromList $ flip map (Set.toList (dp_states pr)) $ \s ->
+    let
+      as = dp_actions pr s
+    in
+    (s, Set.map (\a -> (a, 1%(toInteger $ length as))) as)
+
+
+data Opts num s a = Opts {
+    eo_gamma :: num
+  -- ^ Forgetness
+  , eo_etha :: num
+  -- ^ policy evaluation precision
+  , eo_max_iter :: Int
+  -- ^ policy evaluation iteration limit, [1..maxBound]
+  } deriving(Show)
+
+defaultOpts :: (Fractional num) => Opts num s a
+defaultOpts = Opts {
+    eo_gamma = 0.9
+  , eo_etha = 0.1
+  , eo_max_iter = 10^3
+  }
+
+data EvalState num s = EvalState {
+    _es_delta :: num
+  , _es_v :: V s num
+  , _es_v' :: V s num
+  , _es_iter :: Int
+  } deriving(Show)
+
+makeLenses ''EvalState
+
+initEvalState :: (Fractional num) => V s num -> EvalState num s
+initEvalState v = EvalState 0 v v 0
+
+-- | Iterative policy evaluation algorithm
+-- Figure 4.1, pg.86.
+policy_eval :: (Monad m, DP_Problem pr s a num)
+  => Opts num s a -> P s a -> V s num -> (DP pr m s a num) -> m (V s num)
+policy_eval Opts{..} p v (DP pr _) = do
+  let sum l f = List.sum <$> forM (Set.toList l) f
+
+  view es_v <$> do
+    flip execStateT (initEvalState v) $ loop $ do
+
+      i <- use es_iter
+      when (i > eo_max_iter-1) $ do
+        break ()
+
+      es_delta %= const 0
+
+      forM_ (dp_states pr) $ \s -> do
+        v_s <- (HashMap.!s) <$> use es_v
+        v's <- do
+          sum (action pr p s) $ \(a, fromRational -> pa) -> do
+            (pa*) <$> do
+              sum (dp_transitions pr s a) $ \(s', fromRational -> p) -> do
+                v_s' <- (HashMap.!s') <$> use es_v
+                pure $ p * ((dp_reward pr s a s') + eo_gamma * (v_s'))
+
+        es_v' %= (HashMap.insert s v's)
+        es_delta %= (`max`(abs (v's - v_s)))
+
+      d <- use es_delta
+      when (d < eo_etha) $ do
+        break ()
+
+      v' <- use es_v'
+      es_v %= const v'
+
+      es_iter %= (+1)
+
+policy_action_value :: (DP_Problem pr s a num) => Opts num s a -> s -> a -> V s num -> pr -> num
+policy_action_value Opts{..} s a v pr =
+  List.sum $ flip map (Set.toList $ dp_transitions pr s a) $ \(s', fromRational -> p) ->
+    p * ((dp_reward pr s a s') + eo_gamma * (v HashMap.! s'))
+
+policy_improve :: (Monad m, DP_Problem pr s a num)
+  => Opts num s a -> V s num -> DP pr m s a num -> m (P s a)
+policy_improve o v (DP pr _) = do
+  let sum l f = List.sum <$> forM (Set.toList l) f
+  flip execStateT mempty $ do
+    forM_ (dp_states pr) $ \s -> do
+      (maxv, maxa) <- do
+        foldlM (\(val,maxa) a -> do
+                  pi_s <- pure $ policy_action_value o s a v pr
+                  return $
+                    if Set.null maxa then
+                      (pi_s, Set.singleton a)
+                    else
+                      if pi_s > val then
+                        -- GT
+                        (pi_s, Set.singleton a)
+                      else
+                        if pi_s < val then
+                          -- LT
+                          (val,maxa)
+                        else
+                          -- EQ
+                          (val, Set.insert a maxa)
+               ) (0, Set.empty) (dp_actions pr s)
+
+      let nmax = toInteger (Set.size maxa)
+      modify $ HashMap.insert s (Set.map (\a -> (a,1%nmax)) maxa)
+
+data DP pr m s a num = DP {
+    dp_pr :: pr
+  , dp_trace :: V s num -> P s a -> m ()
+}
+
+
+policy_iteration :: (Monad m, DP_Problem pr s a num, Ord a)
+  => Opts num s a -> P s a -> V s num -> (DP pr m s a num) -> m (V s num, P s a)
+policy_iteration o p v dpr@(DP pr trace) = do
+  let up = lift . lift
+  (v', p') <-
+    flip execStateT (v, p) $ do
+    loop $ do
+      (v,p) <- get
+      v' <- up $ policy_eval o p v dpr
+      p' <- up $ policy_improve o v' dpr
+      up $ trace v' p'
+      put (v', p')
+      when (policy_eq pr p p') $ do
+        break ()
+  return (v',p')
+
+
+
diff --git a/src/RL/Imports.hs b/src/RL/Imports.hs
new file mode 100644
--- /dev/null
+++ b/src/RL/Imports.hs
@@ -0,0 +1,100 @@
+
+module RL.Imports (
+    module Control.Arrow
+  , module Control.Applicative
+  , module Control.Concurrent
+  , module Control.Concurrent.STM
+  , module Control.Monad
+  , module Control.Monad.Trans
+  , module Control.Monad.State.Strict
+  , module Control.Monad.Rnd
+  , module Control.Break
+  , module Control.Lens
+  , module Control.Monad.Free.Class
+  , module Control.Monad.Free.TH
+  , module Control.Monad.Loops
+  , module Data.Bits
+  , module Data.Ratio
+  , module Data.Tuple
+  , module Data.Binary
+  , module Data.List
+  , module Data.Map.Strict
+  , module Data.HashMap.Strict
+  , module Data.HashSet
+  , module Data.Maybe
+  , module Data.Set
+  , module Data.Function
+  , module Data.Foldable
+  , module Data.Text
+  , module Data.Monoid
+  , module Data.Hashable
+  , module Debug.Trace
+  , module Prelude
+  , module System.Random
+  , module System.Random.Mersenne.Pure64
+  , module System.Directory
+  , module Text.Printf
+  , module Text.Heredoc
+  , module Text.Show.Pretty
+  , module Graphics.TinyPlot
+  , module RL.Imports
+  , module GHC.Generics
+)
+
+where
+
+import Control.Arrow ((&&&),(***))
+import Control.Applicative
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.State.Strict
+import Control.Monad.Rnd
+import Control.Break
+import Control.Lens (Lens', makeLenses, (%=), (^.), view, use, uses, zoom, _1, _2, _3, _4, _5, _6)
+import Control.Monad.Free.Class
+import Control.Monad.Free.TH (makeFree)
+import Control.Monad.Loops
+import Data.Bits
+import Data.Ratio
+import Data.Tuple
+import Data.List hiding (break)
+import qualified Data.List as List
+import Data.Map.Strict (Map, (!))
+import qualified Data.Map.Strict as Map
+import Data.Set (Set,member)
+import qualified Data.Set as Set
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Data.HashSet (HashSet)
+import Data.Maybe
+import Data.Foldable
+import Data.Function
+import Debug.Trace hiding(traceM)
+import Prelude hiding(break)
+import System.Random
+import System.Random.Mersenne.Pure64
+import System.Directory
+import Text.Printf
+import Text.Heredoc
+import Text.Show.Pretty
+import Graphics.TinyPlot
+import Data.Text (Text)
+import Data.Monoid ((<>))
+import Data.Hashable
+import Data.Binary hiding(put,get)
+import GHC.Generics (Generic)
+
+
+trace1 :: (Show a) => a -> a
+trace1 a = trace (ppShow a) a
+
+traceM :: (Monad m, Show a) => a -> m ()
+traceM a = trace (ppShow a) (return ())
+
+trace' :: (Show a) => a -> b -> b
+trace' a b = trace (ppShow a) b
+
+loopM s0 f m = iterateUntilM (not . f) m s0
+
diff --git a/src/RL/MC.hs b/src/RL/MC.hs
new file mode 100644
--- /dev/null
+++ b/src/RL/MC.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE DeriveFunctor #-}
+module RL.MC where
+
+import qualified Data.HashMap.Strict as HashMap
+import qualified Prelude
+
+import RL.Imports
+import RL.Types
+
+data MC_Opts = MC_Opts {
+    o_alpha :: MC_Number
+  , o_maxlen :: Int
+  , o_maxlen_reward :: MC_Number
+} deriving (Show)
+
+defaultOpts = MC_Opts {
+    o_alpha = 0.1
+  , o_maxlen = 1000
+  , o_maxlen_reward = -100.0
+  }
+
+type MC_Number = Double
+type Q s a = M s a MC_Number
+type V s = HashMap s MC_Number
+
+emptyQ :: MC_Number -> Q s a
+emptyQ = initM
+
+q2v :: (Bounded a, Enum a, Eq a, Hashable a, Eq s, Hashable s) => Q s a -> V s
+q2v = foldMap_s (\(s,l) -> HashMap.singleton s (snd $ layer_s_max l))
+
+-- FIXME: handle missing states case
+diffV :: (Eq s, Hashable s) => V s -> V s -> MC_Number
+diffV tgt src = sum (HashMap.intersectionWith (\a b -> abs ((a) - (b))) tgt src)
+
+toV :: (Bounded a, Enum a, Eq a, Hashable a, Eq s, Hashable s) => Q s a -> V s
+toV = foldMap_s (\(s,l) -> HashMap.singleton s (snd $ layer_s_max l))
+
+class (Fractional num, Ord s, Ord a, Show s, Show a, Bounded a, Enum a) =>
+    MC_Problem pr s a num | pr->s, pr->a, pr->num where
+  mc_is_terminal :: pr -> s -> Bool
+  mc_reward :: pr -> s -> a -> s -> num
+
+queryQ s = HashMap.toList <$> get_s s <$> get
+modifyQ s a f = modify (modify_s_a s a f)
+
+data MC pr m s a = MC {
+    mc_pr :: pr
+  , mc_transition :: s -> a -> m s
+}
+
+-- | MC-ES learning algorithm, pg 5.4. Alpha-learing rate is used instead of
+-- total averaging, maximum episode length is limited to make sure policy it
+-- terminates
+mc_es_learn :: (Monad m, Hashable s, Hashable a, MC_Problem pr s a MC_Number)
+  => MC_Opts -> Q s a -> s -> a -> MC pr m s a -> m (Q s a)
+mc_es_learn MC_Opts{..} q0 s0 a0 mc@(MC pr transition) = do
+  flip execStateT q0 $ do
+
+    {- Build an episode -}
+    ep <- do
+      view _3 <$> do
+      loopM (s0,a0,[],True) (view _4) $ \(s,a,ep,_) -> do
+        s' <- lift $ mc_transition mc s a
+        a' <- fst . maximumBy (compare`on`snd) <$> queryQ s'
+        if length ep > o_maxlen then
+          return (s', a', (s,a,s',o_maxlen_reward):ep, False)
+        else do
+          r <- pure $ mc_reward pr s a s'
+          if mc_is_terminal pr s' then
+            return (s', a', (s,a,s',r):ep, False)
+          else do
+            return (s', a', (s,a,s',r):ep, True)
+
+    {- Build first-visit revard map -}
+    rm <- do
+      fst <$> do
+      flip execStateT (mempty, 0) $ do
+      forM ep $ \(s,a,s',r) -> do
+        modify $ \(m,g) -> (HashMap.insert (s,a) (g+r) m, g+r)
+
+    {- Update Q -}
+    forM_ (HashMap.toList rm) $ \((s,a),g) -> do
+      modifyQ s a $ \q -> q + o_alpha*(g - q)
+
+
diff --git a/src/RL/TD.hs b/src/RL/TD.hs
new file mode 100644
--- /dev/null
+++ b/src/RL/TD.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE DeriveFunctor #-}
+module RL.TD where
+
+import qualified Prelude
+import qualified Data.HashMap.Strict as HashMap
+
+import RL.Imports
+import RL.Types
+import RL.Utils (eps_greedy_action)
+
+data Q_Opts = Q_Opts {
+    o_alpha :: TD_Number
+  , o_gamma :: TD_Number
+  , o_eps :: TD_Number
+} deriving (Show)
+
+defaultOpts = Q_Opts {
+    o_alpha = 0.1
+  , o_gamma = 1.0
+  , o_eps = 0.3
+  }
+
+type TD_Number = Double
+
+type Q s a = M s a TD_Number
+
+emptyQ :: TD_Number -> Q s a
+emptyQ = initM
+
+toV :: (Bounded a, Enum a, Eq a, Hashable a, Eq s, Hashable s) => Q s a -> HashMap s TD_Number
+toV = foldMap_s (\(s,l) -> HashMap.singleton s (snd $ layer_s_max l))
+
+class (Monad m, Eq s, Hashable s, Show s, Eq a, Hashable a, Enum a, Bounded a, Show a) =>
+    TD_Problem pr m s a | pr -> m, pr -> s , pr -> a where
+  td_is_terminal :: pr -> s -> Bool
+  td_greedy :: pr -> Bool -> a -> a
+  td_reward :: pr -> s -> a -> s -> TD_Number
+  td_transition :: pr -> s -> a -> Q s a -> m s
+  td_modify :: pr -> s -> a -> Q s a  -> m ()
+
+queryQ s = HashMap.toList <$> get_s s <$> get
+modifyQ pr s a f = modify (modify_s_a s a f) >> get >>= lift . td_modify pr s a
+action pr s eps = queryQ s >>= eps_greedy_action eps (td_greedy pr)
+transition pr s a = get >>= lift . td_transition pr s a
+
+-- | Q-Learning algorithm
+q_learn :: (MonadRnd g m, TD_Problem pr m s a) => Q_Opts -> Q s a -> s -> pr -> m (s, Q s a)
+q_learn Q_Opts{..} q0 s0 pr = do
+  flip runStateT q0 $ do
+  loopM s0 (not . td_is_terminal pr) $ \s -> do
+    (a,_) <- action pr s o_eps
+    s' <- transition pr s a
+    r <- pure $ td_reward pr s a s'
+    max_qs' <- snd . maximumBy (compare`on`snd) <$> queryQ s'
+    modifyQ pr s a $ \q -> q + o_alpha * (r + o_gamma * max_qs' - q)
+    return s'
+
+-- | Q-Executive algorithm. Actions are taken greedily, no learning is performed
+q_exec :: (MonadRnd g m, TD_Problem pr m s a) => Q_Opts -> Q s a -> s -> pr -> m s
+q_exec Q_Opts{..} q0 s0 pr = do
+  flip evalStateT q0 $ do
+  loopM s0 (not . td_is_terminal pr) $ \s -> do
+    a <- fst . maximumBy (compare`on`snd) <$> queryQ s
+    s' <- transition pr s a
+    return s'
+
diff --git a/src/RL/TDl.hs b/src/RL/TDl.hs
new file mode 100644
--- /dev/null
+++ b/src/RL/TDl.hs
@@ -0,0 +1,98 @@
+{-# LANGUAGE DeriveFunctor #-}
+module RL.TDl where
+
+import qualified Data.List as List
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.HashSet as HashSet
+
+import Control.Monad.Trans.Free.Church
+import RL.Imports
+import RL.Types
+import RL.Utils (eps_greedy_action)
+
+data TDl_Opts = TDl_Opts {
+    o_alpha :: TD_Number
+  , o_gamma :: TD_Number
+  , o_eps :: TD_Number
+  , o_lambda :: TD_Number
+  } deriving (Show)
+
+type TD_Number = Double
+type Q s a = M s a TD_Number
+type Z s a = M s a TD_Number
+type V s a = HashMap s (a, TD_Number)
+
+emptyQ :: TD_Number -> Q s a
+emptyQ = initM
+
+toV :: (Bounded a, Enum a, Eq a, Hashable a, Eq s, Hashable s) => Q s a -> HashMap s TD_Number
+toV = foldMap_s (\(s,l) -> HashMap.singleton s (snd $ layer_s_max l))
+
+data TDl_State s a = TDl_State {
+    _tdl_q :: Q s a
+  , _tdl_z :: Z s a
+  }
+
+$(makeLenses ''TDl_State)
+
+initialState :: Q s a -> TDl_State s a
+initialState q0 = TDl_State q0 (initM 0)
+
+class (Eq s, Hashable s, Show s, Eq a, Hashable a, Enum a, Bounded a, Show a) =>
+    TDl_Problem pr m s a | pr -> m, pr -> s , pr -> a where
+  td_is_terminal :: pr -> s -> Bool
+  td_greedy :: pr -> Bool -> a -> a
+  td_transition :: pr -> s -> a -> TDl_State s a -> m s
+  td_reward :: pr -> s -> a -> s -> TD_Number
+  td_modify :: pr -> s -> a -> TDl_State s a  -> m ()
+
+queryQ s = HashMap.toList <$> get_s s <$> use tdl_q
+modifyQ pr s a f = tdl_q %= modify_s_a s a f
+listZ pr s a f = (list <$> use tdl_z) >>= mapM_ f >> get >>= lift . td_modify pr s a
+modifyZ pr s a f = tdl_z %= modify_s_a s a f
+action pr s eps = queryQ s >>= eps_greedy_action eps (td_greedy pr)
+transition pr s a = get >>= lift . td_transition pr s a
+getQ s a = get_s_a s a <$> use tdl_q
+
+-- | TD(lambda) learning, aka Sarsa(lambda), pg 171
+tdl_learn :: (MonadRnd g m, TDl_Problem pr m s a)
+  => TDl_Opts -> Q s a -> s -> pr -> m (s, Q s a)
+tdl_learn TDl_Opts{..} q0 s0 pr = do
+  (view _1 *** view tdl_q) <$> do
+  flip runStateT (initialState q0) $ do
+    (a0,q0) <- action pr s0 o_eps
+    loopM (s0,a0) (not . td_is_terminal pr . view _1) $ \(s,a) -> do
+      q <- getQ s a
+      s' <- transition pr s a
+      r <- pure $ td_reward pr s a s'
+      (a',q') <- action pr s' o_eps
+      delta <- pure $ r + o_gamma * q' - q
+      modifyZ pr s a (+1)
+      listZ pr s a $ \(s,a,z) -> do
+        modifyQ pr s a (\q -> q + o_alpha * delta * z)
+        modifyZ pr s a (\z -> o_gamma * o_lambda * z)
+      return (s',a')
+
+
+-- | Watkins's Q(lambda) learning algorithm, pg 174
+qlw_learn :: (MonadRnd g m, TDl_Problem pr m s a)
+  => TDl_Opts -> Q s a -> s -> pr -> m (s, Q s a)
+qlw_learn TDl_Opts{..}  q0 s0 pr =
+  (view _1 *** view tdl_q) <$> do
+  flip runStateT (initialState q0) $ do
+    (a0,q0) <- action pr s0 o_eps
+    loopM (s0,a0,q0) (not . td_is_terminal pr . view _1) $ \(s,a,q) -> do
+      s' <- transition pr s a
+      r <- pure $ td_reward pr s a s'
+      (a',q') <- action pr s' o_eps
+      (a'',q'') <- maximumBy (compare`on`snd) <$> queryQ s'
+      delta <- pure $ r + o_gamma * q'' - q
+      modifyZ pr s a (+1)
+      listZ pr s a $ \(s,a,z) -> do
+        modifyQ pr s a (\q -> q + o_alpha * delta * z)
+        modifyZ pr s a (\z -> if a' == a''
+                                then o_gamma*o_lambda*z
+                                else 0)
+      return (s',a',q')
+
+
diff --git a/src/RL/Types.hs b/src/RL/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/RL/Types.hs
@@ -0,0 +1,64 @@
+module RL.Types where
+
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.HashSet as HashSet
+
+import RL.Imports
+
+type Layer a num = HashMap a num
+type Storage s a num = HashMap s (Layer a num)
+
+-- | Base container used in most of RL algorithms. @M x0 sto@ describes the
+-- 2-dimentional array (`Storage` of `Layers`) where each layer containes fixed
+-- number of elements. New layers are filled with the range of
+-- @[minBound..maxBound]@ default values @x0@
+data M s a num = M {
+    x0 :: num
+  , sto :: Storage s a num
+  } deriving(Show)
+
+-- | Initialises new container, set default layer value to @x@
+initM :: num -> M s a num
+initM x = M x HashMap.empty
+
+mmod :: (Storage s a num -> Storage s a num) -> M s a num -> M s a num
+mmod f m = m { sto = f (sto m) }
+
+aq0 :: (Eq a, Enum a, Hashable a, Bounded a)
+  => num -> HashMap a num
+aq0 q0 = HashMap.fromList [(a,q0) | a <- [minBound .. maxBound]]
+
+get_s :: (Eq a, Enum a, Hashable a, Bounded a, Eq s, Hashable s)
+  => s -> M s a num -> Layer a num
+get_s s (M x0 sto) = maybe (aq0 x0) (`HashMap.union` (aq0 x0)) . HashMap.lookup s $ sto
+
+layer_s_max :: (Eq a, Enum a, Hashable a, Bounded a, Ord num)
+  => Layer a num -> (a,num)
+layer_s_max = maximumBy (compare`on`snd) . HashMap.toList
+
+get_s_a :: (Eq a, Enum a, Hashable a, Bounded a, Eq s, Hashable s)
+  => s -> a -> M s a num -> num
+get_s_a s a (M x0 sto) = maybe x0 (maybe x0 id . HashMap.lookup a) . HashMap.lookup s $ sto
+
+put_s :: (Eq s, Hashable s, Bounded a, Enum a, Eq a, Hashable a)
+  => s -> HashMap a num -> M s a num -> M s a num
+put_s s x = mmod $ HashMap.unionWith HashMap.union (HashMap.singleton s x)
+
+put_s_a :: (Eq s, Hashable s, Bounded a, Enum a, Eq a, Hashable a)
+  => s -> a -> num -> M s a num -> M s a num
+put_s_a s a x = put_s s (HashMap.singleton a x)
+
+modify_s_a :: (Eq s, Hashable s, Bounded a, Enum a, Eq a, Hashable a)
+  => s -> a -> (num -> num) -> M s a num -> M s a num
+modify_s_a s a f q = put_s_a s a (f (get_s_a s a q)) q
+
+list :: M s a num -> [(s,a,num)]
+list q = flip concatMap (HashMap.toList (sto q)) $ \(s,aq) -> flip map (HashMap.toList aq) $ \(a,q) -> (s,a,q)
+
+foldMap_s :: (Eq a, Bounded a, Enum a, Hashable a, Monoid acc) => ((s,Layer a num) -> acc) -> M s a num -> acc
+foldMap_s f (M x0 sto) = foldMap (f . (id *** (`HashMap.union`(aq0 x0)))) (HashMap.toList sto)
+
+fold_s :: (Eq a, Bounded a, Enum a, Hashable a, Monoid acc) => (acc -> (s,Layer a num) -> acc) -> acc -> M s a num -> acc
+fold_s f acc0 (M x0 sto) = foldl' go acc0 (HashMap.toList sto) where
+  go acc (s,l) = f acc (s,l`HashMap.union`(aq0 x0))
+
diff --git a/src/RL/Utils.hs b/src/RL/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/RL/Utils.hs
@@ -0,0 +1,22 @@
+module RL.Utils where
+
+import qualified Control.Monad.Rnd as Rnd
+
+import RL.Imports
+
+-- | Return @eps@-greedy action for some state of problem @pr@. The state is
+-- described with assosiated list of weighted actions @as@
+eps_greedy_action :: (Fractional num, Ord num, Real num, Eq a, MonadRnd g m)
+  => num -> (Bool -> a -> a) -> [(a,num)] -> m (a,num)
+eps_greedy_action eps greedy as = do
+  let (abest, qbest) = maximumBy (compare`on`snd) as
+  let arest = filter (\x -> fst x /= abest) as
+  join $ Rnd.fromList [
+    swap (toRational (1.0-eps), do
+      -- traceM "greedy"
+      return (greedy True abest, qbest)),
+    swap (toRational eps, do
+      -- traceM "random"
+      (r,q) <- Rnd.uniform arest
+      return (greedy False r, q))
+    ]