aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Task/Sierpinski-carpet/00-META.yaml Normal file
View file

@ -0,0 +1,3 @@
---
from: http://rosettacode.org/wiki/Sierpinski_carpet
note: Fractals

44
Task/Sierpinski-carpet/00-TASK.txt Normal file
View file

@ -0,0 +1,44 @@
;Task
Produce a graphical or ASCII-art representation of a [[wp:Sierpinski carpet|Sierpinski carpet]] of order   '''N'''.
For example, the Sierpinski carpet of order   '''3'''   should look like this:
<pre>
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################
######### #########
# ## ## # # ## ## #
######### #########
### ### ### ###
# # # # # # # #
### ### ### ###
######### #########
# ## ## # # ## ## #
######### #########
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################
</pre>
The use of the &nbsp; # &nbsp; character is not rigidly required for ASCII art.
The important requirement is the placement of whitespace and non-whitespace characters.
;Related task:
* &nbsp; [[Sierpinski triangle]]
<br><br>

9
Task/Sierpinski-carpet/11l/sierpinski-carpet.11l Normal file
View file

@ -0,0 +1,9 @@
F sierpinski_carpet(n)
V carpet = [String(‘#’)]
L 1..n
carpet = carpet.map(x -> x‘’x‘’x)
[+] carpet.map(x -> x‘’x.replace(‘#’, ‘ ’)‘’x)
[+] carpet.map(x -> x‘’x‘’x)
R carpet.join("\n")
print(sierpinski_carpet(3))

29
Task/Sierpinski-carpet/ALGOL-68/sierpinski-carpet.alg Normal file
View file

@ -0,0 +1,29 @@
PROC in carpet = (INT in x, in y)BOOL: (
INT x := in x, y := in y;
BOOL out;
DO
IF x = 0 OR y = 0 THEN
out := TRUE; GO TO stop iteration
ELIF x MOD 3 = 1 AND y MOD 3 = 1 THEN
out := FALSE; GO TO stop iteration
FI;
x %:= 3;
y %:= 3
OD;
stop iteration: out
);
PROC carpet = (INT n)VOID:
FOR i TO 3 ** n DO
FOR j TO 3 ** n DO
IF in carpet(i-1, j-1) THEN
print("* ")
ELSE
print(" ")
FI
OD;
print(new line)
OD;
carpet(3)

19
Task/Sierpinski-carpet/ALGOL-W/sierpinski-carpet.alg Normal file
View file

@ -0,0 +1,19 @@
begin
for depth := 3 do begin
integer dim;
dim := 1;
for i := 0 until depth - 1 do dim := dim * 3;
for i := 0 until dim - 1 do begin
for j := 0 until dim - 1 do begin
integer d;
d := dim div 3;
while d not = 0
and not ( ( i rem ( d * 3 ) ) div d = 1 and ( j rem ( d * 3 ) ) div d = 1 )
do d := d div 3;
writeon( if d not = 0 then " " else "##" )
end for_j;
write()
end for_i;
write()
end for_depth
end.

1
Task/Sierpinski-carpet/APL/sierpinski-carpet.apl Normal file
View file

@ -0,0 +1 @@
carpet←{{⊃⍪/,⌿3 3⍴4 0 4\⊂⍵}⍣⍵⊢⍪'#'}

64
Task/Sierpinski-carpet/AWK/sierpinski-carpet.awk Normal file
View file

@ -0,0 +1,64 @@
# WSC.AWK - Waclaw Sierpinski's carpet contributed by Dan Nielsen
#
# syntax: GAWK -f WSC.AWK [-v o={a|A}{b|B}] [-v X=anychar] iterations
#
# -v o=ab default
# a|A loose weave | tight weave
# b|B don't show | show how the carpet is built
# -v X=? Carpet is built with X's. The character assigned to X replaces all X's.
#
# iterations
# The number of iterations. The default is 0 which produces one carpet.
#
# what is the difference between a loose weave and a tight weave:
# loose tight
# X X X X X X X X X XXXXXXXXX
# X X X X X X X XX XX X
# X X X X X X X X X XXXXXXXXX
# X X X X X X XXX XXX
# X X X X X X X X
# X X X X X X XXX XXX
# X X X X X X X X X XXXXXXXXX
# X X X X X X X XX XX X
# X X X X X X X X X XXXXXXXXX
#
# examples:
# GAWK -f WSC.AWK 2
# GAWK -f WSC.AWK -v o=Ab -v X=# 2
# GAWK -f WSC.AWK -v o=Ab -v X=\xDB 2
#
BEGIN {
optns = (o == "") ? "ab" : o
n = ARGV[1] + 0 # iterations
if (n !~ /^[0-9]+$/) { exit(1) }
seed = (optns ~ /A/) ? "XXX,X X,XXX" : "X X X ,X X ,X X X " # tight/loose weave
leng = row = split(seed,A,",") # seed the array
for (i=1; i<=n; i++) { # build carpet
for (a=1; a<=3; a++) {
row = 0
for (b=1; b<=3; b++) {
for (c=1; c<=leng; c++) {
row++
tmp = (a == 2 && b == 2) ? sprintf("%*s",length(A[c]),"") : A[c]
B[row] = B[row] tmp
}
if (optns ~ /B/) { # show how the carpet is built
if (max_row < row+0) { max_row = row }
for (r=1; r<=max_row; r++) {
printf("i=%d row=%02d a=%d b=%d '%s'\n",i,r,a,b,B[r])
}
print("")
}
}
}
leng = row
for (j=1; j<=row; j++) { A[j] = B[j] } # re-seed the array
for (j in B) { delete B[j] } # delete work array
}
for (j=1; j<=row; j++) { # print carpet
if (X != "") { gsub(/X/,substr(X,1,1),A[j]) }
sub(/ +$/,"",A[j])
printf("%s\n",A[j])
}
exit(0)
}

44
Task/Sierpinski-carpet/Action-/sierpinski-carpet.action Normal file
View file

@ -0,0 +1,44 @@
BYTE FUNC InCarpet(BYTE x,y)
DO
IF x MOD 3=1 AND y MOD 3=1 THEN
RETURN (0)
FI
x==/3 y==/3
UNTIL x=0 AND y=0
OD
RETURN (1)
PROC DrawCarpet(INT x0 BYTE y0,depth)
BYTE i,x,y,size
size=1
FOR i=1 TO depth
DO size==*3 OD
FOR y=0 TO size-1
DO
FOR x=0 TO size-1
DO
IF InCarpet(x,y) THEN
Plot(x0+2*x,y0+2*y)
Plot(x0+2*x+1,y0+2*y)
Plot(x0+2*x+1,y0+2*y+1)
Plot(x0+2*x,y0+2*y+1)
FI
OD
OD
RETURN
PROC Main()
BYTE CH=$02FC,COLOR1=$02C5,COLOR2=$02C6
Graphics(8+16)
Color=1
COLOR1=$0C
COLOR2=$02
DrawCarpet(79,15,4)
DO UNTIL CH#$FF OD
CH=$FF
RETURN

76
Task/Sierpinski-carpet/Ada/sierpinski-carpet.ada Normal file
View file

@ -0,0 +1,76 @@
with Ada.Text_Io; use Ada.Text_Io;
procedure Sierpinski_Carpet is
subtype Index_Type is Integer range 1..81;
type Pattern_Array is array(Index_Type range <>, Index_Type range <>) of Boolean;
Pattern : Pattern_Array(1..81,1..81) := (Others =>(others => true));
procedure Clear_Center(P : in out Pattern_Array; X1 : Index_Type; X2 : Index_Type;
Y1 : Index_Type; Y2 : Index_Type) is
Xfirst : Index_Type;
Xlast : Index_Type;
Yfirst : Index_Type;
Ylast : Index_Type;
Diff : Integer;
begin
Xfirst :=(X2 - X1 + 1) / 3 + X1;
Diff := Xfirst - X1;
Xlast := Xfirst + Diff;
Yfirst := (Y2 - Y1) / 3 + Y1;
YLast := YFirst + Diff;
for I in XFirst..XLast loop
for J in YFirst..YLast loop
P(I, J) := False;
end loop;
end loop;
end Clear_Center;
procedure Print(P : Pattern_Array) is
begin
for I in P'range(1) loop
for J in P'range(2) loop
if P(I,J) then
Put('*');
else
Put(' ');
end if;
end loop;
New_Line;
end loop;
end Print;
procedure Divide_Square(P : in out Pattern_Array; Order : Positive) is
Factor : Natural := 0;
X1, X2 : Index_Type;
Y1, Y2 : Index_Type;
Division : Index_Type;
Num_Sections : Index_Type;
begin
while Factor < Order loop
Num_Sections := 3**Factor;
Factor := Factor + 1;
X1 := P'First;
Division := P'Last / Num_Sections;
X2 := Division;
Y1 := X1;
Y2 := X2;
loop
loop
Clear_Center(P, X1, X2, Y1, Y2);
exit when X2 = P'Last;
X1 := X2;
X2 := X2 + Division;
end loop;
exit when Y2 = P'Last;
Y1 := Y2;
Y2 := Y2 + Division;
X1 := P'First;
X2 := Division;
end loop;
end loop;
end Divide_Square;
begin
Divide_Square(Pattern, 3);
Print(Pattern);
end Sierpinski_Carpet;

125
Task/Sierpinski-carpet/AppleScript/sierpinski-carpet-1.applescript Normal file
View file

@ -0,0 +1,125 @@
----------------------- CARPET MODEL ---------------------
-- sierpinskiCarpet :: Int -> [[Bool]]
on sierpinskiCarpet(n)
-- rowStates :: Int -> [Bool]
script rowStates
on |λ|(x, _, xs)
-- cellState :: Int -> Bool
script cellState
-- inCarpet :: Int -> Int -> Bool
on inCarpet(x, y)
if (0 = x or 0 = y) then
true
else
not ((1 = x mod 3) and ¬
(1 = y mod 3)) and ¬
inCarpet(x div 3, y div 3)
end if
end inCarpet
on |λ|(y)
inCarpet(x, y)
end |λ|
end script
map(cellState, xs)
end |λ|
end script
map(rowStates, enumFromTo(0, (3 ^ n) - 1))
end sierpinskiCarpet
--------------------------- TEST -------------------------
on run
-- Carpets of orders 1, 2, 3
set strCarpets to ¬
intercalate(linefeed & linefeed, ¬
map(showCarpet, enumFromTo(1, 3)))
set the clipboard to strCarpets
return strCarpets
end run
---------------------- CARPET DISPLAY --------------------
-- showCarpet :: Int -> String
on showCarpet(n)
-- showRow :: [Bool] -> String
script showRow
-- showBool :: Bool -> String
script showBool
on |λ|(bool)
if bool then
character id 9608
else
" "
end if
end |λ|
end script
on |λ|(xs)
intercalate("", map(my showBool, xs))
end |λ|
end script
intercalate(linefeed, map(showRow, sierpinskiCarpet(n)))
end showCarpet
-------------------- GENERIC FUNCTIONS -------------------
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if m ≤ n then
set xs to {}
repeat with i from m to n
set end of xs to i
end repeat
xs
else
{}
end if
end enumFromTo
-- intercalate :: Text -> [Text] -> Text
on intercalate(strText, lstText)
set {dlm, my text item delimiters} to {my text item delimiters, strText}
set strJoined to lstText as text
set my text item delimiters to dlm
return strJoined
end intercalate
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn

188
Task/Sierpinski-carpet/AppleScript/sierpinski-carpet-2.applescript Normal file
View file

@ -0,0 +1,188 @@
-- weave :: [String] -> [String]
on weave(xs)
script thread
property f : zipWith(my append)
on |λ|(x)
f's |λ|(f's |λ|(xs, x), xs)
end |λ|
end script
script blank
on |λ|(x)
replicate(length of x, space)
end |λ|
end script
concatMap(thread, {xs, map(blank, xs), xs})
end weave
-- TEST ---------------------------------------------------
on run
-- sierpinksi :: Int -> String
script sierpinski
on |λ|(n)
unlines(item n of take(n, ¬
iterate(weave, {character id 9608})))
end |λ|
end script
sierpinski's |λ|(3)
end run
-- GENERIC ABSTRACTIONS -----------------------------------
-- Append two lists.
-- append (++) :: [a] -> [a] -> [a]
-- append (++) :: String -> String -> String
on append(xs, ys)
xs & ys
end append
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & |λ|(item i of xs, i, xs)
end repeat
end tell
return acc
end concatMap
-- iterate :: (a -> a) -> a -> Gen [a]
on iterate(f, x)
script
property v : missing value
property g : mReturn(f)'s |λ|
on |λ|()
if missing value is v then
set v to x
else
set v to g(v)
end if
return v
end |λ|
end script
end iterate
-- length :: [a] -> Int
on |length|(xs)
set c to class of xs
if list is c or string is c then
length of xs
else
(2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
end if
end |length|
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs, i, xs)
end repeat
return lst
end tell
end map
-- min :: Ord a => a -> a -> a
on min(x, y)
if y < x then
y
else
x
end if
end min
-- replicate :: Int -> String -> String
on replicate(n, s)
set out to ""
if n < 1 then return out
set dbl to s
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
set c to class of xs
if list is c then
if 0 < n then
items 1 thru min(n, length of xs) of xs
else
{}
end if
else if string is c then
if 0 < n then
text 1 thru min(n, length of xs) of xs
else
""
end if
else if script is c then
set ys to {}
repeat with i from 1 to n
set v to xs's |λ|()
if missing value is v then
return ys
else
set end of ys to v
end if
end repeat
return ys
else
missing value
end if
end take
-- unlines :: [String] -> String
on unlines(xs)
set {dlm, my text item delimiters} to ¬
{my text item delimiters, linefeed}
set str to xs as text
set my text item delimiters to dlm
str
end unlines
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f)
script
on |λ|(xs, ys)
set lng to min(|length|(xs), |length|(ys))
if 1 > lng then return {}
set xs_ to take(lng, xs) -- Allow for non-finite
set ys_ to take(lng, ys) -- generators like cycle etc
set lst to {}
tell mReturn(f)
repeat with i from 1 to lng
set end of lst to |λ|(item i of xs_, item i of ys_)
end repeat
return lst
end tell
end |λ|
end script
end zipWith

14
Task/Sierpinski-carpet/Applesoft-BASIC/sierpinski-carpet.basic Normal file
View file

@ -0,0 +1,14 @@
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

25
Task/Sierpinski-carpet/Arturo/sierpinski-carpet.arturo Normal file
View file

@ -0,0 +1,25 @@
inCarpet?: function [x,y][
X: x
Y: y
while [true][
if or? zero? X
zero? Y -> return true
if and? 1 = X % 3
1 = Y % 3 -> return false
X: X / 3
Y: Y / 3
]
]
carpet: function [n][
loop 0..dec 3^n 'i [
loop 0..dec 3^n 'j [
prints (inCarpet? i j)? -> "# "
-> " "
]
print ""
]
]
carpet 3

