
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.

#define SOLID "#"
#define EMPTY " "
#define WET   "v"
 
Dim Shared As String grid()
Dim Shared As Integer last, lastrow, m, n
 
Sub make_grid(x As Integer, y As Integer, p As Double)
    m = x
    n = y
    Redim Preserve grid(x*(y+1)+1)
    last = Len(grid)
    Dim As Integer lastrow = last-n
    Dim As Integer i, j
 
    For i = 0 To x-1
        For j = 1 To y
            grid(1+i*(y+1)+j) = Iif(Rnd < p, EMPTY, SOLID)
        Next j
    Next i
End Sub
 
Function ff(i As Integer) As Boolean
    If i <= 0 Or i >= last Or grid(i) <> EMPTY Then Return 0
    grid(i) = WET
    Return i >= lastrow Or (ff(i+m+1) Or ff(i+1) Or ff(i-1) Or ff(i-m-1))
End Function
 
Function percolate() As Integer
    For i As Integer = 2 To m+1
        If ff(i) Then Return 1
    Next i
    Return 0
End Function
 
Dim As Double p
Dim As Integer ip, i, cont
 
make_grid(15, 15, 0.55)
Print "15x15 grid:"
For i = 1 To Ubound(grid)
    Print grid(i);
    If i Mod 15 = 0 Then Print
Next i
 
Print !"\nrunning 10,000 tests for each case:"
For ip As Ubyte = 0 To 10
    p = ip / 10
    cont = 0
    For i = 1 To 10000
        make_grid(15, 15, p)
        cont += percolate()
    Next i
    Print Using "p=#.#:  #.####"; p; cont/10000
Next ip
Sleep