Percolation/Bond percolation: Difference between revisions
Added Perl example
m (Swift style) |
SqrtNegInf (talk | contribs) (Added Perl example) |
||
Line 1,036:
p = 0.900000: 0.0000
</pre>
=={{header|Perl}}==
{{trans|Perl 6}}
<lang perl>my @bond;
my $grid = 10;
my $water = '▒';
$D{$_} = $i++ for qw<DeadEnd Up Right Down Left>;
sub percolate {
generate(shift || 0.6);
fill(my $x = 1,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 == $#bond;
}
}
sub direction {
my($x, $y) = @_;
return $D{Down} if $bond[$y+1][$x ] =~ / /;
return $D{Left} if $bond[$y ][$x-1] =~ / /;
return $D{Right} if $bond[$y ][$x+1] =~ / /;
return $D{Up} if defined $bond[$y-1][$x ] && $bond[$y-1][$x] =~ / /;
return $D{DeadEnd}
}
sub move {
my($dir,$x,$y) = @_;
fill( $x,--$y), fill( $x,--$y) if $dir == $D{Up};
fill( $x,++$y), fill( $x,++$y) if $dir == $D{Down};
fill(--$x, $y), fill(--$x, $y) if $dir == $D{Left};
fill(++$x, $y), fill(++$x, $y) if $dir == $D{Right};
$x, $y
}
sub fill {
my($x, $y) = @_;
$bond[$y][$x] =~ s/ /$water/g
}
sub generate {
our($prob) = shift || 0.5;
@bond = ();
our $sp = ' ';
push @bond, ['│', ($sp, ' ') x ($grid-1), $sp, '│'],
['├', hx('┬'), h(), '┤'];
push @bond, ['│', vx( ), $sp, '│'],
['├', hx('┼'), h(), '┤'] for 1..$grid-1;
push @bond, ['│', vx( ), $sp, '│'],
['├', hx('┴'), h(), '┤'],
['│', ($sp, ' ') x ($grid-1), $sp, '│'];
sub hx { my($c)=@_; my @l; push @l, (h(),$c) for 1..$grid-1; return @l; }
sub vx { my @l; push @l, $sp, v() for 1..$grid-1; return @l; }
sub h { rand() < $prob ? $sp : '───' }
sub v { rand() < $prob ? ' ' : '│' }
}
print "Sample percolation at .6\n";
percolate(.6);
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;
printf "p = %0.1f: %0.2f\n", $p, $total / $tests
}</lang>
{{out}}
<pre>Sample percolation at .6
│▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ │
├───┬───┬───┬▒▒▒┬ ┬ ┬ ┬───┬ ┬───┤
│ ▒▒▒▒▒▒▒ │ │ │
├───┼───┼▒▒▒┼───┼───┼ ┼───┼───┼ ┼ ┤
│ │▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒│ │ │ │
├───┼───┼───┼───┼▒▒▒┼▒▒▒┼ ┼───┼───┼───┤
│ │ │▒▒▒│▒▒▒▒▒▒▒ │
├───┼───┼ ┼───┼───┼───┼▒▒▒┼ ┼ ┼ ┤
│ │ ▒▒▒▒▒▒▒ │ │
├───┼───┼───┼ ┼ ┼▒▒▒┼───┼ ┼ ┼───┤
│ │ │▒▒▒ │ │
├───┼ ┼───┼ ┼───┼▒▒▒┼ ┼ ┼───┼ ┤
│ │ ▒▒▒▒▒▒▒│ │ │
├ ┼ ┼ ┼ ┼▒▒▒┼───┼ ┼───┼───┼ ┤
│ │ ▒▒▒│ │ │
├ ┼ ┼ ┼ ┼▒▒▒┼───┼ ┼ ┼───┼ ┤
│ │ ▒▒▒│ │ │
├───┼ ┼───┼ ┼▒▒▒┼ ┼ ┼ ┼ ┼ ┤
│ │ │▒▒▒ │ │ │ │
├───┼───┼ ┼ ┼▒▒▒┼───┼ ┼ ┼ ┼───┤
│ │ ▒▒▒│ │ │ │
├ ┴───┴ ┴ ┴▒▒▒┴ ┴───┴ ┴ ┴───┤
│ ▒▒▒ │
Doing 100 trials at each porosity:
p = 0.1: 0.00
p = 0.2: 0.00
p = 0.3: 0.00
p = 0.4: 0.03
p = 0.5: 0.38
p = 0.6: 0.83
p = 0.7: 0.99
p = 0.8: 1.00
p = 0.9: 1.00
p = 1.0: 1.00</pre>
=={{header|Perl 6}}==
Line 1,138 ⟶ 1,253:
├───┴▒▒▒┴ ┴ ┴ ┴───┴ ┴ ┴ ┴───┤
│ ▒▒▒ │
Doing 100 trials at each porosity:
| |||