Sierpinski carpet: Difference between revisions
Added Fōrmulæ entry
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
(Added Fōrmulæ entry) |
||
| (17 intermediate revisions by 8 users not shown) | |||
Line 323:
###########################</pre>
=={{header|AppleScript}}==
===Functional===
{{Trans|JavaScript}}
(ES5 Functional version)
Line 696:
█ ██ ██ █
█████████</pre>
----
===Simple===
<syntaxhighlight lang="applescript">on SierpinskiCarpet(n, char)
if (n < 0) then return {}
script o
property lst1 : {char}
property lst2 : missing value
end script
set gap to space
repeat with k from 0 to (n - 1)
copy o's lst1 to o's lst2
repeat with i from 1 to (3 ^ k)
set str to o's lst1's item i
set o's lst1's item i to str & str & str
set o's lst2's item i to str & gap & str
end repeat
set o's lst1 to o's lst1 & o's lst2 & o's lst1
set gap to gap & gap & gap
end repeat
return join(o's lst1, linefeed)
end SierpinskiCarpet
on join(lst, delim)
set astid to AppleScript's text item delimiters
set AppleScript's text item delimiters to delim
set txt to lst as text
set AppleScript's text item delimiters to astid
return txt
end join
return SierpinskiCarpet(3, "#")</syntaxhighlight>
{{output}}
<pre>###########################
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################
######### #########
# ## ## # # ## ## #
######### #########
### ### ### ###
# # # # # # # #
### ### ### ###
######### #########
# ## ## # # ## ## #
######### #########
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################</pre>
=={{header|Arturo}}==
Line 939 ⟶ 985:
</pre>
=={{header|BASIC}}==
==={{header|Applesoft BASIC}}===
<syntaxhighlight lang="applesoftbasic"> 100 HGR
110 POKE 49234,0
120 DEF FN M(X) = X - INT (D * 3) * INT (X / INT (D * 3))
130 DE = 4
140 DI = 3 ^ DE * 3
150 FOR I = 0 TO DI - 1
160 FOR J = 0 TO DI - 1
170 FOR D = DI / 3 TO 0 STEP 0
180 IF INT ( FN M(I) / D) = 1 AND INT ( FN M(J) / D) = 1 THEN 200BREAK
190 D = INT (D / 3): NEXT D
200 HCOLOR= 3 * (D = 0)
210 HPLOT J,I
220 NEXT J
230 NEXT I</syntaxhighlight>
==={{header|BASIC256}}===
<syntaxhighlight lang="basic256">
function in_carpet(x, y)
Line 969 ⟶ 1,031:
</syntaxhighlight>
==={{header|BBC BASIC}}===
{{works with|BBC BASIC for Windows}}
<syntaxhighlight lang="bbcbasic"> Order% = 3
Line 991 ⟶ 1,052:
= TRUE</syntaxhighlight>
[[File:sierpinski_carpet_bbc.gif]]
==={{header|Commodore BASIC}}===
<syntaxhighlight lang="basic">100 PRINT CHR$(147); CHR$(18); "**** SIERPINSKI CARPET ****"
110 PRINT
120 INPUT "ORDER"; O$
130 O = VAL(O$)
140 IF O < 1 THEN 120
150 PRINT
160 SZ = 3 ↑ O
170 FOR Y = 0 TO SZ - 1
180 :FOR X = 0 TO SZ - 1
190 : CH$ = "#"
200 : X1 = X
210 : Y1 = Y
220 : IF (X1 = 0) OR (Y1 = 0) THEN 290
230 : X3 = X1 - 3 * INT(X1 / 3)
240 : Y3 = Y1 - 3 * INT(Y1 / 3)
250 : IF (X3 = 1) AND (Y3 = 1) THEN CH$ = " ": GOTO 290
260 : X1 = INT(X1 / 3)
270 : Y1 = INT(Y1 / 3)
280 : GOTO 220
290 : PRINT CH$;
300 :NEXT X
310 PRINT
320 NEXT Y
</syntaxhighlight>
{{Out}}
All of the Commodore 8-bits have a 25-line display, so orders 3 and up scroll the top of the carpet off the screen. Orders 4+ additionally require at least 81 columns, and even a PET or C128 maxes out at 80. So we'll settle for an order-2 demonstration:
<pre>**** SIERPINSKI CARPET ****
ORDER? 2
#########
# ## ## #
#########
### ###
# # # #
### ###
#########
# ## ## #
#########
READY.</pre>
You can get a more graphical display by replacing the <tt>"#"</tt> with <tt>CHR$(18)+CHR$(186)+CHR$(146)</tt>; for maximum portability it should also output a <tt>CHR$(142)</tt> at some earlier point, maybe by adding it to the otherwise-empty <tt>PRINT</tt> statement on line 110. Then the filled-in squares become mostly-solid blocks with narrow gaps along their right and bottom edges so you can still count them when adjacent.
==={{header|FreeBASIC}}===
{{trans|QB64}}
====ASCII version====
<syntaxhighlight lang="freebasic">
Function in_carpet(x As Uinteger, y As Uinteger) As Boolean
While x <> 0 And y <> 0
If(x Mod 3) = 1 And (y Mod 3) = 1 Then Return False
y = y \ 3: x = x \ 3
Wend
Return True
End Function
Sub carpet(n As Uinteger)
Dim As Uinteger i, j, k = (3^n)-1
For i = 0 To k
For j = 0 To k
If in_carpet(i, j) Then Print("#"); Else Print(" ");
Next j
Print
Next i
End Sub
For k As Byte = 0 To 4
Print !"\nN ="; k
carpet(k)
Next k
Sleep
</syntaxhighlight>
{{trans|QB64}}
====Graphic version====
<syntaxhighlight lang="freebasic">
Screenres 500, 545, 8
Windowtitle "Sierpinski Carpet"
Cls
Color 1, 15
Sub carpet (x As Integer, y As Integer, size As Integer, order As Integer)
Dim As Integer ix, iy, isize, iorder, side, newX, newY
ix = x: iy = y: isize = size: iorder = order
Line (ix, iy)-(ix + isize - 1, iy + isize - 1), 1, BF
side = Int(isize / 3)
newX = ix + side
newY = iy + side
Line (newX, newY)-(newX + side - 1, newY + side - 1), 15, BF
iorder -= 1
If iorder >= 0 Then
carpet(newX - side, newY - side + 1, side, iorder)
carpet(newX, newY - side + 1, side, iorder)
carpet(newX + side, newY - side + 1, side, iorder)
carpet(newX + side, newY, side, iorder)
carpet(newX + side, newY + side, side, iorder)
carpet(newX, newY + side, side, iorder)
carpet(newX - side, newY + side, side, iorder)
carpet(newX - side, newY, side, iorder)
End If
End Sub
carpet(5, 20, 243, 0)
carpet(253, 20, 243, 1)
carpet(5, 293, 243, 2)
carpet(253, 293, 243, 3)
Sleep
</syntaxhighlight>
==={{header|IS-BASIC}}===
<syntaxhighlight lang="is-basic">100 PROGRAM "Sierpins.bas"
110 LET O=3
120 LET SZ=3^O
130 FOR Y=0 TO SZ-1
140 FOR X=0 TO SZ-1
150 LET CH$=CHR$(159)
160 LET X1=X:LET Y1=Y
170 DO UNTIL X1=0
180 IF MOD(X1,3)=1 AND MOD(Y1,3)=1 THEN LET CH$=" ":EXIT DO
190 LET X1=INT(X1/3):LET Y1=INT(Y1/3)
200 LOOP
210 PRINT CH$;
220 NEXT
230 PRINT
240 NEXT </syntaxhighlight>
==={{header|Liberty BASIC}}===
{{works with|Just BASIC}}
<syntaxhighlight lang="lb">NoMainWin
WindowWidth = 508
WindowHeight = 575
Open "Sierpinski Carpets" For Graphics_nsb_nf As #g
#g "Down; TrapClose [halt]"
'labels
#g "Place 90 15;\Order 0"
#g "Place 340 15;\Order 1"
#g "Place 90 286;\Order 2"
#g "Place 340 286;\Order 3"
'carpets
Call carpet 5, 20, 243, 0
Call carpet 253, 20, 243, 1
Call carpet 5, 293, 243, 2
Call carpet 253, 293, 243, 3
#g "Flush"
Wait
[halt]
Close #g
End
Sub carpet x, y, size, order
#g "Color 0 0 128; BackColor 0 0 128"
#g "Place ";x;" ";y
#g "BoxFilled ";x+size-1;" ";y+size-1
#g "Color white; BackColor white"
side = Int(size/3)
newX = x+side
newY = y+side
#g "Place ";newX;" ";newY
#g "BoxFilled ";newX+side-1;" ";newY+side-1
order = order - 1
If order > -1 Then
Call carpet newX-side, newY-side+1, side, order
Call carpet newX, newY-side+1, side, order
Call carpet newX+side, newY-side+1, side, order
Call carpet newX+side, newY, side, order
Call carpet newX+side, newY+side, side, order
Call carpet newX, newY+side, side, order
Call carpet newX-side, newY+side, side, order
Call carpet newX-side, newY, side, order
End If
End Sub</syntaxhighlight>
==={{header|Minimal BASIC}}===
{{trans|BBC BASIC}}
Adapted to text mode. In some systems the screen scrolls for an order greater than 2.
{{works with|BASICA}}
{{works with|Commodore BASIC|3.5}}
{{works with|IS-BASIC}}
{{works with|Nascom ROM BASIC|4.7}}
<syntaxhighlight lang="basic" >
10 REM Sierpinski carpet
20 REM R - order; S - size.
30 LET R = 3
40 LET S = 3^R
50 FOR I = 0 TO S-1
60 FOR J = 0 TO S-1
70 LET X = J
80 LET Y = I
90 GOSUB 500
100 IF C = 1 THEN 130
110 PRINT " ";
120 GOTO 140
130 PRINT "*";
140 NEXT J
150 PRINT
160 NEXT I
170 END
490 REM Is (X,Y) in the carpet? Returns C = 0 (no) or C = 1 (yes).
500 LET C = 0
510 X3 = INT(X/3)
520 Y3 = INT(Y/3)
530 REM If (X mod 3 = 1) and (Y mod 3 = 1) then return
540 IF (X-X3*3)*(Y-Y3*3) = 1 THEN 600
550 LET X = X3
560 LET Y = Y3
570 IF X > 0 THEN 510
580 IF Y > 0 THEN 510
590 LET C = 1
600 RETURN
</syntaxhighlight>
==={{header|Nascom BASIC}}===
{{trans|BBC BASIC}}
{{works with|Nascom ROM BASIC|4.7}}
<syntaxhighlight lang="basic">
10 REM Sierpinski carpet
20 CLS
30 LET RDR=3
40 LET S=3^RDR
50 FOR I=0 TO S-1
60 FOR J=0 TO S-1
70 LET X=J
80 LET Y=I
90 GOSUB 300
100 IF C THEN SET(J,I)
110 NEXT J
120 NEXT I
130 REM ** Set up machine code INKEY$ command
140 IF PEEK(1)<>0 THEN RESTORE 410
150 DOKE 4100,3328:FOR A=3328 TO 3342 STEP 2
160 READ B:DOKE A,B:NEXT A
170 SCREEN 1,15
180 PRINT "Hit any key to exit.";
190 A=USR(0):IF A<0 THEN 190
200 CLS
210 END
290 REM ** Is (X,Y) in the carpet?
295 REM Returns C=0 (no) or C=1 (yes).
300 LET C=0
310 XD3=INT(X/3):YD3=INT(Y/3)
320 IF X-XD3*3=1 AND Y-YD3*3=1 THEN RETURN
330 LET X=XD3
340 LET Y=YD3
350 IF X>0 OR Y>0 THEN GOTO 310
360 LET C=1
370 RETURN
395 REM ** Data for machine code INKEY$
400 DATA 25055,1080,-53,536,-20665,3370,-5664,0
410 DATA 27085,14336,-13564,6399,18178,10927
420 DATA -8179,233
</syntaxhighlight>
==={{header|PureBasic}}===
{{trans|Python}}
<syntaxhighlight lang="purebasic">Procedure in_carpet(x,y)
While x>0 And y>0
If x%3=1 And y%3=1
ProcedureReturn #False
EndIf
y/3: x/3
Wend
ProcedureReturn #True
EndProcedure
Procedure carpet(n)
Define i, j, l=Pow(3,n)-1
For i=0 To l
For j=0 To l
If in_carpet(i,j)
Print("#")
Else
Print(" ")
EndIf
Next
PrintN("")
Next
EndProcedure</syntaxhighlight>
==={{header|QB64}}===
<syntaxhighlight lang="qb64">_Title "Sierpinski Carpet"
Screen _NewImage(500, 545, 8)
Cls , 15: Color 1, 15
'labels
_PrintString (96, 8), "Order 0"
_PrintString (345, 8), "Order 1"
_PrintString (96, 280), "Order 3"
_PrintString (345, 280), "Order 4"
'carpets
Call carpet(5, 20, 243, 0)
Call carpet(253, 20, 243, 1)
Call carpet(5, 293, 243, 2)
Call carpet(253, 293, 243, 3)
Sleep
System
Sub carpet (x As Integer, y As Integer, size As Integer, order As Integer)
Dim As Integer ix, iy, isize, iorder, side, newX, newY
ix = x: iy = y: isize = size: iorder = order
Line (ix, iy)-(ix + isize - 1, iy + isize - 1), 1, BF
side = Int(isize / 3)
newX = ix + side
newY = iy + side
Line (newX, newY)-(newX + side - 1, newY + side - 1), 15, BF
iorder = iorder - 1
If iorder >= 0 Then
Call carpet(newX - side, newY - side + 1, side, iorder)
Call carpet(newX, newY - side + 1, side, iorder)
Call carpet(newX + side, newY - side + 1, side, iorder)
Call carpet(newX + side, newY, side, iorder)
Call carpet(newX + side, newY + side, side, iorder)
Call carpet(newX, newY + side, side, iorder)
Call carpet(newX - side, newY + side, side, iorder)
Call carpet(newX - side, newY, side, iorder)
End If
End Sub</syntaxhighlight>
==={{header|Quite BASIC}}===
{{trans|BBC BASIC}}
In Quite BASIC, the point on the lower left on the canvas is 0, 0.
<syntaxhighlight lang="basic" >
10 REM Sierpinski carpet
20 CLS
30 LET R = 3
40 LET S = 1
50 FOR P = 1 TO R
60 LET S = 3 * S
70 NEXT P
80 REM Now S (size) is 3 to the power of R (order)
90 FOR I = 0 TO S - 1
100 FOR J = 0 TO S - 1
110 LET X = J
120 LET Y = I
130 GOSUB 300
140 IF C = 1 THEN PLOT J, I, "white"
150 NEXT J
160 NEXT I
170 END
300 REM Subroutine -- Is (X,Y) in the carpet?
310 REM Returns C = 0 (no) or C = 1 (yes).
320 LET C = 0
330 IF X % 3 = 1 AND Y % 3 = 1 THEN RETURN
340 LET X = FLOOR(X / 3)
350 LET Y = FLOOR(Y / 3)
360 IF X > 0 OR Y > 0 THEN GOTO 330
370 LET C = 1
380 RETURN
</syntaxhighlight>
==={{header|Sinclair ZX81 BASIC}}===
{{trans|BBC BASIC}}
Works with the unexpanded (1k RAM) ZX81. A screenshot of the output is [http://www.edmundgriffiths.com/zx81sierpcarpet.jpg here].
<syntaxhighlight lang="basic"> 10 LET O=3
20 LET S=3**O
30 FOR I=0 TO S-1
40 FOR J=0 TO S-1
50 LET X=J
60 LET Y=I
70 GOSUB 120
80 IF C THEN PLOT J,I
90 NEXT J
100 NEXT I
110 GOTO 190
120 LET C=0
130 IF X-INT (X/3)*3=1 AND Y-INT (Y/3)*3=1 THEN RETURN
140 LET X=INT (X/3)
150 LET Y=INT (Y/3)
160 IF X>0 OR Y>0 THEN GOTO 130
170 LET C=1
180 RETURN</syntaxhighlight>
==={{header|Tiny BASIC}}===
{{trans|Minimal BASIC}}
In some systems the screen scrolls for an order greater than 2.
{{works with|TinyBasic}}
<syntaxhighlight lang="basic">
10 REM SIERPINSKI CARPET
20 REM R - ORDER; S - SIZE.
30 LET R=3
40 LET S=1
50 LET P=1
60 IF P>R THEN GOTO 100
70 LET S=3*S
80 LET P=P+1
90 GOTO 60
100 REM NOW S IS 3 TO THE POWER OF R
110 LET I=0
120 LET J=0
130 LET X=J
140 LET Y=I
150 GOSUB 500
160 IF C=1 THEN GOTO 190
170 PRINT " ";
180 GOTO 200
190 PRINT "*";
200 LET J=J+1
210 IF J=S THEN GOTO 230
220 GOTO 130
230 PRINT
240 LET I=I+1
250 IF I=S THEN GOTO 270
260 GOTO 120
270 END
490 REM IS (X,Y) IN THE CARPET? RETURNS C = 0 (NO) OR C = 1 (YES).
500 LET C=0
510 W=X/3
520 Z=Y/3
530 IF X-W*3=1 IF Y-Z*3=1 THEN RETURN
540 LET X=W
550 LET Y=Z
560 IF X>0 THEN GOTO 510
570 IF Y>0 THEN GOTO 510
580 LET C=1
590 RETURN
</syntaxhighlight>
{{out}}
<pre>
***************************
* ** ** ** ** ** ** ** ** *
***************************
*** ****** ****** ***
* * * ** * * ** * * *
*** ****** ****** ***
***************************
* ** ** ** ** ** ** ** ** *
***************************
********* *********
* ** ** * * ** ** *
********* *********
*** *** *** ***
* * * * * * * *
*** *** *** ***
********* *********
* ** ** * * ** ** *
********* *********
***************************
* ** ** ** ** ** ** ** ** *
***************************
*** ****** ****** ***
* * * ** * * ** * * *
*** ****** ****** ***
***************************
* ** ** ** ** ** ** ** ** *
***************************
</pre>
==={{header|uBasic/4tH}}===
<syntaxhighlight lang="text">Input "Carpet order: ";n
l = (3^n) - 1
For i = 0 To l
For j = 0 To l
Push i,j
Gosub 100
If Pop() Then
Print "#";
Else
Print " ";
EndIf
Next
Print
Next
End
100 y = Pop(): x = Pop() : Push 1
Do While (x > 0) * (y > 0)
If (x % 3 = 1) * (y % 3 = 1) Then
Push (Pop() - 1)
Break
EndIf
y = y / 3
x = x / 3
Loop
Return</syntaxhighlight>
==={{header|VBA}}===
{{trans|Phix}}<syntaxhighlight lang="vb">Const Order = 4
Function InCarpet(ByVal x As Integer, ByVal y As Integer)
Do While x <> 0 And y <> 0
If x Mod 3 = 1 And y Mod 3 = 1 Then
InCarpet = " "
Exit Function
End If
x = x \ 3
y = y \ 3
Loop
InCarpet = "#"
End Function
Public Sub sierpinski_carpet()
Dim i As Integer, j As Integer
For i = 0 To 3 ^ Order - 1
For j = 0 To 3 ^ Order - 1
Debug.Print InCarpet(i, j);
Next j
Debug.Print
Next i
End Sub</syntaxhighlight>{{out}}
<pre>#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################
### ###### ###### ###### ###### ###### ###### ###### ###### ###
# # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # #
### ###### ###### ###### ###### ###### ###### ###### ###### ###
#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################
######### ################## ################## #########
# ## ## # # ## ## ## ## ## # # ## ## ## ## ## # # ## ## #
######### ################## ################## #########
### ### ### ###### ### ### ###### ### ### ###
# # # # # # # ## # # # # # # ## # # # # # # #
### ### ### ###### ### ### ###### ### ### ###
######### ################## ################## #########
# ## ## # # ## ## ## ## ## # # ## ## ## ## ## # # ## ## #
######### ################## ################## #########
#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################
### ###### ###### ###### ###### ###### ###### ###### ###### ###
# # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # #
### ###### ###### ###### ###### ###### ###### ###### ###### ###
#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################
########################### ###########################
# ## ## ## ## ## ## ## ## # # ## ## ## ## ## ## ## ## #
########################### ###########################
### ###### ###### ### ### ###### ###### ###
# # # ## # # ## # # # # # # ## # # ## # # #
### ###### ###### ### ### ###### ###### ###
########################### ###########################
# ## ## ## ## ## ## ## ## # # ## ## ## ## ## ## ## ## #
########################### ###########################
######### ######### ######### #########
# ## ## # # ## ## # # ## ## # # ## ## #
######### ######### ######### #########
### ### ### ### ### ### ### ###
# # # # # # # # # # # # # # # #
### ### ### ### ### ### ### ###
######### ######### ######### #########
# ## ## # # ## ## # # ## ## # # ## ## #
######### ######### ######### #########
########################### ###########################
# ## ## ## ## ## ## ## ## # # ## ## ## ## ## ## ## ## #
########################### ###########################
### ###### ###### ### ### ###### ###### ###
# # # ## # # ## # # # # # # ## # # ## # # #
### ###### ###### ### ### ###### ###### ###
########################### ###########################
# ## ## ## ## ## ## ## ## # # ## ## ## ## ## ## ## ## #
########################### ###########################
#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################
### ###### ###### ###### ###### ###### ###### ###### ###### ###
# # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # #
### ###### ###### ###### ###### ###### ###### ###### ###### ###
#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################
######### ################## ################## #########
# ## ## # # ## ## ## ## ## # # ## ## ## ## ## # # ## ## #
######### ################## ################## #########
### ### ### ###### ### ### ###### ### ### ###
# # # # # # # ## # # # # # # ## # # # # # # #
### ### ### ###### ### ### ###### ### ### ###
######### ################## ################## #########
# ## ## # # ## ## ## ## ## # # ## ## ## ## ## # # ## ## #
######### ################## ################## #########
#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################
### ###### ###### ###### ###### ###### ###### ###### ###### ###
# # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # ## # # #
### ###### ###### ###### ###### ###### ###### ###### ###### ###
#################################################################################
# ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## ## #
#################################################################################</pre>
==={{header|VBScript}}===
<syntaxhighlight lang="vbscript">Function InCarpet(i,j)
If i > 0 And j > 0 Then
Do While i > 0 And j > 0
If i Mod 3 = 1 And j Mod 3 = 1 Then
InCarpet = " "
Exit Do
Else
InCarpet = "#"
End If
i = Int(i / 3)
j = Int(j / 3)
Loop
Else
InCarpet = "#"
End If
End Function
Function Carpet(n)
k = 3^n - 1
x2 = 0
y2 = 0
For y = 0 To k
For x = 0 To k
x2 = x
y2 = y
WScript.StdOut.Write InCarpet(x2,y2)
Next
WScript.StdOut.WriteBlankLines(1)
Next
End Function
Carpet(WScript.Arguments(0))</syntaxhighlight>
{{out}}
<pre>F:\VBScript>cscript /nologo RosettaCode-Sierpinski_Carpet.vbs 3
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################
######### #########
# ## ## # # ## ## #
######### #########
### ### ### ###
# # # # # # # #
### ### ### ###
######### #########
# ## ## # # ## ## #
######### #########
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################</pre>
==={{header|Yabasic}}===
<syntaxhighlight lang="yabasic">sub sp$(n)
local i, s$
for i = 1 to n
s$ = s$ + " "
next i
return s$
end sub
sub replace$(s$, cf$, cr$)
local i, p
do
i = instr(s$, cf$, p)
if not i break
mid$(s$, i, 1) = cr$
p = i
loop
return s$
end sub
sub foreach$(carpet$, p$, m)
local n, i, t$(1)
n = token(carpet$, t$(), ",")
for i = 1 to n
switch(m)
case 0: p$ = p$ + "," + t$(i) + t$(i) + t$(i) : break
case 1: p$ = p$ + "," + t$(i) + sp$(len(t$(i))) + t$(i) : break
default: error "Method not found!" : break
end switch
next i
return p$
end sub
sub sierpinskiCarpet$(n)
local carpet$, next$, i
carpet$ = "@"
for i = 1 to n
next$ = foreach$(carpet$, "")
next$ = foreach$(carpet$, next$, 1)
carpet$ = foreach$(carpet$, next$)
next i
return carpet$
end sub
print replace$(sierpinskiCarpet$(3), ",", "\n")</syntaxhighlight>
=={{header|Befunge}}==
Line 1,519 ⟶ 2,294:
(println (carpet 3))</syntaxhighlight>
=={{header|Common Lisp}}==
Line 1,845 ⟶ 2,574:
}
}</syntaxhighlight>
=={{header|EasyLang}}==
[https://easylang.dev/ide/#cod=dY+xDsIwDER3f8XtEcEQlQ3+JZhCEYVUKSDo1xOHIDGklgffnf2iDDEIxMcBL7wxTrCwBOAanm2yFmotsU7Zb9Q0tnJXOU6qzkedd2DbqEzVYfvddsUoL2RGQXXVqO6ayoGZZ5kqy8yz6pj/XUuW9l4upxgetwOYmaRvfSQJfYjYOEf5qmHtFXP+/Ac= Run it]
<syntaxhighlight lang="easylang">
proc carp x y sz . .
move x - sz / 2 y - sz / 2
rect sz sz
if sz > 0.5
h = sz / 3
carp x - sz y - sz h
carp x - sz y h
carp x - sz y + sz h
carp x + sz y - sz h
carp x + sz y h
carp x + sz y + sz h
carp x y - sz h
carp x y + sz h
.
.
background 000
clear
color 633
carp 50 50 100 / 3
</syntaxhighlight>
=={{header|Elixir}}==
Line 2,568 ⟶ 3,323:
end program Sierpinski_carpet</syntaxhighlight>
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/L-system}}
'''Solution'''
It can be done using an [[wp:L-system|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 carpet is:
[[File:Fōrmulæ - L-system - Sierpiński carpet 01.png]]
[[File:Fōrmulæ - L-system - Sierpiński carpet 02.png]]
=={{header|Gnuplot}}==
Line 3,938 ⟶ 4,636:
}
}</syntaxhighlight>
=={{header|Lambdatalk}}==
<syntaxhighlight lang="Scheme">
{def sierpinsky
{def sierpinsky.r
{lambda {:n :w}
{if {= :n 0}
then :w
else {sierpinsky.r
{- :n 1}
{S.map {lambda {:x} :x:x:x} :w}
{S.map {lambda {:x} :x{S.replace ■ by o in :x}:x} :w}
{S.map {lambda {:x} :x:x:x} :w} }}}}
{lambda {:n}
{h2 n=:n}{S.replace o by space in
{S.replace \s by {div} in
{sierpinsky.r :n ■}}}}}
-> sierpinsky
{S.map sierpinsky 0 1 2 3}
->
S0
■
S1
■■■
■ ■
■■■
S2
■■■■■■■■■
■ ■■ ■■ ■
■■■■■■■■■
■■■ ■■■
■ ■ ■ ■
■■■ ■■■
■■■■■■■■■
■ ■■ ■■ ■
■■■■■■■■■
S3
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■■■ ■■■■■■ ■■■■■■ ■■■
■ ■ ■ ■■ ■ ■ ■■ ■ ■ ■
■■■ ■■■■■■ ■■■■■■ ■■■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■■■■■■■■■ ■■■■■■■■■
■ ■■ ■■ ■ ■ ■■ ■■ ■
■■■■■■■■■ ■■■■■■■■■
■■■ ■■■ ■■■ ■■■
■ ■ ■ ■ ■ ■ ■ ■
■■■ ■■■ ■■■ ■■■
■■■■■■■■■ ■■■■■■■■■
■ ■■ ■■ ■ ■ ■■ ■■ ■
■■■■■■■■■ ■■■■■■■■■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■■■ ■■■■■■ ■■■■■■ ■■■
■ ■ ■ ■■ ■ ■ ■■ ■ ■ ■
■■■ ■■■■■■ ■■■■■■ ■■■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
</syntaxhighlight>
=={{header|Lua}}==
Line 4,091 ⟶ 4,860:
■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■
■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■ ■</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Line 4,181 ⟶ 4,903:
# ## ## ## ## ## ## ## ## #
###########################</pre>
=={{header|NetRexx}}==
Line 5,249 ⟶ 5,929:
{{out}}
[[Media:Sierpinski_carpet_prolog.svg]]
=={{header|Python}}==
Line 5,504 ⟶ 6,158:
▓▓ ▓▓▓▓ ▓▓▓▓ ▓▓▓▓ ▓▓▓▓ ▓▓▓▓ ▓▓▓▓ ▓▓▓▓ ▓▓▓▓ ▓▓
▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓</pre>
=={{header|Quackery}}==
Line 6,186 ⟶ 6,795:
}
say c.join("\n")</syntaxhighlight>
=={{header|Swift}}==
Line 6,252 ⟶ 6,839:
puts [sierpinski_carpet 3]</syntaxhighlight>
=={{header|UNIX Shell}}==
Line 6,449 ⟶ 7,005:
</pre>
=={{header|
{{trans|Kotlin}}
<syntaxhighlight lang="Zig">
import math
fn main() {
carpet(3)
}
fn carpet(n int) {
power := int(math.pow(3.0, n))
if in_carpet(i, j) == true {print("*")} else{print(" ")}
}
println('')
}
}
fn in_carpet(x int, y int) bool {
mut xx := x
mut yy := y
for xx != 0 && yy != 0 {
if xx % 3 == 1 && yy % 3 == 1 {return false}
xx /= 3
yy /= 3
}
return true
}
</syntaxhighlight>
{{out}}
<pre>
***************************
* ** ** ** ** ** ** ** ** *
***************************
*** ****** ****** ***
***************************
* ** ** ** ** ** ** ** ** *
***************************
********* *********
***************************
* ** ** ** ** ** ** ** ** *
***************************
*** ****** ****** ***
***************************
* ** ** ** ** ** ** ** ** *
***************************
</pre>
=={{header|Wren}}==
{{trans|Python}}
<syntaxhighlight lang="
while (true) {
if (x == 0 || y == 0) return true
Line 6,914 ⟶ 7,362:
SetVid($3); \restore normal text mode
]</syntaxhighlight>
=={{header|Z80 Assembly}}==
| |||