Higher-order functions: Difference between revisions

Content added Content deleted
(→‎{{header|Pascal}}: not showing output is not helpful)
Line 2,449: Line 2,449:
end.</lang>
end.</lang>


=== using FreePascal : Higher-order function MAP / REDUCE ( FOLDL / FOLDR ) / FILTER ===
(*)=== using FreePascal : Higher-order function MAP / REDUCE ( FOLDL / FOLDR ) / FILTER ===
{{works with|FreePascal|version 3.2.0 }}
{{works with|FreePascal|version 3.2.0 }}
<lang Pascal>
<lang Pascal>(*)
UNIT MRF;
UNIT MRF;
{$mode Delphi} {$H+} {$J-} {$R+} (*) https://www.freepascal.org/docs-html/prog/progch1.html (*)
{$mode Delphi} {$H+} {$J-} {$R+} (*) https://www.freepascal.org/docs-html/prog/progch1.html (*)
Line 2,463: Line 2,463:


For debian Linux: apt -y install fpc
For debian Linux: apt -y install fpc
It contains a text IDE called fp
It contains a text IDE called fp




Line 2,471: Line 2,471:
INTERFACE
INTERFACE


USES
USES
Math,
Math,
SysUtils,
SysUtils,
variants;
variants;
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} // Use for variants
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} // Use for variants


TYPE
TYPE

Varyray = array of variant ;
Varyray = array of variant ;


Line 2,485: Line 2,485:
FunC = FUNCTION ( x,y : variant ) : variant ;
FunC = FUNCTION ( x,y : variant ) : variant ;
FunD = FUNCTION ( x,y : longint ) : longint ;
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
IMPLEMENTATION




PROCEDURE Show ( x: variant ) ;
PROCEDURE Show ( x: variant ) ;
BEGIN write( x, ' ' ) ; END ;
BEGIN write( x, ' ' ) ; END ;






FUNCTION Map ( f: FunA ; x: Varyray ) : Varyray ; overload ;
FUNCTION Reverse ( x : Varyray ) : Varyray ;
VAR
VAR
__ : varyray ;
k : integer ;
BEGIN
IF length ( x ) < Low ( x ) + 2 THEN Exit ;


Ar : array of variant ;
Setlength ( __, length ( x ) );

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
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 ) ) ;
SetLength ( Ar, length ( x ) ) ;
result := Ar ;
result := Ar ;
Line 2,544: Line 2,639:




PROCEDURE Map ( f: FunB ; x: Varyray ) ; overload ;
PROCEDURE Map ( f: FunB ; x: Varyray ) ; overload ;

VAR
VAR


k : integer ;
k : integer ;

BEGIN
BEGIN
FOR k := Low ( x ) TO High ( x ) DO f ( x [ k ] ) ;
FOR k := Low ( x ) TO High ( x ) DO f ( x [ k ] ) ;
Line 2,555: Line 2,650:





FUNCTION Map ( f: FunC ; x, y: Varyray ) : Varyray ; overload ;
FUNCTION Map ( f: FunC ; x, y: Varyray ) : Varyray ; overload ;

VAR
VAR


Ar : array of variant ;
Ar : array of variant ;
k : integer ;
k : integer ;

BEGIN
BEGIN

SetLength ( Ar, min ( length ( x ) , length ( y ) ) ) ;
SetLength ( Ar, min ( length ( x ) , length ( y ) ) ) ;


Line 2,571: Line 2,666:


result := Ar ;
result := Ar ;

END;
END;




FUNCTION Map ( f: FunD ; x, y: Varyray ) : Varyray ; overload ;
FUNCTION Map ( f: FunD ; x, y: Varyray ) : Varyray ; overload ;

VAR
VAR

Ar : array of variant ;
Ar : array of variant ;
k : integer ;
k : integer ;

BEGIN
BEGIN

SetLength ( Ar, min ( length ( x ) , length ( y ) ) ) ;
SetLength ( Ar, min ( length ( x ) , length ( y ) ) ) ;


Line 2,591: Line 2,686:


result := Ar ;
result := Ar ;

END;
END;






