Sierpinski curve: Difference between revisions
→{{header|BASIC}}: Added QuickBASIC.
(→{{header|BASIC}}: Added QuickBASIC.) |
|||
(20 intermediate revisions by 12 users not shown) | |||
Line 4:
Produce a graphical or ASCII-art representation of a [[wp:Sierpiński_curve|Sierpinski curve]] of at least order 3.
=={{header|11l}}==
{{trans|C++}}
<syntaxhighlight lang="11l">T SierpinskiCurve
. Float x, y
. Int angle, length
. F line(out)
V theta = radians(Float(.angle))
.x += .length * cos(theta)
.y -= .length * sin(theta)
out.write(‘ L’gconvfmt(.x)‘,’gconvfmt(.y))
. F execute(out, s)
out.write(‘M’gconvfmt(.x)‘,’gconvfmt(.y))
L(c) s
S c
‘F’, ‘G’
.line(out)
‘+’
.angle = (.angle + 45) % 360
‘-’
.angle = (.angle - 45) % 360
. F :rewrite(s)
V t = ‘’
L(c) s
I c == ‘X’
t ‘’= ‘XF+G+XF--F--XF+G+X’
E
t ‘’= c
R t
F write(out, size, length, order)
.length = length
.x = length / sqrt(2)
.y = .x * 2
.angle = 45
out.write(‘<svg xmlns='http://www.w3.org/2000/svg' width='’size‘' height='’size"'>\n")
out.write("<rect width='100%' height='100%' fill='white'/>\n")
out.write(‘<path stroke-width='1' stroke='black' fill='none' d='’)
V s = ‘F--XF--F--XF’
L 0 .< order
s = .:rewrite(s)
.execute(out, s)
out.write("'/>\n</svg>\n")
V out = File(‘sierpinski_curve.svg’, WRITE)
SierpinskiCurve().write(out, 545, 7, 5)</syntaxhighlight>
{{out}}
Same as C++ output.
=={{header|Action!}}==
Action! language does not support recursion. Therefore an iterative approach with a stack has been proposed.
<
DEFINE N_="20+"
DEFINE E_="30+"
Line 169 ⟶ 222:
DO UNTIL CH#$FF OD
CH=$FF
RETURN</
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Sierpinski_curve.png Screenshot from Atari 8-bit computer]
=={{header|ALGOL W}}==
Using code from the [[Sierpinski arrowhead curve]] task.<br>
Curve algorithm based on the XPL0 sample.
<syntaxhighlight lang="algolw">
begin % draw sierpinski curves using ascii art %
integer CANVAS_WIDTH;
CANVAS_WIDTH := 200;
begin
% the ascii art canvas and related items %
string(1) array canvas ( 1 :: CANVAS_WIDTH, 1 :: CANVAS_WIDTH );
integer heading, asciiX, asciiY, width, maxX, maxY, minX, minY;
% draw a line using ascii art - the length is ignored and the heading determines the %
% character to use %
% the position is updated %
procedure drawLine( real value length ) ;
begin
% stores the min and max coordinates %
procedure updateCoordinateRange ;
begin
if asciiX > maxX then maxX := asciiX;
if asciiY > maxY then maxY := asciiY;
if asciiX < minX then minX := asciiX;
if asciiY < minY then minY := asciiY
end updateCoordinateRange ;
if heading = 0 then begin
updateCoordinateRange;
canvas( asciiX, asciiY ) := "_";
asciiX := asciiX + 1
end
else if heading = 45 then begin
updateCoordinateRange;
canvas( asciiX, asciiY ) := "/";
asciiY := asciiY - 1;
asciiX := asciiX + 1
end
else if heading = 90 then begin
updateCoordinateRange;
canvas( asciiX, asciiY ) := "|";
asciiY := asciiY - 1
end
else if heading = 135 then begin
asciiX := asciiX - 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "\";
asciiY := asciiY - 1
end
else if heading = 180 then begin
asciiX := asciiX - 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "_"
end
else if heading = 225 then begin
asciiX := asciiX - 1;
asciiY := asciiY + 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "/"
end
else if heading = 270 then begin
asciiY := asciiY + 1;
updateCoordinateRange;
canvas( asciiX - 1, asciiY ) := "|";
end
else if heading = 315 then begin
asciiY := asciiY + 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "\";
asciiX := asciiX + 1
end if_various_headings
end drawLine ;
% changes the heading by the specified angle ( in degrees ) - angle must be +/- 45 %
procedure turn( integer value angle ) ;
if angle > 0
then heading := ( heading + angle ) rem 360
else begin
heading := heading + angle;
if heading < 0 then heading := heading + 360
end tuen ;
% initialises the ascii art canvas %
procedure initArt ;
begin
heading := 0;
asciiX := CANVAS_WIDTH div 2;
asciiY := asciiX;
maxX := asciiX;
maxY := asciiY;
minX := asciiX;
minY := asciiY;
for x := 1 until CANVAS_WIDTH do for y := 1 until CANVAS_WIDTH do canvas( x, y ) := " "
end initArt ;
% shows the used parts of the canvas %
procedure drawArt ;
begin
for y := minY until maxY do begin
write();
for x := minX until maxX do writeon( canvas( x, y ) )
end for_y ;
write()
end drawIArt ;
% draws a sierpinski curve of the specified order and line length %
procedure sierpinskiCurve( integer value order ) ;
begin
% recursively draws a segment of the sierpinski curve %
procedure curve( integer value order; integer value angle ) ;
if 0 not = order then begin
turn( + angle );
curve( order - 1, - angle );
turn( - angle );
drawline( 1 );
if heading rem 180 = 0 then drawline( 1 );
turn( - angle );
curve( order - 1, - angle );
turn( + angle );
end curve ;
for Quad := 1 until 4 do begin
curve( order * 2, 45 );
turn( 45 );
drawline( 1 );
if heading rem 180 = 0 then drawline( 1 );
turn( 45 );
end for_Quad
end sierpinskiCurve ;
% draw curves %
i_w := 1; s_w := 0; % set output formatting %
for order := 3 do begin
write( "Sierpinski curve of order ", order );
write( "===========================" );
write();
initArt;
sierpinskiCurve( order );
drawArt
end for_order
end
end.
</syntaxhighlight>
{{out}}
<pre>
Sierpinski curve of order 3
===========================
/\__/\ /\__/\ /\__/\ /\__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \__/ __ \ / __ \__/ __ \
\/ \ / \/ \/ \ / \/
| | | |
/\__/ __ \__/\ /\__/ __ \__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \ / __ \__/ __ \ / __ \
\/ \/ \/ \ / \/ \/ \/
| |
/\__/\ /\__/ __ \__/\ /\__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \__/ __ \ / __ \__/ __ \
\/ \ / \/ \/ \ / \/
| | | |
/\__/ __ \__/\ /\__/ __ \__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \ / __ \ / __ \ / __ \
\/ \/ \/ \/ \/ \/ \/ \/
</pre>
=={{header|AutoHotkey}}==
{{trans|Go}}
Requires [https://www.autohotkey.com/boards/viewtopic.php?t=6517 Gdip Library]
<
SierpinskiH := 500
level := 5
Line 331 ⟶ 548:
ExitApp
Return
</syntaxhighlight>
=={{header|BASIC}}==
==={{header|FreeBASIC}}===
{{trans|XPL0}}
<syntaxhighlight lang="vb">#define pi 4 * Atn(1)
#define yellow Rgb(255,255,0)
Dim Shared As Integer posX, posY
Dim Shared As Single direc
Sub Dibuja(largo As Integer)
posX += Fix(largo * Cos(direc))
posY -= Fix(largo * Sin(direc))
Line - (posX, posY), yellow
End Sub
Sub Curva(orden As Integer, angulo As Single, long1 As Single, long2 As Single)
If orden <> 0 Then
direc += angulo
Curva(orden-1, -angulo, long1, long2)
direc -= angulo
Dibuja(long1)
direc -= angulo
Curva(orden-1, -angulo, long1, long2)
direc += angulo
End If
End Sub
Screenres 640, 480, 32
Dim As Single ang45 = pi / 4
Dim As Byte orden = 3
Dim As Byte tam = 20
direc = 0
posX = 640/4
posY = 3*480/4
Pset (posX, posY)
For c As Byte = 1 To 4
Curva(orden*2, ang45, tam/Sqr(2), 5*tam/6)
direc += ang45
Dibuja(tam/Sqr(2))
direc += ang45
Next
Windowtitle "Hit any key to end program"
Sleep</syntaxhighlight>
==={{header|QuickBASIC}}===
{{trans|XPL0}}
<syntaxhighlight lang="qbasic">
REM Sierpinski curve
DECLARE SUB Curve (Lev%, Ang!, L1!, L2!)
DECLARE SUB DrawLine (L!)
CONST Order = 3, Pi = 3.141592654#, Ang45 = Pi / 4!, Size = 20!
CONST Sqr2 = 1.4142135623731#
DIM SHARED Dir, PosX%, PosY%
SCREEN 12
PosX% = 640 \ 4: PosY% = 3 * 480 \ 4
PSET (PosX%, PosY%)
Dir = 0!
FOR Quad% = 1 TO 4
CALL Curve(Order * 2, Ang45, Size / Sqr2, 5! * Size / 6!)
Dir = Dir + Ang45
CALL DrawLine(Size / Sqr2)
Dir = Dir + Ang45
NEXT Quad%
END
SUB Curve (Lev%, Ang, L1, L2)
IF Lev% <> 0 THEN
Dir = Dir + Ang
CALL Curve(Lev% - 1, -Ang, L1, L2)
Dir = Dir - Ang
CALL DrawLine(L1)
Dir = Dir - Ang
CALL Curve(Lev% - 1, -Ang, L1, L2)
Dir = Dir + Ang
END IF
END SUB
SUB DrawLine (L)
PosX% = PosX% + INT(L * COS(Dir) + .5)
PosY% = PosY% - INT(L * SIN(Dir) + .5)
LINE -(PosX%, PosY%), 15
END SUB
</syntaxhighlight>
==={{header|Yabasic}}===
<syntaxhighlight lang="yabasic">// Rosetta Code problem: http://rosettacode.org/wiki/Sierpinski_curve
// Adapted from https://www.ocg.at/sites/ocg.at/files/EuroLogo2001/P74Batagelj.pdf to Yabasic by Galileo, 01/2022
import turtle
sub Sierp(n, a, h, k)
if n = 0 move(k) : return
turn(a) : Sierp(n - 1, -a, h, k) : turn(-a) : move(h)
turn(-a) : Sierp(n - 1, -a, h, k) : turn(a)
end sub
sub Sierpinski(n, d)
local i
pen(false)
goxy(10, 680)
pen(true)
color 255, 255, 0
for i = 1 to 4
Sierp(n, 45, d/sqrt(2), 5*d/6)
turn(45)
move(d/sqrt(2))
turn(45)
next
end sub
startTurtle()
Sierpinski(9, 12) </syntaxhighlight>
=={{header|C++}}==
Output is a file in SVG format. The curve is generated using the Lindenmayer system method.
<
#include <cmath>
#include <fstream>
Line 415 ⟶ 750:
s.write(out, 545, 7, 5);
return 0;
}</
{{out}}
[[Media:Sierpinski_curve_cpp.svg]]
=={{header|EasyLang}}==
[https://easylang.online/show/#cod=jZJNbsIwEIX3PsWTFXXRKBa0RSoLb+EQKAs3GLBqnMhOiXP7akgcIGXRle15n+fnaRpfV7ChDzo2sPqiLQRUNPU5g/+xOmS7EoIBONQeFm09UBQBoFwGCc7HJzFVBuMQWl+dlA9jrlEfEQOJJUKrG7wNGd1U7EYCMIcUNyUkquxBBaiYnBDkWJZz4str9Y3lQ1iwZ1ea5eWuSJJCp5pkiXJXVTDBmuTc3qsu6RE9lDvCuiPEkMEapzuzb09YiHcKnOuLJpD9wzBzGEbkG44BleBbfms6Ipeo6oC98XilujetJy0Y90yjrlITALSdKhV32eljIWmiv1w+4/J7TiSXRl9ogqKIm6K4HpxNuyWxA48cPG7ybT4RdOcoWVrN1Xwp2dz61QLrT3yssBBrxn4B Run it]
<syntaxhighlight>
proc lsysexp level . axiom$ rules$[] .
for l to level
an$ = ""
for c$ in strchars axiom$
for i = 1 step 2 to len rules$[]
if rules$[i] = c$
c$ = rules$[i + 1]
break 1
.
.
an$ &= c$
.
swap axiom$ an$
.
.
proc lsysdraw axiom$ x y ang lng . .
linewidth 0.3
move x y
for c$ in strchars axiom$
if c$ = "F" or c$ = "G"
x += cos dir * lng
y += sin dir * lng
line x y
elif c$ = "-"
dir -= ang
elif c$ = "+"
dir += ang
.
.
.
axiom$ = "F--xF--F--xF"
rules$[] = [ "x" "xF+G+xF--F--xF+G+x" ]
lsysexp 5 axiom$ rules$[]
lsysdraw axiom$ 50 98 45 0.9
</syntaxhighlight>
=={{header|Factor}}==
{{works with|Factor|0.99 2020-08-14}}
<
: curve ( L-system -- L-system )
Line 433 ⟶ 808:
} >>rules ;
[ <L-system> curve "Sierpinski curve" open-window ] with-ui</
Line 468 ⟶ 843:
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Sierpi%C5%84ski_curve}}
'''Solution'''
=== Recursive ===
[[File:Fōrmulæ - Sierpiński curve 01.png]]
'''Test cases'''
[[File:Fōrmulæ - Sierpiński curve 02.png]]
[[File:Fōrmulæ - Sierpiński curve 03.png]]
=== L-system ===
There are generic functions written in Fōrmulæ to compute an L-system in the page [[L-system#Fōrmulæ | L-system]].
The program that creates a Sierpiński curve is:
[[File:Fōrmulæ - L-system - Sierpiński curve 01.png]]
[[File:Fōrmulæ - L-system - Sierpiński curve 02.png]]
=={{header|Go}}==
Line 478 ⟶ 871:
{{trans|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.
<
import (
Line 595 ⟶ 988:
dc.Stroke()
dc.SavePNG("sierpinski_curve.png")
}</
=={{header|Java}}==
{{trans|C++}}
<
public class SierpinskiCurve {
Line 689 ⟶ 1,082:
private static final String PRODUCTION = "XF+G+XF--F--XF+G+X";
private static final int ANGLE = 45;
}</
{{out}}
[[Media:Sierpinski_curve_java.svg]]
=={{header|jq}}==
Line 705 ⟶ 1,098:
depending on the location of the included file, and the command-line
options used.
<
# Compute the curve using a Lindenmayer system of rules
Line 745 ⟶ 1,138:
sierpinski_curve(5)
| svg
</syntaxhighlight>
=={{header|Julia}}==
===Turtle procedural (lineto) version===
Modified from [https://craftofcoding.wordpress.com/2018/05/08/recursive-patterns-the-sierpinski-curve/ Craft of Coding blog, Processing version]
<
function sierpinski_curve(x0, y0, h, level)
Line 802 ⟶ 1,195:
finish()
preview()
</syntaxhighlight>
[[File:sierpinski-curve--drawing.png]]
===LSystem version===
<
sierpcurve = LSystem(Dict("X" => "XF+G+XF--F--XF+G+X"), "F--XF--F--XF")
Line 819 ⟶ 1,213:
showpreview = true
)
</syntaxhighlight>
=={{header|Lambdatalk}}==
<syntaxhighlight lang="scheme">
{def sierp
{def sierp.r
Line 861 ⟶ 1,255:
stroke="#000" fill="transparent" stroke-width="1"}}
}
</syntaxhighlight>
See the result in http://lambdaway.free.fr/lambdawalks/?view=sierpinsky
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<syntaxhighlight lang
=={{header|Nim}}==
{{trans|C++}}
We produce a SVG file using same algorithm as the one of C++ version.
<
type
Line 924 ⟶ 1,318:
var sc = SierpinskiCurve(file: outfile)
sc.write(545, 7, 5)
outfile.close()</
{{out}}
Line 930 ⟶ 1,324:
=={{header|Perl}}==
<
use warnings;
use SVG;
Line 967 ⟶ 1,361:
open my $fh, '>', 'sierpinski-curve.svg';
print $fh $svg->xmlify(-namespace=>'svg');
close $fh;</
See: [https://github.com/SqrtNegInf/Rosettacode-Perl5-Smoke/blob/master/ref/sierpinski-curve.svg sierpinski-curve.svg] (offsite SVG image)
Line 974 ⟶ 1,368:
{{libheader|Phix/online}}
You can run this online [http://phix.x10.mx/p2js/Sierpinski_curve.htm here].
<!--<
<span style="color: #000080;font-style:italic;">--
-- demo\rosetta\Sierpinski_curve.exw
Line 1,144 ⟶ 1,538:
<span style="color: #000000;">main</span><span style="color: #0000FF;">()</span>
<!--</
=={{header|Processing}}==
{{trans|Go}}
<syntaxhighlight lang="processing">
// https://rosettacode.org/wiki/Sierpinski_curve#C.2B.2B
Line 1,293 ⟶ 1,687:
}
}
</syntaxhighlight>
{{out}}
Offsite image at [https://github.com/rupertrussell/sierpinski_curve/blob/main/Sierpinski_Curve_Level5.png Sierpinski_Curve_Level5.png]
Line 1,300 ⟶ 1,694:
=={{header|Python}}==
<
import matplotlib.pyplot as plt
from matplotlib.colors import hsv_to_rgb as hsv
Line 1,330 ⟶ 1,724:
#curve('F', {'F': 'G-F-G', 'G': 'F+G+F'}, 60, 7)
#curve('A', {'A': '+BF-AFA-FB+', 'B': '-AF+BFB+FA-'}, 90, 6)
#curve('FX+FX+', {'X': 'X+YF', 'Y': 'FX-Y'}, 90, 12)</
Output in the plot window.
Line 1,336 ⟶ 1,730:
=={{header|Quackery}}==
<
[ stack ] is switch.arg ( --> [ )
Line 1,365 ⟶ 1,759:
5 times expand
[ $ "turtleduck.qky" loadfile ] now!
[ stack ] is switch.arg ( --> [ )
[ switch.arg put ] is switch ( x --> )
[ switch.arg release ] is otherwise ( --> )
[ switch.arg share
!= iff ]else[ done
otherwise ]'[ do ]done[ ] is case ( x --> )
[ $ "" swap witheach
[ nested quackery join ] ] is expand ( $ --> $ )
[ $ "L" ] is L ( $ --> $ )
[ $ "R" ] is R ( $ --> $ )
[ $ "F" ] is F ( $ --> $ )
[ $ "G" ] is G ( $ --> $ )
[ $ "AFLGLAFRRFRRAFLGLA" ] is A ( $ --> $ )
$ "FRRAFRRFRRAF"
4 times expand
turtle
10 frames
1 8 turn
witheach
[ switch
Line 1,372 ⟶ 1,798:
char A case [ ( ignore ) ]
otherwise [ 5 1 walk ] ] ]
-1 8 turn
1 frames</syntaxhighlight>
{{output}}
[[File:Quackery Sierpinski curve.png]]
=={{header|Raku}}==
Line 1,382 ⟶ 1,809:
{{works with|Rakudo|2020.02}}
<syntaxhighlight lang="raku"
role Lindenmayer {
Line 1,420 ⟶ 1,847:
],
],
);</
See: [https://github.com/thundergnat/rc/blob/master/img/sierpinski-curve-perl6.svg Sierpinski-curve-perl6.svg] (offsite SVG image)
=={{header|Rust}}==
Program output is a file in SVG format.
<
// svg = "0.8.0"
Line 1,507 ⟶ 1,934:
fn main() {
SierpinskiCurve::save("sierpinski_curve.svg", 545, 5).unwrap();
}</
{{out}}
[[Media:Sierpinski_curve_rust.svg]]
=={{header|Sidef}}==
Uses the '''LSystem()''' class from [https://rosettacode.org/wiki/Hilbert_curve#Sidef Hilbert curve].
<
x => 'xF+G+xF--F--xF+G+x',
)
Line 1,530 ⟶ 1,957:
)
lsys.execute('F--xF--F--xF', 5, "sierpiński_curve.png", rules)</
Output image: [https://github.com/trizen/rc/blob/master/img/sierpi%C5%84ski_curve-sidef.png Sierpiński curve]
Line 1,536 ⟶ 1,963:
{{trans|Go}}
{{libheader|DOME}}
<
import "dome" for Window
Line 1,664 ⟶ 2,091:
}
var Game = SierpinskiCurve.new(770, 770, 5, Color.blue, Color.yellow)</
{{out}}
[[File:Wren-Sierpinski_curve.png|400px]]
=={{header|XPL0}}==
[[File:SierpenXPL0.gif|200px|thumb|right]]
<syntaxhighlight lang "XPL0">int PosX, PosY;
real Dir;
proc Draw(Len);
real Len;
[PosX:= PosX + fix(Len*Cos(Dir));
PosY:= PosY - fix(Len*Sin(Dir));
Line(PosX, PosY, $E \yellow\);
];
proc Curve(Lev, Ang, Len1, Len2);
int Lev; real Ang, Len1, Len2;
[if Lev # 0 then
[Dir:= Dir + Ang;
Curve(Lev-1, -Ang, Len1, Len2);
Dir:= Dir - Ang;
Draw(Len1);
Dir:= Dir - Ang;
Curve(Lev-1, -Ang, Len1, Len2);
Dir:= Dir + Ang;
];
];
def Order=3, Pi=3.141592654, Ang45=Pi/4.0, Size=20.;
int Quad;
[SetVid($12); \VGA graphics: 640x480x8
PosX:= 640/4; PosY:= 3*480/4;
Move(PosX, PosY);
Dir:= 0.;
for Quad:= 1 to 4 do
[Curve(Order*2, Ang45, Size/Sqrt(2.), 5.*Size/6.);
Dir:= Dir + Ang45;
Draw(Size/Sqrt(2.));
Dir:= Dir + Ang45;
];
]</syntaxhighlight>
=={{header|zkl}}==
Uses Image Magick and
the PPM class from http://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#zkl
<
fcn sierpinskiCurve(order){
Line 1,729 ⟶ 2,168:
}
img.writeJPGFile("sierpinskiCurve.zkl.jpg");
}</
{{out}}
Offsite image at [http://www.zenkinetic.com/Images/RosettaCode/sierpinskiCurve.zkl.jpg Sierpinski curve order 5]
|