Sierpinski curve

From Rosetta Code
Sierpinski curve 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.


Task

Produce a graphical or ASCII-art representation of a Sierpinski curve of at least order 3.

Go[edit]

Library: Go Graphics
Translation of: Phix

A partial translation anyway which produces a static image of a SC of level 5, yellow on blue, which can be viewed with a utility such as EOG.

package main
 
import (
"github.com/fogleman/gg"
"math"
)
 
var (
width = 770.0
height = 770.0
dc = gg.NewContext(int(width), int(height))
)
 
var cx, cy, h float64
 
func lineTo(newX, newY float64) {
dc.LineTo(newX-width/2+h, height-newY+2*h)
cx, cy = newX, newY
}
 
func lineN() { lineTo(cx, cy-2*h) }
func lineS() { lineTo(cx, cy+2*h) }
func lineE() { lineTo(cx+2*h, cy) }
func lineW() { lineTo(cx-2*h, cy) }
 
func lineNW() { lineTo(cx-h, cy-h) }
func lineNE() { lineTo(cx+h, cy-h) }
func lineSE() { lineTo(cx+h, cy+h) }
func lineSW() { lineTo(cx-h, cy+h) }
 
func sierN(level int) {
if level == 1 {
lineNE()
lineN()
lineNW()
} else {
sierN(level - 1)
lineNE()
sierE(level - 1)
lineN()
sierW(level - 1)
lineNW()
sierN(level - 1)
}
}
 
func sierE(level int) {
if level == 1 {
lineSE()
lineE()
lineNE()
} else {
sierE(level - 1)
lineSE()
sierS(level - 1)
lineE()
sierN(level - 1)
lineNE()
sierE(level - 1)
}
}
 
func sierS(level int) {
if level == 1 {
lineSW()
lineS()
lineSE()
} else {
sierS(level - 1)
lineSW()
sierW(level - 1)
lineS()
sierE(level - 1)
lineSE()
sierS(level - 1)
}
}
 
func sierW(level int) {
if level == 1 {
lineNW()
lineW()
lineSW()
} else {
sierW(level - 1)
lineNW()
sierN(level - 1)
lineW()
sierS(level - 1)
lineSW()
sierW(level - 1)
}
}
 
func squareCurve(level int) {
sierN(level)
lineNE()
sierE(level)
lineSE()
sierS(level)
lineSW()
sierW(level)
lineNW()
lineNE() // needed to close the square in the top left hand corner
}
 
func main() {
dc.SetRGB(0, 0, 1) // blue background
dc.Clear()
level := 5
cx, cy = width/2, height
h = cx / math.Pow(2, float64(level+1))
squareCurve(level)
dc.SetRGB255(255, 255, 0) // yellow curve
dc.SetLineWidth(2)
dc.Stroke()
dc.SavePNG("sierpinski_curve.png")
}

Julia[edit]

Turtle procedural (lineto) version[edit]

Modified from Craft of Coding blog, Processing version

using Luxor
 
function sierpinski_curve(x0, y0, h, level)
x1, y1 = x0, y0
lineto(x, y) = begin line(Point(x1, y1), Point(x, y), :stroke); x1, y1 = x, y end
lineN() = lineto(x1,y1-2*h)
lineS() = lineto(x1,y1+2*h)
lineE() = lineto(x1+2*h,y1)
lineW() = lineto(x1-2*h,y1)
lineNW() = lineto(x1-h,y1-h)
lineNE() = lineto(x1+h,y1-h)
lineSE() = lineto(x1+h,y1+h)
lineSW() = lineto(x1-h,y1+h)
function drawN(i)
if i == 1
lineNE(); lineN(); lineNW()
else
drawN(i-1); lineNE(); drawE(i-1); lineN(); drawW(i-1); lineNW(); drawN(i-1)
end
end
function drawE(i)
if i == 1
lineSE(); lineE(); lineNE()
else
drawE(i-1); lineSE(); drawS(i-1); lineE(); drawN(i-1); lineNE(); drawE(i-1)
end
end
function drawS(i)
if i == 1
lineSW(); lineS(); lineSE()
else
drawS(i-1); lineSW(); drawW(i-1); lineS(); drawE(i-1); lineSE(); drawS(i-1)
end
end
function drawW(i)
if i == 1
lineNW(); lineW(); lineSW()
else
drawW(i-1); lineNW(); drawN(i-1); lineW(); drawS(i-1); lineSW(); drawW(i-1)
end
end
function draw_curve(levl)
drawN(levl); lineNE(); drawE(levl); lineSE()
drawS(levl); lineSW(); drawW(levl); lineNW()
end
draw_curve(level)
end
 
Drawing(800, 800)
sierpinski_curve(10, 790, 3, 6)
finish()
preview()
 

LSystem version[edit]

using Lindenmayer # https://github.com/cormullion/Lindenmayer.jl
 
sierpcurve = LSystem(Dict("X" => "XF+G+XF--F--XF+G+X"), "F--XF--F--XF")
 
drawLSystem(sierpcurve,
forward = 10,
turn = 45,
startingpen= (0.2, 0.8, 0.8),
startingx = -380,
startingy = 380,
startingorientation = π/4,
iterations = 5,
filename = "sierpinski_curve.png",
showpreview = true
)
 

Perl[edit]

use strict;
use warnings;
use SVG;
use List::Util qw(max min);
 
use constant pi => 2 * atan2(1, 0);
 
my $rule = 'XF+F+XF--F--XF+F+X';
my $S = 'F--F--XF--F--XF';
$S =~ s/X/$rule/g for 1..5;
 
my (@X, @Y);
my ($x, $y) = (0, 0);
my $theta = pi/4;
my $r = 6;
 
for (split //, $S) {
if (/F/) {
push @X, sprintf "%.0f", $x;
push @Y, sprintf "%.0f", $y;
$x += $r * cos($theta);
$y += $r * sin($theta);
}
elsif (/\+/) { $theta += pi/4; }
elsif (/\-/) { $theta -= pi/4; }
}
 
my ($xrng, $yrng) = ( max(@X) - min(@X), max(@Y) - min(@Y));
my ($xt, $yt) = (-min(@X) + 10, -min(@Y) + 10);
 
my $svg = SVG->new(width=>$xrng+20, height=>$yrng+20);
my $points = $svg->get_path(x=>\@X, y=>\@Y, -type=>'polyline');
$svg->rect(width=>"100%", height=>"100%", style=>{'fill'=>'black'});
$svg->polyline(%$points, style=>{'stroke'=>'orange', 'stroke-width'=>1}, transform=>"translate($xt,$yt)");
 
open my $fh, '>', 'sierpinski-curve.svg';
print $fh $svg->xmlify(-namespace=>'svg');
close $fh;

See: sierpinski-curve.svg (offsite SVG image)

Phix[edit]

Library: pGUI
-- demo\rosetta\Sierpinski_curve.exw
--
-- Draws curves lo to hi (simultaneously), initially {1,1}, max {8,8}
-- Press +/- to change hi, shift +/- to change lo.
-- ("=_" are also mapped to "+-", for the non-numpad +/-)
--
include pGUI.e
 
Ihandle dlg, canvas
cdCanvas cddbuffer, cdcanvas
 
integer width, height,
lo = 1, hi = 1
atom cx, cy, h
 
procedure lineTo(atom newX, newY)
cdCanvasVertex(cddbuffer, newX-width/2+h, height-newY+2*h)
cx = newX
cy = newY
end procedure
 
procedure lineN() lineTo(cx,cy-2*h) end procedure
procedure lineS() lineTo(cx,cy+2*h) end procedure
procedure lineE() lineTo(cx+2*h,cy) end procedure
procedure lineW() lineTo(cx-2*h,cy) end procedure
 
procedure lineNW() lineTo(cx-h,cy-h) end procedure
procedure lineNE() lineTo(cx+h,cy-h) end procedure
procedure lineSE() lineTo(cx+h,cy+h) end procedure
procedure lineSW() lineTo(cx-h,cy+h) end procedure
 
procedure sierN(integer level)
if level=1 then
lineNE() lineN()
lineNW()
else
sierN(level-1) lineNE()
sierE(level-1) lineN()
sierW(level-1) lineNW()
sierN(level-1)
end if
end procedure
 
procedure sierE(integer level)
if level=1 then
lineSE() lineE()
lineNE()
else
sierE(level-1) lineSE()
sierS(level-1) lineE()
sierN(level-1) lineNE()
sierE(level-1)
end if
end procedure
 
procedure sierS(integer level)
if level=1 then
lineSW() lineS()
lineSE()
else
sierS(level-1) lineSW()
sierW(level-1) lineS()
sierE(level-1) lineSE()
sierS(level-1)
end if
end procedure
 
procedure sierW(integer level)
if level=1 then
lineNW() lineW()
lineSW()
else
sierW(level-1) lineNW()
sierN(level-1) lineW()
sierS(level-1) lineSW()
sierW(level-1)
end if
end procedure
 
procedure sierpinskiCurve(integer level)
sierN(level) lineNE()
sierE(level) lineSE()
sierS(level) lineSW()
sierW(level) lineNW()
end procedure
 
function redraw_cb(Ihandle /*ih*/, integer /*posx*/, integer /*posy*/)
{width, height} = IupGetIntInt(canvas, "DRAWSIZE")
cdCanvasActivate(cddbuffer)
for level=lo to hi do
cx = width/2
cy = height
h = cx/power(2,level+1)
cdCanvasBegin(cddbuffer, CD_CLOSED_LINES)
sierpinskiCurve(level)
cdCanvasEnd(cddbuffer)
end for
cdCanvasFlush(cddbuffer)
return IUP_DEFAULT
end function
 
