Skip to content

Instantly share code, notes, and snippets.

@stephenjbarr
Created January 4, 2015 23:11
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save stephenjbarr/578abcfd8d0c8381643e to your computer and use it in GitHub Desktop.
Save stephenjbarr/578abcfd8d0c8381643e to your computer and use it in GitHub Desktop.
Monad Transformer advice outline
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Random
import Data.Map as Map
import Data.Maybe
import Control.Seq as Seq
import Control.Monad.Par
import Control.DeepSeq
data ProblemParams = ProblemParams {
get_alpha :: !Double
, get_beta :: !Double
} deriving (Show)
data Answer = Answer {
ans_val :: Double
, ans_descr :: String
} deriving (Show)
type App a = RandT (ReaderT ProblemParams Par a)
type Point = [Double]
-- The main functionality of the code is to,
-- for a given ProblemParams, solve a problem.
-- Some of that problem consists of the evaluation
-- of pure functions (e.g. sim_f1, sim_f2)
-- One part of this problem requires Monte Carlo simulation
-- and hence the need for the average of sim_f3 for a
-- sampled set of points.
------------------------------
-- These are representative of the types of functions I have
-- and the general layout of my code
sim_outer :: ProblemParams -> [Point] -> Answer
sim_outer pp xis = ans
where
y1 = sim_f1 pp
y2 = sim_f2 pp
-- y3 requires Monte Carlo Simulation, which is somewhat
-- slow and so I am using the Par monad to parallelize.
y3 = mean $ runPar $ parMap (sim_f3 pp) xis
ysum = y1 + y2 + y3
ans = Answer ysum (sim_descr pp)
sim_f1 :: ProblemParams -> Double
sim_f1 pp = 2.0 * (get_alpha pp)
sim_f2 :: ProblemParams -> Double
sim_f2 pp = 1.0 + (get_beta pp)
sim_f3 :: ProblemParams -> Point -> Double
sim_f3 pp point = ((get_alpha pp) + (get_beta pp)) * (sum point)
sim_descr :: ProblemParams -> String
sim_descr pp = "alpha = " ++ (show (get_alpha pp)) ++ ", beta = " ++ (show (get_beta pp))
pp0 = ProblemParams 1.0 2.0
----------------------------------------
-- CLARIFICATION NEEDED HERE:
-- what is the best way to put all of this together, such that
-- 1. Utilize ReaderT to pass ProblemParams to sim_* functions
-- 2. Use runApp rather than runRandT, e.g. I want to see how RandT is used in a transformer context
-- 3. What else can I do, stylistically, to make this nicer?
-- runApp :: App a -> a
-- runApp app = runRandT $ runReaderT $ runPar app
-- simulation :: ProblemParams -> App a
-- simulation = do
-- points <- sample_points -- RandT here?
-- res <- sim_outer pp sample_points -- Reader to pass in pp to all sim_* functions
-- descr <- sim_descr pp
-- return $ Answer res descr
-- What should main look like?
-- main = do
-- res <- runApp (simulation pp0)
-- print res
-- the plan is to have this be a "server" which receives ProblemParams objects over
-- JSON, runs the simulation, packges up Answer in a JSON, and sends the results back.
--
main = do
gen <- newStdGen
(pts, g') <- runRandT (sample_points pp0 1000) gen
let res = sim_outer pp0 pts
print res
----------------------------------------
-- helpers
-- | Get n points uniformly distributed between 0 and 1
unifn :: (RandomGen g, Monad m) => Int -> RandT g m [Double]
unifn n = sequence (replicate n unif)
-- | Get a point uniformly distributed between 0 and 1
unif :: (RandomGen g, Monad m) => RandT g m Double
unif = getRandomR (0,1)
mean :: [Double] -> Double
mean = go 0 0
where
go s l [] = s / fromIntegral l
go s l (x:xs) = s `seq` l `seq`
go (s+x) (l+1) xs
chunk :: Int -> [a] -> [[a]]
chunk _ [] = []
chunk n xs = as : chunk n bs where (as,bs) = splitAt n xs
sample_points :: (RandomGen g, Monad m) =>
ProblemParams
-> Int -- ^ Number of points to sample
-> RandT g m [Point]
sample_points pp n = do
let width = 10
let npts = n * width
samples <- unifn npts
return $ chunk n samples
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment