Sierpinski triangle/Graphical

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:

Icon and Unicon

The following code is adapted from a program by Ralph E. 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.

Library: Icon Programming Library

<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.

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>