50
Task/Sierpinski-carpet/Asymptote/sierpinski-carpet.asymptote Normal file
View file

@ -0,0 +1,50 @@
path across(path p, real node) {
return
point(p, node + 1/3) + point(p, node - 1/3) - point(p, node);
}
path corner_subquad(path p, real node) {
return
point(p, node) --
point(p, node + 1/3) --
across(p, node) --
point(p, node - 1/3) --
cycle;
}
path noncorner_subquad(path p, real node1, real node2) {
return
point(p, node1 + 1/3) --
across(p, node1) --
across(p, node2) --
point(p, node2 - 1/3) --
cycle;
}
void carpet(path p, int order) {
if (order == 0)
fill(p);
else {
for (real node : sequence(0, 3)) {
carpet(corner_subquad(p, node), order - 1);
carpet(noncorner_subquad(p, node, node + 1), order - 1);
}
}
}
path q =
// A square
unitsquare
// An oblong rhombus
// (0, 0) -- (5, 3) -- (0, 6) -- (-5, 3) -- cycle
// A trapezoid
// (0, 0) -- (4, 2) -- (6, 2) -- (10, 0) -- cycle
// A less regular quadrilateral
// (0, 0) -- (4, 1) -- (9, -4) -- (1, -1) -- cycle
// A concave shape
// (0, 0) -- (5, 3) -- (10, 0) -- (5, 1) -- cycle
;
size(9 inches, 6 inches);
carpet(q, 5);

20
Task/Sierpinski-carpet/AutoHotkey/sierpinski-carpet.ahk Normal file
View file

@ -0,0 +1,20 @@
Loop 4
MsgBox % Carpet(A_Index)
Carpet(n) {
Loop % 3**n {
x := A_Index-1
Loop % 3**n
t .= Dot(x,A_Index-1)
t .= "`n"
}
Return t
}
Dot(x,y) {
While x>0 && y>0
If (mod(x,3)=1 && mod(y,3)=1)
Return " "
Else x //= 3, y //= 3
Return "."
}

25
Task/Sierpinski-carpet/BASIC256/sierpinski-carpet.basic Normal file
View file

@ -0,0 +1,25 @@
function in_carpet(x, y)
while x <> 0 and y <> 0
if(x mod 3) = 1 and (y mod 3) = 1 then return False
y = int(y / 3): x = int(x / 3)
end while
return True
end function
Subroutine carpet(n)
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 subroutine
for k = 0 to 3
print "N = "; k
call carpet(k)
print
next k
end

18
Task/Sierpinski-carpet/BBC-BASIC/sierpinski-carpet.basic Normal file
View file

@ -0,0 +1,18 @@
Order% = 3
side% = 3^Order%
VDU 23,22,8*side%;8*side%;64,64,16,128
FOR Y% = 0 TO side%-1
FOR X% = 0 TO side%-1
IF FNincarpet(X%,Y%) PLOT X%*16,Y%*16+15
NEXT
NEXT Y%
REPEAT WAIT 1 : UNTIL FALSE
END
DEF FNincarpet(X%,Y%)
REPEAT
IF X% MOD 3 = 1 IF Y% MOD 3 = 1 THEN = FALSE
X% DIV= 3
Y% DIV= 3
UNTIL X%=0 AND Y%=0
= TRUE

10
Task/Sierpinski-carpet/BQN/sierpinski-carpet-1.bqn Normal file
View file

@ -0,0 +1,10 @@
_decode ← {⌽𝕗|⌊∘÷⟜𝕗⍟(↕1+·⌊𝕗⋆⁼1⌈⊢)}
Carpet ← { # 2D Array method using ∾.
{∾(3‿3⥊4≠↕9)⊏⟨(≢𝕩)⥊0,𝕩⟩}⍟(𝕩-1) 1‿1⥊1
}
Carpet1 ← { # base conversion method, works in a single step.
¬{∨´𝕨∧○((-𝕨⌈○≠𝕩)⊸↑)𝕩}⌜˜2|3 _decode¨↕3⋆𝕩-1
}
•Show " #"⊏˜Carpet 4
•Show (Carpet ≡ Carpet1) 4

30
Task/Sierpinski-carpet/BQN/sierpinski-carpet-2.bqn Normal file
View file

@ -0,0 +1,30 @@
┌─
╵"###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################
######### #########
# ## ## # # ## ## #
######### #########
### ### ### ###
# # # # # # # #
### ### ### ###
######### #########
# ## ## # # ## ## #
######### #########
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################"
┘
1

4
Task/Sierpinski-carpet/Befunge/sierpinski-carpet.bf Normal file
View file

@ -0,0 +1,4 @@
311>*#3\>#-:#1_$:00p00g-#@_010p0>:20p10g30v
>p>40p"#"30g40g*!#v_$48*30g3%1-v^ >$55+,1v>
0 ^p03/3g03/3g04$_v#!*!-1%3g04!<^_^#- g00 <
^3g01p02:0p01_@#-g>#0,#02#:0#+g#11#g+#0:#<^

15
Task/Sierpinski-carpet/Brainf---/sierpinski-carpet.bf Normal file
View file

@ -0,0 +1,15 @@
input order and print the associated Sierpinski carpet
orders over 5 require larger cell sizes
+++>>+[[-]>[-],[+[-----------[>[-]++++++[<------>-]<--<<[->>++++++++++<<]>>[-<<+
>>]<+>]]]<]<<[>>+<<-]+>[>>[-]>[-]<<<<[>>>>+<<<<-]>>>>[<<[<<+>>>+<-]>[<+>-]>-]<<<
-]>[-]<<[>+>+<<-]>>[<<+>>-]<[<[>>+>+<<<-]>>>[<<<+>>>-]<[<[>>+>>>+<<<<<-]>>[<<+>>
-]<[>>+>>>+<<<<<-]>>[<<+>>-]>>->-<<<<+[[>+>+<<-]>[<+>-]>[>[>>+>+<<<-]>>>[<<<+>>>
-]+++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]>[-]>>[-]<->+<[>-]>[<<<+>>>->]<<[-]<<<[>>+>+
<<<-]>>>[<<<+>>>-]+++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]>[-]>>[-]<->+<[>-]>[<<<+>>>-
>]<<[-]<<<[>[>+<-]<-]>[-]>[<<+>>-]<<[>>++++[<++++++++>-]<.[-]<<[-]<[-]<<<->>>>>-
]<<<-]<<[>+>+<<-]>[<+>-]>[>[>>+<<-]>>>+++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]>[-]>[-]
>[<<<<<+>>>>>-]<<<+++<[->-[>+>>]>[+[-<+>]>+>>]<<<<<]>[-]>[-]>[<<<+>>>-]<<<<[>>+>
+<<<-]>>>[<<<+>>>-]<<[>>+>+<<<-]>>>[<<<+>>>-]<<[>[>+<-]<-]>[-]+>[[-]<->]<[->+<]>
[<<+>>-]<<[>>+++++[<+++++++>-]<.[-]<<[-]<[-]<<<->>>>>-]<<<-]<<]<-]++++++++++.[-]
<-]

40
Task/Sierpinski-carpet/C++/sierpinski-carpet-1.cpp Normal file
View file

@ -0,0 +1,40 @@
// contributed to rosettacode.org by Peter Helcmanovsky
// BCT = Binary-Coded Ternary: pairs of bits form one digit [0,1,2] (0b11 is invalid digit)
#include <cstdint>
#include <cstdlib>
#include <cstdio>
static constexpr int32_t bct_low_bits = 0x55555555;
static int32_t bct_decrement(int32_t v) {
--v; // either valid BCT (v-1), or block of bottom 0b00 digits becomes invalid 0b11
return v ^ (v & (v>>1) & bct_low_bits); // fix all 0b11 to 0b10 (digit "2")
}
int main (int argc, char *argv[])
{
// parse N from first argument, if no argument, use 3 as default value
const int32_t n = (1 < argc) ? std::atoi(argv[1]) : 3;
// check for valid N (0..9) - 16 requires 33 bits for BCT form 1<<(n*2) => hard limit
if (n < 0 || 9 < n) { // but N=9 already produces 370MB output
std::printf("N out of range (use 0..9): %ld\n", long(n));
return 1;
}
const int32_t size_bct = 1<<(n*2); // 3**n in BCT form (initial value for loops)
// draw the carpet, two nested loops counting down in BCT form of values
int32_t y = size_bct;
do { // all lines loop
y = bct_decrement(y); // --Y (in BCT)
int32_t x = size_bct;
do { // line loop
x = bct_decrement(x); // --X (in BCT)
// check if x has ternary digit "1" at same position(s) as y -> output space (hole)
std::putchar((x & y & bct_low_bits) ? ' ' : '#');
} while (0 < x);
std::putchar('\n');
} while (0 < y);
return 0;
}

122
Task/Sierpinski-carpet/C++/sierpinski-carpet-2.cpp Normal file
View file

@ -0,0 +1,122 @@
#include <windows.h>
#include <math.h>
//--------------------------------------------------------------------------------------------------
const int BMP_SIZE = 738;
//--------------------------------------------------------------------------------------------------
class Sierpinski
{
public:
void draw( HDC wdc, int wid, int hei, int ord )
{
_wdc = wdc;
_ord = wid / static_cast<int>( pow( 3.0, ord ) );
drawIt( 0, 0, wid, hei );
}
void setHWND( HWND hwnd ) { _hwnd = hwnd; }
private:
void drawIt( int x, int y, int wid, int hei )
{
if( wid < _ord || hei < _ord ) return;
int w = wid / 3, h = hei / 3;
RECT rc;
SetRect( &rc, x + w, y + h, x + w + w, y + h + h );
FillRect( _wdc, &rc, static_cast<HBRUSH>( GetStockObject( BLACK_BRUSH ) ) );
for( int a = 0; a < 3; a++ )
for( int b = 0; b < 3; b++ )
{
if( a == 1 && b == 1 ) continue;
drawIt( x + b * w, y + a * h, w, h );
}
}
HWND _hwnd;
HDC _wdc;
int _ord;
};
//--------------------------------------------------------------------------------------------------
class wnd
{
public:
wnd() { _inst = this; }
int wnd::Run( HINSTANCE hInst )
{
_hInst = hInst;
_hwnd = InitAll();
_carpet.setHWND( _hwnd );
ShowWindow( _hwnd, SW_SHOW );
UpdateWindow( _hwnd );
MSG msg;
ZeroMemory( &msg, sizeof( msg ) );
while( msg.message != WM_QUIT )
{
if( PeekMessage( &msg, NULL, 0, 0, PM_REMOVE ) != 0 )
{
TranslateMessage( &msg );
DispatchMessage( &msg );
}
}
return UnregisterClass( "_SIERPINSKI_", _hInst );
}
private:
void wnd::doPaint( HDC dc ) { _carpet.draw( dc, BMP_SIZE, BMP_SIZE, 5 ); }
static int WINAPI wnd::WndProc( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam )
{
switch( msg )
{
case WM_DESTROY: PostQuitMessage( 0 ); break;
case WM_PAINT:
{
PAINTSTRUCT ps;
HDC dc = BeginPaint( hWnd, &ps );
_inst->doPaint( dc );
EndPaint( hWnd, &ps );
}
default:
return DefWindowProc( hWnd, msg, wParam, lParam );
}
return 0;
}
HWND InitAll()
{
WNDCLASSEX wcex;
ZeroMemory( &wcex, sizeof( wcex ) );
wcex.cbSize = sizeof( WNDCLASSEX );
wcex.style = CS_HREDRAW | CS_VREDRAW;
wcex.lpfnWndProc = ( WNDPROC )WndProc;
wcex.hInstance = _hInst;
wcex.hCursor = LoadCursor( NULL, IDC_ARROW );
wcex.hbrBackground = ( HBRUSH )( COLOR_WINDOW + 1 );
wcex.lpszClassName = "_SIERPINSKI_";
RegisterClassEx( &wcex );
RECT rc = { 0, 0, BMP_SIZE, BMP_SIZE };
AdjustWindowRect( &rc, WS_SYSMENU | WS_CAPTION, FALSE );
int w = rc.right - rc.left,
h = rc.bottom - rc.top;
return CreateWindow( "_SIERPINSKI_", ".: Sierpinski carpet -- PJorente :.", WS_SYSMENU, CW_USEDEFAULT, 0, w, h, NULL, NULL, _hInst, NULL );
}
static wnd* _inst;
HINSTANCE _hInst;
HWND _hwnd;
Sierpinski _carpet;
};
wnd* wnd::_inst = 0;
//--------------------------------------------------------------------------------------------------
int APIENTRY _tWinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPTSTR lpCmdLine, int nCmdShow )
{
wnd myWnd;
return myWnd.Run( hInstance );
}
//--------------------------------------------------------------------------------------------------

24
Task/Sierpinski-carpet/C-sharp/sierpinski-carpet.cs Normal file
View file

@ -0,0 +1,24 @@
using System;
using System.Collections.Generic;
using System.Linq;
class Program
{
static List<string> NextCarpet(List<string> carpet)
{
return carpet.Select(x => x + x + x)
.Concat(carpet.Select(x => x + x.Replace('#', ' ') + x))
.Concat(carpet.Select(x => x + x + x)).ToList();
}
static List<string> SierpinskiCarpet(int n)
{
return Enumerable.Range(1, n).Aggregate(new List<string> { "#" }, (carpet, _) => NextCarpet(carpet));
}
static void Main(string[] args)
{
foreach (string s in SierpinskiCarpet(3))
Console.WriteLine(s);
}
}

21
Task/Sierpinski-carpet/C/sierpinski-carpet-1.c Normal file
View file

@ -0,0 +1,21 @@
#include <stdio.h>
int main()
{
int i, j, dim, d;
int depth = 3;
for (i = 0, dim = 1; i < depth; i++, dim *= 3);
for (i = 0; i < dim; i++) {
for (j = 0; j < dim; j++) {
for (d = dim / 3; d; d /= 3)
if ((i % (d * 3)) / d == 1 && (j % (d * 3)) / d == 1)
break;
printf(d ? " " : "##");
}
printf("\n");
}
return 0;
}

92
Task/Sierpinski-carpet/C/sierpinski-carpet-2.c Normal file
View file

@ -0,0 +1,92 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
typedef struct sCarpet {
int dim; // dimension
char *data; // character data
char **rows; // pointers to data rows
} *Carpet;
/* Clones a tile into larger carpet, or blank if center */
void TileCarpet( Carpet d, int r, int c, Carpet tile )
{
int y0 = tile->dim*r;
int x0 = tile->dim*c;
int k,m;
if ((r==1) && (c==1)) {
for(k=0; k < tile->dim; k++) {
for (m=0; m < tile->dim; m++) {
d->rows[y0+k][x0+m] = ' ';
}
}
}
else {
for(k=0; k < tile->dim; k++) {
for (m=0; m < tile->dim; m++) {
d->rows[y0+k][x0+m] = tile->rows[k][m];
}
}
}
}
/* define a 1x1 starting carpet */
static char s1[]= "#";
static char *r1[] = {s1};
static struct sCarpet single = { 1, s1, r1};
Carpet Sierpinski( int n )
{
Carpet carpet;
Carpet subCarpet;
int row,col, rb;
int spc_rqrd;
subCarpet = (n > 1) ? Sierpinski(n-1) : &single;
carpet = malloc(sizeof(struct sCarpet));
carpet->dim = 3*subCarpet->dim;
spc_rqrd = (2*subCarpet->dim) * (carpet->dim);
carpet->data = malloc(spc_rqrd*sizeof(char));
carpet->rows = malloc( carpet->dim*sizeof(char *));
for (row=0; row<subCarpet->dim; row++) {
carpet->rows[row] = carpet->data + row*carpet->dim;
rb = row+subCarpet->dim;
carpet->rows[rb] = carpet->data + rb*carpet->dim;
rb = row+2*subCarpet->dim;
carpet->rows[rb] = carpet->data + row*carpet->dim;
}
for (col=0; col < 3; col++) {
/* 2 rows of tiles to copy - third group points to same data a first */
for (row=0; row < 2; row++)
TileCarpet( carpet, row, col, subCarpet );
}
if (subCarpet != &single ) {
free(subCarpet->rows);
free(subCarpet->data);
free(subCarpet);
}
return carpet;
}
void CarpetPrint( FILE *fout, Carpet carp)
{
char obuf[730];
int row;
for (row=0; row < carp->dim; row++) {
strncpy(obuf, carp->rows[row], carp->dim);
fprintf(fout, "%s\n", obuf);
}
fprintf(fout,"\n");
}
int main(int argc, char *argv[])
{
// FILE *f = fopen("sierp.txt","w");
CarpetPrint(stdout, Sierpinski(3));
// fclose(f);
return 0;
}

81
Task/Sierpinski-carpet/C/sierpinski-carpet-3.c Normal file
View file

@ -0,0 +1,81 @@
#include <stdio.h>
#include <stdlib.h>
typedef struct _PartialGrid{
char** base;
int xbegin, xend, ybegin, yend; // yend strictly not used
} PartialGrid;
void sierpinski_hollow(PartialGrid G){
int len = G.xend - G.xbegin+1;
int unit = len/3;
for(int i = G.xbegin+unit; i <G.xbegin+2*unit;i++){
for(int j = G.ybegin+unit; j <G.ybegin+2*unit;j++){
G.base[j][i] = ' ';
}}
}
void sierpinski(PartialGrid G, int iterations){
if(iterations==0)
return;
if((iterations)==1){
sierpinski_hollow(G);
sierpinski(G,0);
}
sierpinski_hollow(G);
for(int i=0;i<3;i++){
for(int j=0;j<3;j++){
int length = G.xend-G.xbegin+1;
int unit = length/3;
PartialGrid q = {G.base, G.xbegin + i*unit, G.xbegin+(i+1)*unit-1,
G.ybegin+j*unit, G.ybegin+(j+1)*unit-1};
sierpinski(q, iterations-1);
}
}
}
int intpow(int base, int expo){
if(expo==0){
return 1;
}
return base*intpow(base,expo-1);
}
int allocate_grid(char*** g, int n, const char sep){
int size = intpow(3,n+1);
*g = (char**)calloc(size, sizeof(char*));
if(*g==NULL)
return -1;
for(int i = 0; i < size; ++i){
(*g)[i] = (char*)calloc(size, sizeof(char));
if((*g)[i] == NULL)
return -1;
for(int j = 0; j < size; j++){
(*g)[i][j] = sep;
}
}
return size;
}
void print_grid(char** b, int size){
for(int i = 0; i < size; i++){
printf("%s\n",b[i]);
}
}
int main(){
int n = 3;
char** basegrid;
int size = allocate_grid(&basegrid, n, '#');
if(size == -1)
return 1; //bad alloc
PartialGrid b = {basegrid, 0, size-1, 0, size-1};
sierpinski(b, n);
print_grid(basegrid, size);
free(basegrid);
return 0;
}

20
Task/Sierpinski-carpet/Clojure/sierpinski-carpet.clj Normal file
View file

@ -0,0 +1,20 @@
(ns example
(:require [clojure.contrib.math :as math]))
(defn in-carpet? [x y]
(loop [x x, y y]
(cond
(or (zero? x) (zero? y)) true
(and (= 1 (mod x 3)) (= 1 (mod y 3))) false
:else (recur (quot x 3) (quot y 3)))))
(defn carpet [n]
(apply str
(interpose
\newline
(for [x (range (math/expt 3 n))]
(apply str
(for [y (range (math/expt 3 n))]
(if (in-carpet? x y) "*" " ")))))))
(println (carpet 3))

