Rosetta Code

Higher-order functions: Difference between revisions

Page Discussion

Higher-order functions (view source)

Revision as of 10:18, 10 July 2021

4,958 bytes added ,  2 years ago
→‎using FreePascal : Higher-order function MAP / REDUCE ( FOLDL / FOLDR ) / FILTER
(→‎{{header|Pascal}}: not showing output is not helpful)
Line 2,449:
end.</lang>
 
(*)=== using FreePascal : Higher-order function MAP / REDUCE ( FOLDL / FOLDR ) / FILTER ===
{{works with|FreePascal|version 3.2.0 }}
<lang Pascal>(*)
UNIT MRF;
{$mode Delphi} {$H+} {$J-} {$R+} (*) https://www.freepascal.org/docs-html/prog/progch1.html (*)
Line 2,463:
 
For debian Linux: apt -y install fpc
It contains a text IDE called fp
 
 
Line 2,471:
INTERFACE
 
USES
Math,
SysUtils,
variants;
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} // Use for variants
 
TYPE
 
Varyray = array of variant ;
 
Line 2,485:
FunC = FUNCTION ( x,y : variant ) : variant ;
FunD = FUNCTION ( x,y : longint ) : longint ;
FunE = FUNCTION ( x,y : variant ) : variant ;
 
 
PROCEDURE Show ( x : variant ) ;
FUNCTION Reverse ( x : Varyray ) : Varyray ;
FUNCTION Head ( x : Varyray ) : variant ;
FUNCTION Last ( x : Varyray ) : variant ;
FUNCTION Tail ( x : Varyray ) : Varyray ;
FUNCTION Take ( y : variant ; x : Varyray ) : Varyray ;
FUNCTION Map ( f : FunA ; x: Varyray ) : Varyray ; overload ;
PROCEDURE Map ( f : FunB ; x: Varyray ) ; overload ;
FUNCTION Map ( f : FunC ; x, y: Varyray ) : Varyray ; overload ;
FUNCTION Map ( f : FunD ; x, y: Varyray ) : Varyray ; overload ;
FUNCTION Filter ( f : FunA ; x: Varyray ) : Varyray ; overload ;
FUNCTION Filter ( f : FunE ; y: variant; x: Varyray ) : Varyray ; overload ;
FUNCTION FoldL ( f : FunC ; x: Varyray ) : variant ; overload ;
FUNCTION FoldL ( f : FunD ; x: Varyray ) : variant ; overload ;
FUNCTION FoldL ( f : FunE ; y: variant; x: Varyray ) : variant ; overload ;
FUNCTION Reduce ( f : FunC ; x: Varyray ) : variant ; overload ;
FUNCTION Reduce ( f : FunD ; x: Varyray ) : variant ; overload ;
FUNCTION Reduce ( f : FunE ; y: variant; x: Varyray ) : variant ; overload ;
FUNCTION FoldR ( f : FunC ; x: Varyray ) : variant ; overload ;
FUNCTION FoldR ( f : FunD ; x: Varyray ) : variant ; overload ;
 
(*) FOR TESTING (*)
 
FUNCTION RandFillInt ( x: variant ) : variant ;
FUNCTION RandFillReal ( x: variant ) : variant ;
 
FUNCTION AND_xy ( x, y: variant ) : variant ;
FUNCTION OR_xy ( x, y: variant ) : variant ;
FUNCTION AVG ( x: Varyray ) : variant ;
FUNCTION All ( f: FunA ; x: Varyray ) : variant ;
FUNCTION Any ( f: FunA ; x: Varyray ) : variant ;
 
FUNCTION Add ( x, y: variant ) : variant ;
FUNCTION Mult ( x, y: variant ) : variant ;
FUNCTION contain ( x, y: variant ) : variant ;
FUNCTION delete ( x, y: variant ) : variant ;
 
