Jump to content

Percolation/Mean cluster density: Difference between revisions

Added Perl example
(Added Perl example)
Line 820:
8192 0.065766
</pre>
 
=={{header|Perl}}==
{{trans|Perl 6}}
<lang perl>$fill = 'x';
$D{$_} = $i++ for qw<DeadEnd Up Right Down Left>;
 
sub deq { defined $_[0] && $_[0] eq $_[1] }
 
sub perctest {
my($grid) = @_;
generate($grid);
my $block = 1;
for my $y (0..$grid-1) {
for my $x (0..$grid-1) {
fill($x, $y, $block++) if $perc[$y][$x] eq $fill
}
}
($block - 1) / $grid**2;
}
 
sub generate {
my($grid) = @_;
for my $y (0..$grid-1) {
for my $x (0..$grid-1) {
$perc[$y][$x] = rand() < .5 ? '.' : $fill;
}
}
}
 
sub fill {
my($x, $y, $block) = @_;
$perc[$y][$x] = $block;
my @stack;
while (1) {
if (my $dir = direction( $x, $y )) {
push @stack, [$x, $y];
($x,$y) = move($dir, $x, $y, $block)
} else {
return unless @stack;
($x,$y) = @{pop @stack};
}
}
}
 
sub direction {
my($x, $y) = @_;
return $D{Down} if deq($perc[$y+1][$x ], $fill);
return $D{Left} if deq($perc[$y ][$x-1], $fill);
return $D{Right} if deq($perc[$y ][$x+1], $fill);
return $D{Up} if deq($perc[$y-1][$x ], $fill);
return $D{DeadEnd};
}
 
sub move {
my($dir,$x,$y,$block) = @_;
$perc[--$y][ $x] = $block if $dir == $D{Up};
$perc[++$y][ $x] = $block if $dir == $D{Down};
$perc[ $y][ --$x] = $block if $dir == $D{Left};
$perc[ $y][ ++$x] = $block if $dir == $D{Right};
($x, $y)
}
 
my $K = perctest(15);
for my $row (@perc) {
printf "%3s", $_ for @$row;
print "\n";
}
printf "𝘱 = 0.5, 𝘕 = 15, 𝘒 = %.4f\n\n", $K;
 
$trials = 5;
for $N (10, 30, 100, 300, 1000) {
my $total = 0;
$total += perctest($N) for 1..$trials;
printf "𝘱 = 0.5, trials = $trials, 𝘕 = %4d, 𝘒 = %.4f\n", $N, $total / $trials;
}</lang>
{{out}}
<pre> 1 1 1 . . . . 2 2 2 . . . . .
. 1 . 1 1 1 . 2 2 . 2 2 2 . 3
. 1 . . 1 . 2 2 2 2 2 2 . . 3
1 1 1 . 1 . 2 2 . . . . 4 4 .
1 1 1 . 1 . . 2 . . . . . . 1
1 1 1 1 1 . . 2 . . 5 . 6 . .
1 1 . . 1 1 . 2 . 7 . . . 1 1
1 . . . 1 1 . 2 2 . . 8 8 . 1
. 9 9 9 . 1 . . 2 2 . . . 1 1
. . 9 9 . . 10 . . . 11 . 12 . .
. 9 9 . 13 13 . 13 . 14 . . 12 . .
15 . . 13 13 13 13 13 . . . 16 . 17 .
15 . . 13 . 13 . 13 13 . . 16 16 . .
. 18 . . 13 13 13 13 . . . . . 19 19
1 . 1 . . 13 . . . . 20 . 19 19 .
𝘱 = 0.5, 𝘕 = 15, 𝘒 = 0.0889
 
𝘱 = 0.5, trials = 5, 𝘕 = 10, 𝘒 = 0.0980
𝘱 = 0.5, trials = 5, 𝘕 = 30, 𝘒 = 0.0738
𝘱 = 0.5, trials = 5, 𝘕 = 100, 𝘒 = 0.0670
𝘱 = 0.5, trials = 5, 𝘕 = 300, 𝘒 = 0.0660
𝘱 = 0.5, trials = 5, 𝘕 = 1000, 𝘒 = 0.0661</pre>
 
=={{header|Perl 6}}==
2,392

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.