Sierpinski triangle/Graphical: Difference between revisions

From Rosetta Code
Content added Content deleted
m ({{omit from|GUISS}})
(Add Haskell entry.)
Line 144: Line 144:
return 0;
return 0;
}</lang>
}</lang>
=={{header|Haskell}}==
This program uses the [http://hackage.haskell.org/package/diagrams diagrams] package to produce the Sierpinski triangle. The package implements an embedded [http://en.wikipedia.org/wiki/EDSL#Usage_patterns DSL] for producing vector graphics. Depending on the command-line arguments, the program can generate SVG, PNG, PDF or PostScript output.

For fun, we take advantage of Haskell's layout rules, and the operators provided by the diagrams package, to give the <tt>reduce</tt> function the shape of a triangle. It could also be written as <tt>reduce t = t === (t ||| t)</tt>.

The command to produce the SVG output is <tt>sierpinski -o Sierpinski-Haskell.svg</tt>.

[[File:Sierpinski-Haskell.svg|thumb|Sierpinski Triangle]]
<lang haskell>import Diagrams.Prelude
import Diagrams.Backend.Cairo.CmdLine

triangle = eqTriangle # fc black # lw 0

reduce t = t
===
(t ||| t)

sierpinski = iterate reduce triangle

main = defaultMain $ sierpinski !! 7
</lang>

=={{header|Icon}} and {{header|Unicon}}==
=={{header|Icon}} and {{header|Unicon}}==
The following code is adapted from a program by Ralph Griswold that demonstrates an interesting way to draw the Sierpinski Triangle. Given an argument of the order it will calculate the canvas size needed with margin. It will not stop you from asking for a triangle larger than you display. For an explanation, see "Chaos and Fractals", Heinz-Otto Peitgen, Harmut Jurgens, and Dietmar Saupe, Springer-Verlah, 1992, pp. 132-134.
The following code is adapted from a program by Ralph Griswold that demonstrates an interesting way to draw the Sierpinski Triangle. Given an argument of the order it will calculate the canvas size needed with margin. It will not stop you from asking for a triangle larger than you display. For an explanation, see "Chaos and Fractals", Heinz-Otto Peitgen, Harmut Jurgens, and Dietmar Saupe, Springer-Verlah, 1992, pp. 132-134.

Revision as of 04:04, 29 July 2011

Sierpinski triangle/Graphical is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Produce a graphical representation of a Sierpinski triangle of order N in any orientation.

An example of Sierpinski's triangle (order = 8) looks like this:

Asymptote

This simple-minded recursive apporach doesn't scale well to large orders, but neither would your PostScript viewer, so there's nothing to gain from a more efficient algorithm. Thus are the perils of vector graphics.

<lang asymptote>path subtriangle(path p, real node) {

   return
       point(p, node) --
       point(p, node + 1/2) --
       point(p, node - 1/2) --
       cycle;

}

void sierpinski(path p, int order) {

   if (order == 0)
       fill(p);
   else {
       sierpinski(subtriangle(p, 0), order - 1);
       sierpinski(subtriangle(p, 1), order - 1);
       sierpinski(subtriangle(p, 2), order - 1);
   }

}

sierpinski((0, 0) -- (5 inch, 1 inch) -- (2 inch, 6 inch) -- cycle, 10);</lang>

C

Code lifted from Dragon curve. Given a depth n, draws a triangle of size 2^n in a PNM file to the standard output. Usage: gcc -lm stuff.c -o sierp; ./sierp 9 > triangle.pnm. Sample image generated with depth 9. Generated image's size depends on the depth: it plots dots, but does not draw lines, so a large size with low depth is not possible.

<lang C>#include <stdio.h>

  1. include <stdlib.h>
  2. include <string.h>
  3. include <math.h>

long long x, y, dx, dy, scale, clen, cscale; typedef struct { double r, g, b; } rgb; rgb ** pix;

void sc_up() { scale *= 2; x *= 2; y *= 2; cscale *= 3; }

void h_rgb(long long x, long long y) { rgb *p = &pix[y][x];

  1. define SAT 1

double h = 6.0 * clen / cscale; double VAL = 1; double c = SAT * VAL; double X = c * (1 - fabs(fmod(h, 2) - 1));

switch((int)h) { case 0: p->r += c; p->g += X; return; case 1: p->r += X; p->g += c; return; case 2: p->g += c; p->b += X; return; case 3: p->g += X; p->b += c; return; case 4: p->r += X; p->b += c; return; default: p->r += c; p->b += X; } }

void iter_string(char * str, int d) { long long len; while (*str != '\0') { switch(*(str++)) { case 'X': if (d) iter_string("XHXVX", d - 1); else{ clen ++; h_rgb(x/scale, y/scale); x += dx; y -= dy; } continue; case 'V': len = 1LLU << d; while (len--) { clen ++; h_rgb(x/scale, y/scale); y += dy; } continue; case 'H': len = 1LLU << d; while(len --) { clen ++; h_rgb(x/scale, y/scale); x -= dx; } continue; } } }

void sierp(long leng, int depth) { long i; long h = leng + 20, w = leng + 20;

/* allocate pixel buffer */ rgb *buf = malloc(sizeof(rgb) * w * h); pix = malloc(sizeof(rgb *) * h); for (i = 0; i < h; i++) pix[i] = buf + w * i; memset(buf, 0, sizeof(rgb) * w * h);

       /* init coords; scale up to desired; exec string */

x = y = 10; dx = leng; dy = leng; scale = 1; clen = 0; cscale = 3; for (i = 0; i < depth; i++) sc_up(); iter_string("VXH", depth);

/* write color PNM file */ unsigned char *fpix = malloc(w * h * 3); double maxv = 0, *dbuf = (double*)buf;

for (i = 3 * w * h - 1; i >= 0; i--) if (dbuf[i] > maxv) maxv = dbuf[i]; for (i = 3 * h * w - 1; i >= 0; i--) fpix[i] = 255 * dbuf[i] / maxv;

printf("P6\n%ld %ld\n255\n", w, h); fflush(stdout); /* printf and fwrite may treat buffer differently */ fwrite(fpix, h * w * 3, 1, stdout); }

int main(int c, char ** v) { int size, depth;

depth = (c > 1) ? atoi(v[1]) : 10; size = 1 << depth;

fprintf(stderr, "size: %d depth: %d\n", size, depth); sierp(size, depth + 2);

return 0; }</lang>

Haskell

This program uses the diagrams package to produce the Sierpinski triangle. The package implements an embedded DSL for producing vector graphics. Depending on the command-line arguments, the program can generate SVG, PNG, PDF or PostScript output.

For fun, we take advantage of Haskell's layout rules, and the operators provided by the diagrams package, to give the reduce function the shape of a triangle. It could also be written as reduce t = t === (t ||| t).

The command to produce the SVG output is sierpinski -o Sierpinski-Haskell.svg.

Sierpinski Triangle

<lang haskell>import Diagrams.Prelude import Diagrams.Backend.Cairo.CmdLine

triangle = eqTriangle # fc black # lw 0

reduce t = t

             ===
          (t ||| t)

sierpinski = iterate reduce triangle

main = defaultMain $ sierpinski !! 7 </lang>

Icon and Unicon

The following code is adapted from a program by Ralph Griswold that demonstrates an interesting way to draw the Sierpinski Triangle. Given an argument of the order it will calculate the canvas size needed with margin. It will not stop you from asking for a triangle larger than you display. For an explanation, see "Chaos and Fractals", Heinz-Otto Peitgen, Harmut Jurgens, and Dietmar Saupe, Springer-Verlah, 1992, pp. 132-134.

Sample Output for order=8

<lang Icon>link wopen

procedure main(A)

  local width, margin, x, y
  
  width := 2 ^ (order := (0 < integer(\A[1])) | 8)
  wsize := width + 2 * (margin := 30 )
  WOpen("label=Sierpinski", "size="||wsize||","||wsize) | 
     stop("*** cannot open window")
  every y := 0 to width - 1 do
     every x := 0 to width - 1 do
        if iand(x, y) = 0 then DrawPoint(x + margin, y + margin)
 Event()

end</lang>

Original source IPL Graphics/sier1.

J

Solution: <lang j> load 'viewmat'

  'rgb'viewmat--. |. (~:_1&|.)^:(<@#) (2^8){.1

</lang>

Perl

Writes out an EPS given an arbitrary triangle. The perl code only calculates the bounding box, while real work is done in postscript. <lang Perl>use List::Util qw'min max sum';

sub write_eps { my @x = @_[0, 2, 4]; my @y = @_[1, 3, 5]; my $sx = sum(@x) / 3; my $sy = sum(@y) / 3; @x = map { $_ - $sx } @x; @y = map { $_ - $sy } @y;

print <<"HEAD"; %!PS-Adobe-3.0 %%BoundingBox: @{[min(@x) - 10]} @{[min(@y) - 10]} @{[max(@x) + 10]} @{[max(@y) + 10]} /v1 { $x[0] $y[0] } def /v2 { $x[1] $y[1] } def /v3 { $x[2] $y[2] } def /t { translate } def /r { .5 .5 scale 2 copy t 2 index sierp pop neg exch neg exch t 2 2 scale } def

/sierp { dup 1 sub dup 0 ne { v1 r v2 r v3 r } { v1 moveto v2 lineto v3 lineto} ifelse pop } def

9 sierp fill pop showpage %%EOF HEAD }

write_eps 0, 0, 300, 215, -25, 200;</lang>

Perl 6

This is a recursive solution. It is not really practical for more than 8 levels of recursion, but anything more than 7 is barely visible anyway. <lang perl6>my $side = 512; my $height = get_height($side); my $levels = 8;

sub get_height ($side) { $side * 3.sqrt / 2 }

sub triangle ( $x1, $y1, $x2, $y2, $x3, $y3, $fill?, $animate? ) {

   print "<polygon points=\"$x1,$y1 $x2,$y2 $x3,$y3\"";
   if $fill { print " style=\"fill: $fill; stroke-width: 0;\"" };
   if $animate 
   {
       say ">\n  <animate attributeType=\"CSS\" attributeName=\"opacity\"\n  values=\"1;0;1\""
         ~ " keyTimes=\"0;.5;1\" dur=\"20s\" repeatCount=\"indefinite\" />\n</polygon>"
   }
   else
   {        
      say ' />';
   }

}

sub fractal ( $x1, $y1, $x2, $y2, $x3, $y3, $r is copy ) {

    triangle( $x1, $y1, $x2, $y2, $x3, $y3 );
    return unless --$r;
    my $side = abs($x3 - $x2) / 2;
    my $height = get_height($side);
    fractal( $x1, $y1-$height*2, $x1-$side/2, $y1-3*$height, $x1+$side/2, $y1-3*$height, $r);
    fractal( $x2, $y1, $x2-$side/2, $y1-$height, $x2+$side/2, $y1-$height, $r);
    fractal( $x3, $y1, $x3-$side/2, $y1-$height, $x3+$side/2, $y1-$height, $r);

}

say '<?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"> <svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg"> <defs>

 <radialGradient id="basegradient" cx="50%" cy="65%" r="50%" fx="50%" fy="65%">
   <stop offset="10%" stop-color="#ff0" />
   <stop offset="60%" stop-color="#f00" />
   <stop offset="99%" stop-color="#00f" />
 </radialGradient>

</defs>';

triangle( $side/2, 0, 0, $height, $side, $height, 'url(#basegradient)' ); triangle( $side/2, 0, 0, $height, $side, $height, '#000', 'animate' ); say '<g style="fill: #fff; stroke-width: 0;">'; fractal( $side/2, $height, $side*3/4, $height/2, $side/4, $height/2, $levels ); say '</g></svg>';</lang>

Tcl

This code maintains a queue of triangles to cut out; though a stack works just as well, the observed progress is more visually pleasing when a queue is used.

Library: Tk

<lang tcl>package require Tcl 8.5 package require Tk

proc mean args {expr {[::tcl::mathop::+ {*}$args] / [llength $args]}} proc sierpinski {canv coords order} {

   $canv create poly $coords -fill black -outline {}
   set queue [list [list {*}$coords $order]]
   while {[llength $queue]} {

lassign [lindex $queue 0] x1 y1 x2 y2 x3 y3 order set queue [lrange $queue 1 end] if {[incr order -1] < 0} continue set x12 [mean $x1 $x2]; set y12 [mean $y1 $y2] set x23 [mean $x2 $x3]; set y23 [mean $y2 $y3] set x31 [mean $x3 $x1]; set y31 [mean $y3 $y1] $canv create poly $x12 $y12 $x23 $y23 $x31 $y31 -fill white -outline {} update idletasks; # So we can see progress lappend queue [list $x1 $y1 $x12 $y12 $x31 $y31 $order] \ [list $x12 $y12 $x2 $y2 $x23 $y23 $order] \ [list $x31 $y31 $x23 $y23 $x3 $y3 $order]

   }

}

pack [canvas .c -width 400 -height 400 -background white] update; # So we can see progress sierpinski .c {200 10 390 390 10 390} 7</lang>