FUNCTION Add1 ( x: variant ) : variant ;
FUNCTION sine ( x: variant ) : variant ;
FUNCTION cosine ( x: variant ) : variant ;
FUNCTION cotangens ( x: variant ) : variant ;
FUNCTION Is_Even ( x: variant ) : variant ;
FUNCTION Is_Odd ( x: variant ) : variant ;
 
PROCEDURE Show ( x: variant ) ;
FUNCTION Map ( f: FunA ; x: Varyray ) : Varyray ; overload ;
PROCEDURE Map ( f: FunB ; x: Varyray ) ; overload ;
FUNCTION Map ( f: FunC ; x, y: Varyray ) : Varyray ; overload ;
FUNCTION Map ( f: FunD ; x, y: Varyray ) : Varyray ; overload ;
FUNCTION Filter ( f: FunA ; x: Varyray ) : Varyray ;
FUNCTION FoldL ( f: FunC ; x: Varyray ) : variant ; overload ;
FUNCTION FoldL ( f: FunD ; x: Varyray ) : variant ; overload ;
FUNCTION Reduce ( f: FunC ; x: Varyray ) : variant ; overload ;
FUNCTION Reduce ( f: FunD ; x: Varyray ) : variant ; overload ;
FUNCTION FoldR ( f: FunC ; x: Varyray ) : variant ; overload ;
FUNCTION FoldR ( f: FunD ; x: Varyray ) : variant ; overload ;
FUNCTION Add ( x, y: variant ) : variant ;
FUNCTION Add1 ( x: variant ) : variant ;
FUNCTION AND_xy ( x, y: variant ) : variant ;
FUNCTION AVG ( x: Varyray ) : variant ;
FUNCTION cosine ( x: variant ) : variant ;
FUNCTION Is_Even ( x: variant ) : variant ;
FUNCTION Mult ( x, y: variant ) : variant ;
FUNCTION Is_Odd ( x: variant ) : variant ;
FUNCTION OR_xy ( x, y: variant ) : variant ;
FUNCTION RandFillInt ( x: variant ) : variant ;
FUNCTION RandFillReal ( x: variant ) : variant ;
FUNCTION sine ( x: variant ) : variant ;
FUNCTION ForAll ( f: FunA ; x: Varyray ) : variant ;
FUNCTION AnyOf ( f: FunA ; x: Varyray ) : variant ;
 
 
IMPLEMENTATION
 
 
PROCEDURE Show ( x: variant ) ;
BEGIN write( x, ' ' ) ; END ;
 
 
 
FUNCTION Map ( f: FunAReverse ;( x x: Varyray ) : Varyray ; overload ;
VAR
__ : varyray ;
k : integer ;
BEGIN
IF length ( x ) < Low ( x ) + 2 THEN Exit ;
 
ArSetlength ( :__, length array( ofx variant) );
 
k : integer ;
FOR k := Low ( x ) to High ( x ) DO
__ [ k ] := x [ High ( x ) - k ] ;
 
result := __ ;
 
Setlength ( __, 0 );
 
END;
 
 
 
FUNCTION Head ( x : Varyray ) : variant ;
BEGIN result := x [ Low ( x ) ] ; END;
 
 
FUNCTION Last ( x : Varyray ) : variant ;
BEGIN result := x [ High ( x ) ] ; END;
 
 
FUNCTION Tail ( x : Varyray ) : Varyray ;
VAR
__ : varyray ;
k : integer ;
BEGIN
Setlength ( __, High ( x ) );
 
FOR k := Low ( x ) + 1 to High ( x ) DO
__ [ k - 1 ] := x [ k ] ;
 
result := __ ;
 
Setlength ( __, 0 );
 
END;
 
 
 
FUNCTION Take ( y : variant ; x : Varyray ) : Varyray ;
VAR
__ : varyray ;
k : integer ;
BEGIN
 
 
Setlength ( __, y );
 
FOR k := Low ( x ) to y - 1 DO
__ [ k ] := x [ k ] ;
 
result := __ ;
 
Setlength ( __, 0 );
 
END;
 
 
 
FUNCTION Map ( f: FunA ; x: Varyray ) : Varyray ; overload ;
 
VAR
 
Ar : array of variant ;
k : integer ;
 
BEGIN
 
SetLength ( Ar, length ( x ) ) ;
result := Ar ;
Line 2,544 ⟶ 2,639:
 
 
PROCEDURE Map ( f: FunB ; x: Varyray ) ; overload ;
 
VAR
 
k : integer ;
 
BEGIN
FOR k := Low ( x ) TO High ( x ) DO f ( x [ k ] ) ;
Line 2,555 ⟶ 2,650:
 
 
 
FUNCTION Map ( f: FunC ; x, y: Varyray ) : Varyray ; overload ;
 
VAR
 
Ar : array of variant ;
k : integer ;
 
BEGIN
 
SetLength ( Ar, min ( length ( x ) , length ( y ) ) ) ;
 
Line 2,571 ⟶ 2,666:
 
result := Ar ;
 
END;
 
 
 
FUNCTION Map ( f: FunD ; x, y: Varyray ) : Varyray ; overload ;
 
VAR
 
Ar : array of variant ;
k : integer ;
 
BEGIN
 
SetLength ( Ar, min ( length ( x ) , length ( y ) ) ) ;
 
Line 2,591 ⟶ 2,686:
 
result := Ar ;
 
END;
 
 
 
FUNCTION Filter Map ( f: FunAFunE ; x: variant; y: Varyray ) : Varyray ; overload ;
 
VAR
 
Ar : array of variant ;
k : integer ;
 
BEGIN
 
SetLength ( Ar, min ( length ( x ) , length ( y ) ) ) ;
 
FOR k := Low ( Ar ) TO High ( Ar ) DO
Ar [ k ] := f ( x , y [ k ] ) ;
 
result := Ar ;
 
END;
 
 
 
FUNCTION Filter ( f: FunA ; x: Varyray ) : Varyray ; overload ;
 
VAR
 
Line 2,604 ⟶ 2,719:
k : integer ;
len : integer ;
 
BEGIN
 
SetLength ( Ar, 0 ) ;
result := Ar ;
Line 2,633 ⟶ 2,748:
 
 
FUNCTION FoldL Filter ( f: FunCFunE ; y: variant; x: Varyray ) : variantVaryray ; overload ;
 
VAR
 
Ar : array of variant ;
__ : variant ;
k : integer ;
len : integer ;
 
BEGIN
 
SetLength ( Ar, 0 ) ;
result := Ar ;
 
FOR k := Low ( x ) TO High ( x ) DO
BEGIN
 
__ := f ( y, x [ k ] ) ;
 
IF __ <> False THEN
 
BEGIN
 
len := Length ( Ar ) ;
SetLength ( Ar, len + 1 ) ;
Ar [ len ] := __ ;
 
END ;
 
END ;
 
result := Ar ;
 
END;
 
 
 
FUNCTION FoldL ( f: FunC ; x: Varyray ) : variant ; overload ;
 
VAR
 
k : integer ;
 
BEGIN
 
result := x [ Low ( x ) ] ;
 
Line 2,650 ⟶ 2,802:
 
 
FUNCTION FoldL ( f: FunD ; x: Varyray ) : variant ; overload ;
 
VAR
 
k : integer ;
 
BEGIN
 
result := x [ Low ( x ) ] ;
 
Line 2,667 ⟶ 2,819:
 
 
FUNCTION Reduce FoldL ( f: FunCFunE ; y: variant; x: Varyray ) : variant ; overload ;
 
VAR
 
k : integer ;
 
BEGIN
 
 
FOR k := Low ( x ) TO High ( x ) DO
result := f ( y , x [ k ] ) ;
 
END ;
 
 
 
FUNCTION Reduce ( f: FunC ; x: Varyray ) : variant ; overload ;
BEGIN result := FoldL ( f , x ) ; END ;
 
 
 
FUNCTION Reduce ( f: FunD ; x: Varyray ) : variant ; overload ;
BEGIN result := FoldL ( f , x ) ; END ;
 
 
 
FUNCTION FoldR Reduce ( f: FunCFunE ; y: variant; x: Varyray ) : variant ; overload ;
BEGIN result := FoldL ( f , y, x ) ; END ;
 
 
 
FUNCTION FoldR ( f: FunC ; x: Varyray ) : variant ; overload ;
 
VAR
 
k : integer ;
 
BEGIN
 
result := x [ High ( x ) ] ;
 
FOR k := High ( x ) - 1 DOWNTO Low ( x ) DO
result := f ( result result, x [ k ] ) ;
 
END ;
Line 2,694 ⟶ 2,867:
 
 
FUNCTION FoldR ( f: FunD ; x: Varyray ) : variant ; overload ;
 
VAR
 
k : integer ;
 
BEGIN
 
 
result := x [ High ( x ) ];
 
FOR k := High ( x ) - 1 DOWNTO Low ( x ) DO
result := f ( result , x [ k ] ) ;
 
END ;
Line 2,712 ⟶ 2,885:
 
 
(*) TEST Functions (*)
 
(*) TEST Functions (*)
 
(*)
 
Special thanks to PascalDragon , winni & BobDog ( FreePascal.org ),
who explained the specifics of the compiler.
 
(*)
 
 
FUNCTION Add ( x, y: variant ) : variant ;
BEGIN result := x + y ; END ;
 
 
Line 2,734 ⟶ 2,906:
 
FUNCTION AND_xy ( x, y: variant ) : variant ;
BEGIN result := ( x and y ) = True ; END ;
 
 
 
FUNCTION AVG ( x: Varyray ) : variant ;
 
VAR
 
k : integer ;
 
BEGIN
 
result := 0.0 ;
 
Line 2,755 ⟶ 2,927:
 
 
FUNCTION cosineCosine ( x: variant ) : variant ;
BEGIN result := cos ( x ); END ;
 
 
 
FUNCTION Cotangens ( x: variant ) : variant ;
BEGIN
IF ( x = 0 ) Then Exit ( 'Inf');
result := cot ( x );
END ;
 
 
 
FUNCTION Is_Even ( x: variant ) : variant ;
 
Line 2,774 ⟶ 2,954:
 
FUNCTION Mult( x, y: variant ) : variant ;
BEGIN result := x * y ; END ;
 
 
 
FUNCTION Contain ( x, y: variant ) : variant ;
BEGIN result := x = y ; END ;
 
 
 
FUNCTION Delete ( x, y: variant ) : variant ;
BEGIN
IF ( x = y ) THEN Exit ( False ) ;
result := y;
END ;
 
 
Line 2,792 ⟶ 2,984:
 
FUNCTION OR_xy ( x, y: variant ) : variant ;
BEGIN result := ( x or y ) = True; END ;
 
 
Line 2,815 ⟶ 3,007:
 
 
FUNCTION ForAllAll ( f: FunA ; x: Varyray ) : variant ;
 
VAR
 
k : integer ;
 
BEGIN
 
result := True ;
 
Line 2,832 ⟶ 3,024:
 
 
FUNCTION AnyOfAny ( f: FunA ; x: Varyray ) : variant ;
 
VAR
 
k : integer ;
 
BEGIN
 
result := False ;
 
FOR k := Low ( x ) TO High ( x ) DO
result := OR_xy ( result , f ( x [ k ] ) ) ;
 
END ;
END.
 
 
 
 
 
Line 2,855 ⟶ 3,050:
{$mode Delphi} {$H+} {$J-} {$R+} (*) https://www.freepascal.org/docs-html/prog/progch1.html (*)
USES
MRF,
Math,
SysUtils,
Variants;
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} // Use for variants
 
VAR
Line 2,865 ⟶ 3,060:
a,b,c : array of variant ;
 
AccuAcc : variant ;
 
BEGIN
 
Randomize ;
 
setlength ( a, 46 ) ;
setlength ( b, 4 ) ;
setlength ( c, 46 ) ;
 
a := Map ( RandFillRealRandFillInt , a ) ;
Map ( show , a ) ;
writeln ;
writeln ;
 
Accu := FoldR ( add , a ) ;
WriteLn ( 'Sum = ' , Accu ) ;
writeln ;
writeln ;
Accu := Reduce ( mult , a ) ;
WriteLn ( 'Product = ' , Accu ) ;
writeln ;
writeln ;
 
b := Map ( RandFillInt , b ) ;
WriteLn ( 'b :');
Map ( show , b ) ;
writeln ;
 
c := Map ( RandFillInt , c ) ;
Map ( show , c ) ;
writeln ;
 
Acc := FoldL ( add , a ) ;
WriteLn ( 'Sum = ' , Acc ) ;
writeln ;
AccuAcc := avgReduce ( contain ( , 31, a ) ;
WriteLn ( 'avgcontains = ' , Acc , Accu ) ;
writeln ;
 
c := Filter ( delete , 31, a ) ;
WriteLn ( 'del c :' ) ;
Map ( show , c ) ;
writeln ;
 
ca := Filter Reverse ( Is_Odd , b c ) ;
writelnWriteLn ( 'Oddreverse c : ' , length ( c ) ) ;
Map ( show , ca ) ;
writeln ;
 
Acc := avg ( b ) ;
WriteLn ( 'avg = ' , Acc ) ;
writeln ;
 
Accuc := FoldL (Map min ( cotangens , cb ) ;
WriteLnwriteln ( 'mincot =: ' ,) Accu );
writelnMap ( show , c ) ;
writeln ;
 
AccuAcc := FoldL FoldR ( maxmin , cb ) ;
WriteLn ( 'maxmin = ' , AccuAcc );
writeln ;
 
Acc := FoldR ( max , b ) ;
WriteLn ( 'max = ' , Acc );
writeln ;
 
Map ( show , b ) ;
AccuAcc := ForAllAll ( Is_Odd , b ) ;
writeln ;
WriteLn ( 'All Is_Odd = ' , Acc ) ;
writeln ;
 
WriteLn ( 'ForAll Is_Odd = ' , Accu ) ;
Map ( show , b ) ;
Acc := Any ( Is_Even , b ) ;
writeln ;
WriteLn ( 'Any Is_Even = ' , Acc ) ;
writeln ;
 
Acc := Map Head ( show , b ) ;
Accu := AnyOf WriteLn ( Is_Even'Head = ' , b Acc ) ;
 
Acc := Last ( b ) ;
WriteLn ( 'Last = ' , Acc ) ;
 
Map ( show , b ) ;
a := Tail ( b ) ;
writeln ;
WriteLn ( 'Tail of b :' ) ;
Map ( show , a ) ;
writeln ;
 
WriteLn ( 'AnyOf Is_Even = ' , Accu ) ;
Map ( show , b ) ;
a := Take ( 2, b ) ;
writeln ;
WriteLn ( 'Take 2 from b :' ) ;
Map ( show , a ) ;
writeln ;
 
Line 2,935 ⟶ 3,152:
setlength ( b, 0 ) ;
setlength ( a, 0 ) ;
 
Line 2,941 ⟶ 3,159:
 
 
 
</lang>JPD 2021/07/09
</lang>JPD 2021/07/10
 
Output:
 
Random ( Like me :)
{{improve|Pascal|not showing output is not helpful}}
 
=={{header|Perl}}==
JPD
122

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/13804"