September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -1,69 +1,76 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
import Control.Monad
|
||||
import Control.Monad.Random
|
||||
import Data.Array.Unboxed
|
||||
import Data.List
|
||||
import Formatting
|
||||
import Control.Monad
|
||||
import Control.Monad.Random
|
||||
import Data.Array.Unboxed
|
||||
import Data.List
|
||||
import Formatting
|
||||
|
||||
type Field = UArray (Int, Int) Char
|
||||
|
||||
-- Start percolating some seepage through a field.
|
||||
-- Recurse to continue percolation with spreading seepage.
|
||||
-- Recurse to continue percolation with new seepage.
|
||||
percolateR :: [(Int, Int)] -> Field -> (Field, [(Int,Int)])
|
||||
percolateR [] f = (f, [])
|
||||
percolateR seep f = percolateR
|
||||
(concat $ fmap neighbors validSeep)
|
||||
(f // map (\p -> (p,'.')) validSeep) where
|
||||
neighbors p@(r,c) = [(r-1,c), (r+1,c), (r, c-1), (r, c+1)]
|
||||
((rLo,cLo),(rHi,cHi)) = bounds f
|
||||
validSeep = filter (\p@(r,c) -> r >= rLo &&
|
||||
r <= rHi &&
|
||||
c >= cLo &&
|
||||
c <= cHi &&
|
||||
f!p == ' ') $ nub $ sort seep
|
||||
percolateR seep f =
|
||||
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
|
||||
|
||||
-- Percolate a field; Return the percolated field.
|
||||
neighbors (x,y) = [(x,y-1), (x,y+1), (x-1,y), (x+1,y)]
|
||||
|
||||
in percolateR
|
||||
(concatMap neighbors validSeep)
|
||||
(f // map (\p -> (p,'.')) validSeep)
|
||||
|
||||
-- Percolate a field. Return the percolated field.
|
||||
percolate :: Field -> Field
|
||||
percolate start =
|
||||
let ((_,_),(_,cHi)) = bounds start
|
||||
(final, _) = percolateR [(0,c) | c <- [0..cHi]] start
|
||||
let ((_,_),(xHi,_)) = bounds start
|
||||
(final, _) = percolateR [(x,0) | x <- [0..xHi]] start
|
||||
in final
|
||||
|
||||
-- Generate a random field.
|
||||
randomField :: Int -> Int -> Double -> Rand StdGen Field
|
||||
randomField rows cols threshold = do
|
||||
rnd <- replicateM rows (replicateM cols $ getRandomR (0.0, 1.0))
|
||||
return $ array ((0,0), (rows-1, cols-1))
|
||||
[((r,c), if rnd !! r !! c < threshold then ' '
|
||||
else '#')
|
||||
| r <- [0..rows-1], c <- [0..cols-1] ]
|
||||
initField :: Int -> Int -> Double -> Rand StdGen Field
|
||||
initField w h threshold = do
|
||||
frnd <- fmap (\rv -> if rv<threshold then ' ' else '#') <$> getRandoms
|
||||
return $ listArray ((0,0), (w-1, h-1)) frnd
|
||||
|
||||
-- Assess whether or not percolation reached bottom of field.
|
||||
leaky :: Field -> Bool
|
||||
leaky f = '.' `elem` [f!(rHi,c) | c <- [cLo..cHi]] where
|
||||
((_,cLo),(rHi,cHi)) = bounds f
|
||||
-- Get a list of "leaks" from the bottom of a field.
|
||||
leaks :: Field -> [Bool]
|
||||
leaks f =
|
||||
let ((xLo,_),(xHi,yHi)) = bounds f
|
||||
in [f!(x,yHi)=='.'| x <- [xLo..xHi]]
|
||||
|
||||
-- Run test once; Return bool indicating success or failure.
|
||||
oneTest :: Int -> Int -> Double -> Rand StdGen Bool
|
||||
oneTest rows cols threshold =
|
||||
leaky <$> percolate <$> randomField rows cols threshold
|
||||
oneTest w h threshold =
|
||||
or.leaks.percolate <$> initField w h threshold
|
||||
|
||||
-- Run test multple times; Return the number of tests that pass
|
||||
-- Run test multple times; Return the number of tests that pass.
|
||||
multiTest :: Int -> Int -> Int -> Double -> Rand StdGen Double
|
||||
multiTest repeats rows cols threshold = do
|
||||
x <- replicateM repeats $ oneTest rows cols threshold
|
||||
let leakyCount = length $ filter (==True) x
|
||||
return $ fromIntegral leakyCount / fromIntegral repeats
|
||||
multiTest testCount w h threshold = do
|
||||
results <- replicateM testCount $ oneTest w h threshold
|
||||
let leakyCount = length $ filter id results
|
||||
return $ fromIntegral leakyCount / fromIntegral testCount
|
||||
|
||||
-- Display a field with walls and leaks.
|
||||
showField :: Field -> IO ()
|
||||
showField a = mapM_ print [ [ a!(r,c) | c <- [cLo..cHi]] | r <- [rLo..rHi]]
|
||||
where ((rLo,cLo),(rHi,cHi)) = bounds a
|
||||
showField a = do
|
||||
let ((xLo,yLo),(xHi,yHi)) = bounds a
|
||||
mapM_ print [ [ a!(x,y) | x <- [xLo..xHi]] | y <- [yLo..yHi]]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
g <- getStdGen
|
||||
let (startField, g2) = runRand (randomField 15 15 0.6) g
|
||||
putStrLn "Unpercolated field with 0.6 threshold."
|
||||
let w = 15
|
||||
h = 15
|
||||
threshold = 0.6
|
||||
(startField, g2) = runRand (initField w h threshold) g
|
||||
|
||||
putStrLn ("Unpercolated field with " ++ show threshold ++ " threshold.")
|
||||
putStrLn ""
|
||||
showField startField
|
||||
|
||||
|
|
@ -72,12 +79,17 @@ main = do
|
|||
putStrLn ""
|
||||
showField $ percolate startField
|
||||
|
||||
let testCount = 10000
|
||||
densityCount = 10
|
||||
|
||||
putStrLn ""
|
||||
putStrLn "Results of running percolation test 10000 times with thresholds ranging from 0.0 to 1.0 ."
|
||||
let d = 10
|
||||
let ns = [0..10]
|
||||
let tests = sequence [multiTest 10000 15 15 v
|
||||
| n <- ns,
|
||||
let v = fromIntegral n / fromIntegral d ]
|
||||
let results = zip ns (evalRand tests g2)
|
||||
mapM_ print [format ("p=" % int % "/" % int % " -> " % fixed 4) n d r | (n,r) <- results]
|
||||
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]
|
||||
tests = sequence [multiTest testCount w h v
|
||||
| density <- densities,
|
||||
let v = fromIntegral density / fromIntegral densityCount ]
|
||||
results = zip densities (evalRand tests g2)
|
||||
mapM_ print [format ("p=" % int % "/" % int % " -> " % fixed 4) density densityCount x | (density,x) <- results]
|
||||
|
|
|
|||
|
|
@ -0,0 +1,64 @@
|
|||
my $block = '▒';
|
||||
my $water = '+';
|
||||
my $pore = ' ';
|
||||
my $grid = 15;
|
||||
my @site;
|
||||
|
||||
enum Direction <DeadEnd Up Right Down Left>;
|
||||
|
||||
say 'Sample percolation at .6';
|
||||
percolate(.6);
|
||||
.join.say for @site;
|
||||
say "\n";
|
||||
|
||||
my $tests = 1000;
|
||||
say "Doing $tests trials at each porosity:";
|
||||
for .1, .2 ... 1 -> $p {
|
||||
printf "p = %0.1f: %0.3f\n", $p, (sum percolate($p) xx $tests) / $tests
|
||||
}
|
||||
|
||||
sub infix:<deq> ( $a, $b ) { $a.defined && ($a eq $b) }
|
||||
|
||||
sub percolate ( $prob = .6 ) {
|
||||
@site[0] = [$pore xx $grid];
|
||||
@site[$grid + 1] = [$pore xx $grid];
|
||||
|
||||
for ^$grid X 1..$grid -> ($x, $y) {
|
||||
@site[$y;$x] = rand < $prob ?? $pore !! $block
|
||||
}
|
||||
@site[0;0] = $water;
|
||||
|
||||
my @stack;
|
||||
my $current = [0;0];
|
||||
|
||||
loop {
|
||||
if my $dir = direction( $current ) {
|
||||
@stack.push: $current;
|
||||
$current = move( $dir, $current )
|
||||
}
|
||||
else {
|
||||
return 0 unless @stack;
|
||||
$current = @stack.pop
|
||||
}
|
||||
return 1 if $current[1] > $grid
|
||||
}
|
||||
|
||||
sub direction( [$x, $y] ) {
|
||||
(Down if @site[$y + 1][$x] deq $pore) ||
|
||||
(Left if @site[$y][$x - 1] deq $pore) ||
|
||||
(Right if @site[$y][$x + 1] deq $pore) ||
|
||||
(Up if @site[$y - 1][$x] deq $pore) ||
|
||||
DeadEnd
|
||||
}
|
||||
|
||||
sub move ( $dir, @cur ) {
|
||||
my ( $x, $y ) = @cur;
|
||||
given $dir {
|
||||
when Up { @site[--$y][$x] = $water }
|
||||
when Down { @site[++$y][$x] = $water }
|
||||
when Left { @site[$y][--$x] = $water }
|
||||
when Right { @site[$y][++$x] = $water }
|
||||
}
|
||||
[$x, $y]
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
fcn makeGrid(m,n,p){
|
||||
grid:=Data((m+1)*(n+1)); // first row and right edges are buffers
|
||||
grid.write(" "*m); grid.write("\r");
|
||||
do(n){
|
||||
do(m){ grid.write(((0.0).random(1)<p) and "+" or "."); } // cell is porous or not
|
||||
grid.write("\n");
|
||||
}
|
||||
grid
|
||||
}
|
||||
fcn ff(grid,x,m){ // walk across row looking for a porous cell
|
||||
if(grid[x]!=43) return(0); // '+' == 43 ASCII == porous
|
||||
grid[x]="#";
|
||||
return(x+m>=grid.len() or
|
||||
ff(grid,x+m,m) or ff(grid,x+1,m) or ff(grid,x-1,m) or ff(grid,x-m,m));
|
||||
}
|
||||
fcn percolate(grid,m){
|
||||
x:=m+1; i:=0; while(i<m and not ff(grid,x,m)){ x+=1; i+=1; }
|
||||
return(i<m); // percolated through the grid?
|
||||
}
|
||||
|
||||
grid:=makeGrid(15,15,0.60);
|
||||
println("Did liquid percolate: ",percolate(grid,15));
|
||||
println("15x15 grid:\n",grid.text);
|
||||
|
||||
println("Running 10,000 tests for each case:");
|
||||
foreach p in ([0.0 .. 1.0, 0.1]){
|
||||
cnt:=0.0; do(10000){ cnt+=percolate(makeGrid(15,15,p),15); }
|
||||
"p=%.1f: %.4f".fmt(p, cnt/10000).println();
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue