Anonymous user
Percolation/Mean cluster density: Difference between revisions
→{{header|Haskell}}: added solution
(→{{header|Haskell}}: added solution) |
|||
Line 478:
t= 5 p=0.50 n= 4096 sim=0.06585
</pre>
=={{header|Haskell}}==
<lang haskell>{-# language FlexibleContexts #-}
import Data.List
import Data.Maybe
import System.Random
import Control.Monad.State
import Text.Printf
import Data.Set (Set)
import qualified Data.Set as S
type Matrix = [[Bool]]
type Cell = (Int, Int)
type Cluster = Set (Int, Int)
clusters :: Matrix -> [Cluster]
clusters m = unfoldr findCuster cells
where
cells = S.fromList [ (i,j) | (r, i) <- zip m [0..]
, (x, j) <- zip r [0..], x]
findCuster s = do
(p, ps) <- S.minView s
return $ runState (expand p) ps
expand p = do
ns <- state $ extract (neigbours p)
xs <- mapM expand $ S.elems ns
return $ S.insert p $ mconcat xs
extract s1 s2 = (s2 `S.intersection` s1, s2 S.\\ s1)
neigbours (i,j) = S.fromList [(i-1,j),(i+1,j),(i,j-1),(i,j+1)]
n = length m
showClusters :: Matrix -> String
showClusters m = unlines [ unwords [ mark (i,j)
| j <- [0..n-1] ]
| i <- [0..n-1] ]
where
cls = clusters m
n = length m
mark c = maybe "." snd $ find (S.member c . fst) $ zip cls syms
syms = sequence [['a'..'z'] ++ ['A'..'Z']]
------------------------------------------------------------
randomMatrices :: Int -> StdGen -> [Matrix]
randomMatrices n = clipBy n . clipBy n . randoms
where
clipBy n = unfoldr (Just . splitAt n)
randomMatrix n = head . randomMatrices n
tests :: Int -> StdGen -> [Int]
tests n = map (length . clusters) . randomMatrices n
task :: Int -> StdGen -> (Int, Double)
task n g = (n, result)
where
result = mean $ take 10 $ map density $ tests n g
density c = fromIntegral c / fromIntegral n**2
mean lst = sum lst / genericLength lst
main = newStdGen >>= mapM_ (uncurry (printf "%d\t%.5f\n")) . res
where
res = mapM task [10,50,100,500]</lang>
<pre>λ> newStdGen >>= putStrLn . showClusters . randomMatrix 15
. . a a . b b b b . . c c . .
d d . . . . . . b b . c . . .
d . . e . . . b b . c c . f f
d d d . g g . b b . c c c . .
. d . d . . b b . h . . c . i
d d . d d d . . h h h h . . i
d d d d . d . . h . . . . i i
. . . d . d . . h . i i i i i
. j . d . . . . . k . i . i .
. . l . . . . k k k k . . i i
m m . m . . . k k . . n . i .
m m m m m . o . k . n n . . .
. m . m . p . k k . . n . . q
. m m . . . r . k . . n n . q
. m . s s . r r . t . . . . q
λ> take 10 $ tests 15 (mkStdGen 42)
[33,18,26,18,29,14,23,21,18,24]
λ> main
10 0.10100
50 0.07072
100 0.06878
500 0.06676</pre>
=={{header|J}}==
| |||