Sierpinski triangle/Graphical: Difference between revisions
added ti-basic =D |
mNo edit summary |
||
Line 1,272:
{{omit from|ACL2}}
{{omit from|GUISS}}
[[Category:Geometry]]
|
Revision as of 05:47, 26 June 2015
You are encouraged to solve this task according to the task description, using any language you may know.
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:
ActionScript
SierpinskiTriangle class: <lang ActionScript3> package {
import flash.display.GraphicsPathCommand; import flash.display.Sprite; /** * A Sierpinski triangle. */ public class SierpinskiTriangle extends Sprite { /** * Creates a new SierpinskiTriangle object. * * @param n The order of the Sierpinski triangle. * @param c1 The background colour. * @param c2 The foreground colour. * @param width The width of the triangle. * @param height The height of the triangle. */ public function SierpinskiTriangle(n:uint, c1:uint, c2:uint, width:Number, height:Number):void { _init(n, c1, c2, width, height); } /** * Generates the triangle. * * @param n The order of the Sierpinski triangle. * @param c1 The background colour. * @param c2 The foreground colour. * @param width The width of the triangle. * @param height The height of the triangle. * @private */ private function _init(n:uint, c1:uint, c2:uint, width:Number, height:Number):void { if ( n <= 0 ) return; // Draw the outer triangle. graphics.beginFill(c1); graphics.moveTo(width / 2, 0); graphics.lineTo(0, height); graphics.lineTo(width, height); graphics.lineTo(width / 2, 0); // Draw the inner triangle. graphics.beginFill(c2); graphics.moveTo(width / 4, height / 2); graphics.lineTo(width * 3 / 4, height / 2); graphics.lineTo(width / 2, height); graphics.lineTo(width / 4, height / 2); if ( n == 1 ) return; // Recursively generate three Sierpinski triangles of half the size and order n - 1 and position them appropriately. var sub1:SierpinskiTriangle = new SierpinskiTriangle(n - 1, c1, c2, width / 2, height / 2); var sub2:SierpinskiTriangle = new SierpinskiTriangle(n - 1, c1, c2, width / 2, height / 2); var sub3:SierpinskiTriangle = new SierpinskiTriangle(n - 1, c1, c2, width / 2, height / 2); sub1.x = width / 4; sub1.y = 0; sub2.x = 0; sub2.y = height / 2; sub3.x = width / 2; sub3.y = height / 2; addChild(sub1); addChild(sub2); addChild(sub3); } }
} </lang>
Document class: <lang ActionScript3> package {
import flash.display.Sprite; import flash.events.Event; public class Main extends Sprite { public function Main():void { if ( stage ) init(); else addEventListener(Event.ADDED_TO_STAGE, init); } private function init(e:Event = null):void { var s:SierpinskiTriangle = new SierpinskiTriangle(5, 0x0000FF, 0xFFFF00, 300, 150 * Math.sqrt(3)); // Equilateral triangle (blue and yellow) s.x = s.y = 20; addChild(s); } }
} </lang>
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>
AutoHotkey
<lang AutoHotkey>#NoEnv
- SingleInstance, Force
SetBatchLines, -1
- Parameters
Width := 512, Height := Width/2*3**0.5, n := 8 ; iterations = 8
- Uncomment if Gdip.ahk is not in your standard library
- Include ..\lib\Gdip.ahkl
If !pToken := Gdip_Startup() ; Start gdi+ { MsgBox, 48, gdiplus error!, Gdiplus failed to start. Please ensure you have gdiplus on your system ExitApp }
- I've added a simple new function here, just to ensure if anyone is having any problems then to make sure they are using the correct library version
if (Gdip_LibraryVersion() < 1.30) { MsgBox, 48, Version error!, Please download the latest version of the gdi+ library ExitApp } OnExit, Exit
- Create a layered window (+E0x80000
- must be used for UpdateLayeredWindow to work!) that is always on top (+AlwaysOnTop), has no taskbar entry or caption
Gui, -Caption +E0x80000 +LastFound +OwnDialogs +Owner +AlwaysOnTop Gui, Show hwnd1 := WinExist() OnMessage(0x201, "WM_LBUTTONDOWN")
, hbm := CreateDIBSection(Width, Height) , hdc := CreateCompatibleDC() , obm := SelectObject(hdc, hbm) , G := Gdip_GraphicsFromHDC(hdc) , Gdip_SetSmoothingMode(G, 4)
- Sierpinski triangle by subtracting triangles
, pBrushBlack := Gdip_BrushCreateSolid(0xff000000) , rectangle := 0 "," 0 "|" 0 "," Height "|" Width "," Height "|" Width "," 0 , Gdip_FillPolygon(G, pBrushBlack, rectangle, FillMode=0)
, pBrushBlue := Gdip_BrushCreateSolid(0xff0000ff) , triangle := Width/2 "," 0 "|" 0 "," Height "|" Width "," Height , Gdip_FillPolygon(G, pBrushBlue, triangle, FillMode=0) , Gdip_DeleteBrush(pBrushBlue)
, UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height)
, k:=2, x:=0, y:=0, i:=1 Loop, % n { Sleep 0.5*1000 While x*y<Width*Height { triangle := x "," y "|" x+Width/2/k "," y+Height/k "|" x+Width/k "," y , Gdip_FillPolygon(G, pBrushBlack, triangle, FillMode=0) , x += Width/k , (x >= Width) ? (x := i*Width/2/k, y += Height/k, i:=!i) : "" } UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height) , k*=2, x:=0, y:=0, i:=1 }
Gdip_DeleteBrush(pBrushBlack)
, UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height) Sleep, 1*1000
- Bonus
- Sierpinski triangle by random dots
Gdip_GraphicsClear(G, 0xff000000) , pBrushBlue := Gdip_BrushCreateSolid(0xff0000ff) , x1:=Width/2, y1:=0, x2:=0, y2:=Height, x3:=Width, y3:=Height , x:= Width/2, y:=Height/2 ; I'm to lazy to pick a random point. Loop, % n { Loop, % 10*10**(A_Index/2) { Random, rand, 1, 3 x := abs(x+x%rand%)/2 , y := abs(y+y%rand%)/2 , Gdip_FillEllipse(G, pBrushBlue, x, y, 1, 1) } UpdateLayeredWindow(hwnd1, hdc, (A_ScreenWidth-Width)/2, (A_ScreenHeight-Height)/2, Width, Height) Sleep, 0.5*1000 } SelectObject(hdc, obm) , DeleteObject(hbm) , DeleteDC(hdc) , Gdip_DeleteGraphics(G) Return
Exit: Gdip_Shutdown(pToken) ExitApp
WM_LBUTTONDOWN() { If (A_Gui = 1) PostMessage, 0xA1, 2 }</lang>
BBC BASIC
<lang bbcbasic> order% = 8
size% = 2^order% VDU 23,22,size%;size%;8,8,16,128 FOR Y% = 0 TO size%-1 FOR X% = 0 TO size%-1 IF (X% AND Y%)=0 PLOT X%*2,Y%*2 NEXT NEXT Y%
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>
- include <stdlib.h>
- include <string.h>
- 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];
- 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(const 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>
D
The output image is the same as the Go version. This requires the module from the Grayscale image Task.
<lang d>void main() {
import grayscale_image;
enum order = 8, margin = 10, width = 2 ^^ order;
auto im = new Image!Gray(width + 2 * margin, width + 2 * margin); im.clear(Gray.white);
foreach (immutable y; 0 .. width) foreach (immutable x; 0 .. width) if ((x & y) == 0) im[x + margin, y + margin] = Gray.black; im.savePGM("sierpinski.pgm");
}</lang>
ERRE
<lang ERRE> PROGRAM SIERPINSKY
!$INCLUDE="PC.LIB"
BEGIN
ORDER%=8 SIZE%=2^ORDER% SCREEN(9) GR_WINDOW(0,0,520,520) FOR Y%=0 TO SIZE%-1 DO FOR X%=0 TO SIZE%-1 DO IF (X% AND Y%)=0 THEN PSET(X%*2,Y%*2,2) END IF END FOR END FOR GET(K$)
END PROGRAM </lang>
gnuplot
Generating X,Y coordinates by the ternary digits of parameter t.
<lang gnuplot># triangle_x(n) and triangle_y(n) return X,Y coordinates for the
- Sierpinski triangle point number n, for integer n.
triangle_x(n) = (n > 0 ? 2*triangle_x(int(n/3)) + digit_to_x(int(n)%3) : 0) triangle_y(n) = (n > 0 ? 2*triangle_y(int(n/3)) + digit_to_y(int(n)%3) : 0) digit_to_x(d) = (d==0 ? 0 : d==1 ? -1 : 1) digit_to_y(d) = (d==0 ? 0 : 1)
- Plot the Sierpinski triangle to "level" many replications.
- "trange" and "samples" are chosen so the parameter t runs through
- integers t=0 to 3**level-1, inclusive.
level=6 set trange [0:3**level-1] set samples 3**level set parametric set key off plot triangle_x(t), triangle_y(t) with points</lang>
Go
<lang go>package main
import (
"fmt" "image" "image/color" "image/draw" "image/png" "os"
)
func main() {
const order = 8 const width = 1 << order const margin = 10 bounds := image.Rect(-margin, -margin, width+2*margin, width+2*margin) im := image.NewGray(bounds) gBlack := color.Gray{0} gWhite := color.Gray{255} draw.Draw(im, bounds, image.NewUniform(gWhite), image.ZP, draw.Src)
for y := 0; y < width; y++ { for x := 0; x < width; x++ { if x&y == 0 { im.SetGray(x, y, gBlack) } } } f, err := os.Create("sierpinski.png") if err != nil { fmt.Println(err) return } if err = png.Encode(f, im); err != nil { fmt.Println(err) } if err = f.Close(); err != nil { fmt.Println(err) }
}</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.
<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-Verlag, 1992, pp. 132-134.
<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>
or
<lang j> load'viewmat' viewmat(,~,.~)^:8,1 </lang>
Java
Solution: <lang java> import javax.swing.*; import java.awt.*;
/**
- SierpinskyTriangle.java
- Draws a SierpinskyTriangle in a JFrame
- The order of complexity is given from command line, but
- defaults to 3
- @author Istarnion
- /
class SierpinskyTriangle {
public static void main(String[] args) { int i = 3; // Default to 3 if(args.length >= 1) { try { i = Integer.parseInt(args[0]); } catch(NumberFormatException e) { System.out.println("Usage: 'java SierpinskyTriangle [level]'\nNow setting level to "+i); } } final int level = i;
JFrame frame = new JFrame("Sierpinsky Triangle - Java"); frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
JPanel panel = new JPanel() { @Override public void paintComponent(Graphics g) { g.setColor(Color.BLACK); drawSierpinskyTriangle(level, 20, 20, 360, (Graphics2D)g); } };
panel.setPreferredSize(new Dimension(400, 400));
frame.add(panel); frame.pack(); frame.setResizable(false); frame.setLocationRelativeTo(null); frame.setVisible(true); }
private static void drawSierpinskyTriangle(int level, int x, int y, int size, Graphics2D g) { if(level <= 0) return;
g.drawLine(x, y, x+size, y); g.drawLine(x, y, x, y+size); g.drawLine(x+size, y, x, y+size);
drawSierpinskyTriangle(level-1, x, y, size/2, g); drawSierpinskyTriangle(level-1, x+size/2, y, size/2, g); drawSierpinskyTriangle(level-1, x, y+size/2, size/2, g); } } </lang>
Liberty BASIC
The ability of LB to handle very large integers makes the Pascal triangle method very attractive. If you alter the rem'd line you can ask it to print the last, central term... <lang lb> nomainwin
open "test" for graphics_nsb_fs as #gr
- gr "trapclose quit"
- gr "down; home"
- gr "posxy cx cy"
order =10
w =cx *2: h =cy *2
dim a( h, h) 'line, col
- gr "trapclose quit"
- gr "down; home"
a( 1, 1) =1
for i = 2 to 2^order -1
scan a( i, 1) =1 a( i, i) =1 for j = 2 to i -1 'a(i,j)=a(i-1,j-1)+a(i-1,j) 'LB is quite capable for crunching BIG numbers a( i, j) =(a( i -1, j -1) +a( i -1, j)) mod 2 'but for this task, last bit is enough (and it much faster) next for j = 1 to i if a( i, j) mod 2 then #gr "set "; cx +j -i /2; " "; i next
next
- gr "flush"
wait
sub quit handle$
close #handle$ end
end sub </lang> Up to order 10 displays on a 1080 vertical pixel screen.
Logo
This will draw a graphical Sierpinski gasket using turtle graphics. <lang logo>to sierpinski :n :length
if :n = 0 [stop] repeat 3 [sierpinski :n-1 :length/2 fd :length rt 120]
end seth 30 sierpinski 5 200</lang>
Mathematica
<lang Mathematica>Sierpinski[n_] :=Nest[Flatten[Table[{{
#i, 1, (#i, 1 + #i, 2)/2, (#i, 1 + #i, 3)/ 2}, {(#i, 1 + #i, 2)/2, #[[i, 2]], (#i, 2 + #i, 3)/2}, {(#i, 1 + #i, 3)/ 2, (#i, 2 + #i, 3)/2, #i, 3}}, {i, Length[#]}], 1] &, {{{0, 0}, {1/2, 1}, {1, 0}}}, n]
Show[Graphics[{Opacity[1], Black, Map[Polygon, Sierpinski[8], 1]}, AspectRatio -> 1]]</lang>
<lang Mathematica>sierpinski[v_, 0] := Polygon@v; sierpinski[v_, n_] := sierpinski[#, n - 1] & /@ (Mean /@ # & /@ v~Tuples~2~Partition~3); Graphics@sierpinski[N@{{0, 0}, {1, 0}, {.5, .8}}, 3]</lang>
<lang Mathematica>sierpinski = Map[Mean, Partition[Tuples[#, 2], 3], {2}] &; p = Nest[Join @@ sierpinski /@ # &, {{{0, 0}, {1, 0}, {.5, .8}}}, 3]; Graphics[Polygon@p]</lang>
OCaml
<lang ocaml>open Graphics
let round v =
int_of_float (floor (v +. 0.5))
let middle (x1, y1) (x2, y2) =
((x1 +. x2) /. 2.0, (y1 +. y2) /. 2.0)
let draw_line (x1, y1) (x2, y2) =
moveto (round x1) (round y1); lineto (round x2) (round y2);
let draw_triangle (p1, p2, p3) =
draw_line p1 p2; draw_line p2 p3; draw_line p3 p1;
let () =
open_graph ""; let width = float (size_x ()) in let height = float (size_y ()) in let pad = 20.0 in let initial_triangle = ( (pad, pad), (width -. pad, pad), (width /. 2.0, height -. pad) ) in let rec loop step tris = if step <= 0 then tris else loop (pred step) ( List.fold_left (fun acc (p1, p2, p3) -> let m1 = middle p1 p2 and m2 = middle p2 p3 and m3 = middle p3 p1 in let tri1 = (p1, m1, m3) and tri2 = (p2, m2, m1) and tri3 = (p3, m3, m2) in tri1 :: tri2 :: tri3 :: acc ) [] tris ) in let res = loop 6 [ initial_triangle ] in List.iter draw_triangle res; ignore (read_key ())</lang>
run with:
ocaml graphics.cma sierpinski.ml
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>
PicoLisp
Slight modification of the text version, requires ImageMagick's display: <lang PicoLisp>(de sierpinski (N)
(let (D '("1") S "0") (do N (setq D (conc (mapcar '((X) (pack S X S)) D) (mapcar '((X) (pack X "0" X)) D) ) S (pack S S) ) ) D ) )
(out '(display -)
(let Img (sierpinski 7) (prinl "P1") (prinl (length (car Img)) " " (length Img)) (mapc prinl Img) ) )
</lang>
PostScript
<lang PostScript>%!PS
/sierp { % level ax ay bx by cx cy
6 cpy triangle sierpr
} bind def
/sierpr {
12 cpy 10 -4 2 { 5 1 roll exch 4 -1 roll add 0.5 mul 3 1 roll add 0.5 mul 3 -1 roll 2 roll } for % l a b c bc ac ab 13 -1 roll dup 0 gt { 1 sub dup 4 cpy 18 -2 roll sierpr dup 7 index 7 index 2 cpy 16 -2 roll sierpr 9 3 roll 1 index 1 index 2 cpy 13 4 roll sierpr } { 13 -6 roll 7 { pop } repeat } ifelse triangle
} bind def
/cpy { { 5 index } repeat } bind def
/triangle {
newpath moveto lineto lineto closepath stroke
} bind def
6 50 100 550 100 300 533 sierp showpage</lang>
Prolog
Works with SWI-Prolog and XPCE.
Recursive version
Works up to sierpinski(13). <lang Prolog>sierpinski(N) :- sformat(A, 'Sierpinski order ~w', [N]), new(D, picture(A)), draw_Sierpinski(D, N, point(350,50), 600), send(D, size, size(690,690)), send(D, open).
draw_Sierpinski(Window, 1, point(X, Y), Len) :- X1 is X - round(Len/2), X2 is X + round(Len/2), Y1 is Y + Len * sqrt(3) / 2, send(Window, display, new(Pa, path)),
(
send(Pa, append, point(X, Y)), send(Pa, append, point(X1, Y1)), send(Pa, append, point(X2, Y1)), send(Pa, closed, @on), send(Pa, fill_pattern, colour(@default, 0, 0, 0)) ).
draw_Sierpinski(Window, N, point(X, Y), Len) :-
Len1 is round(Len/2),
X1 is X - round(Len/4),
X2 is X + round(Len/4),
Y1 is Y + Len * sqrt(3) / 4,
N1 is N - 1,
draw_Sierpinski(Window, N1, point(X, Y), Len1),
draw_Sierpinski(Window, N1, point(X1, Y1), Len1),
draw_Sierpinski(Window, N1, point(X2, Y1), Len1).</lang>
Iterative version
<lang Prolog>:- dynamic top/1.
sierpinski_iterate(N) :- retractall(top(_)), sformat(A, 'Sierpinski order ~w', [N]), new(D, picture(A)), draw_Sierpinski_iterate(D, N, point(550, 50)), send(D, open).
draw_Sierpinski_iterate(Window, N, point(X,Y)) :- assert(top([point(X,Y)])), NbTours is 2 ** (N - 1), % Size is given here to preserve the "small" triangles when N is big Len is 10, forall(between(1, NbTours, _I), ( retract(top(Lst)), assert(top([])), forall(member(P, Lst), draw_Sierpinski(Window, P, Len)))).
draw_Sierpinski(Window, point(X, Y), Len) :- X1 is X - round(Len/2), X2 is X + round(Len/2), Y1 is Y + round(Len * sqrt(3) / 2), send(Window, display, new(Pa, path)),
(
send(Pa, append, point(X, Y)), send(Pa, append, point(X1, Y1)), send(Pa, append, point(X2, Y1)), send(Pa, closed, @on), send(Pa, fill_pattern, colour(@default, 0, 0, 0)) ), retract(top(Lst)), ( member(point(X1, Y1), Lst) -> select(point(X1,Y1), Lst, Lst1) ; Lst1 = [point(X1, Y1)|Lst]),
( member(point(X2, Y1), Lst1) -> select(point(X2,Y1), Lst1, Lst2) ; Lst2 = [point(X2, Y1)|Lst1]),
assert(top(Lst2)).</lang>
Python
<lang python>#!/usr/bin/env python
- import necessary modules
- ------------------------
from numpy import * import turtle
- Functions defining the drawing actions
- (used by the function DrawSierpinskiTriangle).
- ----------------------------------------------
def Left(turn, point, fwd, angle, turt): turt.left(angle) return [turn, point, fwd, angle, turt] def Right(turn, point, fwd, angle, turt): turt.right(angle) return [turn, point, fwd, angle, turt] def Forward(turn, point, fwd, angle, turt): turt.forward(fwd) return [turn, point, fwd, angle, turt] </lang> <lang python>##########################################################################################
- The drawing function
- --------------------
- level level of Sierpinski triangle (minimum value = 1)
- ss screensize (Draws on a screen of size ss x ss. Default value = 400.)
- -----------------------------------------------------------------------------------------
def DrawSierpinskiTriangle(level, ss=400): # typical values turn = 0 # initial turn (0 to start horizontally) angle=60.0 # in degrees
# Initialize the turtle turtle.hideturtle() turtle.screensize(ss,ss) turtle.penup() turtle.degrees()
# The starting point on the canvas fwd0 = float(ss) point=array([-fwd0/2.0, -fwd0/2.0])
# Setting up the Lindenmayer system # Assuming that the triangle will be drawn in the following way: # 1.) Start at a point # 2.) Draw a straight line - the horizontal line (H) # 3.) Bend twice by 60 degrees to the left (--) # 4.) Draw a straight line - the slanted line (X) # 5.) Bend twice by 60 degrees to the left (--) # 6.) Draw a straight line - another slanted line (X) # This produces the triangle in the first level. (so the axiom to begin with is H--X--X) # 7.) For the next level replace each horizontal line using # X->XX # H -> H--X++H++X--H # The lengths will be halved.
decode = {'-':Left, '+':Right, 'X':Forward, 'H':Forward}
axiom = 'H--X--X'
# Start the drawing turtle.goto(point[0], point[1]) turtle.pendown() turtle.hideturtle() turt=turtle.getpen() startposition=turt.clone()
# Get the triangle in the Lindenmayer system fwd = fwd0/(2.0**level) path = axiom for i in range(0,level): path=path.replace('X','XX') path=path.replace('H','H--X++H++X--H')
# Draw it. for i in path: [turn, point, fwd, angle, turt]=decode[i](turn, point, fwd, angle, turt)
DrawSierpinskiTriangle(5) </lang>
Racket
<lang Racket>
- lang racket
(require 2htdp/image) (define (sierpinski n)
(if (zero? n) (triangle 2 'solid 'red) (let ([t (sierpinski (- n 1))]) (freeze (above t (beside t t))))))
</lang> Test: <lang racket>
- the following will show the graphics if run in DrRacket
(sierpinski 8)
- or use this to dump the image into a file, shown on the right
(require file/convertible) (display-to-file (convert (sierpinski 8) 'png-bytes) "sierpinski.png") </lang>
Ruby
<lang ruby>Shoes.app(:height=>540,:width=>540, :title=>"Sierpinski Triangle") do
def triangle(slot, tri, color) x, y, len = tri slot.append do fill color shape do move_to(x,y) dx = len * Math::cos(Math::PI/3) dy = len * Math::sin(Math::PI/3) line_to(x-dx, y+dy) line_to(x+dx, y+dy) line_to(x,y) end end end @s = stack(:width => 520, :height => 520) {} @s.move(10,10)
length = 512 @triangles = length/2,0,length triangle(@s, @triangles[0], rgb(0,0,0))
@n = 1 animate(1) do if @n <= 7 @triangles = @triangles.inject([]) do |sum, (x, y, len)| dx = len/2 * Math::cos(Math::PI/3) dy = len/2 * Math::sin(Math::PI/3) triangle(@s, [x, y+2*dy, -len/2], rgb(255,255,255)) sum += [[x, y, len/2], [x-dx, y+dy, len/2], [x+dx, y+dy, len/2]] end end @n += 1 end
keypress do |key| case key when :control_q, "\x11" then exit end end
end</lang>
Run BASIC
<lang runbasic>graphic #g, 300,300 order = 8 width = 100 w = width * 11 dim canvas(w,w) canvas(1,1) = 1
for x = 2 to 2^order -1
canvas(x,1) = 1 canvas(x,x) = 1 for y = 2 to x -1 canvas( x, y) = (canvas(x -1,y -1) + canvas(x -1, y)) mod 2 if canvas(x,y) mod 2 then #g "set "; width + (order*3) + y - x / 2;" "; x next y
next x render #g
- g "flush"
wait</lang>
Seed7
<lang seed7>$ include "seed7_05.s7i";
include "draw.s7i"; include "keybd.s7i";
const proc: main is func
local const integer: order is 8; const integer: width is 1 << order; const integer: margin is 10; var integer: x is 0; var integer: y is 0; begin screen(width + 2 * margin, width + 2 * margin); clear(curr_win, white); KEYBOARD := GRAPH_KEYBOARD; for y range 0 to pred(width) do for x range 0 to pred(width) do if bitset conv x & bitset conv y = bitset.value then point(margin + x, margin + y, black); end if; end for; end for; ignore(getc(KEYBOARD)); end func;</lang>
Original source: [1]
Sidef
<lang ruby>func sierpinski_triangle(n) -> Array {
var triangle = ['*']; { |i| var sp = (' ' * Math.pow(2, i-1)); triangle = (triangle.map {|x| sp + x + sp} + triangle.map {|x| x + ' ' + x}); } * n; triangle;
}
class Array {
method to_png(scale=1, bgcolor='white', fgcolor='black') {
var gd = ( try { require 'GD::Simple' } catch { warn "GD::Simple is not installed!"; return }; );
var width = self.max_by{.len}.len; self.map!{|r| "%-#{width}s" % r};
var img = gd.new(width * scale, self.len * scale);
self.range.each { |i| (i * scale) ..^ (i * scale + scale) -> each { |j| var row = self[i]; img.moveTo(0, j); loop { if (row.sub!(/^(\s+)/); $1.len?) { img.fgcolor(bgcolor); img.line(scale * $1.len); } elsif (row.sub!(/^(\S+)/); $1.len?) { img.fgcolor(fgcolor); img.line(scale * $1.len); } else { break } } } };
return img.png; }
}
var triangle = sierpinski_triangle(8); var raw_png = triangle.to_png(bgcolor:'black', fgcolor:'red');
var file = %f'triangle.png'; file.open('>:raw', \var fh, \var err)
|| die "Can't write to file '#{file}': #{err}";
fh.print(raw_png); fh.close;</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.
<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>
{header|TI-83}
<lang ti83b>:1→X:1→Y
- Zdecimal
- Horizontal 3.1
- Vertical -4.5
- While 1
- X+1→X
- DS<(Y,1
- While 0
- X→Y
- 1→X
- End
- If pxl-Test(Y-1,X) xor (pxl-Test(Y,X-1
- PxlOn(Y,X
- End</lang>
This could be made faster, but I just wanted to use the DS<( command
XPL0
<lang XPL0>include c:\cxpl\codes; \intrinsic 'code' declarations def Order=7, Size=1<<Order; int X, Y; [SetVid($13); \set 320x200 graphics video mode for Y:= 0 to Size-1 do
for X:= 0 to Size-1 do if (X&Y)=0 then Point(X, Y, 4\red\);
X:= ChIn(1); \wait for keystroke SetVid(3); \restore normal text display ]</lang>
zkl
Uses the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl
<lang zkl>const Order=8, Size=(1).shiftLeft(Order); img:=PPM(300,300); foreach y,x in (Size,Size){ if(x.bitAnd(y)==0) img[x,y]=0xff0000 } img.write(File("foo.ppm","wb"));</lang>
- Output:
Same as the BBC BASIC image but with red and another order of triangles.
- Programming Tasks
- Solutions by Programming Task
- ActionScript
- Asymptote
- AutoHotkey
- GDIP
- BBC BASIC
- C
- D
- ERRE
- Gnuplot
- Go
- Haskell
- Icon
- Unicon
- Icon Programming Library
- J
- Java
- Liberty BASIC
- Logo
- Mathematica
- OCaml
- Perl
- Perl 6
- PicoLisp
- PostScript
- Prolog
- Python
- Numpy
- Turtle
- Racket
- Ruby
- Shoes
- Run BASIC
- Seed7
- Sidef
- Tcl
- Tk
- XPL0
- Zkl
- ACL2/Omit
- GUISS/Omit
- Geometry