
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.

package require Tcl 8.6
 
oo::class create SitePercolation {
    variable cells w h
    constructor {width height probability} {
	set w $width
	set h $height
	for {set cells {}} {[llength $cells] < $h} {lappend cells $row} {
	    for {set row {}} {[llength $row] < $w} {lappend row $cell} {
		set cell [expr {rand() < $probability}]
	    }
	}
    }
    method print {out} {
	array set map {0 "#" 1 " " -1 .}
	puts "+[string repeat . $w]+"
	foreach row $cells {
	    set s "|"
	    foreach cell $row {
		append s $map($cell)
	    }
	    puts [append s "|"]
	}
	set outline [lrepeat $w "-"]
	foreach index $out {
	    lset outline $index "."
	}
	puts "+[join $outline {}]+"
    }
    method percolate {} {
	for {set work {}; set i 0} {$i < $w} {incr i} {
	    if {[lindex $cells 0 $i]} {lappend work 0 $i}
	}
	try {
	    my Fill $work
	    return {}
	} trap PERCOLATED x {
	    return [list $x]
	}
    }
    method Fill {queue} {
	while {[llength $queue]} {
	    set queue [lassign $queue y x]
	    if {$y >= $h} {throw PERCOLATED $x}
	    if {$y < 0 || $x < 0 || $x >= $w} continue
	    if {[lindex $cells $y $x]<1} continue
	    lset cells $y $x -1
	    lappend queue [expr {$y+1}] $x [expr {$y-1}] $x
	    lappend queue $y [expr {$x-1}] $y [expr {$x+1}]
	}
    }
}
 
# Demonstrate one run
puts "Sample percolation, 15x15 p=0.6"
SitePercolation create bp 15 15 0.6
bp print [bp percolate]
bp destroy
puts ""
 
# Collect statistics
apply {{} {
    puts "Percentage of tries that percolate, varying p"
    set tries 100
    for {set pint 0} {$pint <= 10} {incr pint} {
	set p [expr {$pint * 0.1}]
	set tot 0
	for {set i 0} {$i < $tries} {incr i} {
	    set bp [SitePercolation new 15 15 $p]
	    if {[$bp percolate] ne ""} {
		incr tot
	    }
	    $bp destroy
	}
	puts [format "p=%.2f: %2.1f%%" $p [expr {$tot*100./$tries}]]
    }
}}