Sierpinski square curve: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎{{header|Julia}}: mark as incorrect, since it does not generate the Sierpinski square curve)
(Go/Julia moved, Phix replaced, see talk page)
Line 4: Line 4:


Produce a graphical or ASCII-art representation of a [[wp:Sierpiński_curve|Sierpinski square curve]] of at least order 3.
Produce a graphical or ASCII-art representation of a [[wp:Sierpiński_curve|Sierpinski square curve]] of at least order 3.


=={{header|Go}}==
{{libheader|Go Graphics}}
{{trans|Phix}}
A partial translation anyway which produces a static image of a SSC of level 5, yellow on blue, which can be viewed with a utility such as EOG.
<lang go>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_square_curve.png")
}</lang>

=={{header|Julia}}==
{{incorrect||Does not generate the Sierpinski '''square''' curve}}
Modified from [https://craftofcoding.wordpress.com/2018/05/08/recursive-patterns-the-sierpinski-curve/ Craft of Coding blog, Processing version]
<lang Julia>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()
</lang>


=={{header|Perl}}==
=={{header|Perl}}==
Line 276: Line 95:


=={{header|Phix}}==
=={{header|Phix}}==
<lang Phix>constant rule = "XF-F+F-XF+F+XF-F+F-X"
{{libheader|pGUI}}
string s = "F+F+XF+F+XF"
<lang Phix>-- demo\rosetta\Sierpinski_square_curve.exw
for n=1 to 4 do
--
string next = ""
-- Draws curves lo to hi (simultaneously), initially {1,1}, max {8,8}
for i=1 to length(s) do
-- Press +/- to change hi, shift +/- to change lo.
integer ch = s[i]
-- ("=_" are also mapped to "+-", for the non-numpad +/-)
next &= iff(ch='X'?rule:ch)
--
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
end for
s = next
cdCanvasFlush(cddbuffer)
end for
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 square 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 square curve (1..1)")
IupSetCallback(dlg, "K_ANY", Icallback("key_cb"))

IupMap(dlg)
IupShowXY(dlg,IUP_CENTER,IUP_CENTER)
IupMainLoop()
IupClose()
end procedure


sequence X = {}, Y= {}
main()</lang>
atom x=0, y=0, theta=PI/4, r = 6
string svg = ""
for i=1 to length(s) do
integer ch = s[i]
switch ch do
case 'F': X &= x; x += r*cos(theta)
Y &= y; y += r*sin(theta)
case '+': theta += PI/2
case '-': theta -= PI/2
end switch
end for
constant svgfmt = """
<svg xmlns="http://www.w3.org/2000/svg" height="%d" width="%d">
<rect height="100%%" width="100%%" style="fill:black" />
<polyline points="%s" style="stroke: orange; stroke-width: 1" transform="translate(%d,%d)" />
</svg>"""
string points = ""
for i=1 to length(X) do
points &= sprintf("%.2f,%.2f ",{X[i],Y[i]})
end for
integer fn = open("sierpinski_square_curve.svg","w")
atom xt = -min(X)+10,
yt = -min(Y)+10
printf(fn,svgfmt,{max(X)+xt+10,max(Y)+yt+10,points,xt,yt})
close(fn)</lang>


=={{header|Sidef}}==
=={{header|Sidef}}==

Revision as of 16:51, 5 March 2020

Sierpinski square 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 square curve of at least order 3.

Perl

<lang perl>use strict; use warnings; use SVG; use List::Util qw(max min); use constant pi => 2 * atan2(1, 0);

my $rule = 'XF-F+F-XF+F+XF-F+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/2; }
   elsif (/\-/) { $theta -= pi/2; }

}

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-square-curve.svg'; print $fh $svg->xmlify(-namespace=>'svg'); close $fh;</lang> See: sierpinski-square-curve.svg (offsite SVG image)

Perl 6

Works with: Rakudo version 2020.02

<lang perl6>use SVG;