function map_cb(Ihandle ih)
cdcanvas = cdCreateCanvas(CD_IUP, ih)
cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
cdCanvasSetBackground(cddbuffer, CD_WHITE)
cdCanvasSetForeground(cddbuffer, CD_BLUE)
return IUP_DEFAULT
end function
 
function key_cb(Ihandle /*ih*/, atom c)
if c=K_ESC then return IUP_CLOSE end if
if find(c,"+=-_") then
bool bShift = IupGetInt(NULL,"SHIFTKEY")
if c='+' or c='=' then
if bShift then
lo = min(lo+1,hi)
else
hi = min(8,hi+1)
end if
elsif c='-' or c='_' then
if bShift then
lo = max(1,lo-1)
else
hi = max(lo,hi-1)
end if
end if
IupSetStrAttribute(dlg, "TITLE", "Sierpinski curve (%d..%d)",{lo,hi})
cdCanvasClear(cddbuffer)
IupUpdate(canvas)
end if
return IUP_CONTINUE
end function
 
procedure main()
IupOpen()
 
canvas = IupCanvas(NULL)
IupSetAttribute(canvas, "RASTERSIZE", "770x770")
IupSetCallback(canvas, "MAP_CB", Icallback("map_cb"))
IupSetCallback(canvas, "ACTION", Icallback("redraw_cb"))
 
dlg = IupDialog(canvas)
IupSetAttribute(dlg, "TITLE", "Sierpinski curve (1..1)")
IupSetCallback(dlg, "K_ANY", Icallback("key_cb"))
 
IupMap(dlg)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupMainLoop()
IupClose()
end procedure
 
main()

Raku[edit]

(formerly Perl 6)

Works with: Rakudo version 2020.02
use SVG;
 
role Lindenmayer {
has %.rules;
method succ {
self.comb.map( { %!rules{$^c} // $c } ).join but Lindenmayer(%!rules)
}
}
 
my $sierpinski = 'F--XF--F--XF' but Lindenmayer( { X => 'XF+G+XF--F--XF+G+X' } );
 
$sierpinski++ xx 5;
 
my $dim = 640;
my $scale = 8;
my $dir = pi/4;
my @points = (316, -108);
 
for $sierpinski.comb {
state ($x, $y) = @points[0,1];
state $d = 0;
when 'F'|'G' { @points.append: ($x += $scale * $d.cos).round(1), ($y += $scale * $d.sin).round(1) }
when '+' { $d -= $dir }
when '-' { $d += $dir }
default { }
}
 
my $out = './sierpinski-curve-perl6.svg'.IO;
 
$out.spurt: SVG.serialize(
svg => [
:width($dim), :height($dim),
:rect[:width<100%>, :height<100%>, :fill<black>],
:polyline[
:points(@points.join: ','), :fill<black>,
:transform("rotate(45, 320, 320)"), :style<stroke:#F7DF1E>,
],
],
);

See: Sierpinski-curve-perl6.svg (offsite SVG image)

Sidef[edit]

Uses the LSystem() class from Hilbert curve.

var rules = Hash(
x => 'xF+G+xF--F--xF+G+x',
)
 
var lsys = LSystem(
width: 550,
height: 550,
 
xoff: -9,
yoff: -271,
 
len: 5,
angle: 45,
color: 'dark green',
)
 
lsys.execute('F--xF--F--xF', 5, "sierpiński_curve.png", rules)

Output image: Sierpiński curve

zkl[edit]

Uses Image Magick and the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl

sierpinskiCurve(5) : turtle(_,45,45);	// n=5 --> 11,606 characters
 
fcn sierpinskiCurve(order){
LSystem("F--XF--F--XF",Dictionary("X","XF+G+XF--F--XF+G+X"), order)
}
fcn LSystem(axiom,rules,order){ // Lindenmayer system
buf1,buf2 := Data(Void,axiom).howza(3), Data().howza(3); // characters
do(order){
buf1.pump(buf2.clear(),'wrap(c){ rules.find(c,c) }); // change if rule
t:=buf1; buf1=buf2; buf2=t; // swap buffers
}
buf1
}
 
fcn turtle(curve,angle,startAngle){ // angles in degrees
const D=10.0;
dir:=startAngle;
img,color := PPM(800,800), 0x00ff00; // green on black
x,y := 15, img.h - x;
foreach c in (curve){
switch(c){
case("F","G"){ // draw forward
a,b := D.toRectangular(dir.toFloat().toRad());
img.line(x,y, (x+=a.round()),(y+=b.round()), color)
}
case("+"){ dir=(dir + angle)%360; } // turn left angle
case("-"){ dir=(dir - angle)%360; } // turn right angle
}
}
img.writeJPGFile("sierpinskiCurve.zkl.jpg");
}
Output:

Offsite image at Sierpinski curve order 5