Anonymous user
Percolation/Bond percolation: Difference between revisions
Added haskell version
Thundergnat (talk | contribs) m (→{{header|Perl 6}}: Remove some superstitious parenthesis, minor code tweaks) |
(Added haskell version) |
||
Line 580:
p=0.90, 0.000
</pre>
=={{header|Haskell}}==
<lang haskell>{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Monad.Random
import Data.Array.Unboxed
import Data.List
import Formatting
data Field = Field { f :: UArray (Int, Int) Char
, hWall :: UArray (Int, Int) Bool
, vWall :: UArray (Int, Int) Bool
}
-- Start percolating some seepage through a field.
-- Recurse to continue percolation with new seepage.
percolateR :: [(Int, Int)] -> Field -> (Field, [(Int,Int)])
percolateR [] (Field f h v) = (Field f h v, [])
percolateR seep (Field f h v) =
let ((xLo,yLo),(xHi,yHi)) = bounds f
validSeep = filter (\p@(x,y) -> x >= xLo
&& x <= xHi
&& y >= yLo
&& y <= yHi
&& f!p == ' ') $ nub $ sort seep
north (x,y) = if v ! (x ,y ) then [] else [(x ,y-1)]
south (x,y) = if v ! (x ,y+1) then [] else [(x ,y+1)]
west (x,y) = if h ! (x ,y ) then [] else [(x-1,y )]
east (x,y) = if h ! (x+1,y ) then [] else [(x+1,y )]
neighbors (x,y) = north(x,y) ++ south(x,y) ++ west(x,y) ++ east(x,y)
in percolateR
(concatMap neighbors validSeep)
(Field (f // map (\p -> (p,'.')) validSeep) h v)
-- Percolate a field; Return the percolated field.
percolate :: Field -> Field
percolate start@(Field f _ _) =
let ((_,_),(xHi,_)) = bounds f
(final, _) = percolateR [(x,0) | x <- [0..xHi]] start
in final
-- Generate a random field.
initField :: Int -> Int -> Double -> Rand StdGen Field
initField width height threshold = do
let f = listArray ((0,0), (width-1, height-1)) $ repeat ' '
hrnd <- fmap (<threshold) <$> getRandoms
let h0 = listArray ((0,0),(width, height-1)) hrnd
h1 = h0 // [((0,y), True) | y <- [0..height-1]] -- close left
h2 = h1 // [((width,y), True) | y <- [0..height-1]] -- close right
vrnd <- fmap (<threshold) <$> getRandoms
let v0 = listArray ((0,0),(width-1, height)) vrnd
v1 = v0 // [((x,0), True) | x <- [0..width-1]] -- close top
return $ Field f h2 v1
-- Assess whether or not percolation reached bottom of field.
leaks :: Field -> [Bool]
leaks (Field f _ v) =
let ((xLo,_),(xHi,yHi)) = bounds f
in [f!(x,yHi)=='.' && not (v!(x,yHi+1)) | x <- [xLo..xHi]]
-- Run test once; Return bool indicating success or failure.
oneTest :: Int -> Int -> Double -> Rand StdGen Bool
oneTest width height threshold =
or.leaks.percolate <$> initField width height threshold
-- Run test multple times; Return the number of tests that pass.
multiTest :: Int -> Int -> Int -> Double -> Rand StdGen Double
multiTest testCount width height threshold = do
results <- replicateM testCount $ oneTest width height threshold
let leakyCount = length $ filter id results
return $ fromIntegral leakyCount / fromIntegral testCount
-- Helper function for display
alternate :: [a] -> [a] -> [a]
alternate [] _ = []
alternate (a:as) bs = a : alternate bs as
-- Display a field with walls and leaks.
showField :: Field -> IO ()
showField field@(Field a h v) = do
let ((xLo,yLo),(xHi,yHi)) = bounds a
fLines = [ [ a!(x,y) | x <- [xLo..xHi]] | y <- [yLo..yHi]]
hLines = [ [ if h!(x,y) then '|' else ' ' | x <- [xLo..xHi+1]] | y <- [yLo..yHi]]
vLines = [ [ if v!(x,y) then '-' else ' ' | x <- [xLo..xHi]] | y <- [yLo..yHi+1]]
lattice = [ [ '+' | x <- [xLo..xHi+1]] | y <- [yLo..yHi+1]]
hDrawn = zipWith alternate hLines fLines
vDrawn = zipWith alternate lattice vLines
mapM_ putStrLn $ alternate vDrawn hDrawn
let leakLine = [ if l then '.' else ' ' | l <- leaks field]
putStrLn $ alternate (repeat ' ') leakLine
main :: IO ()
main = do
g <- getStdGen
let threshold = 0.45
(startField, g2) = runRand (initField 10 10 threshold) g
putStrLn ("Unpercolated field with " ++ show threshold ++ " threshold.")
putStrLn ""
showField startField
putStrLn ""
putStrLn "Same field after percolation."
putStrLn ""
showField $ percolate startField
let testCount = 10000
densityCount = 10
putStrLn ""
putStrLn ("Results of running percolation test " ++ show testCount ++ " times with thresholds ranging from 0/" ++ show densityCount ++ " to " ++ show densityCount ++ "/" ++ show densityCount ++ " .")
let densities = [0..densityCount]
let tests = sequence [multiTest testCount 10 10 v
| density <- densities,
let v = fromIntegral density / fromIntegral densityCount ]
let results = zip densities (evalRand tests g2)
mapM_ print [format ("p=" % int % "/" % int % " -> " % fixed 4) density densityCount x | (density,x) <- results]</lang>
{{out}}
<pre>
Unpercolated field with 0.45 threshold.
+-+-+-+-+-+-+-+-+-+-+
| | | | | | | |
+-+-+ +-+ + + + + +-+
| | | | | | | |
+ + +-+-+ + +-+-+ + +
| | | |
+ +-+-+-+ +-+-+ +-+ +
| | | | | |
+ +-+ + + +-+-+ + +-+
| | | | | |
+-+-+ + + + + +-+ + +
| | | | | | | |
+-+ + + + + + + +-+-+
| | | | |
+ + + + + +-+ +-+ + +
| | | | | | | | |
+ + + +-+-+-+-+-+ + +
| | | | |
+ +-+ +-+ +-+ + + +-+
| | | | | |
+ + + + +-+ +-+-+-+ +
Same field after percolation.
+-+-+-+-+-+-+-+-+-+-+
|. . . .|.|.|.|.|.|.|
+-+-+ +-+ + + + + +-+
| |.|. . . .|.|.|.|.|
+ + +-+-+ + +-+-+ + +
| |. . . . .|. . . .|
+ +-+-+-+ +-+-+ +-+ +
| |. . .|.|. . . .|.|
+ +-+ + + +-+-+ + +-+
| |. . .|. . . .|.|.|
+-+-+ + + + + +-+ + +
| |.|. .|.|.|.|. . .|
+-+ + + + + + + +-+-+
|. . . . .|. .|. .|.|
+ + + + + +-+ +-+ + +
|.|.|.|.|. . .| |.|.|
+ + + +-+-+-+-+-+ + +
|.|. . . .|. . .|. .|
+ +-+ +-+ +-+ + + +-+
|.| |.|. . . . . .| |
+ + + + +-+ +-+-+-+ +
. . . .
Results of running percolation test 10000 times with thresholds ranging from 0/10 to 10/10 .
"p=0/10 -> 1.0000"
"p=1/10 -> 1.0000"
"p=2/10 -> 1.0000"
"p=3/10 -> 0.9969"
"p=4/10 -> 0.9171"
"p=5/10 -> 0.5026"
"p=6/10 -> 0.0901"
"p=7/10 -> 0.0025"
"p=8/10 -> 0.0000"
"p=9/10 -> 0.0000"
"p=10/10 -> 0.0000"
</pre>
=={{header|Perl 6}}==
{{works with|Rakudo|2017.02}}
| |||