Concatenative topics
Concatenative meta
Other languages
Meta
The Sierpinski triangle of order 4 should look like this:
*
* *
* *
* * * *
* *
* * * *
* * * *
* * * * * * * *
* *
* * * *
* * * *
* * * * * * * *
* * * *
* * * * * * * *
* * * * * * * *
* * * * * * * * * * * * * * * *
@sierpinski ( -> )
( mask ) [ LIT2r 0a18 ] [ LIT2r 2018 ]
( size ) [ LIT2 &size 1001 ] SUB
&>ver ( -- )
DUP INCk
&>pad ( length -- )
DEOkr
#01 SUB DUP ?&>pad
&>fill ( length i -- )
ANDk DUP2r ?{ POP2r ORA2kr } DEOr DEOkr
INC ADDk ,&size LDR LTH ?&>fill
POP2 OVR2r DEOr
#01 SUB INCk ?&>ver
POP POP2r POP2r BRK
:N 16;
N [ dup (y)
[' .c] dotimes (print padding)
N [ dup (x)
over2 drop 1- (y' = y - 1)
swap N !- (x' = N - x)
& (x' & y')
\' \'* ifte .c ' .c ] (print * or space)
dotimes .nl]
dotimes: plot ( i j -- )
bitand zero? "* " " " ? write ;
: pad ( n -- )
1 - [ bl ] times ;
: plot-row ( n -- )
dup 1 + [ tuck - plot ] with each-integer ;
: sierpinski ( n -- )
dup '[ _ over - pad plot-row nl ] each-integer ;vocab each_int:
define helper<+P> (Int32, Int32, (Int32 -> +P) -> +P):
-> n, i, f ;
if (i < n):
i f call
n (i + 1) f helper
define each_int<+P> (Int32, (Int32 -> +P) -> +P):
zero swap each_int::helper
define with_arg<R1..., R2..., T, A, B, S..., +P2, +P1>(R1..., T, B, (R2..., T, A -> S... +P2) -> R1..., B, (R2..., A -> S... +P1) +P1):
{swap} dip {{swap} dip call} apply apply
define plot (Int32, Int32 -> +IO):
(&) zero (=) if {"* "} else {" "} print
define over<A, B> (A, B -> A, B, A):
-> a, b; a b a
define tuck<A, B> (A, B -> B, A, B):
swap over
define times<+P> (Int32, (-> +P) -> +P):
{drop} swap compose each_int
define pad (Int32 -> +IO):
1 (-) {" " print} times
define plot_row (Int32 -> +IO):
dup 1 (+) {tuck (-) plot} with_arg each_int
define sierpinski (Int32 -> +IO):
dup {over (-) pad plot_row "\n" print} apply each_int
16 sierpinski: star ( -- ) [char] * emit space ;
: plot ( i j -- ) and 0= if star else 2 spaces then ;
: padd ( n -- ) 0 +do space loop ;
: 2^ ( n -- 2^n ) dup 0= if 1 else 1- 2 swap lshift then ;
: sierpinski ( o -- )
2^ dup 1- -1 swap -do
i padd dup 0 +do
i j plot
loop cr
1 -loop ;
4 sierpinski# can be made better by someone with more uiua experience S ← ↻1=0⊞(/+⬚0×)∩⋯:⟜:⊙-.⇡.ⁿ:2 P ← ∵(□↯:@ )⇌:≡(□♭⊏:[" " " □"]↙)+1⇡⧻.
This revision created on Sat, 9 Mar 2024 12:53:27 by razetime (add uiua)