aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

47
Task/Forest-fire/Haskell/forest-fire-1.hs
View file

@ -1,47 +0,0 @@
import Data.List
import Control.Arrow
import Control.Monad
import System.Random
data Cell = Empty | Tree | Fire deriving (Eq)
instance Show Cell where
show Empty = " "
show Tree = "T"
show Fire = "$"
randomCell = liftM ([Empty, Tree] !!) (randomRIO (0,1) :: IO Int)
randomChance = randomRIO (0,1.0) :: IO Double
rim b = map (fb b). (fb =<< rb) where
fb = liftM2 (.) (:) (flip (++) . return)
rb = fst. unzip. zip (repeat b). head
take3x3 = concatMap (transpose. map take3). take3 where
take3 = init. init. takeWhile (not.null). map(take 3). tails
list2Mat n = takeWhile(not.null). map(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

25
Task/Forest-fire/Haskell/forest-fire-2.hs
View file

@ -1,25 +0,0 @@
*Main> evolveForest 6 50 3
>>>>>> 1:
T T T TTTTTTTTT TT TT T T T TT TT
TTT TT T TT TTTT T T TT T T T T T T TTTTT T
T TT T TTT T TTTTT TTTTTTTT T TTT TTTT TT
TT TT T TT T TTT T T T TTTT T TTT TT T TT
TT TT TT TT T T T T TT T T TT T T TTTTT
T TT T T T TTTTTT T T T T T TT T TT
>>>>>> 2:
T T T TTTTTTTTT TT TT TT T $ TT TT
TTT TT T TT TTTT T T TT T T T T T T TTTTT T
TT TTTT TT$ T TTTTTT TTTTT$TT T T$T TTTT TT
TT TT T TT T TTTTTTT T TTTT T TTT TT T TT
TT TT TT TT T T T T TT T T TT T T TTTTT
TTT TT TT T T TTTTTT T T T T T TT TT TT
>>>>>> 3:
TTTTT T TTTTTTTTT TT TT TT T TT TT
TTTT TT T $$ TTTT T T $$ T T T T $ $ TTTTT T
TTTTTTT T$ T TTTTTT TTTT$ $T T $ $ TTTTT TT
TT TT T $$ T TTTTTTT T $$$T T TTT $$ T T TTT
TT TT TT TTT T T TT TT TT T T TT T T TTTTT
TTT TT TT T T T TTTTTT T T T T T TT TT TT

59
Task/Forest-fire/Haskell/forest-fire.hs Normal file
View file

@ -0,0 +1,59 @@
import System.Random (randomRIO)
import Data.List (tails, transpose)
import Control.Monad (liftM2, replicateM, unless)
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 = liftM2 (.) (:) (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