"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Demos/TriDGallery.pm" between
PDL-2.077.tar.gz and PDL-2.078.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

TriDGallery.pm  (PDL-2.077):TriDGallery.pm  (PDL-2.078)
skipping to change at line 73 skipping to change at line 73
$q=$r**2-$i**2+$t; $h=2*$r*$i+$u; $q=$r**2-$i**2+$t; $h=2*$r*$i+$u;
$d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0)); $d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q, $h; ($r,$i)=map $_->clip(-5,5), $q, $h;
} }
imagrgb[$x/30]; imagrgb[$x/30];
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|], |],
[actnw => q| [actnw => q|
# Torus... (barrel) [Tjl] # Color Mandelbrot anim [Tjl]
nokeeptwiddling3d();
$x=zeroes 300,300;
$t=$r=$x->xlinvals(-1.5,0.5);
$u=$i=$x->ylinvals(-1,1);
for(1..30) {
$q=$r**2-$i**2+$t; $h=2*$r*$i+$u; $d=$r**2+$i**2;
$x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[($x==0)*($r/2+0.75),($x==0)*($i+1)/2,$x/30];
}
keeptwiddling3d();
twiddle3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# Neat variation of color mandelbrot
sub f {return abs(sin($_[0]*30))}
$x=zeroes 300,300;
$r=$x->xlinvals(-1.5, 0.5); $i=$x->ylinvals(-1,1); $t=$r; $u=$i;
nokeeptwiddling3d();
for(1..30) {
$q=$r**2-$i**2+$t;
$h=2*$r*$i+$u; $d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[f(($x==0)*($r/2+0.75)),f(($x==0)*($i+1)/2),$x/30];
}
keeptwiddling3d();
twiddle3d();
|],
[actnw => q|
# Torus... (barrel) [Tjl]
$s=40;$x=zeroes $s,$s;$t=$x->xlinvals(0,6.284); $s=40;$x=zeroes $s,$s;$t=$x->xlinvals(0,6.284);
$u=$x->ylinvals(0,6.284);$o=5;$i=1;$v=$o+$i*sin$u; $u=$x->ylinvals(0,6.284);$o=5;$i=1;$v=$o+$i*sin$u;
imag3d([$v*sin$t,$v*cos$t,$i*cos$u]); imag3d([$v*sin$t,$v*cos$t,$i*cos$u]);
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|], |],
[actnw => q| [actnw => q|
# Ripply torus [Tjl] # Ripply torus [Tjl]
$s=40; $x=zeroes 2*$s,$s/2; $t=$x->xlinvals(0,6.284); $s=40; $x=zeroes 2*$s,$s/2; $t=$x->xlinvals(0,6.284);
$u=$x->ylinvals(0,6.284); $o=5; $i=1; $v=$o+$i*sin $u; $u=$x->ylinvals(0,6.284); $o=5; $i=1; $v=$o+$i*sin $u;
imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]); imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|], |],
[actnw => q| [actnw => q|
# Ripply torus distorted [Tjl] # Ripply torus distorted [Tjl]
use PDL; use PDL::Graphics::TriD;
$s=40;$x=zeroes 2*$s,$s/2;$t=$x->xlinvals(0,6.284);$u=$x->ylinvals(0, $s=40;$x=zeroes 2*$s,$s/2;$t=$x->xlinvals(0,6.284);$u=$x->ylinvals(0,
6.284); $o=5;$i=1;$v=$o-$o/2*sin(3*$t)+$i*sin$u; 6.284); $o=5;$i=1;$v=$o-$o/2*sin(3*$t)+$i*sin$u;
imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]); imag3d([$v*sin$t,$v*cos$t,$i*cos($u)+$o*sin(3*$t)]);
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# 3D cardioid [Tjl]
use PDL::Graphics::TriD::Polygonize;
imag3d PDL::Graphics::TriD::StupidPolygonize::stupidpolygonize(
float(0,0,0), 5, 50, 10, sub {
my($x,$y,$z) = $_[0]->mv(0,-1)->dog;
1 - ($x**2 + 1.5*$y**2 + 0.3 * $z**2 + 5*($x**2-$y)**2);
}), {Lines => 0};
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|], |],
[actnw => q| [actnw => q|
# Volume rendering [Robin Williams] # Volume rendering [Robin Williams]
$y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0; $y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0;
$x=byte($y>$c); $x=byte($y>$c);
foreach(1,2,4) { foreach(1,2,4) {
$t=($x->slice("0:-2")<<$_); $t+=$x->slice("1:-1"); $x = $t->mv(0,2); $t=($x->slice("0:-2")<<$_); $t+=$x->slice("1:-1"); $x = $t->mv(0,2);
} }
points3d [whichND(($x != 0) & ($x != 255))->transpose->dog]; points3d [whichND(($x != 0) & ($x != 255))->transpose->dog];
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|], |],
[actnw => q| [actnw => q|
# one possible addition to volume rendering... # one possible addition to volume rendering...
$y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0; $y=zeroes(50,50,50); $y=sin(0.3*$y->rvals)*cos(0.3*$y->xvals); $c=0;
$x=byte($y>$c); $x=byte($y>$c);
foreach (1,2,4) { foreach (1,2,4) {
$t= $x->slice("0:-2")<<$_; $t= $x->slice("0:-2")<<$_;
$t+=$x->slice("1:-1"); $t+=$x->slice("1:-1");
skipping to change at line 139 skipping to change at line 175
# imagrgb[$d]if($k++%2); $s=conv2d($d,$k)/8;$i=90*90*random(50);$t=$d-> # imagrgb[$d]if($k++%2); $s=conv2d($d,$k)/8;$i=90*90*random(50);$t=$d->
# clump(2)-> index($i);$t.=($s->clump(2)->index($i)>.5);}while(!twiddle3d) # clump(2)-> index($i);$t.=($s->clump(2)->index($i)>.5);}while(!twiddle3d)
[actnw => q~ [actnw => q~
# Fractal mountain range [Tuomas Lukka] # Fractal mountain range [Tuomas Lukka]
use PDL::Image2D; use PDL::Image2D;
$k=ones(5,5) / 25; $x=5; $y=ones(1,1)/2; $k=ones(5,5) / 25; $x=5; $y=ones(1,1)/2;
for(1..7) { for(1..7) {
$c=$y->dupN(2,2)->copy; $c=$y->dupN(2,2)->copy;
$c+=$x*$c->random; $x/=3; $c+=$x*$c->random; $x/=3;
$y=conv2d($c,$k); imag3d[$y],{Lines => 0}; $y=conv2d($c,$k); imag3d[$y],{Lines => 0, Smooth => 0};
} }
# [press 'q' in the graphics window to iterate (runs 7 times)] # [press 'q' in the graphics window to iterate (runs 7 times)]
~], ~],
[actnw => q~ [actnw => q~
# Electron simulation by Mark Baker: https://perlmonks.org/?node_id=963819 # Electron simulation by Mark Baker: https://perlmonks.org/?node_id=963819
nokeeptwiddling3d; nokeeptwiddling3d;
$c = 0; $c = 0;
while (1) { do {
$n = 6.28 * ++$c; $n = 6.28 * ++$c;
$x = $c*rvals((zeros(9000))*$c); $x = $c*rvals((zeros(9000))*$c);
$cz = -1**$x*$c; $cz = -1**$x*$c;
$cy = -1**$x*sin$x*$c; $cy = -1**$x*sin$x*$c;
$cx = -1**$c*rvals($x)*$c; $cx = -1**$c*rvals($x)*$c;
$w = $cz-$cy-$cx; $w = $cz-$cy-$cx;
$g = sin($w); $g = sin($w);
$r = cos($cy+$c+$cz); $r = cos($cy+$c+$cz);
$b = cos($w); $b = cos($w);
$i = ($cz-$cx-$cy); $i = ($cz-$cx-$cy);
$q = $i*$n; $q = $i*$n;
points3d [ $b*sin($q), $r*cos($q), $g*sin$q], [$g,$b,$r]; points3d [ $b*sin($q), $r*cos($q), $g*sin$q], [$g,$b,$r];
last if twiddle3d(); # exit from loop when 'q' pressed } while (!twiddle3d); # exit from loop when 'q' pressed
}
keeptwiddling3d(); # restore waiting for user to press 'q' keeptwiddling3d(); # restore waiting for user to press 'q'
~], ~],
[actnw => q~ [actnw => q~
# Game of life [Robin Williams (edited by Tjl)] # Game of life [Robin Williams (edited by Tjl)]
use PDL::Image2D; use PDL::Image2D;
$d=byte(random(zeroes(40,40))>0.85); $k=byte [[1,1,1],[1,0,1],[1,1,1]]; $d=byte(random(zeroes(40,40))>0.85); $k=byte [[1,1,1],[1,0,1],[1,1,1]];
nokeeptwiddling3d; nokeeptwiddling3d;
do { do {
imagrgb [$d]; $s=conv2d($d,$k); imagrgb [$d]; $s=conv2d($d,$k);
$d&=($s<4); $d&=($s>1); $d|=($s==3); $d&=($s<4); $d&=($s>1); $d|=($s==3);
} while (!twiddle3d); } while (!twiddle3d);
keeptwiddling3d(); keeptwiddling3d();
~], ~],
[actnw => q| [actnw => q|
# We hope you did like that and got a feeling of # We hope you did like that and got a feeling of
# the power of PDL. # the power of PDL.
# Now it's up to you to submit even better TriD demos. # Now it's up to you to submit even better TriD demos.
close3d() if $|.__PACKAGE__.q|::we_opened; close3d() if $|.__PACKAGE__.q|::we_opened;
|], |],
); );
sub demo { @demo } sub demo { @demo }
my @disabled = ( my @disabled = (
[actnw => q| [actnw => q|
# Color Mandelbrot anim (nokeeptwiddling3d removed -> fits) [Tjl]
use PDL; use PDL::Graphics::TriD;
nokeeptwiddling3d();
$x=zeroes 300,300;$r=$x->xlinvals(-1.5,
0.5);$i=$x->ylinvals(-1,1);$t=$r;$u=$i;
for(1..30) {
$q=$r**2-$i**2+$t; $h=2*$r*$i+$u; $d=$r**2+$i**2;
$x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[($x==0)*($r/2+0.75),($x==0)*($i+1)/2,$x/30];
}
keeptwiddling3d();
# [press 'q' in the graphics window when done]
|],
[act => q|
# Lucy deconvolution (AJ 79, 745) [Robin Williams (=> TriD by Tjl)] # Lucy deconvolution (AJ 79, 745) [Robin Williams (=> TriD by Tjl)]
nokeeptwiddling3d(); nokeeptwiddling3d();
sub smth {use PDL::Image2D; conv2d($_[0],exp(-(rvals ones(3,3))**2));} sub smth {use PDL::Image2D; conv2d($_[0],exp(-(rvals ones(3,3))**2));}
$x=rfits("m51.fits")->float; $c=$d=avg($x)+0*$x; $x=rfits("m51.fits")->float; $c=$d=avg($x)+0*$x;
while(max $c>1.1) {$c=smth($x/smth($d));$d*=$c;imagrgb[$d/850];} while(max $c>1.1) {$c=smth($x/smth($d));$d*=$c;imagrgb[$d/850];}
keeptwiddling3d(); keeptwiddling3d();
twiddle3d();
# [press 'q' in the graphics window when done]
|],
[actnw => q|
# spherical dynamics [Mark R Baker]
nokeeptwiddling3d();
for $c(1..99){
$n=6.28*$c; $g=$c*rvals(sin(zeros(5000))*$c);
$cz=-1**$g*$c; $cy=$g*cos$g*$c; $cx=$c*rvals($g)*$c;
$g=cos($w=$cz+$cy+$cx); $r=sin$cy+$c+$cz; $y=sin$w;
$i=$cz-$cx-$cy; $q=$i*$n;
points3d[$y*sin$q,$r*cos$q,$g*sin$q],[$r,$g,$y];
}
keeptwiddling3d();
# [press 'q' in the graphics window when done] # [press 'q' in the graphics window when done]
|], |],
[actnw => q|
# Neat, but too big variation of color mandelbrot
sub f {return abs(sin($_[0]*30))}
$x=zeroes 300,300;
$r=$x->xlinvals(-1.5, 0.5); $i=$x->ylinvals(-1,1); $t=$r; $u=$i;
nokeeptwiddling3d();
for(1..30) {
$q=$r**2-$i**2+$t;
$h=2*$r*$i+$u; $d=$r**2+$i**2; $x=lclip($x,$_*($d>2.0)*($x==0));
($r,$i)=map $_->clip(-5,5), $q,$h;
imagrgb[f(($x==0)*($r/2+0.75)),f(($x==0)*($i+1)/2),$x/30];
}
keeptwiddling3d();
|],
[actnw => q~ [actnw => q~
# Dewdney's voters (parallelized) [Tjl, inspired by the above 'life'] # Dewdney's voters (parallelized) [Tjl, inspired by the above 'life']
use PDL::Image2D; use PDL::Image2D;
nokeeptwiddling3d; nokeeptwiddling3d;
$d=byte(random(zeroes(100,100))>0.5); $d=byte(random(zeroes(100,100))>0.5); $k=float [[1,1,1],[1,0,1],[1,1,1]];
do{ do{
$k=float [[1,1,1],[1,0,1],[1,1,1]];
imagrgb[$d]; imagrgb[$d];
$s=conv2d($d,$k)/8; $s=conv2d($d,$k)/8;
$r = $s->float->random; $r = $s->float->random;
$e = ($s>$r); $e = ($s>$r);
$d .= $e; $d .= $e;
} while(!twiddle3d); } while(!twiddle3d);
keeptwiddling3d(); keeptwiddling3d();
~], ~],
); );
 End of changes. 20 change blocks. 
65 lines changed or deleted 48 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)