Generator/Exponential: Difference between revisions
m
Moved Wren entry into correct alphabetical order.
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
m (Moved Wren entry into correct alphabetical order.) |
||
| (7 intermediate revisions by 5 users not shown) | |||
Line 623:
{{Out}}
<pre>{529, 576, 625, 676, 784, 841, 900, 961, 1024, 1089}</pre>
=={{header|ATS}}==
<syntaxhighlight lang="ats">
(* "Generators" *)
(* I implement "generators" as non-linear closures. *)
#include "share/atspre_staload.hats"
#define NIL list_nil ()
#define :: list_cons
(* Integer powers where base and power are of any unsigned integer
types. *)
fn {tk_b, tk_p : tkind}
g1uint_ipow
(base : g1uint tk_b,
power : g1uint tk_p)
:<> g1uint tk_b =
let
fun
loop {p : nat}
.<p>.
(b : g1uint tk_b,
p : g1uint (tk_p, p),
accum : g1uint tk_b)
:<> g1uint tk_b =
let
val ph = half p
val accum = (if ph + ph = p then accum else accum * b)
in
if ph = g1i2u 0 then
accum
else
loop (b * b, ph, accum)
end
prval () = lemma_g1uint_param base
prval () = lemma_g1uint_param power
in
loop (base, power, g1i2u 1)
end
overload ipow with g1uint_ipow of 100
(* Some unit tests of ipow. *)
val- 0U = ipow (0U, 100U)
val- 1U = ipow (0U, 0U) (* Sometimes a convenient result. *)
val- 9UL = ipow (3UL, 2ULL)
val- 81ULL = ipow (3ULL, 4U)
typedef generator (tk : tkind) =
() -<cloref1> g1uint tk
typedef option_generator (tk : tkind) =
() -<cloref1> Option (g1uint tk)
fn {tk_b : tkind}
{tk_p : tkind}
make_powers_generator
(power : g1uint tk_p)
:<!wrt> generator tk_b =
let
val base : ref (g1uint tk_b) = ref (g1i2u 0)
in
lam () =>
let
val b = !base
val result = ipow (b, power)
in
!base := succ b;
result
end
end
fn {tk : tkind}
make_generator_of_1_that_are_not_also_2
(gen1 : generator tk,
gen2 : generator tk)
:<!wrt> generator tk =
let
val initialized : ref bool = ref false
val x2 : ref (g1uint tk) = ref (g1i2u 0)
fn
check (x1 : g1uint tk)
:<1> bool =
let
fun
loop ()
:<1> bool =
if x1 <= !x2 then
(x1 <> !x2)
else
begin
!x2 := gen2 ();
loop ()
end
in
loop ()
end
in
lam () =>
let
var result : g1uint tk = g1i2u 0
var found_one : bool = false
in
if ~(!initialized) then
begin
!x2 := gen2 ();
!initialized := true
end;
while (~found_one)
let
val next1 = gen1 ()
in
if check next1 then
begin
result := next1;
found_one := true
end
end;
result
end
end
fn {tk : tkind}
make_dropper
(n : size_t,
gen : generator tk)
:<!wrt> generator tk =
let
val counter : ref size_t = ref n
in
lam () =>
begin
while (isneqz (!counter))
let
val _ = gen ()
in
!counter := pred (!counter)
end;
gen ()
end
end
fn {tk : tkind}
make_taker
(n : size_t,
gen : generator tk)
:<!wrt> option_generator tk =
let
val counter : ref size_t = ref n
in
lam () =>
if iseqz (!counter) then
None ()
else
begin
!counter := pred (!counter);
Some (gen ())
end
end
implement
main0 () =
let
stadef tk = uintknd
macdef filter = make_generator_of_1_that_are_not_also_2<tk>
val squares_generator = make_powers_generator<tk> 2U
val cubes_generator = make_powers_generator<tk> 3U
val gen = filter (squares_generator, cubes_generator)
val gen = make_dropper<tk> (i2sz 20, gen)
val gen = make_taker<tk> (i2sz 10, gen)
var done : bool = false
in
while (~done)
begin
case+ gen () of
| None () => done := true
| Some x => print! (" ", x)
end;
println! ()
end
</syntaxhighlight>
{{out}}
<pre>$ patscc -DATS_MEMALLOC_GCBDW generator-exponential.dats -lgc && ./a.out
529 576 625 676 784 841 900 961 1024 1089</pre>
=={{header|C}}==
Line 1,204 ⟶ 1,396:
{{out}}
<pre>[529, 576, 625, 676, 784, 841, 900, 961, 1024, 1089]</pre>
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,Math,StdCtrls,ExtCtrls}}
This program demostrates hierarchial object structure. It starts with a base generator object that has all the basic features need by a generator. Child objects are then created which customized the behavior to generate squares, cubes and filtered squares. Once the base object is created, any variation can be created with just a few lines of code. This is the power of polymorphism and inheritance.
<syntaxhighlight lang="Delphi">
{Custom object forms basic generator}
type TCustomGen = class(TObject)
private
FNumber: integer;
FExponent: integer;
FStart: integer;
protected
property Exponent: integer read FExponent write FExponent;
public
constructor Create; virtual;
procedure Reset;
function Next: integer; virtual;
procedure Skip(Count: integer);
property Start: integer read FStart write FStart;
end;
{Child object specifically for generating Squares}
type TSquareGen = class(TCustomGen)
public
constructor Create; override;
end;
{Child object specifically for generating cubes}
type TCubeGen = class(TCustomGen)
public
constructor Create; override;
end;
{Child object specifically for filtering squares}
type TFilterSquareGen = class(TSquareGen)
private
function IsCube(N: integer): boolean;
public
function Next: integer; override;
end;
{ TCustomGen }
constructor TCustomGen.Create;
begin
Start:=0;
{Default to returning X^1}
Exponent:=1;
Reset;
end;
function TCustomGen.Next: integer;
{Find next number in sequence}
var I: integer;
begin
Result:=FNumber;
{Raise to specified power}
for I:=1 to FExponent-1 do Result:=Result * Result;
{Get next base}
Inc(FNumber);
end;
procedure TCustomGen.Reset;
begin
FNumber:=Start;
end;
procedure TCustomGen.Skip(Count: integer);
{Skip specified number of items}
var I: integer;
begin
for I:=1 to Count do Next;
end;
{ TSquareGen }
constructor TSquareGen.Create;
begin
inherited;
Exponent:=2;
end;
{ TCubeGen }
constructor TCubeGen.Create;
begin
inherited;
Exponent:=3;
end;
{ TFilterSquareGen }
function TFilterSquareGen.IsCube(N: integer): boolean;
{Test if number is perfect cube}
var I: integer;
begin
I:=Round(Power(N,1/3));
Result:=I*I*I = N;
end;
function TFilterSquareGen.Next: integer;
begin
{Gets inherited next square, rejects cubes}
repeat Result:=inherited Next
until not IsCube(Result);
end;
{-----------------------------------------------------------}
procedure DoTest(Memo: TMemo; Gen: TCustomGen; SkipCnt: integer; Title: string);
{Carry out TGenerators tests. "Gen" is a TCustomGen which is the parent of}
{all generators. That means "DoTest" can work with any type of generator}
var S: string;
var I,V: integer;
begin
Gen.Reset;
Gen.Skip(SkipCnt);
Memo.Lines.Add(Title);
S:='[';
for I:=1 to 10 do S:=S+Format(' %d',[Gen.Next]);
Memo.Lines.Add(S+']');
end;
procedure TestGenerators(Memo: TMemo);
{Tests all three types of generators}
var SquareGen: TSquareGen;
var CubeGen: TCubeGen;
var Filtered: TFilterSquareGen;
begin
SquareGen:=TSquareGen.Create;
try
CubeGen:=TCubeGen.Create;
try
Filtered:=TFilterSquareGen.Create;
try
DoTest(Memo,SquareGen,0,'Testing Square Generator');
DoTest(Memo,CubeGen,0,'Testing Cube Generator');
DoTest(Memo,Filtered,20,'Testing Squares with cubes removed');
finally Filtered.Free; end;
finally CubeGen.Free; end;
finally SquareGen.Free; end;
end;
</syntaxhighlight>
{{out}}
<pre>
Testing Square Generator
[ 0 1 4 9 16 25 36 49 64 81]
Testing Cube Generator
[ 0 1 16 81 256 625 1296 2401 4096 6561]
Testing Squares with cubes removed
[ 529 576 625 676 784 841 900 961 1024 1089]
</pre>
=={{header|E}}==
Line 2,455 ⟶ 2,818:
<syntaxhighlight lang="m2000 interpreter">
Module Generator {
PowGen = Lambda (e)
e // closure
-> {
i++
= i**e
}
}
Squares=Lambda
PowGen=PowGen(2) // closure
->{
= PowGen()
}
Cubes=Lambda
PowGen=PowGen(3) // closure
-> {
= PowGen()
}
Filter=Lambda
z=Squares(), // closure
Squares, // closure
m, // closure
Cubes // closure
->{
while m<z :m=cubes():end while
if z=m then z=Squares()
= z : z=Squares()
}
For i=1 to 20 : dropit=Filter() :Next i
Document doc$="Non-cubic squares (21st to 30th)"
Print doc$
doc$={
} \\ a new line to doc$
For i=1 to 10
f=Filter()
Print Format$("I: {0::-2}, F: {1}",i+20, f)
doc$=Format$("I: {0::-2}, F: {1}",i+20, f)+{
}
Clipboard doc$
}
Line 3,209 ⟶ 3,578:
=={{header|Raku}}==
(formerly Perl 6)
As with Haskell, generators are disguised as lazy lists in Raku.
<syntaxhighlight lang="raku" line>sub powers($m) {
my @squares = powers(2);
my @cubes = powers(3);
sub infix:<with-out> (@orig, @veto) {
gather for @veto -> $veto {
take @orig.shift while @orig[0] before $veto;
Line 3,432 ⟶ 3,801:
=={{header|Scheme}}==
===Scheme using conventional closures===
<syntaxhighlight lang="lisp">(define (power-seq n)
(let ((i 0))
Line 3,469 ⟶ 3,839:
1024
1089</pre>
===Scheme using ''call with current continuation''===
This method can be elaborated upon to, for instance, provide functionality similar to that of Icon co-expressions.
<syntaxhighlight lang="scheme">
;;; Generators using call/cc.
(cond-expand
(r7rs)
(chicken (import r7rs)))
(define-library (suspendable-procedures)
(export suspend)
(export make-generator-procedure)
(import (scheme base))
(begin
(define *suspend* (make-parameter (lambda (x) x)))
(define (suspend v) ((*suspend*) v))
(define (make-generator-procedure thunk)
;; This is for making a suspendable procedure that takes no
;; arguments when resumed. The result is a simple generator of
;; values.
(define (next-run return)
(define (my-suspend v)
(set! return (call/cc (lambda (resumption-point)
(set! next-run resumption-point)
(return v)))))
(parameterize ((*suspend* my-suspend))
(suspend (thunk))))
(lambda () (call/cc next-run)))
)) ;; end library (suspendable-procedures)
(import (scheme base))
(import (scheme case-lambda))
(import (scheme write))
(import (suspendable-procedures))
(define (make-integers-generator i0)
(make-generator-procedure
(lambda ()
(let loop ((i i0))
(suspend i)
(loop (+ i 1))))))
(define make-nth-powers-generator
(case-lambda
((n i0)
(define next-int (make-integers-generator i0))
(make-generator-procedure
(lambda ()
(let loop ()
(suspend (expt (next-int) n))
(loop)))))
((n)
(make-nth-powers-generator n 0))))
(define (make-filter-generator gen1 gen2)
(make-generator-procedure
(lambda ()
(let loop ((x1 (gen1))
(x2 (gen2)))
(cond ((= x1 x2) (loop (gen1) x2)) ; Skip this x1.
((< x1 x2) (begin ; Return this x1.
(suspend x1)
(loop (gen1) x2)))
(else (loop x1 (gen2))))))))
(define (gen-drop n)
(lambda (generator)
(make-generator-procedure
(lambda ()
(do ((i 0 (+ i 1)))
((= i n))
(generator))
(let loop ()
(suspend (generator))
(loop))))))
(define (gen-take n)
(lambda (generator)
(make-generator-procedure
(lambda ()
(do ((i 0 (+ i 1)))
((= i n))
(suspend (generator)))
(let loop ()
(suspend #f)
(loop))))))
(define my-generator
((gen-take 10)
((gen-drop 20)
(make-filter-generator
(make-nth-powers-generator 2)
(make-nth-powers-generator 3)))))
(let loop ()
(let ((x (my-generator)))
(when x
(display " ")
(display x)
(loop))))
(newline)
</syntaxhighlight>
{{out}}
Using Gauche Scheme.
<pre>$ gosh generator-exponential.scm
529 576 625 676 784 841 900 961 1024 1089</pre>
Using CHICKEN Scheme (which has efficient '''call/cc'''). You will need the '''r7rs''' egg.
<pre>$ csi -s generator-exponential.scm && ./a.out
529 576 625 676 784 841 900 961 1024 1089</pre>
=={{header|SenseTalk}}==
Line 3,869 ⟶ 4,354:
1024
1089</pre>
=={{header|Wren}}==
Closure based solution. Similar approach to Go (first example).
<syntaxhighlight lang="
var i = 0
return Fn.new {
Line 3,938 ⟶ 4,391:
}
System.print()</syntaxhighlight>
{{out}}
<pre>
529 576 625 676 784 841 900 961 1024 1089
</pre>
=={{header|XPL0}}==
<syntaxhighlight lang="xpl0">code ChOut=8, IntOut=11;
func Gen(M); \Generate Mth powers of positive integers
int M;
int N, R, I;
[N:= [0, 0, 0, 0]; \provides own/static variables
R:= 1;
for I:= 1 to M do R:= R*N(M);
N(M):= N(M)+1;
return R;
];
func Filter; \Generate squares of positive integers that aren't cubes
int S, C;
[C:= [0]; \static variable = smallest cube > current square
repeat S:= Gen(2);
while S > C(0) do C(0):= Gen(3);
until S # C(0);
return S;
];
int I;
[for I:= 1 to 20 do Filter; \drop first 20 values
for I:= 1 to 10 do [IntOut(0, Filter); ChOut(0, ^ )]; \show next 10 values
]</syntaxhighlight>
{{out}}
| |||