FUNCTION Filter ( f: FunA ; x: Varyray ) : Varyray ;
FUNCTION Map ( f: FunE ; 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
VAR


Line 2,604: Line 2,719:
k : integer ;
k : integer ;
len : integer ;
len : integer ;

BEGIN
BEGIN

SetLength ( Ar, 0 ) ;
SetLength ( Ar, 0 ) ;
result := Ar ;
result := Ar ;
Line 2,633: Line 2,748:




FUNCTION FoldL ( f: FunC ; x: Varyray ) : variant ; overload ;
FUNCTION Filter ( f: FunE ; y: variant; x: Varyray ) : Varyray ; overload ;

VAR
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 ;
k : integer ;

BEGIN
BEGIN

result := x [ Low ( x ) ] ;
result := x [ Low ( x ) ] ;


Line 2,650: Line 2,802:




FUNCTION FoldL ( f: FunD ; x: Varyray ) : variant ; overload ;
FUNCTION FoldL ( f: FunD ; x: Varyray ) : variant ; overload ;

VAR
VAR


k : integer ;
k : integer ;

BEGIN
BEGIN

result := x [ Low ( x ) ] ;
result := x [ Low ( x ) ] ;


Line 2,667: Line 2,819:




FUNCTION Reduce ( f: FunC ; x: Varyray ) : variant ; overload ;
FUNCTION FoldL ( f: FunE ; 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 ;
BEGIN result := FoldL ( f , x ) ; END ;






FUNCTION Reduce ( f: FunD ; x: Varyray ) : variant ; overload ;
FUNCTION Reduce ( f: FunD ; x: Varyray ) : variant ; overload ;
BEGIN result := FoldL ( f , x ) ; END ;
BEGIN result := FoldL ( f , x ) ; END ;






FUNCTION FoldR ( f: FunC ; x: Varyray ) : variant ; overload ;
FUNCTION Reduce ( f: FunE ; y: variant; x: Varyray ) : variant ; overload ;
BEGIN result := FoldL ( f , y, x ) ; END ;



FUNCTION FoldR ( f: FunC ; x: Varyray ) : variant ; overload ;

VAR
VAR

k : integer ;
k : integer ;

BEGIN
BEGIN


result := x [ High ( x ) ] ;
result := x [ High ( x ) ] ;

FOR k := High ( x ) - 1 DOWNTO Low ( x ) DO
FOR k := High ( x ) - 1 DOWNTO Low ( x ) DO
result := f ( result , x [ k ] ) ;
result := f ( result, x [ k ] ) ;


END ;
END ;
Line 2,694: Line 2,867:




FUNCTION FoldR ( f: FunD ; x: Varyray ) : variant ; overload ;
FUNCTION FoldR ( f: FunD ; x: Varyray ) : variant ; overload ;

VAR
VAR

k : integer ;
k : integer ;

BEGIN
BEGIN



result := x [ High ( x ) ];
result := x [ High ( x ) ];


FOR k := High ( x ) - 1 DOWNTO Low ( x ) DO
FOR k := High ( x ) - 1 DOWNTO Low ( x ) DO
result := f ( result , x [ k ] ) ;
result := f ( result, x [ k ] ) ;


END ;
END ;
Line 2,712: Line 2,885:




(*) TEST Functions (*)

(*) TEST Functions (*)


(*)
(*)


Special thanks to PascalDragon , winni & BobDog ( FreePascal.org ),
Special thanks to PascalDragon , winni & BobDog ( FreePascal.org ),
who explained the specifics of the compiler.
who explained the specifics of the compiler.


(*)
(*)



FUNCTION Add ( x, y: variant ) : variant ;
FUNCTION Add ( x, y: variant ) : variant ;
BEGIN result := x + y ; END ;
BEGIN result := x + y ; END ;




Line 2,734: Line 2,906:


FUNCTION AND_xy ( x, y: variant ) : variant ;
FUNCTION AND_xy ( x, y: variant ) : variant ;
BEGIN result := ( x and y ) = True ; END ;
BEGIN result := ( x and y ) = True ; END ;






FUNCTION AVG ( x: Varyray ) : variant ;
FUNCTION AVG ( x: Varyray ) : variant ;

VAR
VAR

k : integer ;
k : integer ;

BEGIN
BEGIN

result := 0.0 ;
result := 0.0 ;


Line 2,755: Line 2,927:




FUNCTION cosine ( x: variant ) : variant ;
FUNCTION Cosine ( x: variant ) : variant ;
BEGIN result := cos ( x ); END ;
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 ;
FUNCTION Is_Even ( x: variant ) : variant ;


Line 2,774: Line 2,954:


FUNCTION Mult( x, y: variant ) : variant ;
FUNCTION Mult( x, y: variant ) : variant ;
BEGIN result := x * y ; END ;
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: Line 2,984:


FUNCTION OR_xy ( x, y: variant ) : variant ;
FUNCTION OR_xy ( x, y: variant ) : variant ;
BEGIN result := ( x or y ) = True; END ;
BEGIN result := ( x or y ) = True; END ;




Line 2,815: Line 3,007:




FUNCTION ForAll ( f: FunA ; x: Varyray ) : variant ;
FUNCTION All ( f: FunA ; x: Varyray ) : variant ;

VAR
VAR

k : integer ;
k : integer ;

BEGIN
BEGIN

result := True ;
result := True ;


Line 2,832: Line 3,024:




FUNCTION AnyOf ( f: FunA ; x: Varyray ) : variant ;
FUNCTION Any ( f: FunA ; x: Varyray ) : variant ;

VAR
VAR

k : integer ;
k : integer ;

BEGIN
BEGIN

result := False ;
result := False ;


FOR k := Low ( x ) TO High ( x ) DO
FOR k := Low ( x ) TO High ( x ) DO
result := OR_xy ( result , f ( x [ k ] ) ) ;
result := OR_xy ( result , f ( x [ k ] ) ) ;

END ;
END ;
END.
END.







Line 2,855: Line 3,050:
{$mode Delphi} {$H+} {$J-} {$R+} (*) https://www.freepascal.org/docs-html/prog/progch1.html (*)
{$mode Delphi} {$H+} {$J-} {$R+} (*) https://www.freepascal.org/docs-html/prog/progch1.html (*)
USES
USES
MRF,
MRF,
Math,
Math,
SysUtils,
SysUtils,
Variants;
Variants;
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} // Use for variants
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} // Use for variants


