sub minkowski {
    my ($d, $level) = @_ ;
    if ($level==0) {fd($d); return 1;} 
    minkowski($d/4,$level-1);
    rt(-90); minkowski($d/4,$level-1);
    rt( 90); minkowski($d/4,$level-1);
    rt( 90); minkowski($d/4,$level-1);
    minkowski($d/4,$level-1);
    rt(-90); minkowski($d/4,$level-1);
    rt(-90); minkowski($d/4,$level-1);
    rt( 90); minkowski($d/4,$level-1);
}
[download]

sub minkowski {
    my ($d, $level) = @_ ;

    fd($d), return unless $level--;

    $d /= 4;

    minkowski($d,$level);
    rt(-90); minkowski($d,$level);
    rt( 90); minkowski($d,$level);
    rt( 90); minkowski($d,$level);
    minkowski($d,$level);
    rt(-90); minkowski($d,$level);
    rt(-90); minkowski($d,$level);
    rt( 90); minkowski($d,$level);
}
[download]

sub minkowski {
    my ($d, $level, $rt) = @_ ;

    rt($rt) if $rt;
    fd($d), return unless $level--;

    $d /= 4;

    minkowski($d,$level);
    minkowski($d,$level, -90);
    minkowski($d,$level,  90);
    minkowski($d,$level,  90);
    minkowski($d,$level);
    minkowski($d,$level, -90);
    minkowski($d,$level, -90);
    minkowski($d,$level,  90);
}
[download]

sub minkowski {
    my ($d, $level, $rt) = @_;

    rt($rt) if $rt;
    fd($d), return unless $level--;

    $d /= 4;
    minkowski($d, $level, $_)
        for 0, -90, 90, 90, 0, -90, -90, 90;
}
[download]

Makeshifts last the longest.

#!/usr/bin/perl -w
use strict;
use integer;

my $depth   = 4;
my $start   = '_/_\_\_/_';    # _ = forward, / = left, \ = right
my $fractal = $start;

$fractal =~ s/_/$start/og for ( 0 .. $depth );

$fractal =~ s/_/0 0.8 rlineto /g;
$fractal =~ s,/,90 rotate ,g;
$fractal =~ s,\\,270 rotate ,g;
print '%!', "\n", '0.1 setlinewidth 500 100 moveto ', 
  $fractal, 'stroke showpage', "\n";
[download]

Can't remember what this fractal is called, sorry. As it stands, it should render on A4 and Letter paper.

--
bowling trophy thieves, die!

Cool. Didn't think of using PostScript before. That looks like some sort of 1D automata. (If anyone wanna see, view it here, which was flap 90 degree clockwise , just to fit the screen better.)

It's definitely a fractal curve. It's just so long since I did fractal things, I don't remember what people were calling these them.

String rewriting is all in The Science of Fractal Images, ed Peitgen & Saupe (Springer-Verlag, 1991, ISBN: 0387966080). Of course, they were using an awkward Pascal-like pseudocode language with no regular expressions ...

Here's at least part of the famous snowflake. I think I changed three lines:

#!/usr/bin/perl -w
use strict;
use integer;

my $depth   = 4;
my $start   = '_/_\_/_';    # _ = forward, / = left, \ = right
my $fractal = $start;

$fractal =~ s/_/$start/og for ( 0 .. $depth );

$fractal =~ s/_/0 0.8 rlineto /g;
$fractal =~ s,/,60 rotate ,g;
$fractal =~ s,\\,240 rotate ,g;
print '%!', "\n", '0.1 setlinewidth 500 100 moveto ', $fractal,
  'stroke showpage', "\n";
[download]

Now what would be really cool would be a Perl routine that would parse ASCII-art axioms and production rules, and generate the fractal. My free time is not that copious.

--
bowling trophy thieves, die!

        $xy->[0][scalar(@{$xy->[0]})] = $d*sin(PI*$h/180) + $xy->[0][$
+#{@{$xy->[0]}}];
        $xy->[1][scalar(@{$xy->[1]})] = $d*cos(PI*$h/180) + $xy->[1][$
+#{@{$xy->[1]}}]; 

No, I defined plotxy() in the code; it isn't part of GD. I only included it in Closure, omitted elsewhere since it's redundant to include it three times in the post.

As for the two lines...

If $xy = [[4,5,6],[4,5,6]], scalar(@{$xy->[0]}) = scalar(@{$xy->[0]}) = 3, the number of elements.

$xy->[0] points to the first array in $xy; $xy->[1] second.

@{$xy->[0]} dereferences $xy->[0] into an array.

So, $xy->[0][scalar(@{$xy->[0]})] will be like $xy->[0][3], the new element in the array, yet to be defined, since the index of the last position is 2.

$d*sin(PI*$h/180) is just some transformation stuff from trigonometry/geometry/calculus.

$#{@{$xy->[0]}} gives you the index of the last element, which is 2 in this example.

So, $xy->[0][$#{@{$xy->[0]}}] = $xy->[0][$#{@{$xy->[1]}}] gives you 6.

(I've noticed you have "...$+#..." in your reply. When you see + in a code in the post, it indicates a continuation from the previous line. When you cut and past codes, those + might be inadvertently included. Remember to remove them.)

Hence, the two lines basically say,

new x coordinate = distance (on x axis) from old x coordinate + old x coordinate
new y coordinate = distance (on y axis) from old y coordinate + old y coordinate

You can get rid of the "+" by using the "d/l code" link:

comment on Fractal Curves: Short & Fast Codes?
       --->    d/l code   <---
[download]

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];}
[download]

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);
}
[download]

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);
[download]

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);
[download]

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);
...
[download]

would probably save a few calls to sin & cos.