
Percolation Simulation

This is a simulation of aspects of mathematical percolation theory.

For other percolation simulations, see Category:Percolation Simulations, or:
1D finite grid simulation
Mean run density 
2D finite grid simulations
Site percolation | Bond percolation | Mean cluster density

Given an 



M
×
N


{\displaystyle M\times N}

 rectangular array of cells numbered 




c
e
l
l

[
0..
M
−
1
,
0..
N
−
1
]


{\displaystyle \mathrm {cell} [0..M-1,0..N-1]}

assume 



M


{\displaystyle M}

 is horizontal and 



N


{\displaystyle N}

 is downwards.

Assume that the probability of any cell being filled is a constant 



p


{\displaystyle p}

 where

 



0.0
≤
p
≤
1.0


{\displaystyle 0.0\leq p\leq 1.0}


The task

Simulate creating the array of cells with probability 



p


{\displaystyle p}

 and then
testing if there is a route through adjacent filled cells from any on row 



0


{\displaystyle 0}

 to any on row 



N


{\displaystyle N}

, i.e. testing for site percolation.

Given 



p


{\displaystyle p}

 repeat the percolation 



t


{\displaystyle t}

 times to estimate the proportion of times that the fluid can percolate to the bottom for any given 



p


{\displaystyle p}

.

Show how the probability of percolating through the random grid changes with 



p


{\displaystyle p}

 going from 



0.0


{\displaystyle 0.0}

 to 



1.0


{\displaystyle 1.0}

 in 



0.1


{\displaystyle 0.1}

 increments and with the number of repetitions to estimate the fraction at any given 



p


{\displaystyle p}

 as 



t
>=
100


{\displaystyle t>=100}

.

Use an 



M
=
15
,
N
=
15


{\displaystyle M=15,N=15}

 grid of cells for all cases.

Optionally depict a percolation through a cell grid graphically.

Show all output on this page.

my $block = '▒';
my $water = '+';
my $pore  = ' ';
my $grid  = 15;
my @site;
 
$D{$_} = $i++ for qw<DeadEnd Up Right Down Left>;
 
sub deq { defined $_[0] && $_[0] eq $_[1] }
 
sub percolate {
    my($prob) = shift || 0.6;
    $site[0] = [($pore) x $grid];
    for my $y (1..$grid) {
        for my $x (0..$grid-1) {
            $site[$y][$x] = rand() < $prob ? $pore : $block;
        }
    }
    $site[$grid + 1] = [($pore) x $grid];
    $site[0][0] = $water;
 
    my $x = 0;
    my $y = 0;
    my @stack;
 
    while () {
        if (my $dir = direction($x,$y)) {
            push @stack, [$x,$y];
            ($x,$y) = move($dir, $x, $y)
        } else {
            return 0 unless @stack;
            ($x,$y) = @{pop @stack}
        }
        return 1 if $y > $grid;
    }
}
 
sub direction {
    my($x, $y) = @_;
    return $D{Down}  if deq($site[$y+1][$x  ], $pore);
    return $D{Right} if deq($site[$y  ][$x+1], $pore);
    return $D{Left}  if deq($site[$y  ][$x-1], $pore);
    return $D{Up}    if deq($site[$y-1][$x  ], $pore);
    return $D{DeadEnd};
}
 
sub move {
    my($dir,$x,$y) = @_;
    $site[--$y][   $x] = $water if $dir == $D{Up};
    $site[++$y][   $x] = $water if $dir == $D{Down};
    $site[  $y][ --$x] = $water if $dir == $D{Left};
    $site[  $y][ ++$x] = $water if $dir == $D{Right};
    $x, $y
}
 
my $prob = 0.65;
percolate($prob);
 
print "Sample percolation at $prob\n";
print join '', @$_, "\n" for @site;
print "\n";
 
my $tests = 100;
print "Doing $tests trials at each porosity:\n";
my @table;
for my $p (1 .. 10) {
    $p = $p/10;
    my $total = 0;
    $total += percolate($p) for 1..$tests;
    push @table, sprintf "p = %0.1f: %0.2f", $p, $total / $tests
}
 
print "$_\n" for @table;