VAR
VAR
Line 2,865: Line 3,060:
a,b,c : array of variant ;
a,b,c : array of variant ;


Accu : variant ;
Acc : variant ;


BEGIN
BEGIN

Randomize ;
Randomize ;


setlength ( a, 4 ) ;
setlength ( a, 6 ) ;
setlength ( b, 4 ) ;
setlength ( b, 4 ) ;
setlength ( c, 4 ) ;
setlength ( c, 6 ) ;

a := Map ( RandFillReal , a ) ;
a := Map ( RandFillInt , a ) ;
Map ( show , a ) ;
Map ( show , a ) ;
writeln ;
writeln ;

Accu := FoldR ( add , a ) ;
WriteLn ( 'Sum = ' , Accu ) ;
writeln ;
writeln ;
Accu := Reduce ( mult , a ) ;
WriteLn ( 'Product = ' , Accu ) ;
writeln ;
writeln ;
writeln ;


b := Map ( RandFillInt , b ) ;
b := Map ( RandFillInt , b ) ;
WriteLn ( 'b :');
Map ( show , b ) ;
Map ( show , b ) ;
writeln ;
writeln ;

c := Map ( RandFillInt , c ) ;
Map ( show , c ) ;
writeln ;

Acc := FoldL ( add , a ) ;
WriteLn ( 'Sum = ' , Acc ) ;
writeln ;
writeln ;
Accu := avg ( a ) ;
Acc := Reduce ( contain , 31, a ) ;
WriteLn ( 'avg = ' , Accu ) ;
WriteLn ( 'contains = ' , Acc ) ;
writeln ;
writeln ;

c := Filter ( delete , 31, a ) ;
WriteLn ( 'del c :' ) ;
Map ( show , c ) ;
writeln ;
writeln ;

c := Filter ( Is_Odd , b ) ;
a := Reverse ( c ) ;
writeln ( 'Odd : ' , length ( c ) ) ;
WriteLn ( 'reverse c :' ) ;
Map ( show , c ) ;
Map ( show , a ) ;
writeln ;
writeln ;

Acc := avg ( b ) ;
WriteLn ( 'avg = ' , Acc ) ;
writeln ;
writeln ;


Accu := FoldL ( min , c ) ;
c := Map ( cotangens , b ) ;
WriteLn ( 'min = ' , Accu );
writeln ( 'cot : ' ) ;
writeln ;
Map ( show , c ) ;
writeln ;
writeln ;


Accu := FoldL ( max , c ) ;
Acc := FoldR ( min , b ) ;
WriteLn ( 'max = ' , Accu );
WriteLn ( 'min = ' , Acc );
writeln ;
writeln ;

Acc := FoldR ( max , b ) ;
WriteLn ( 'max = ' , Acc );
writeln ;
writeln ;


Map ( show , b ) ;
Map ( show , b ) ;
Accu := ForAll ( Is_Odd , b ) ;
Acc := All ( Is_Odd , b ) ;
writeln ;
writeln ;
WriteLn ( 'All Is_Odd = ' , Acc ) ;
writeln ;
writeln ;

WriteLn ( 'ForAll Is_Odd = ' , Accu ) ;
Map ( show , b ) ;
Acc := Any ( Is_Even , b ) ;
writeln ;
writeln ;
WriteLn ( 'Any Is_Even = ' , Acc ) ;
writeln ;
writeln ;


Map ( show , b ) ;
Acc := Head ( b ) ;
Accu := AnyOf ( Is_Even , b ) ;
WriteLn ( 'Head = ' , Acc ) ;

Acc := Last ( b ) ;
WriteLn ( 'Last = ' , Acc ) ;

Map ( show , b ) ;
a := Tail ( b ) ;
writeln ;
writeln ;
WriteLn ( 'Tail of b :' ) ;
Map ( show , a ) ;
writeln ;
writeln ;

WriteLn ( 'AnyOf Is_Even = ' , Accu ) ;
Map ( show , b ) ;
a := Take ( 2, b ) ;
writeln ;
writeln ;
WriteLn ( 'Take 2 from b :' ) ;
Map ( show , a ) ;
writeln ;
writeln ;


Line 2,935: Line 3,152:
setlength ( b, 0 ) ;
setlength ( b, 0 ) ;
setlength ( a, 0 ) ;
setlength ( a, 0 ) ;


Line 2,941: Line 3,159:





</lang>JPD 2021/07/09
</lang>JPD 2021/07/10


Output:
Output:


Random ( Like me :)
Random ( Like me :)
{{improve|Pascal|not showing output is not helpful}}


=={{header|Perl}}==
=={{header|Perl}}==
Retrieved from "https://rosettacode.org/wiki/Higher-order_functions"