summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJaron Kent-Dobias <jaron@kent-dobias.com>2019-02-27 11:21:56 -0500
committerJaron Kent-Dobias <jaron@kent-dobias.com>2019-02-27 11:21:56 -0500
commit8a4f282eb65af9e74b9c044b5b4558af41b6a107 (patch)
tree81d151e2be2a5f95543f89cd2a7363a7400d2b7b
parentbdb9f22c1bf5821697561e96bb1913469d160d5f (diff)
downloadsethna.hs-8a4f282eb65af9e74b9c044b5b4558af41b6a107.tar.gz
sethna.hs-8a4f282eb65af9e74b9c044b5b4558af41b6a107.tar.bz2
sethna.hs-8a4f282eb65af9e74b9c044b5b4558af41b6a107.zip
started two problems
-rw-r--r--02.05.hs30
-rw-r--r--08.01.hs56
2 files changed, 86 insertions, 0 deletions
diff --git a/02.05.hs b/02.05.hs
new file mode 100644
index 0000000..bad7367
--- /dev/null
+++ b/02.05.hs
@@ -0,0 +1,30 @@
+
+import System.Random
+import Control.Monad.State
+import Data.List.Split (chunksOf)
+
+import Graphics.Rendering.Chart.Easy
+import Graphics.Rendering.Chart.Backend.Cairo
+
+import Data.Colour.Names
+import Diagrams.Prelude
+import Diagrams.Backend.SVG.CmdLine
+
+randomWalk :: (RandomGen g) => Int -> Int -> State g [[Double]]
+randomWalk d n = get >>= (\g -> let (g1, g2) = split g in (put g1) >> (return $ take n $ scanl (\x y -> map (uncurry (+)) $ zip x y) (replicate d 0.0) $ chunksOf d $ randomRs (-0.5,0.5) g2))
+
+drawWalk :: [[Double]] -> Diagram B
+drawWalk w = fromVertices $ (\[x, y] -> p2 (x, y)) <$> w
+
+main = do
+ g <- newStdGen
+ let (w10, g2) = runState (randomWalk 2 10) g
+ let (w1000, g3) = runState (randomWalk 2 1000) g2
+ let (w100000, g4) = runState (randomWalk 2 100000) g3
+-- mainWith $ foldr1 Diagrams.Prelude.atop [lc red $ drawWalk w10, lc blue $ drawWalk w1000, lc green $ drawWalk w100000]
+ let (e1, g5) = runState (sequence $ replicate 10000 $ randomWalk 2 2) g4
+ let (e10, g6) = runState (sequence $ replicate 10000 $ randomWalk 2 11) g5
+ mainWith $ foldr1 Diagrams.Prelude.atop [mconcat $ map (place (lw Diagrams.Prelude.none $ fc yellow $ ((circle 0.01) :: Diagram B))) (map (\[x, y] -> p2 (x, y)) (map last e1)), mconcat $ map (place (lw Diagrams.Prelude.none $ fc black $ circle 0.01)) (map (\[x, y] -> p2 (x, y)) (map last e10))]
+
+
+
diff --git a/08.01.hs b/08.01.hs
new file mode 100644
index 0000000..bb971be
--- /dev/null
+++ b/08.01.hs
@@ -0,0 +1,56 @@
+
+import System.Random
+import Control.Monad.State
+import Data.Maybe
+import Data.Tuple
+import Data.Sequence as Seq
+import Data.Foldable
+
+-- | Take a random element from a list, removing it from the list.
+randomChoice :: RandomGen g => State (Seq a, g) (Maybe a)
+randomChoice = get >>= (\(xs, g) -> if (Seq.null xs) then (return Nothing) else (let
+ (r, g2) = randomR (0, Seq.length xs - 1) g
+ in (put (deleteAt r xs, g2) >> (return (Just $ index xs r))
+ )))
+
+-- | Returns a list of randomly chosen values with no repeats.
+randomChoices :: RandomGen g => Int -> State (Seq a, g) (Seq a)
+randomChoices n = state (\si ->
+ let (maybeVals, sf) = runState (sequence $ Prelude.replicate n randomChoice) si
+ in (fromList $ catMaybes maybeVals, sf)
+ )
+
+data Bacterium = Red | Green deriving Show
+type Bacteria = Seq Bacterium
+
+reproduce :: Bacteria -> Bacteria
+reproduce b = b <> b
+
+eat :: RandomGen g => (Bacteria, g) -> (Bacteria, g)
+eat (b, g) = snd $ runState (randomChoices $ Seq.length b `quot` 2) (b, g)
+
+hour :: RandomGen g => (Bacteria, g) -> (Bacteria, g)
+hour (b, g) = eat (reproduce b, g)
+
+initialize :: Int -> Bacteria
+initialize n = (Seq.replicate (n `quot` 2) Red) <> (Seq.replicate (n `quot` 2) Green)
+
+isRed :: Bacterium -> Bool
+isRed Red = True
+isRed Green = False
+
+nRed :: Bacteria -> Int
+nRed b = Seq.length $ Seq.filter isRed b
+
+isDone :: Bacteria -> Bool
+isDone b | nRed b == 0 = True
+ | nRed b == Seq.length b = True
+ | otherwise = False
+
+run :: RandomGen g => Int -> g -> ([Bacteria], g)
+run n g = (fst <$> steps, snd $ last steps)
+ where steps = takeWhile (not . isDone . fst) $ iterate hour (initialize n, g)
+
+lifetime :: [Bacteria] -> Int
+lifetime b = Data.Foldable.length b
+