in reply to Fractal Curves: Short & Fast Codes?
There are several things that you could do to improve the performance of your plotting routine.
sub min {(sort {$a<=>$b} @_ )[0];} sub max {(sort {$a<=>$b} @_ )[-1];}
Sorting an array in order to find the minimum or maximum is a very expensive way to do it if you are going to discard the results of the sort. Doing it twice, well that just profligate:)
As you need both min and max of both set of coordinates, it would be better to discover both in a single pass rather than sorting each array twice to get them.
sub min_max { my( $min, $max ) = ( 1e-308, 1e308 ); for(@_){ $min = $_ if $_ < $min; $max = $_ if $_ > $max; } return ($min, $max); }
The reason you need the min and max values is to allow you size the bitmap and transform the coordinates so that the figures draw will be nicely centered. The GD package also comes with a sub-package GD::Polyline which includes functions for scaling and offseting a Polyline as well as the ability to pass the entire polyline to the rendering engine in a single pass rather than line by line. This removes the need for a lot of the math at the Perl level, pushing it instead into the rendering engine in compiled C, which ought to improve things a little, though I haven't benchmarked it.
#! perl -slw use strict; use GD; use GD::Polyline; use Data::Dumper; use constant PI => 3.14159265359; sub Turtle { my( $dir, $polyline, $xy ) = ( 0, new GD::Polyline, [ 0, 0 ] ); return sub { return $polyline unless @_; $dir += shift||0; my $dist = shift||0; $xy->[0] += $dist*sin(PI*$dir/180); $xy->[1] += $dist*cos(PI*$dir/180); $polyline->addPt( @$xy ); return; }; } sub plotxy { my( $polyline, $file, $scale ) = @_; $polyline->scale( $scale, $scale, 0, 0 ) if $scale; my( $centre_x, $centre_y ) = $polyline->centroid; $polyline->offset( int($centre_x+10), 10 + -int(2*$centre_y) ); my( $width, $height ) = ($polyline->bounds)[2,3]; my $image = new GD::Image( $width + 10, $height + 10 ); my $white = $image->colorAllocate(255,255,255); my $black = $image->colorAllocate(0,0,0); $image->transparent($white); $image->interlaced('true'); $image->polyline( $polyline, $black ); open(IMG, ">$file"); binmode IMG; print IMG $image->jpeg; } sub koch { my ($turtle, $d, $level) = @_ ; if ($level==0) {$turtle->(0,$d); return 1;} $turtle->( 0,0); koch($turtle,$d/3,$level-1); $turtle->(-60,0); koch($turtle,$d/3,$level-1); $turtle->(120,0); koch($turtle,$d/3,$level-1); $turtle->(-60,0); koch($turtle,$d/3,$level-1); } my $turtle = Turtle(); map {$turtle->(120, 0); koch($turtle, 170, 4);} 0..2; plotxy($turtle->(), 'koch.jpg', 3); # Minkowski Island sub minkowski { my ($turtle, $d, $level) = @_ ; if ($level==0) {$turtle->(0,$d); return 1;} minkowski($turtle,$d/4,$level-1); $turtle->(-90,0); minkowski($turtle,$d/4,$level-1); $turtle->( 90,0); minkowski($turtle,$d/4,$level-1); $turtle->( 90,0); minkowski($turtle,$d/4,$level-1); minkowski($turtle,$d/4,$level-1); $turtle->(-90,0); minkowski($turtle,$d/4,$level-1); $turtle->(-90,0); minkowski($turtle,$d/4,$level-1); $turtle->( 90,0); minkowski($turtle,$d/4,$level-1); } $turtle = Turtle(); map {$turtle->(90,0); minkowski($turtle, 150, 3);} 0..3; plotxy($turtle->(), 'minkowski.jpg', 2); # Dragon Curve sub dragon1 { my ($turtle, $d, $level) = @_ ; if ($level==0) {$turtle->(0,$d); return 1;} dragon($turtle,$d*0.707,$level-1); $turtle->(-90,0); dragon1($turtle,$d*0.707,$level-1); } sub dragon { my ($turtle, $d, $level) = @_ ; if ($level==0) {$turtle->(0,$d); return 1;} dragon($turtle,$d*0.707,$level-1); $turtle->(90,0); dragon1($turtle,$d*0.707,$level-1); } $turtle = Turtle(); dragon($turtle, 150, 12); plotxy($turtle->(), 'dragon.jpg', 2);
There is still some potential for improvement here, but I tried to leave the Turtle stuff pretty much as you had it. A couple of things worthy of note. You use map in a void context in several places. Until quite recently, I beleive that this was noticably less efficient that using
for(@array) { ...};
I believe that this has improved somewhat in recent versions with map detecting that is was being used in a void context and not bothering to build the return array, but it is still seen as being "bad form":)
You mentioned having problems with Memoize. I'm not sure what the problems you were having were, but there is nothing to stop you using the same logic yourself. For example, trancsendental functions tend to be quite expensive. With fractals, the angles you are calculating tend to be the same ones again and again. It makes sense in this case to save the results of the calculation and reuse them rather than recalculating them.
Replacing this (from my code above)
$xy->[0] += $dist*sin(PI*$dir/180); $xy->[1] += $dist*cos(PI*$dir/180);
with something like
my %sin_d; sub sin_d{ my $d=shift; $sin_d{$d} || ( $sin_d{$d} = sin(PI +*$d/180) ); } my %cos_d; sub cos_d{ my $d=shift; $cos_d{$d} || ( $cos_d{$d} = cos(PI +*$d/180) ); } .... $xy->[0] += $dist * sin_d($dir); $xy->[1] += $dist * cos_d($dir); ...
would probably save a few calls to sin & cos.
|
|---|