From 8a4f282eb65af9e74b9c044b5b4558af41b6a107 Mon Sep 17 00:00:00 2001 From: Jaron Kent-Dobias Date: Wed, 27 Feb 2019 11:21:56 -0500 Subject: started two problems --- 02.05.hs | 30 ++++++++++++++++++++++++++++++ 08.01.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 86 insertions(+) create mode 100644 02.05.hs create mode 100644 08.01.hs 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 + -- cgit v1.2.3-54-g00ecf