Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
46
Task/Generator-Exponential/Forth/generator-exponential.fth
Normal file
46
Task/Generator-Exponential/Forth/generator-exponential.fth
Normal file
|
|
@ -0,0 +1,46 @@
|
|||
\ genexp-rcode.fs Generator/Exponential for RosettaCode.org
|
||||
|
||||
\ Generator/filter implementation using return stack as continuations stack
|
||||
: ENTER ( cont.addr -- ;borrowed from M.L.Gasanenko papers)
|
||||
>R
|
||||
;
|
||||
: | ( f -- ;true->go ahead, false->return into generator )
|
||||
IF EXIT THEN R> DROP
|
||||
;
|
||||
: GEN ( -- ;generate forever what is between 'GEN' and ';' )
|
||||
BEGIN R@ ENTER AGAIN
|
||||
;
|
||||
: STOP ( f -- ;return to caller of word that contain 'GEN' )
|
||||
IF R> DROP R> DROP R> DROP THEN
|
||||
;
|
||||
|
||||
\ Problem at hand
|
||||
: square ( n -- n^2 ) dup * ;
|
||||
: cube ( n -- n^3 ) dup square * ;
|
||||
|
||||
\ Faster tests using info that tested numbers are monotonic growing
|
||||
VARIABLE Sqroot \ last square root
|
||||
VARIABLE Cbroot \ last cubic root
|
||||
: square? ( u -- f ;test U for square number)
|
||||
BEGIN
|
||||
Sqroot @ square over <
|
||||
WHILE
|
||||
1 Sqroot +!
|
||||
REPEAT
|
||||
Sqroot @ square =
|
||||
;
|
||||
: cube? ( u -- f ;test U for cubic number)
|
||||
BEGIN
|
||||
Cbroot @ cube over <
|
||||
WHILE
|
||||
1 Cbroot +!
|
||||
REPEAT
|
||||
Cbroot @ cube =
|
||||
;
|
||||
VARIABLE Counter
|
||||
: (go) ( u -- u' )
|
||||
GEN 1+ Counter @ 30 >= STOP
|
||||
dup square? | dup cube? 0= | Counter @ 20 >= 1 Counter +! | dup .
|
||||
;
|
||||
:noname 0 Counter ! 1 Sqroot ! 1 Cbroot ! 0 (go) drop ;
|
||||
execute cr bye
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
sub powers($m) { 0..* X** $m }
|
||||
|
||||
my @squares := powers(2);
|
||||
my @cubes := powers(3);
|
||||
my @squares = powers(2);
|
||||
my @cubes = powers(3);
|
||||
|
||||
sub infix:<without> (@orig,@veto) {
|
||||
gather for @veto -> $veto {
|
||||
|
|
|
|||
|
|
@ -1,47 +1,40 @@
|
|||
/*REXX program to show how to use a generator (also known as iterators).*/
|
||||
numeric digits 10000 /*just in case we need big 'uns. */
|
||||
parse arg show; show = word(show 0, 1) /*show this many.*/
|
||||
@gen.= /*generators start from scratch. */
|
||||
do j=1 to show; call tell 'squares' ,gen_squares(j) ; end
|
||||
do j=1 to show; call tell 'cubes' ,gen_cubes(j) ; end
|
||||
do j=1 to show; call tell 'sq¬cubes',gen_sqNcubes(j) ; end
|
||||
if show>0 then say 'dropping 1st ──► 20th values.'
|
||||
do j=1 to 20; drop @gen.sqNcubes.j ; end
|
||||
do j=20+1 for 10 ; call tell 'sq¬cubes',gen_sqNcubes(j) ; end
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*─────────────────────────────────────gen_powers iterator──────────────*/
|
||||
gen_powers: procedure expose @gen.; parse arg x,p; if x=='' then return
|
||||
if @gen.powers.x.p=='' then @gen.powers.x.p=x**p; return @gen.powers.x.p
|
||||
/*─────────────────────────────────────gen_squares iterator─────────────*/
|
||||
gen_squares: procedure expose @gen.; parse arg x; if x=='' then return
|
||||
if @gen.squares.x=='' then do; call gen_powers x,2
|
||||
@gen.squares.x=@gen.powers.x.2
|
||||
end
|
||||
return @gen.squares.x
|
||||
/*─────────────────────────────────────gen_cubes iterator───────────────*/
|
||||
gen_cubes: procedure expose @gen.; parse arg x; if x=='' then return
|
||||
if @gen.cubes.j=='' then do; call gen_powers x,3
|
||||
@gen.cubes.x=@gen.powers.x.3
|
||||
end
|
||||
return @gen.cubes.x
|
||||
/*─────────────────────────────────────gen_squares not cubes iterator───*/
|
||||
gen_sqNcubes: procedure expose @gen.; parse arg x; if x=='' then return
|
||||
s=0
|
||||
if @gen.sqNcubes.x=='' then do j=1 to x
|
||||
if @gen.sqNcubes\=='' then do; sq=sq+1
|
||||
iterate
|
||||
end
|
||||
do s=s+1 /*slow way to weed out cubes*/
|
||||
?=gen_squares(s)
|
||||
do c=1 until gen_cubes(c)>?
|
||||
if gen_cubes(c)==? then iterate s
|
||||
end /*c*/
|
||||
leave
|
||||
end /*s*/
|
||||
@gen.sqNcubes.x=?
|
||||
@gen.sqNcubes.x=@gen.squares.s
|
||||
end /*j*/
|
||||
return @gen.sqNcubes.x
|
||||
/*──────────────────────────────────TELL subroutine─────────────────────*/
|
||||
tell: if j==1 then say /* [↓] format args to be aligned.*/
|
||||
say right(arg(1),20) right(j,5) right(arg(2),20); return
|
||||
/*REXX program demonstrates how to use a generator (also known as iterators).*/
|
||||
parse arg N .; if N=='' then N=20 /*N not specified? Then use default.*/
|
||||
@.= /* [↓] calculate squares,cubes,pureSq.*/
|
||||
do j=1 for N; call Gsquare j
|
||||
call Gcube j
|
||||
call GpureSquare j /*these are cube─free squares.*/
|
||||
end /*j*/
|
||||
|
||||
do k=1 for N; @.pureSquare.k=; end /*k*/ /*dropping 1st N values.*/
|
||||
|
||||
w=length(N+10); ps='pure square' /*width of the numbers. */
|
||||
|
||||
do m=N+1 for 10; say ps right(m, w)":" right(GpureSquare(m), 3*w)
|
||||
end /*m*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
Gpower: procedure expose @.; parse arg x,p; q=@.pow.x.p
|
||||
if q\=='' then return q; _=x**p
|
||||
if pos(.,_)\==0 then do
|
||||
parse var _ 'E' e; numeric digits e+5; _=x**p
|
||||
end /* [↑] re─calculate with more digits.*/
|
||||
@.pow.x.p=_
|
||||
return _
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
Gsquare: procedure expose @.; parse arg x; q=@.square.x
|
||||
if q=='' then @.square.x=Gpower(x,2)
|
||||
return @.square.x
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
Gcube: procedure expose @.; parse arg x; q=@.cube.x
|
||||
if q=='' then @.cube.x=Gpower(x,3); _=@.cube.x; @.3pow._=1
|
||||
return @.cube.x
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
GpureSquare: procedure expose @.; parse arg x; q=@.pureSquare.x
|
||||
if q\=='' then return q
|
||||
#=0
|
||||
do j=1 until #==x; ?=Gpower(j,2) /*search for pure square*/
|
||||
if @.3pow.?==1 then iterate /*is it a power of 3 ? */
|
||||
#=#+1; @.pureSquare.#=? /*assign next pureSquare*/
|
||||
end /*j*/
|
||||
return @.pureSquare.x
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue