RosettaCodeData/Task/Pell-numbers/Quackery/pell-numbers.quackery
2023-07-01 13:44:08 -04:00

100 lines
2.1 KiB
Text

[ $ "bigrat.qky" loadfile ] now!
[ ' [ 0 ] swap
witheach
[ over -1 peek
+ join ]
behead drop ] is cumsum ( [ --> [ )
[ dup -1 peek 2 *
over -2 peek + join ] is nextterm ( [ --> [ )
[ over 2 - times
nextterm
swap split drop ] is sequence ( n [ --> [ )
[ ' [ 0 1 ] sequence ] is pells ( n --> [ )
[ ' [ 2 2 ] sequence ] is companions ( n --> [ )
[ [] swap 1+
dup companions
behead drop
swap pells
behead drop
witheach
[ dip
[ behead 2 / ]
join nested
rot swap join
swap ]
drop ] is rootytwos ( n --> [ )
[ stack ] is index ( --> s )
[ temp put
1 index put
[] ' [ 0 1 ]
[ 1 index tally
over size
temp share < while
nextterm
behead drop
index share
isprime until
dup -1 peek
dup isprime iff
[ swap dip
[ index share
swap join
nested join ] ]
else drop
again ]
drop
index release
temp release ] is pellprimes ( n --> [ )
[ [] over 2 * pells
rot times
[ behead dip behead +
join ]
nip ] is nsws ( n --> [ )
[ [] swap 1+ dup
2 * 1+ pells
dup cumsum
swap rot times
[ over i^ 2 * peek
dup 1+ join
over i^ 2 * 1+ peek
join
dip rot nested join
unrot ]
2drop behead drop ] is nirts ( n --> [ )
say "Pell numbers " 10 pells echo
cr cr
say "Pell-Lucas's " 10 companions echo
cr cr
say "Approximations of sqrt(2)"
cr
10 rootytwos
witheach
[ do 2dup
vulgar$ echo$ sp
10 point$ echo$ cr ]
cr
say "Pell Primes "
7 pellprimes dup
[] swap
witheach [ 1 peek join ] echo
cr
say "their indices "
[] swap
witheach [ 0 peek join ] echo
cr cr
say "NSW numbers " 10 nsws echo
cr cr
say "Near isosceles right triangles"
cr
10 nirts witheach [ echo cr ]