Jump to content

Higher-order functions: Difference between revisions

Higher-order functions (view source)

Revision as of 16:42, 8 July 2021

3,711 bytes added ,  2 years ago
→‎using FreePascal : Higher-order function MAP / FILTER
Line 2,449:
end.</lang>
 
=== using FreePascal : Higher-order function MAP / REDUCE ( FOLDL / FOLDR ) / FILTER ===
{{works with|FreePascal|version 3.2.0 }}
<lang Pascal>
PROGRAM HigherOrderMapHigherOrderMapReduce;
 
{$mode Delphi} {$H+} {$J-} {$R+} (*) https://www.freepascal.org/docs-html/prog/progch1.html (*)
Line 2,461:
The free and readable alternative at C/C++ speeds
compiles natively to almost any platform, including raspberry PI *
Can run independentlyindepENDently from DELPHI / Lazarus
 
For debian Linux: apt -y install fpc
Line 2,478:
TYPE
Varyray = array of variant ;
 
FunA = FUNCTION ( x : variant ) : variant ;
FunB = PROCEDURE ( x : variant ) ;
FunC = FUNCTION ( x,y : variant ) : variant ;
FunD = FUNCTION ( x,y : longint ) : longint ;
Varyray = array of variant ;
 
 
Line 2,492:
 
 
FUNCTION mapMap ( f: FunA ; x: Varyray ) : Varyray ; overload ;
VAR
Line 2,503:
SetLength ( Ar, length ( x ) ) ;
result := Ar ;
 
FOR k := Low ( x ) TO High ( x ) DO
Ar [ k ] := f ( x [ k ] ) ;
 
result := Ar ;
 
Line 2,511 ⟶ 2,513:
 
 
PROCEDURE mapMap ( f: FunB ; x: Varyray ) ; overload ;
VAR
Line 2,523 ⟶ 2,525:
 
FUNCTION mapMap ( f: FunC ; x, y: Varyray ) : Varyray ; overload ;
VAR
Line 2,534 ⟶ 2,536:
SetLength ( Ar, length ( x ) ) ;
result := Ar ;
 
FOR k := Low ( x ) TO High ( x ) DO
Ar [ k ] := f ( x [ k ] , y [ k ] ) ;
 
result := Ar ;
Line 2,542 ⟶ 2,546:
FUNCTION mapMap ( f: FunD ; x, y: Varyray ) : Varyray ; overload ;
VAR
Ar : array of variant ;
k : integer ;
Line 2,552 ⟶ 2,557:
SetLength ( Ar, length ( x ) ) ;
result := Ar ;
 
FOR k := Low ( x ) TO High ( x ) DO
Ar [ k ] := f ( x [ k ] , y [ k ] ) ;
 
result := Ar ;
Line 2,576 ⟶ 2,583:
FOR k := Low ( x ) TO High ( x ) DO
BEGIN
 
