Initial data commit

Task/Forest-fire/Haskell/forest-fire.hs

@@ -0,0 +1,59 @@
+import Control.Monad (replicateM, unless)
+import Data.List (tails, transpose)
+import System.Random (randomRIO)
+
+data Cell
+  = Empty
+  | Tree
+  | Fire
+  deriving (Eq)
+
+instance Show Cell where
+  show Empty = " "
+  show Tree = "T"
+  show Fire = "$"
+
+randomCell :: IO Cell
+randomCell = fmap ([Empty, Tree] !!) (randomRIO (0, 1) :: IO Int)
+
+randomChance :: IO Double
+randomChance = randomRIO (0, 1.0) :: IO Double
+
+rim :: a -> [[a]] -> [[a]]
+rim b = fmap (fb b) . (fb =<< rb)
+  where
+    fb = (.) <$> (:) <*> (flip (++) . return)
+    rb = fst . unzip . zip (repeat b) . head
+
+take3x3 :: [[a]] -> [[[a]]]
+take3x3 = concatMap (transpose . fmap take3) . take3
+  where
+    take3 = init . init . takeWhile (not . null) . fmap (take 3) . tails
+
+list2Mat :: Int -> [a] -> [[a]]
+list2Mat n = takeWhile (not . null) . fmap (take n) . iterate (drop n)
+
+evolveForest :: Int -> Int -> Int -> IO ()
+evolveForest m n k = do
+  let s = m * n
+  fs <- replicateM s randomCell
+  let nextState xs = do
+        ts <- replicateM s randomChance
+        vs <- replicateM s randomChance
+        let rv [r1, [l, c, r], r3] newTree fire
+              | c == Fire = Empty
+              | c == Tree && Fire `elem` concat [r1, [l, r], r3] = Fire
+              | c == Tree && 0.01 >= fire = Fire
+              | c == Empty && 0.1 >= newTree = Tree
+              | otherwise = c
+        return $ zipWith3 rv xs ts vs
+      evolve i xs =
+        unless (i > k) $
+        do let nfs = nextState $ take3x3 $ rim Empty $ list2Mat n xs
+           putStrLn ("\n>>>>>> " ++ show i ++ ":")
+           mapM_ (putStrLn . concatMap show) $ list2Mat n xs
+           nfs >>= evolve (i + 1)
+  evolve 1 fs
+
+main :: IO ()
+main = evolveForest 6 50 3