23
Task/Sierpinski-carpet/Commodore-BASIC/sierpinski-carpet.basic Normal file
View file

@ -0,0 +1,23 @@
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

10
Task/Sierpinski-carpet/Common-Lisp/sierpinski-carpet.lisp Normal file
View file

@ -0,0 +1,10 @@
(defun print-carpet (order)
(let ((size (expt 3 order)))
(flet ((trinary (x) (format nil "~3,vR" order x))
(ones (a b) (and (eql a #\1) (eql b #\1))))
(loop for i below size do
(fresh-line)
(loop for j below size do
(princ (if (some #'ones (trinary i) (trinary j))
" "
"#")))))))

11
Task/Sierpinski-carpet/Crystal/sierpinski-carpet.crystal Normal file
View file

@ -0,0 +1,11 @@
def sierpinski_carpet(n)
carpet = ["#"]
n.times do
carpet = carpet.map { |x| x + x + x } +
carpet.map { |x| x + x.tr("#"," ") + x } +
carpet.map { |x| x + x + x }
end
carpet
end
5.times{ |i| puts "\nN=#{i}"; sierpinski_carpet(i).each { |row| puts row } }

14
Task/Sierpinski-carpet/D/sierpinski-carpet-1.d Normal file
View file

@ -0,0 +1,14 @@
import std.stdio, std.string, std.algorithm, std.array;
auto sierpinskiCarpet(in int n) pure nothrow @safe {
auto r = ["#"];
foreach (immutable _; 0 .. n) {
const p = r.map!q{a ~ a ~ a}.array;
r = p ~ r.map!q{a ~ a.replace("#", " ") ~ a}.array ~ p;
}
return r.join('\n');
}
void main() {
3.sierpinskiCarpet.writeln;
}

14
Task/Sierpinski-carpet/D/sierpinski-carpet-2.d Normal file
View file

@ -0,0 +1,14 @@
import std.stdio, std.algorithm, std.range, std.functional;
auto nextCarpet(in string[] c) pure nothrow {
/*immutable*/ const b = c.map!q{a ~ a ~ a}.array;
return b ~ c.map!q{a ~ a.replace("#", " ") ~ a}.array ~ b;
}
void main() {
["#"]
.recurrence!((a, n) => a[n - 1].nextCarpet)
.dropExactly(3)
.front
.binaryReverseArgs!writefln("%-(%s\n%)");
}

27
Task/Sierpinski-carpet/D/sierpinski-carpet-3.d Normal file
View file

@ -0,0 +1,27 @@
import std.stdio, std.array;
char[][] sierpinskiCarpet(in size_t n) pure nothrow @safe {
auto mat = uninitializedArray!(typeof(return))(3 ^^ n, 3 ^^ n);
foreach (immutable r, row; mat) {
row[] = '#';
foreach (immutable c, ref cell; row) {
size_t r2 = r, c2 = c;
while (r2 && c2) {
if (r2 % 3 == 1 && c2 % 3 == 1) {
cell = ' ';
break;
}
r2 /= 3;
c2 /= 3;
}
}
}
return mat;
}
void main() {
writefln("%-(%s\n%)", 3.sierpinskiCarpet);
7.sierpinskiCarpet.length.writeln;
}

28
Task/Sierpinski-carpet/DWScript/sierpinski-carpet.dw Normal file
View file

@ -0,0 +1,28 @@
function InCarpet(x, y : Integer) : Boolean;
begin
while (x<>0) and (y<>0) do begin
if ((x mod 3)=1) and ((y mod 3)=1) then
Exit(False);
x := x div 3;
y := y div 3;
end;
Result := True;
end;
procedure Carpet(n : Integer);
var
i, j, p : Integer;
begin
p := Round(IntPower(3, n));
for i:=0 to p-1 do begin
for j:=0 to p-1 do begin
if InCarpet(i, j) then
Print('#')
else Print(' ');
end;
PrintLn('');
end;
end;
Carpet(3);

19
Task/Sierpinski-carpet/E/sierpinski-carpet.e Normal file
View file

@ -0,0 +1,19 @@
def inCarpet(var x, var y) {
while (x > 0 && y > 0) {
if (x %% 3 <=> 1 && y %% 3 <=> 1) {
return false
}
x //= 3
y //= 3
}
return true
}
def carpet(order) {
for y in 0..!(3**order) {
for x in 0..!(3**order) {
print(inCarpet(x, y).pick("#", " "))
}
println()
}
}

30
Task/Sierpinski-carpet/ERRE/sierpinski-carpet.erre Normal file
View file

@ -0,0 +1,30 @@
PROGRAM SIERP_CARPET
! for rosettacode.org
!$INTEGER
BEGIN
OPEN("O",1,"OUT.PRN")
PRINT(CHR$(12);) !CLS
DEPTH=3
DIMM=1
FOR I=0 TO DEPTH-1 DO
DIMM=DIMM*3
END FOR
FOR I=0 TO DIMM-1 DO
FOR J=0 TO DIMM-1 DO
D=DIMM DIV 3
REPEAT
EXIT IF ((I MOD (D*3)) DIV D=1 AND (J MOD (D*3)) DIV D=1)
D=D DIV 3
UNTIL NOT(D>0)
IF D>0 THEN PRINT(#1," ";) ELSE PRINT(#1,"##";) END IF
END FOR
PRINT(#1,)
END FOR
! PRINT(#1,CHR$(12);) for printer only!
CLOSE(1)
END PROGRAM

19
Task/Sierpinski-carpet/EasyLang/sierpinski-carpet.easy Normal file
View file

@ -0,0 +1,19 @@
proc carp x y sz . .
move x - sz / 2 y - sz / 2
rect sz sz
if sz > 0.5
h = sz / 3
call carp x - sz y - sz h
call carp x - sz y h
call carp x - sz y + sz h
call carp x + sz y - sz h
call carp x + sz y h
call carp x + sz y + sz h
call carp x y - sz h
call carp x y + sz h
.
.
background 000
clear
color 633
call carp 50 50 100 / 3

16
Task/Sierpinski-carpet/Elixir/sierpinski-carpet.elixir Normal file
View file

@ -0,0 +1,16 @@
defmodule RC do
def sierpinski_carpet(n), do: sierpinski_carpet(n, ["#"])
def sierpinski_carpet(0, carpet), do: carpet
def sierpinski_carpet(n, carpet) do
new_carpet = Enum.map(carpet, fn x -> x <> x <> x end) ++
Enum.map(carpet, fn x -> x <> String.replace(x, "#", " ") <> x end) ++
Enum.map(carpet, fn x -> x <> x <> x end)
sierpinski_carpet(n-1, new_carpet)
end
end
Enum.each(0..3, fn n ->
IO.puts "\nN=#{n}"
Enum.each(RC.sierpinski_carpet(n), fn line -> IO.puts line end)
end)

19
Task/Sierpinski-carpet/Erlang/sierpinski-carpet.erl Normal file
View file

@ -0,0 +1,19 @@
% Implemented by Arjun Sunel
-module(carpet).
-export([main/0]).
main() ->
sierpinski_carpet(3).
sierpinski_carpet(N) ->
lists: foreach(fun(X) -> lists: foreach(fun(Y) -> carpet(X,Y) end,lists:seq(0,trunc(math:pow(3,N))-1)), io:format("\n") end, lists:seq(0,trunc(math:pow(3,N))-1)).
carpet(X,Y) ->
if
X=:=0 ; Y=:=0 ->
io:format("*");
(X rem 3)=:=1, (Y rem 3) =:=1 ->
io:format(" ");
true ->
carpet(X div 3, Y div 3)
end.

26
Task/Sierpinski-carpet/Euphoria/sierpinski-carpet.euphoria Normal file
View file

@ -0,0 +1,26 @@
include std/math.e
integer order = 4
function InCarpet(atom x, atom y)
while 1 do
if x = 0 or y = 0 then
return 1
elsif floor(mod(x,3)) = 1 and floor(mod(y,3)) = 1 then
return 0
end if
x /= 3
y /= 3
end while
end function
for i = 0 to power(3,order)-1 do
for j = 0 to power(3,order)-1 do
if InCarpet(i,j) = 1 then
puts(1,"#")
else
puts(1," ")
end if
end for
puts(1,'\n')
end for

28
Task/Sierpinski-carpet/Excel/sierpinski-carpet-1.excel Normal file
View file

@ -0,0 +1,28 @@
SHOWBLOCKS
=LAMBDA(xs,
IF(0 <> xs, "█", " ")
)
SIERPCARPET
=LAMBDA(n,
APPLYN(n)(
SIERPWEAVE
)(1)
)
SIERPWEAVE
=LAMBDA(xs,
LET(
triple, REPLICATECOLS(3)(xs),
gap, LAMBDA(x, IF(x, 0, 0))(xs),
middle, APPENDCOLS(
APPENDCOLS(xs)(gap)
)(xs),
APPENDROWS(
APPENDROWS(triple)(middle)
)(triple)
)
)

75
Task/Sierpinski-carpet/Excel/sierpinski-carpet-2.excel Normal file
View file

@ -0,0 +1,75 @@
APPENDCOLS
=LAMBDA(xs,
LAMBDA(ys,
LET(
nx, COLUMNS(xs),
ny, COLUMNS(ys),
colIndexes, SEQUENCE(1, nx + ny),
rowIndexes, SEQUENCE(MAX(ROWS(xs), ROWS(ys))),
IFERROR(
IF(nx < colIndexes,
INDEX(ys, rowIndexes, colIndexes - nx),
INDEX(xs, rowIndexes, colIndexes)
),
NA()
)
)
)
)
APPENDROWS
=LAMBDA(xs,
LAMBDA(ys,
LET(
nx, ROWS(xs),
rowIndexes, SEQUENCE(nx + ROWS(ys)),
colIndexes, SEQUENCE(
1,
MAX(COLUMNS(xs), COLUMNS(ys))
),
IFERROR(
IF(rowIndexes <= nx,
INDEX(xs, rowIndexes, colIndexes),
INDEX(ys, rowIndexes - nx, colIndexes)
),
NA()
)
)
)
)
APPLYN
=LAMBDA(n,
LAMBDA(f,
LAMBDA(x,
IF(0 < n,
APPLYN(n - 1)(f)(
f(x)
),
x
)
)
)
)
REPLICATECOLS
=LAMBDA(n,
LAMBDA(xs,
LET(
nCols, COLUMNS(xs),
h, n * nCols,
ixs, SEQUENCE(ROWS(xs), h, 0, 1),
INDEX(
xs,
1 + QUOTIENT(ixs, h),
1 + MOD(ixs, nCols)
)
)
)
)

16
Task/Sierpinski-carpet/F-Sharp/sierpinski-carpet.fs Normal file
View file

@ -0,0 +1,16 @@
open System
let blank x = new String(' ', String.length x)
let nextCarpet carpet =
List.map (fun x -> x + x + x) carpet @
List.map (fun x -> x + (blank x) + x) carpet @
List.map (fun x -> x + x + x) carpet
let rec sierpinskiCarpet n =
let rec aux n carpet =
if n = 0 then carpet
else aux (n-1) (nextCarpet carpet)
aux n ["#"]
List.iter (printfn "%s") (sierpinskiCarpet 3)

7
Task/Sierpinski-carpet/Factor/sierpinski-carpet.factor Normal file
View file

@ -0,0 +1,7 @@
USING: kernel math math.matrices prettyprint ;
: sierpinski ( n -- )
1 - { { 1 1 1 } { 1 0 1 } { 1 1 1 } } swap over [ kron ]
curry times [ 1 = "#" " " ? ] matrix-map simple-table. ;
3 sierpinski

40
Task/Sierpinski-carpet/Fan/sierpinski-carpet.fan Normal file
View file

@ -0,0 +1,40 @@
**
** Generates a square Sierpinski gasket
**
class SierpinskiCarpet
{
public static Bool inCarpet(Int x, Int y){
while(x!=0 && y!=0){
if (x % 3 == 1 && y % 3 == 1)
return false;
x /= 3;
y /= 3;
}
return true;
}
static Int pow(Int n, Int exp)
{
rslt := 1
exp.times { rslt *= n }
return rslt
}
public static Void carpet(Int n){
for(i := 0; i < pow(3, n); i++){
buf := StrBuf()
for(j := 0; j < pow(3, n); j++){
if( inCarpet(i, j))
buf.add("*");
else
buf.add(" ");
}
echo(buf);
}
}
Void main()
{
carpet(4)
}
}

17
Task/Sierpinski-carpet/Fennel/sierpinski-carpet.fennel Normal file
View file

@ -0,0 +1,17 @@
(fn in-carpet? [x y]
(if
(or (= 0 x) (= 0 y)) true
(and (= 1 (% x 3)) (= 1 (% y 3))) false
(in-carpet? (// x 3) (// y 3))))
(fn make-carpet [size]
(for [y 0 (- (^ 3 size) 1)]
(for [x 0 (- (^ 3 size) 1)]
(if (in-carpet? x y)
(io.write "#")
(io.write " ")))
(io.write "\n")))
(for [i 0 3]
(make-carpet i)
(print))

16
Task/Sierpinski-carpet/Forth/sierpinski-carpet.fth Normal file
View file

@ -0,0 +1,16 @@
\ Generates a square Sierpinski gasket
: 1? over 3 mod 1 = ; ( n1 n2 -- n1 n2 f)
: 3/ 3 / swap ; ( n1 n2 -- n2/3 n1)
\ is this cell in the carpet?
: incarpet ( n1 n2 -- f)
begin over over or while 1? 1? and if 2drop false exit then 3/ 3/ repeat
2drop true \ return true if in the carpet
;
\ draw a carpet of n size
: carpet ( n --)
1 swap 0 ?do 3 * loop dup \ calculate power of 3
0 ?do dup 0 ?do i j incarpet if [char] # else bl then emit loop cr loop
drop \ evaluate every cell in the carpet
;
cr 4 carpet

42
Task/Sierpinski-carpet/Fortran/sierpinski-carpet.f Normal file
View file

@ -0,0 +1,42 @@
program Sierpinski_carpet
implicit none
call carpet(4)
contains
function In_carpet(a, b)
logical :: in_carpet
integer, intent(in) :: a, b
integer :: x, y
x = a ; y = b
do
if(x == 0 .or. y == 0) then
In_carpet = .true.
return
else if(mod(x, 3) == 1 .and. mod(y, 3) == 1) then
In_carpet = .false.
return
end if
x = x / 3
y = y / 3
end do
end function
subroutine Carpet(n)
integer, intent(in) :: n
integer :: i, j
do i = 0, 3**n - 1
do j = 0, 3**n - 1
if(In_carpet(i, j)) then
write(*, "(a)", advance="no") "#"
else
write(*, "(a)", advance="no") " "
end if
end do
write(*,*)
end do
end subroutine Carpet
end program Sierpinski_carpet

24
Task/Sierpinski-carpet/FreeBASIC/sierpinski-carpet-1.basic Normal file
View file

@ -0,0 +1,24 @@
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

33
Task/Sierpinski-carpet/FreeBASIC/sierpinski-carpet-2.basic Normal file
View file

@ -0,0 +1,33 @@
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

11
Task/Sierpinski-carpet/Gnuplot/sierpinski-carpet-1.gnuplot Normal file
View file

@ -0,0 +1,11 @@
## SCff.gp 1/14/17 aev
## Plotting Sierpinski carpet fractal.
## dat-files are PARI/GP generated output files:
## http://rosettacode.org/wiki/Sierpinski_carpet#PARI.2FGP
#cd 'C:\gnupData'
##SC5
clr = '"green"'
filename = "SC5gp1"
ttl = "Sierpinski carpet fractal, v.#1"
load "plotff.gp"

20
Task/Sierpinski-carpet/Gnuplot/sierpinski-carpet-2.gnuplot Normal file
View file

@ -0,0 +1,20 @@
## plotscf.gp 12/7/16 aev
## Plotting a Sierpinski carpet fractal to the png-file.
## Note: assign variables: ord (order), clr (color), filename and ttl (before using load command).
## ord (order) # a.k.a. level - defines size of fractal (also number of dots).
reset
set terminal png font arial 12 size 640,640
ofn=filename.".png"
set output ofn
unset border; unset xtics; unset ytics; unset key;
set title ttl font "Arial:Bold,12"
set xrange [0:1]; set yrange [0:1];
sc(n, x, y, d) = n >= ord ? \
sprintf('set object rect from %f,%f to %f,%f fc rgb @clr fs solid;', x, y, x+d, y+d) : \
sc(n+1, x, y, d/3) . sc(n+1, x+d/3, y, d/3) . \
sc(n+1, x+2*d/3, y, d/3) . sc(n+1, x, y+d/3, d/3) . \
sc(n+1, x+2*d/3, y+d/3, d/3) . sc(n+1, x, y+2*d/3, d/3) . \
sc(n+1, x+d/3, y+2*d/3, d/3) . sc(n+1, x+2*d/3, y+2*d /3, d/3);
eval(sc(0, 0.0, 0.0, 1.0))
plot -100
set output

27
Task/Sierpinski-carpet/Gnuplot/sierpinski-carpet-3.gnuplot Normal file
View file

@ -0,0 +1,27 @@
## plotscf1.gp 12/7/16 aev
## Plotting a Sierpinski carpet fractal to the png-file.
## Note: assign variables: ord (order, just for title), clr (color), filename and ttl (before using load command).
## In this version order is always 5.
reset
set terminal png font arial 12 size 640,640
ofn=filename.".png"
set output ofn
unset border; unset xtics; unset ytics; unset key;
set title ttl font "Arial:Bold,12"
o=3
sqr(x,y) = abs(x + y) + abs(x - y) - o
f(x) = o*abs(x) - o
c0(x,y) = abs(x + y) + abs(x - y) - 1
c1(x,y) = c0(o*x,f(y)) * c0(f(x),o*y) * c0(f(x),f(y))
c2(x,y) = c1(o*x,f(y)) * c1(f(x),o*y) * c1(f(x),f(y))
c3(x,y) = c2(o*x,f(y)) * c2(f(x),o*y) * c2(f(x),f(y))
c4(x,y) = c3(o*x,f(y)) * c3(f(x),o*y) * c3(f(x),f(y))
sc(x,y) = sqr(x,y)>0 || c0(x,y)*c1(x,y)*c2(x,y)*c3(x,y)*c4(x,y)<0 ? 0:1
set xrange [-1.5:1.5]; set yrange [-1.5:1.5];
set pm3d map;
set palette model RGB defined (0 "white", 1 @clr);
set size ratio -1
smp=640; set samples smp; set isosamples smp;
unset colorbox
splot sc(x,y)
set output

20
Task/Sierpinski-carpet/Gnuplot/sierpinski-carpet-4.gnuplot Normal file
View file

@ -0,0 +1,20 @@
## pSCF.gp 12/7/16 aev
## Plotting Sierpinski carpet fractals.
## Note: assign variables: ord (order), clr (color), filename and ttl (before using load command).
## ord (order) # a.k.a. level - defines size of fractal (also number of dots).
#cd 'C:\gnupData'
##SCF21
ord=3; clr = '"red"';
filename = "SCF21gp"; ttl = "Sierpinski carpet fractal #21, ord ".ord;
load "plotscf.gp"
##SCF22
ord=5; clr = '"brown"';
filename = "SCF22gp"; ttl = "Sierpinski carpet fractal #22, ord ".ord;
load "plotscf.gp"
##SCF31
ord=5; clr = '"navy"';
filename = "SCF31gp"; ttl = "Sierpinski carpet fractal #31, ord ".ord;
load "plotscf1.gp"

28
Task/Sierpinski-carpet/Go/sierpinski-carpet.go Normal file
View file

@ -0,0 +1,28 @@
package main
import (
"fmt"
"strings"
"unicode/utf8"
)
var order = 3
var grain = "#"
func main() {
carpet := []string{grain}
for ; order > 0; order-- {
// repeat expression allows for multiple character
// grain and for multi-byte UTF-8 characters.
hole := strings.Repeat(" ", utf8.RuneCountInString(carpet[0]))
middle := make([]string, len(carpet))
for i, s := range carpet {
middle[i] = s + hole + s
carpet[i] = strings.Repeat(s, 3)
}
carpet = append(append(carpet, middle...), carpet...)
}
for _, r := range carpet {
fmt.Println(r)
}
}

19
Task/Sierpinski-carpet/Groovy/sierpinski-carpet-1.groovy Normal file
View file

@ -0,0 +1,19 @@
def base3 = { BigInteger i -> i.toString(3) }
def sierpinskiCarpet = { int order ->
StringBuffer sb = new StringBuffer()
def positions = 0..<(3**order)
def digits = 0..<([order,1].max())
positions.each { i ->
String i3 = base3(i).padLeft(order, '0')
positions.each { j ->
String j3 = base3(j).padLeft(order, '0')
sb << (digits.any{ i3[it] == '1' && j3[it] == '1' } ? ' ' : order.toString().padRight(2) )
}
sb << '\n'
}
sb.toString()
}

1
Task/Sierpinski-carpet/Groovy/sierpinski-carpet-2.groovy Normal file
View file

@ -0,0 +1 @@
(0..4).each { println sierpinskiCarpet(it) }

16
Task/Sierpinski-carpet/Haskell/sierpinski-carpet-1.hs Normal file
View file

@ -0,0 +1,16 @@
inCarpet :: Int -> Int -> Bool
inCarpet 0 _ = True
inCarpet _ 0 = True
inCarpet x y = not ((xr == 1) && (yr == 1)) && inCarpet xq yq
where ((xq, xr), (yq, yr)) = (x `divMod` 3, y `divMod` 3)
carpet :: Int -> [String]
carpet n = map
(zipWith
(\x y -> if inCarpet x y then '#' else ' ')
[0..3^n-1]
. repeat)
[0..3^n-1]
printCarpet :: Int -> IO ()
printCarpet = mapM_ putStrLn . carpet

10
Task/Sierpinski-carpet/Haskell/sierpinski-carpet-2.hs Normal file
View file

@ -0,0 +1,10 @@
nextCarpet :: [String] -> [String]
nextCarpet carpet = border ++ map f carpet ++ border
where border = map (concat . replicate 3) carpet
f x = x ++ map (const ' ') x ++ x
sierpinskiCarpet :: Int -> [String]
sierpinskiCarpet n = iterate nextCarpet ["#"] !! n
main :: IO ()
main = mapM_ putStrLn $ sierpinskiCarpet 3

13
Task/Sierpinski-carpet/Haskell/sierpinski-carpet-3.hs Normal file
View file

@ -0,0 +1,13 @@
main :: IO ()
main = putStr . unlines . (!!3) $ iterate next ["#"]
next :: [String] -> [String]
next block =
block ! block ! block
++
block ! center ! block
++
block ! block ! block
where
(!) = zipWith (++)
center = map (map $ const ' ') block

16
Task/Sierpinski-carpet/Haskell/sierpinski-carpet-4.hs Normal file
View file

@ -0,0 +1,16 @@
carpet :: Int -> String
carpet = unlines . (iterate weave ["██"] !!)
weave :: [String] -> [String]
weave xs =
let f = zipWith (<>)
g = flip f
in concatMap
(g xs . f xs)
[ xs,
fmap (const ' ') <$> xs,
xs
]
main :: IO ()
main = mapM_ (putStrLn . carpet) [0 .. 2]

17
Task/Sierpinski-carpet/Haskell/sierpinski-carpet-5.hs Normal file
View file

@ -0,0 +1,17 @@
carpet :: Int -> String
carpet = unlines . (iterate weave ["██"] !!)
weave :: [String] -> [String]
weave =
let thread = zipWith (<>)
in ( (>>=)
. ( (:)
<*> ( ((:) . fmap (fmap (const ' ')))
<*> return
)
)
)
<*> ((.) <$> flip thread <*> thread)
main :: IO ()
main = mapM_ (putStrLn . carpet) [0 .. 2]

63
Task/Sierpinski-carpet/Haskell/sierpinski-carpet-6.hs Normal file
View file

@ -0,0 +1,63 @@
{-# LANGUAGE DoRec #-}
import Control.Monad.Trans (lift)
import Data.Colour (Colour)
import Diagrams.Prelude hiding (after)
import Diagrams.Backend.Cairo (Cairo)
import Diagrams.Backend.Cairo.Gtk (defaultRender)
import Graphics.Rendering.Diagrams.Points ()
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.GC (gcNew)
main :: IO ()
main = do
_ <- initGUI
window <- windowNew
_ <- window `onDestroy` mainQuit
window `windowSetResizable` False
area <- drawingAreaNew
_ <- area `on` sizeRequest $ return (Requisition 500 500)
_ <- window `containerAdd` area
widgetShowAll window
rec con <- area `on` exposeEvent $ do
lift $ signalDisconnect con
lift $ area `defaultRender` carpet 5
switchToPixBuf area
mainGUI
-- just workaround for slow redrawing
switchToPixBuf :: DrawingArea -> EventM EExpose Bool
switchToPixBuf area =
eventArea >>= \ea -> lift $ do
dw <- widgetGetDrawWindow area
(w,h) <- drawableGetSize dw
Just pb <- pixbufGetFromDrawable dw ea
gc <- gcNew dw
_ <- area `on` exposeEvent $ lift $
False <$ drawPixbuf dw gc pb 0 0 0 0 w h RgbDitherNone 0 0
return False
carpet :: Int -> Diagram Cairo R2
carpet = (iterate next (cell white) !!)
-- of course, one can use hcat / vcat - combinators
next :: Diagram Cairo R2 -> Diagram Cairo R2
next block =
scale (1/3) . centerXY $
(block ||| block ||| block)
===
(block ||| centr ||| block)
===
(block ||| block ||| block)
where
centr = cell black
cell :: Colour Float -> Diagram Cairo R2
cell color = square 1 # lineWidth 0 # fillColor color

24
Task/Sierpinski-carpet/Icon/sierpinski-carpet.icon Normal file
View file

@ -0,0 +1,24 @@
$define FILLER "*" # the filler character
procedure main(A)
width := 3 ^ ( order := (0 < \A[1]) | 3 )
write("Carpet order= ",order)
every !(canvas := list(width)) := list(width," ") # prime the canvas
every y := 1 to width & x := 1 to width do # traverse it
if IsFilled(x-1,y-1) then canvas[x,y] := FILLER # fill
every x := 1 to width & y := 1 to width do
writes((y=1,"\n")|"",canvas[x,y]," ") # print
end
procedure IsFilled(x,y) # succeed if x,y should be filled
while x ~= 0 & y ~= 0 do {
if x % 3 = y %3 = 1 then fail
x /:= 3
y /:=3
}
return
end

13
Task/Sierpinski-carpet/Io/sierpinski-carpet.io Normal file
View file

@ -0,0 +1,13 @@
sierpinskiCarpet := method(n,
carpet := list("@")
n repeat(
next := list()
carpet foreach(s, next append(s .. s .. s))
carpet foreach(s, next append(s .. (s asMutable replaceSeq("@"," ")) .. s))
carpet foreach(s, next append(s .. s .. s))
carpet = next
)
carpet join("\n")
)
sierpinskiCarpet(3) println

2
Task/Sierpinski-carpet/J/sierpinski-carpet-1.j Normal file
View file

@ -0,0 +1,2 @@
N=:3
(a:(<1;1)}3 3$<)^:N' '

27
Task/Sierpinski-carpet/J/sierpinski-carpet-2.j Normal file
View file

@ -0,0 +1,27 @@
N=:2
(a:(<1;1)}3 3$<)^:N' '
┌─────────────┬─────────────┬─────────────┐
│┌───┬───┬───┐│┌───┬───┬───┐│┌───┬───┬───┐│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│└───┴───┴───┘│└───┴───┴───┘│└───┴───┴───┘│
├─────────────┼─────────────┼─────────────┤
│┌───┬───┬───┐│ │┌───┬───┬───┐│
││ │ │ ││ ││ │ │ ││
│├───┼───┼───┤│ │├───┼───┼───┤│
││ │ │ ││ ││ │ │ ││
│├───┼───┼───┤│ │├───┼───┼───┤│
││ │ │ ││ ││ │ │ ││
│└───┴───┴───┘│ │└───┴───┴───┘│
├─────────────┼─────────────┼─────────────┤
│┌───┬───┬───┐│┌───┬───┬───┐│┌───┬───┬───┐│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│└───┴───┴───┘│└───┴───┴───┘│└───┴───┴───┘│
└─────────────┴─────────────┴─────────────┘

4
Task/Sierpinski-carpet/J/sierpinski-carpet-3.j Normal file
View file

@ -0,0 +1,4 @@
#:7 5 7
1 1 1
1 0 1
1 1 1

27
Task/Sierpinski-carpet/J/sierpinski-carpet-4.j Normal file
View file

@ -0,0 +1,27 @@
N=:2
((#:7 5 7){_2{.<)^:N' '
┌─────────────┬─────────────┬─────────────┐
│┌───┬───┬───┐│┌───┬───┬───┐│┌───┬───┬───┐│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│└───┴───┴───┘│└───┴───┴───┘│└───┴───┴───┘│
├─────────────┼─────────────┼─────────────┤
│┌───┬───┬───┐│ │┌───┬───┬───┐│
││ │ │ ││ ││ │ │ ││
│├───┼───┼───┤│ │├───┼───┼───┤│
││ │ │ ││ ││ │ │ ││
│├───┼───┼───┤│ │├───┼───┼───┤│
││ │ │ ││ ││ │ │ ││
│└───┴───┴───┘│ │└───┴───┴───┘│
├─────────────┼─────────────┼─────────────┤
│┌───┬───┬───┐│┌───┬───┬───┐│┌───┬───┬───┐│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│├───┼───┼───┤│├───┼───┼───┤│├───┼───┼───┤│
││ │ │ │││ │ │ │││ │ │ ││
│└───┴───┴───┘│└───┴───┴───┘│└───┴───┴───┘│
└─────────────┴─────────────┴─────────────┘

40
Task/Sierpinski-carpet/J/sierpinski-carpet-5.j Normal file
View file

@ -0,0 +1,40 @@
scarp=:{{' #'{~(#:7 5 7) ,/@(1 3 ,/"2@|: */)^:y ,.1}}
scarp 2
#########
# ## ## #
#########
### ###
# # # #
### ###
#########
# ## ## #
#########
scarp 3
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################
######### #########
# ## ## # # ## ## #
######### #########
### ### ### ###
# # # # # # # #
### ### ### ###
######### #########
# ## ## # # ## ## #
######### #########
###########################
# ## ## ## ## ## ## ## ## #
###########################
### ###### ###### ###
# # # ## # # ## # # #
### ###### ###### ###
###########################
# ## ## ## ## ## ## ## ## #
###########################

19
Task/Sierpinski-carpet/Java/sierpinski-carpet-1.java Normal file
View file

@ -0,0 +1,19 @@
public static boolean inCarpet(long x, long y) {
while (x!=0 && y!=0) {
if (x % 3 == 1 && y % 3 == 1)
return false;
x /= 3;
y /= 3;
}
return true;
}
public static void carpet(final int n) {
final double power = Math.pow(3,n);
for(long i = 0; i < power; i++) {
for(long j = 0; j < power; j++) {
System.out.print(inCarpet(i, j) ? "*" : " ");
}
System.out.println();
}
}

59
Task/Sierpinski-carpet/Java/sierpinski-carpet-2.java Normal file
View file

@ -0,0 +1,59 @@
import java.awt.*;
import java.awt.event.ActionEvent;
import javax.swing.*;
public class SierpinskiCarpet extends JPanel {
private final int dim = 513;
private final int margin = 20;
private int limit = dim;
public SierpinskiCarpet() {
setPreferredSize(new Dimension(dim + 2 * margin, dim + 2 * margin));
setBackground(Color.white);
setForeground(Color.orange);
new Timer(2000, (ActionEvent e) -> {
limit /= 3;
if (limit <= 3)
limit = dim;
repaint();
}).start();
}
void drawCarpet(Graphics2D g, int x, int y, int size) {
if (size < limit)
return;
size /= 3;
for (int i = 0; i < 9; i++) {
if (i == 4) {
g.fillRect(x + size, y + size, size, size);
} else {
drawCarpet(g, x + (i % 3) * size, y + (i / 3) * size, size);
}
}
}
@Override
public void paintComponent(Graphics gg) {
super.paintComponent(gg);
Graphics2D g = (Graphics2D) gg;
g.setRenderingHint(RenderingHints.KEY_ANTIALIASING,
RenderingHints.VALUE_ANTIALIAS_ON);
g.translate(margin, margin);
drawCarpet(g, 0, 0, dim);
}
public static void main(String[] args) {
SwingUtilities.invokeLater(() -> {
JFrame f = new JFrame();
f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE);
f.setTitle("Sierpinski Carpet");
f.setResizable(false);
f.add(new SierpinskiCarpet(), BorderLayout.CENTER);
f.pack();
f.setLocationRelativeTo(null);
f.setVisible(true);
});
}
}

72
Task/Sierpinski-carpet/JavaScript/sierpinski-carpet-1.js Normal file
View file

@ -0,0 +1,72 @@
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=utf-8">
<title>Sierpinski Carpet</title>
<script type='text/javascript'>
var black_char = "#";
var white_char = " ";
var SierpinskiCarpet = function(size) {
this.carpet = [black_char];
for (var i = 1; i <= size; i++) {
this.carpet = [].concat(
this.carpet.map(this.sier_top),
this.carpet.map(this.sier_middle),
this.carpet.map(this.sier_top)
);
}
}
SierpinskiCarpet.prototype.sier_top = function(x) {
var str = new String(x);
return new String(str+str+str);
}
SierpinskiCarpet.prototype.sier_middle = function (x) {
var str = new String(x);
var spacer = str.replace(new RegExp(black_char, 'g'), white_char);
return new String(str+spacer+str);
}
SierpinskiCarpet.prototype.to_string = function() {
return this.carpet.join("\n")
}
SierpinskiCarpet.prototype.to_html = function(target) {
var table = document.createElement('table');
for (var i = 0; i < this.carpet.length; i++) {
var row = document.createElement('tr');
for (var j = 0; j < this.carpet[i].length; j++) {
var cell = document.createElement('td');
cell.setAttribute('class', this.carpet[i][j] == black_char ? 'black' : 'white');
cell.appendChild(document.createTextNode('\u00a0'));
row.appendChild(cell);
}
table.appendChild(row);
}
target.appendChild(table);
}
</script>
<style type='text/css'>
table {border-collapse: collapse;}
td {width: 1em;}
.black {background-color: black;}
.white {background-color: white;}
</style>
</head>
<body>
<pre id='to_string' style='float:left; margin-right:0.25in'></pre>
<div id='to_html'></div>
<script type='text/javascript'>
var sc = new SierpinskiCarpet(3);
document.getElementById('to_string').appendChild(document.createTextNode(sc.to_string()));
sc.to_html(document.getElementById('to_html'));
</script>
</body>
</html>

56
Task/Sierpinski-carpet/JavaScript/sierpinski-carpet-2.js Normal file
View file

@ -0,0 +1,56 @@
// Orders 1, 2 and 3 of the Sierpinski Carpet
// as lines of text.
// Generic text output for use in any JavaScript environment
// Browser JavaScripts may use console.log() to return textual output
// others use print() or analogous functions.
[1, 2, 3].map(function sierpinskiCarpetOrder(n) {
// An (n * n) grid of (filled or empty) sub-rectangles
// n --> [[s]]
var carpet = function (n) {
var lstN = range(0, Math.pow(3, n) - 1);
// State of each cell in an N * N grid
return lstN.map(function (x) {
return lstN.map(function (y) {
return inCarpet(x, y);
});
});
},
// State of a given coordinate in the grid:
// Filled or not ?
// (See https://en.wikipedia.org/wiki/Sierpinski_carpet#Construction)
// n --> n --> bool
inCarpet = function (x, y) {
return (!x || !y) ? true :
!(
(x % 3 === 1) &&
(y % 3 === 1)
) && inCarpet(
x / 3 | 0,
y / 3 | 0
);
},
// Sequence of integers from m to n
// n --> n --> [n]
range = function (m, n) {
return Array.apply(null, Array(n - m + 1)).map(
function (x, i) {
return m + i;
}
);
};
// Grid of booleans mapped to lines of characters
// [[bool]] --> s
return carpet(n).map(function (line) {
return line.map(function (bool) {
return bool ? '\u2588' : ' ';
}).join('');
}).join('\n');
}).join('\n\n');

43
Task/Sierpinski-carpet/JavaScript/sierpinski-carpet-3.js Normal file
View file

@ -0,0 +1,43 @@
(() => {
'use strict';
// sierpinskiCarpet :: Int -> String
let sierpinskiCarpet = n => {
// carpet :: Int -> [[String]]
let carpet = n => {
let xs = range(0, Math.pow(3, n) - 1);
return xs.map(x => xs.map(y => inCarpet(x, y)));
},
// https://en.wikipedia.org/wiki/Sierpinski_carpet#Construction
// inCarpet :: Int -> Int -> Bool
inCarpet = (x, y) =>
(!x || !y) ? true : !(
(x % 3 === 1) &&
(y % 3 === 1)
) && inCarpet(
x / 3 | 0,
y / 3 | 0
);
return carpet(n)
.map(line => line.map(bool => bool ? '\u2588' : ' ')
.join(''))
.join('\n');
};
// GENERIC
// range :: Int -> Int -> [Int]
let range = (m, n) =>
Array.from({
length: Math.floor(n - m) + 1
}, (_, i) => m + i);
// TEST
return [1, 2, 3]
.map(sierpinskiCarpet);
})();

92
Task/Sierpinski-carpet/JavaScript/sierpinski-carpet-4.js Normal file
View file

@ -0,0 +1,92 @@
(() => {
'use strict';
// weave :: [String] -> [String]
const weave = xs => {
const f = zipWith(append);
return concatMap(
x => f(f(xs)(x))(xs)
)([
xs,
map(x => replicate(length(x))(' '))(
xs
),
xs
]);
};
// TEST -----------------------------------------------
const main = () => {
const
sierp = n => unlines(
take(1 + n, iterate(weave, ['\u2588']))[n]
),
carpet = sierp(2);
return (
// console.log(carpet),
carpet
);
};
// GENERIC ABSTRACTIONS -------------------------------
// append (++) :: [a] -> [a] -> [a]
// append (++) :: String -> String -> String
const append = xs => ys => xs.concat(ys);
// concatMap :: (a -> [b]) -> [a] -> [b]
const concatMap = f => xs =>
xs.reduce((a, x) => a.concat(f(x)), []);
// iterate :: (a -> a) -> a -> Gen [a]
function* iterate(f, x) {
let v = x;
while (true) {
yield(v);
v = f(v);
}
}
// Returns Infinity over objects without finite length
// this enables zip and zipWith to choose the shorter
// argument when one is non-finite, like cycle, repeat etc
// length :: [a] -> Int
const length = xs => xs.length || Infinity;
// map :: (a -> b) -> [a] -> [b]
const map = f => xs => xs.map(f);
// replicate :: Int -> String -> String
const replicate = n => s => s.repeat(n);
// take :: Int -> [a] -> [a]
// take :: Int -> String -> String
const take = (n, xs) =>
xs.constructor.constructor.name !== 'GeneratorFunction' ? (
xs.slice(0, n)
) : [].concat.apply([], Array.from({
length: n
}, () => {
const x = xs.next();
return x.done ? [] : [x.value];
}));
// unlines :: [String] -> String
const unlines = xs => xs.join('\n');
// zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
const zipWith = f => xs => ys => {
const
lng = Math.min(length(xs), length(ys)),
as = take(lng, xs),
bs = take(lng, ys);
return Array.from({
length: lng
}, (_, i) => f(as[i])(bs[i]));
};
// MAIN -----------------------------------------------
return main();
})();

18
Task/Sierpinski-carpet/Jq/sierpinski-carpet-1.jq Normal file
View file

@ -0,0 +1,18 @@
def inCarpet(x; y):
x as $x | y as $y |
if $x == -1 or $y == -1 then "\n"
elif $x == 0 or $y == 0 then "*"
elif ($x % 3) == 1 and ($y % 3) == 1 then " "
else inCarpet($x/3 | floor; $y/3 | floor)
end;
def ipow(n):
. as $in | reduce range(0;n) as $i (1; . * $in);
def carpet(n):
(3|ipow(n)) as $power
| [ inCarpet( range(0; $power) ; range(0; $power), -1 )]
| join("") ;
carpet(3)

1
Task/Sierpinski-carpet/Jq/sierpinski-carpet-2.jq Normal file
View file

@ -0,0 +1 @@
jq -n -r -c -f sierpinski.jq

16
Task/Sierpinski-carpet/Julia/sierpinski-carpet.julia Normal file
View file

@ -0,0 +1,16 @@
function sierpinski(n::Integer, token::AbstractString="*")
x = fill(token, 1, 1)
for _ in 1:n
t = fill(" ", size(x))
x = [x x x; x t x; x x x]
end
return x
end
function printsierpinski(m::Matrix)
for r in 1:size(m, 1)
println(join(m[r, :]))
end
end
sierpinski(2, "#") |> printsierpinski

22
Task/Sierpinski-carpet/Kotlin/sierpinski-carpet-1.kotlin Normal file
View file

@ -0,0 +1,22 @@
// version 1.1.2
fun inCarpet(x: Int, y: Int): Boolean {
var xx = x
var yy = y
while (xx != 0 && yy != 0) {
if (xx % 3 == 1 && yy % 3 == 1) return false
xx /= 3
yy /= 3
}
return true
}
fun carpet(n: Int) {
val power = Math.pow(3.0, n.toDouble()).toInt()
for(i in 0 until power) {
for(j in 0 until power) print(if (inCarpet(i, j)) "*" else " ")
println()
}
}
fun main(args: Array<String>) = carpet(3)

57
Task/Sierpinski-carpet/Kotlin/sierpinski-carpet-2.kotlin Normal file
View file

@ -0,0 +1,57 @@
// version 1.1.2
import java.awt.*
import javax.swing.*
public class SierpinskiCarpet : JPanel() {
private val dim = 513
private val margin = 20
private var limit = dim
init {
val size = dim + 2 * margin
preferredSize = Dimension(size, size)
background = Color.blue
foreground = Color.yellow
Timer(2000) {
limit /= 3
if (limit <= 3) limit = dim
repaint()
}.start()
}
private fun drawCarpet(g: Graphics2D, x: Int, y: Int, s: Int) {
var size = s
if (s < limit) return
size /= 3
for (i in 0 until 9) {
if (i == 4) {
g.fillRect(x + size, y + size, size, size)
}
else {
drawCarpet(g, x + (i % 3) * size, y + (i / 3) * size, size)
}
}
}
override fun paintComponent(gg: Graphics) {
super.paintComponent(gg)
val g = gg as Graphics2D
g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, RenderingHints.VALUE_ANTIALIAS_ON)
g.translate(margin, margin)
drawCarpet(g, 0, 0, dim)
}
}
fun main(args: Array<String>) {
SwingUtilities.invokeLater {
val f = JFrame()
f.defaultCloseOperation = JFrame.EXIT_ON_CLOSE
f.title = "Sierpinski Carpet"
f.isResizable = false
f.add(SierpinskiCarpet(), BorderLayout.CENTER)
f.pack()
f.setLocationRelativeTo(null)
f.isVisible = true
}
}

65
Task/Sierpinski-carpet/Lambdatalk/sierpinski-carpet.lambdatalk Normal file
View file

@ -0,0 +1,65 @@
{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
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■■■ ■■■■■■ ■■■■■■ ■■■
■ ■ ■ ■■ ■ ■ ■■ ■ ■ ■
■■■ ■■■■■■ ■■■■■■ ■■■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■■■■■■■■■ ■■■■■■■■■
■ ■■ ■■ ■ ■ ■■ ■■ ■
■■■■■■■■■ ■■■■■■■■■
■■■ ■■■ ■■■ ■■■
■ ■ ■ ■ ■ ■ ■ ■
■■■ ■■■ ■■■ ■■■
■■■■■■■■■ ■■■■■■■■■
■ ■■ ■■ ■ ■ ■■ ■■ ■
■■■■■■■■■ ■■■■■■■■■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■■■ ■■■■■■ ■■■■■■ ■■■
■ ■ ■ ■■ ■ ■ ■■ ■ ■ ■
■■■ ■■■■■■ ■■■■■■ ■■■
■■■■■■■■■■■■■■■■■■■■■■■■■■■
■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■■ ■
■■■■■■■■■■■■■■■■■■■■■■■■■■■

45
Task/Sierpinski-carpet/Liberty-BASIC/sierpinski-carpet.basic Normal file
View file

@ -0,0 +1,45 @@
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

19
Task/Sierpinski-carpet/Lua/sierpinski-carpet.lua Normal file
View file

@ -0,0 +1,19 @@
local function carpet(n, f)
print("n = " .. n)
local function S(x, y)
if x==0 or y==0 then return true
elseif x%3==1 and y%3==1 then return false end
return S(x//3, y//3)
end
for y = 0, 3^n-1 do
for x = 0, 3^n-1 do
io.write(f(S(x, y)))
end
print()
end
print()
end
for n = 0, 4 do
carpet(n, function(b) return b and "■ " or " " end)
end

6
Task/Sierpinski-carpet/MATLAB/sierpinski-carpet.m Normal file
View file

@ -0,0 +1,6 @@
n = 3;
c = string('#');
for k = 1 : n
c = [c + c + c, c + c.replace('#', ' ') + c, c + c + c];
end
disp(c.join(char(10)))

4
Task/Sierpinski-carpet/Mathematica/sierpinski-carpet.math Normal file
View file

@ -0,0 +1,4 @@
full={{1,1,1},{1,0,1},{1,1,1}}
empty={{0,0,0},{0,0,0},{0,0,0}}
n=3;
Grid[Nest[ArrayFlatten[#/.{0->empty,1->full}]&,{{1}},n]//.{0->" ",1->"#"}]

30
Task/Sierpinski-carpet/Minimal-BASIC/sierpinski-carpet.basic Normal file
View file

@ -0,0 +1,30 @@
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

36
Task/Sierpinski-carpet/Nascom-BASIC/sierpinski-carpet.basic Normal file
View file

@ -0,0 +1,36 @@
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

46
Task/Sierpinski-carpet/NetRexx/sierpinski-carpet.netrexx Normal file
View file

@ -0,0 +1,46 @@
/* NetRexx */
options replace format comments java crossref symbols nobinary
numeric digits 1000
runSample(arg)
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method runSample(arg) public static
DARK_SHADE = '\u2593'
parse arg ordr filr .
if ordr = '' | ordr = '.' then ordr = 3
if filr = '' | filr = '.' then filler = DARK_SHADE
else filler = filr
drawSierpinskiCarpet(ordr, filler)
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method drawSierpinskiCarpet(ordr, filler = Rexx '@') public static binary
x = long
y = long
powr = 3 ** ordr
loop x = 0 to powr - 1
loop y = 0 to powr - 1
if isSierpinskiCarpetCellFilled(x, y) then cell = filler
else cell = ' '
say cell'\-'
end y
say
end x
return
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
method isSierpinskiCarpetCellFilled(x = long, y = long) public static binary returns boolean
isTrue = boolean (1 == 1)
isFalse = \isTrue
isFilled = isTrue
loop label edge while x \= 0 & y \= 0
if x // 3 = 1 & y // 3 = 1 then do
isFilled = isFalse
leave edge
end
x = x % 3
y = y % 3
end edge
return isFilled

20
Task/Sierpinski-carpet/Nim/sierpinski-carpet.nim Normal file
View file

@ -0,0 +1,20 @@
import math
proc inCarpet(x, y: int): bool =
var x = x
var y = y
while true:
if x == 0 or y == 0:
return true
if x mod 3 == 1 and y mod 3 == 1:
return false
x = x div 3
y = y div 3
proc carpet(n: int) =
for i in 0 ..< 3^n:
for j in 0 ..< 3^n:
stdout.write if inCarpet(i, j): "* " else: " "
echo()
carpet(3)

18
Task/Sierpinski-carpet/OCaml/sierpinski-carpet-1.ocaml Normal file
View file

@ -0,0 +1,18 @@
let rec in_carpet x y =
if x = 0 || y = 0 then true
else if x mod 3 = 1 && y mod 3 = 1 then false
else in_carpet (x / 3) (y / 3)
(* I define my own operator for integer exponentiation *)
let rec (^:) a b =
if b = 0 then 1
else if b mod 2 = 0 then let x = a ^: (b / 2) in x * x
else a * (a ^: (b - 1))
let carpet n =
for i = 0 to (3 ^: n) - 1 do
for j = 0 to (3 ^: n) - 1 do
print_char (if in_carpet i j then '*' else ' ')
done;
print_newline ()
done

14
Task/Sierpinski-carpet/OCaml/sierpinski-carpet-2.ocaml Normal file
View file

@ -0,0 +1,14 @@
let nextCarpet carpet =
List.map (fun x -> x ^ x ^ x) carpet @
List.map (fun x -> x ^ String.make (String.length x) ' ' ^ x) carpet @
List.map (fun x -> x ^ x ^ x) carpet
let rec sierpinskiCarpet n =
let rec aux n carpet =
if n = 0 then carpet
else aux (n-1) (nextCarpet carpet)
in
aux n ["#"]
let () =
List.iter print_endline (sierpinskiCarpet 3)

29
Task/Sierpinski-carpet/Objeck/sierpinski-carpet.objeck Normal file
View file

@ -0,0 +1,29 @@
class SierpinskiCarpet {
function : Main(args : String[]) ~ Nil {
Carpet(3);
}
function : InCarpet(x : Int, y : Int) ~ Bool {
while(x<>0 & y<>0) {
if(x % 3 = 1 & y % 3 = 1) {
return false;
};
x /= 3;
y /= 3;
};
return true;
}
function : Carpet(n : Int) ~ Nil {
power := 3.0->Power(n->As(Float));
for(i := 0; i < power; i+=1;) {
for(j := 0; j < power; j+=1;) {
c := InCarpet(i, j) ? '*' : ' ';
c->Print();
};
IO.Console->PrintLine();
};
}
}

15
Task/Sierpinski-carpet/Oforth/sierpinski-carpet.fth Normal file
View file

@ -0,0 +1,15 @@
: carpet(n)
| dim i j k |
3 n pow ->dim
0 dim 1 - for: i [
0 dim 1 - for: j [
dim 3 / ->k
while(k) [
i k 3 * mod k / 1 == j k 3 * mod k / 1 == and ifTrue: [ break ]
k 3 / ->k
]
k ifTrue: [ " " ] else: [ "#" ] print
]
printcr
] ;

39
Task/Sierpinski-carpet/Order/sierpinski-carpet.order Normal file
View file

@ -0,0 +1,39 @@
#include <order/interpreter.h>
#define ORDER_PP_DEF_8in_carpet ORDER_PP_FN( \
8fn(8X, 8Y, \
8if(8or(8is_0(8X), 8is_0(8Y)), \
8true, \
8let((8Q, 8quotient(8X, 3)) \
(8R, 8remainder(8X, 3)) \
(8S, 8quotient(8Y, 3)) \
(8T, 8remainder(8Y, 3)), \
8and(8not(8and(8equal(8R, 1), 8equal(8T, 1))), \
8in_carpet(8Q, 8S))))) )
#define ORDER_PP_DEF_8carpet ORDER_PP_FN( \
8fn(8N, \
8lets((8R, 8seq_iota(0, 8pow(3, 8N))) \
(8G, 8seq_map(8fn(8Y, 8seq_map(8fn(8X, 8pair(8X, 8Y)), \
8R)), \
8R)), \
8seq_map(8fn(8S, 8seq_map(8fn(8P, 8apply(8in_carpet, 8P)), \
8S)), \
8G))) )
#define ORDER_PP_DEF_8carpet_to_string ORDER_PP_FN( \
8fn(8C, \
8seq_fold( \
8fn(8R, 8S, \
8adjoin(8R, \
8seq_fold(8fn(8P, 8B, 8adjoin(8P, 8if(8B, 8("#"), 8(" ")))), \
8nil, 8S), \
8("\n"))), \
8nil, 8C)) )
#include <stdio.h>
int main(void) {
printf(ORDER_PP( 8carpet_to_string(8carpet(3)) ));
return 0;
}

22
Task/Sierpinski-carpet/Oz/sierpinski-carpet.oz Normal file
View file

@ -0,0 +1,22 @@
declare
%% A carpet is a list of lines.
fun {NextCarpet Carpet}
{Flatten
[{Map Carpet XXX}
{Map Carpet X_X}
{Map Carpet XXX}
]}
end
fun {XXX X} X#X#X end
fun {X_X X} X#{Spaces {VirtualString.length X}}#X end
fun {Spaces N} if N == 0 then nil else & |{Spaces N-1} end end
fun lazy {Iterate F X}
X|{Iterate F {F X}}
end
SierpinskiCarpets = {Iterate NextCarpet ["#"]}
in
%% print all lines of the Sierpinski carpet of order 3
{ForAll {Nth SierpinskiCarpets 4} System.showInfo}

31
Task/Sierpinski-carpet/PARI-GP/sierpinski-carpet-1.parigp Normal file
View file

@ -0,0 +1,31 @@
\\ Improved simple plotting using matrix mat (color and scaling added).
\\ Matrix should be filled with 0/1. 7/6/16 aev
iPlotmat(mat,clr)={
my(xz=#mat[1,],yz=#mat[,1],vx=List(),vy=vx,xmin,xmax,ymin,ymax,c=0.625);
for(i=1,yz, for(j=1,xz, if(mat[i,j]==0, next, listput(vx,i); listput(vy,j))));
xmin=listmin(vx); xmax=listmax(vx); ymin=listmin(vy); ymax=listmax(vy);
plotinit(0); plotcolor(0,clr);
plotscale(0, xmin,xmax,ymin,ymax);
plotpoints(0, Vec(vx)*c,Vec(vy));
plotdraw([0,xmin,ymin]);
print(" *** matrix: ",xz,"x",yz,", ",#vy," DOTS");
}
\\ iPlotV2(): Improved plotting from a file written by the wrtmat(). (color added)
\\ Saving possibly huge generation time if re-plotting needed.
iPlotV2(fn, clr)={
my(F,nf,vx=List(),vy=vx,Vr,xmin,xmax,ymin,ymax,c=0.625);
F=readstr(fn); nf=#F;
print(" *** Plotting from: ", fn, " - ", nf, " DOTS");
for(i=1,nf, Vr=stok(F[i]," "); listput(vx,eval(Vr[1])); listput(vy,eval(Vr[2])));
xmin=listmin(vx); xmax=listmax(vx); ymin=listmin(vy); ymax=listmax(vy);
plotinit(0); plotcolor(0,clr);
plotscale(0, xmin,xmax,ymin,ymax);
plotpoints(0, Vec(vx)*c,Vec(vy));
plotdraw([0,xmin,ymin]);
}
\\ Are x,y inside Sierpinski carpet? (1-yes, 0-no) 6/10/16 aev
inSC(x,y)={
while(1, if(!x||!y,return(1));
if(x%3==1&&y%3==1, return(0));
x\=3; y\=3;);\\wend
}

19
Task/Sierpinski-carpet/PARI-GP/sierpinski-carpet-2.parigp Normal file
View file

@ -0,0 +1,19 @@
\\ Sierpinski carpet fractal (n - order, clr - color, dfn - data file name)
\\ 6/10/16, upgraded 11/29/16 aev
pSierpinskiC(n, clr=5, dfn="")={
my(n3=3^n-1,M,pf=n>=5);
if(pf, M=matrix(n3+1,n3+1));
for(i=0,n3, for(j=0,n3,
if(inSC(i,j),
if(pf, M[i+1,j+1]=1, print1("* ")), if(!pf, print1(" ")));
); if(!pf, print(""));
);\\fend i
if(!pf, return(0));
if(dfn=="", c, wrtmat(M, dfn));
}
{\\ Test:
pSierpinskiC(3);
pSierpinskiC(5,14); \\ SierpC5.png, color - navy
}
{pSierpinskiC(5,,"c:\\pariData\\SC5.dat");
iPlotV2("c:\\pariData\\SC5.dat",10);} \\ SierpC5a.png, color - dark-green

28
Task/Sierpinski-carpet/PHP/sierpinski-carpet.php Normal file
View file

@ -0,0 +1,28 @@
<?php
function isSierpinskiCarpetPixelFilled($x, $y) {
while (($x > 0) or ($y > 0)) {
if (($x % 3 == 1) and ($y % 3 == 1)) {
return false;
}
$x /= 3;
$y /= 3;
}
return true;
}
function sierpinskiCarpet($order) {
$size = pow(3, $order);
for ($y = 0 ; $y < $size ; $y++) {
for ($x = 0 ; $x < $size ; $x++) {
echo isSierpinskiCarpetPixelFilled($x, $y) ? '#' : ' ';
}
echo PHP_EOL;
}
}
for ($order = 0 ; $order <= 3 ; $order++) {
echo 'N=', $order, PHP_EOL;
sierpinskiCarpet($order);
echo PHP_EOL;
}

Some files were not shown because too many files have changed in this diff Show more