Percolation/Mean cluster density: Difference between revisions

→‎Tcl: Added implementation
m (Slight reorganisation of task description for better clarity)
(→‎Tcl: Added implementation)
Line 478:
| . .. .....| | F HH AAAAA|
8 clusters</pre>
 
=={{header|Tcl}}==
{{works with|Tcl|8.6}}
<lang tcl>package require Tcl 8.6
 
proc determineClusters {w h p} {
# Construct the grid
set grid [lrepeat $h [lrepeat $w 0]]
for {set i 0} {$i < $h} {incr i} {
for {set j 0} {$j < $w} {incr j} {
lset grid $i $j [expr {rand() < $p ? -1 : 0}]
}
}
# Find (and count) the clusters
set cl 0
for {set i 0} {$i < $h} {incr i} {
for {set j 0} {$j < $w} {incr j} {
if {[lindex $grid $i $j] == -1} {
incr cl
for {set q [list $i $j];set k -1} {$k+1<[llength $q]} {} {
set y [lindex $q [incr k]]
set x [lindex $q [incr k]]
if {[lindex $grid $y $x] != -1} continue
lset grid $y $x $cl
foreach dx {1 0 -1 0} dy {0 1 0 -1} {
set nx [expr {$x+$dx}]
set ny [expr {$y+$dy}]
if {
$nx >= 0 && $ny >= 0 && $nx < $w && $ny < $h &&
[lindex $grid $ny $nx] == -1
} then {
lappend q $ny $nx
}
}
}
}
}
}
return [list $cl $grid]
}
 
# Print a sample 15x15 grid
lassign [determineClusters 15 15 0.5] n g
puts "15x15 grid, p=0.5, with $n clusters"
puts "+[string repeat - 15]+"
foreach r $g {puts |[join [lmap x $r {format %c [expr {$x==0?32:64+$x}]}] ""]|}
puts "+[string repeat - 15]+"
 
# Determine the densities as the grid size increases
puts "p=0.5, iter=5"
foreach n {5 30 180 1080 6480} {
set tot 0
for {set i 0} {$i < 5} {incr i} {
lassign [determineClusters $n $n 0.5] nC
incr tot $nC
}
puts "n=$n, K(p)=[expr {$tot/5.0/$n**2}]"
}</lang>
{{out}}
<pre>
15x15 grid, p=0.5, with 21 clusters
+---------------+
| A B CCCCC|
| D A BBB C |
|E B F CCCC|
| B B F CC C|
|BBB B BB CCC|
|B BBBBBB CCCCC|
| B B G C C|
|H II G G J |
|HH II G GG K|
|HH II GGG GG K|
| I G GGGG |
|LL GGG GG M N|
| L G G O P |
|LLLL Q R |
|L L S T UUU|
+---------------+
p=0.5, iter=5
n=5, K(p)=0.184
n=30, K(p)=0.07155555555555557
n=180, K(p)=0.06880246913580246
n=1080, K(p)=0.0661267146776406
n=6480, K(p)=0.06582889898643499
</pre>
Anonymous user