role Lindenmayer {

   has %.rules;
   method succ {
       self.comb.map( { %!rules{$^c} // $c } ).join but Lindenmayer(%!rules)
   }

}

my $sierpinski = 'X' but Lindenmayer( { X => 'XF-F+F-XF+F+XF-F+F-X' } );

$sierpinski++ xx 5;

my $dim = 600; my $scale = 6;

my @points = (-80, 298);

for $sierpinski.comb {

   state ($x, $y) = @points[0,1];
   state $d = $scale + 0i;
   when 'F' { @points.append: ($x += $d.re).round(1), ($y += $d.im).round(1) }
   when /< + - >/ { $d *= "{$_}1i" }
   default { }

}

my @t = @points.tail(2).clone;

my $out = './sierpinski-square-curve-perl6.svg'.IO;

$out.spurt: SVG.serialize(

   svg => [
       :width($dim), :height($dim),
       :rect[:width<100%>, :height<100%>, :fill<black>],
       :polyline[
         :points((@points, map {(@t »+=» $_).clone}, ($scale,0), (0,$scale), (-$scale,0)).join: ','),
         :fill<black>, :transform("rotate(45, 300, 300)"), :style<stroke:#61D4FF>,
       ],
       :polyline[
         :points(@points.map( -> $x,$y { $x, $dim - $y + 1 }).join: ','),
         :fill<black>, :transform("rotate(45, 300, 300)"), :style<stroke:#61D4FF>,
       ],
   ],

);</lang> See: Sierpinski-square-curve-perl6.svg (offsite SVG image)

Phix

<lang Phix>constant rule = "XF-F+F-XF+F+XF-F+F-X" string s = "F+F+XF+F+XF" for n=1 to 4 do

   string next = ""
   for i=1 to length(s) do
       integer ch = s[i]
       next &= iff(ch='X'?rule:ch)
   end for
   s = next

end for

sequence X = {}, Y= {} atom x=0, y=0, theta=PI/4, r = 6 string svg = "" for i=1 to length(s) do

   integer ch = s[i]
   switch ch do
       case 'F':   X &= x; x += r*cos(theta)
                   Y &= y; y += r*sin(theta)
       case '+':   theta += PI/2
       case '-':   theta -= PI/2
   end switch

end for constant svgfmt = """ <svg xmlns="http://www.w3.org/2000/svg" height="%d" width="%d">

<rect height="100%%" width="100%%" style="fill:black" />
<polyline points="%s" style="stroke: orange; stroke-width: 1" transform="translate(%d,%d)" />

</svg>""" string points = "" for i=1 to length(X) do

   points &= sprintf("%.2f,%.2f ",{X[i],Y[i]})

end for integer fn = open("sierpinski_square_curve.svg","w") atom xt = -min(X)+10,

    yt = -min(Y)+10

printf(fn,svgfmt,{max(X)+xt+10,max(Y)+yt+10,points,xt,yt}) close(fn)</lang>

Sidef

Uses the LSystem() class from Hilbert curve. <lang ruby>var rules = Hash(

   x => 'xF-F+F-xF+F+xF-F+F-x',

)

var lsys = LSystem(

   width:  510,
   height: 510,
   xoff: -505,
   yoff: -254,
   len:   4,
   angle: 90,
   color: 'dark green',

)

lsys.execute('F+xF+F+xF', 5, "sierpiński_square_curve.png", rules)</lang> Output image: Sierpiński square curve

zkl

Uses Image Magick and the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl <lang zkl>sierpinskiSquareCurve(4) : turtle(_);

fcn sierpinskiSquareCurve(n){ // Lindenmayer system --> Data of As

  var [const] A="AF-F+F-AF+F+AF-F+F-A", B="";  // Production rules
  var [const] Axiom="F+AF+F+AF";
  buf1,buf2 := Data(Void,Axiom).howza(3), Data().howza(3);  // characters
  do(n){
     buf1.pump(buf2.clear(),fcn(c){ if(c=="A") A else if(c=="B") B else c });
     t:=buf1; buf1=buf2; buf2=t;	// swap buffers
  }
  buf1		// n=4 --> 3,239 characters

}

fcn turtle(curve){ // a "square" turtle, directions are +-90*

  const D=10;
  ds,dir := T( T(D,0), T(0,-D), T(-D,0), T(0,D) ), 2; // turtle offsets
  dx,dy := ds[dir];
  img,color := PPM(650,650), 0x00ff00;  // green on black
  x,y := img.w/2, 10;
  curve.replace("A","").replace("B","");  // A & B are no-op during drawing
  foreach c in (curve){
     switch(c){

case("F"){ img.line(x,y, (x+=dx),(y+=dy), color) } // draw forward case("+"){ dir=(dir+1)%4; dx,dy = ds[dir] } // turn right 90* case("-"){ dir=(dir-1)%4; dx,dy = ds[dir] } // turn left 90*

     }
  }
  img.writeJPGFile("sierpinskiSquareCurve.zkl.jpg");

}</lang>

Output:

Offsite image at Sierpinski square curve of order 4