__ := f ( 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 := ord ( f ( 0, x [ 0 ] ) = 0 ) ;
 
FOR k := Low ( x ) TO High ( x ) DO
result := f ( result , x [ k ] ) ;
 
END ;
 
 
 
FUNCTION FoldL ( f: FunD ; x: Varyray ) : variant ; overload ;
VAR
 
k : integer ;
BEGIN
result := ord ( f ( 0, x [ 0 ] ) = 0 ) ;
 
FOR k := Low ( x ) TO High ( x ) DO
result := f ( result , 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 ( f: FunC ; x: Varyray ) : variant ; overload ;
VAR
k : integer ;
BEGIN
result := ord ( f ( 0, x [ 0 ] ) = 0 ) ;
FOR k := High ( x ) DOWNTO Low ( x ) DO
result := f ( result , x [ k ] ) ;
 
END ;
 
 
 
FUNCTION FoldR ( f: FunD ; x: Varyray ) : variant ; overload ;
VAR
k : integer ;
BEGIN
result := ord ( f ( 0, x [ 0 ] ) = 0 ) ;
 
FOR k := High ( x ) DOWNTO Low ( x ) DO
result := f ( result , x [ k ] ) ;
 
END ;
 
 
 
(*) TEST Functions (*)
 
(*)
 
Special thanks to PascalDragon & winni ( FreePascal.org ),
who explained the specifics of the compiler.
 
(*)
 
FUNCTION Add ( x, y: variant ) : variant ;
BEGIN result := x + y ; END ;
 
FUNCTION RandFillInt ( x: variant ) : variant ;
BEGIN result := Random ( 100 ) ; END ;
 
 
FUNCTION Add1 ( x: variant ) : variant ;
BEGIN result := x + 1 ; END ;
 
 
FUNCTION RandFillFloat ( x: variant ) : variant ;
 
FUNCTION AND_xy ( x, y: variant ) : variant ;
BEGIN result := ( x and y ) = True ; END ;
 
 
 
FUNCTION AVG ( x: Varyray ) : variant ;
VAR
tmp : float = 100.0 ;
BEGIN result := ( Randomk ( ) ) * tmp: ; ENDinteger ;
BEGIN
result := 0.0 ;
 
FOR k := Low ( x ) TO High ( x ) DO
result := result + ( x [ k ] - result ) / ( k + 1 );
 
END ;
 
FUNCTION Incr ( x: variant ) : variant ;
BEGIN result := x + 1 ; END ;
 
 
FUNCTION cosine ( x: variant ) : variant ;
BEGIN result := cos ( x ); END ;
 
 
FUNCTION Even ( x: variant ) : variant ;
FUNCTION Is_Even ( x: variant ) : variant ;
 
BEGIN
Line 2,619 ⟶ 2,736:
result := x
ELSE
Resultresult := False
 
END;
Line 2,625 ⟶ 2,742:
 
 
FUNCTION Odd Mult( x, y: variant ) : variant ;
BEGIN result := x * y ; END ;
 
 
 
FUNCTION Is_Odd ( x: variant ) : variant ;
 
BEGIN
Line 2,632 ⟶ 2,754:
result := x
ELSE
Resultresult := False
 
END;
Line 2,638 ⟶ 2,760:
 
 
FUNCTION OR_xy ( x, y: variant ) : variant ;
(*)
BEGIN result := ( x or y ) = True; END ;
 
Special thanks to PascalDragon & winni ( FreePascal.org ),
who explained the specifics of the compiler.
 
(*)
 
FUNCTION sinusRandFillInt ( x: variant ) : variant ;
BEGIN result := Random ( 100 ) ; END ;
 
 
 
FUNCTION RandFillFloat ( x: variant ) : variant ;
 
VAR
tmp : float = 100.0 ;
 
BEGIN result := ( Random ( ) ) * tmp ; END ;
 
 
 
FUNCTION sine ( x: variant ) : variant ;
BEGIN result := sin ( x ); END ;
 
 
 
FUNCTION cosinusForAll ( f: FunA ; x: variantVaryray ) : variant ;
BEGIN result := cos ( x ); END ;
VAR
k : integer ;
BEGIN
result := True ;
 
FOR k := Low ( x ) TO High ( x ) DO
result := AND_xy ( result , f ( x [ k ] ) ) ;
 
END ;
 
 
 
FUNCTION AnyOf ( f: FunA ; x: Varyray ) : variant ;
VAR
k : integer ;
VAR
BEGIN
result := False ;
 
a,b,c,d FOR k := Low ( x ) TO High array( ofx variant) ;DO
result := OR_xy ( result , f ( x [ k ] ) ) ;
END ;
 
 
 
VAR
 
a,b,c : array of variant ;
 
Accu : variant ;
 
BEGIN
Line 2,668 ⟶ 2,831:
setlength ( b, 7 ) ;
setlength ( c, 7 ) ;
setlength ( d, 7 ) ;
a := mapMap ( RandFillInt , a ) ;
map Map ( show , a ) ;
writeln ;
writeln ;
 
bAccu := mapFoldR ( add ( RandFillInt , ba ) ;
map WriteLn ( show'Sum = ' , Accu , b ) ;
writeln ;
writeln ;
Accu := Reduce ( mult , a ) ;
WriteLn ( 'Product = ' , Accu ) ;
writeln ;
writeln ;
 
db := FilterMap ( even ( RandFillInt , b , a ) ;
map Map ( show ( show , d ) ; , b ) ;
writeln ;
writeln ;
Accu := avg ( a ) ;
WriteLn ( 'avg = ' ,Accu );
writeln ;
writeln ;
dc := Filter ( oddIs_Odd , a , a ) ;
map Map ( show , dc ) ;
writeln ;
writeln ;
 
d := map ( max Map ( show , a, b ) ;
Accu := ForAll map( Is_Odd ( show , b , d ) ;
writeln ;
writeln ;
WriteLn ( 'ForAll Is_Odd = ' , Accu ) ;
writeln ;
writeln ;
 
Map ( show , b ) ;
Accu := AnyOf ( Is_Even , b ) ;
writeln ;
writeln ;
WriteLn ( 'AnyOf Is_Even = ' , Accu ) ;
writeln ;
writeln ;
 
 
setlength ( d, 0 ) ;
setlength ( c, 0 ) ;
setlength ( b, 0 ) ;
Line 2,705 ⟶ 2,884:
END.
 
 
</lang>JPD 2021/07/08
 
</lang>JPD 2021/07/07
 
Output:
JPD
122

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/13790"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information