September 2017 Update

Task/First-class-functions/AppleScript/first-class-functions-2.applescript

@@ -1,30 +1,30 @@
-on run {}
+on run
 
-    set lstFn to {sin_, cos_, cube_}
-    set lstInvFn to {asin_, acos_, croot_}
+    set fs to {sin_, cos_, cube_}
+    set afs to {asin_, acos_, croot_}
 
     -- Form a list of three composed function objects,
     -- and map testWithHalf() across the list to produce the results of
     -- application of each composed function (base function composed with inverse) to 0.5
 
-    map(testWithHalf, zipWith(mCompose, lstFn, lstInvFn))
+    script testWithHalf
+        on |λ|(f)
+            mReturn(f)'s |λ|(0.5)
+        end |λ|
+    end script
 
+    map(testWithHalf, zipWith(mCompose, fs, afs))
 
     --> {0.5, 0.5, 0.5}
-
 end run
 
-on testWithHalf(mf)
-    mf's lambda(0.5)
-end testWithHalf
-
 -- Simple composition of two unadorned handlers into
 -- a method of a script object
 on mCompose(f, g)
     script
-        on lambda(x)
-            mReturn(f)'s lambda(mReturn(g)'s lambda(x))
-        end lambda
+        on |λ|(x)
+            mReturn(f)'s |λ|(mReturn(g)'s |λ|(x))
+        end |λ|
     end script
 end mCompose
 
@@ -34,7 +34,7 @@ on map(f, xs)
         set lng to length of xs
         set lst to {}
         repeat with i from 1 to lng
-            set end of lst to lambda(item i of xs, i, xs)
+            set end of lst to |λ|(item i of xs, i, xs)
         end repeat
         return lst
     end tell
@@ -47,37 +47,31 @@ on mReturn(f)
         f
     else
         script
-            property lambda : f
+            property |λ| : f
         end script
     end if
 end mReturn
 
 -- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
 on zipWith(f, xs, ys)
-    set nx to length of xs
-    set ny to length of ys
-    if nx < 1 or ny < 1 then
-        {}
-    else
-        set lng to cond(nx < ny, nx, ny)
-        set lst to {}
-        tell mReturn(f)
-            repeat with i from 1 to lng
-                set end of lst to lambda(item i of xs, item i of ys)
-            end repeat
-            return lst
-        end tell
-    end if
+    set lng to min(length of xs, length of ys)
+    set lst to {}
+    tell mReturn(f)
+        repeat with i from 1 to lng
+            set end of lst to |λ|(item i of xs, item i of ys)
+        end repeat
+        return lst
+    end tell
 end zipWith
 
--- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b)
-on cond(bool, f, g)
-    if bool then
-        f
+-- min :: Ord a => a -> a -> a
+on min(x, y)
+    if y < x then
+        y
     else
-        g
+        x
     end if
-end cond
+end min
 
 on sin:r
     (do shell script "echo 's(" & r & ")' | bc -l") as real

Task/First-class-functions/Elena/first-class-functions.elena

@@ -1,19 +1,18 @@
-#import system.
-#import system'routines.
-#import system'math.
-#import extensions'routines.
+import system'routines.
+import system'math.
+import extensions'routines.
 
-#class(extension)op
+extension op
 {
-    #method compose : f : g
-        = (self::g eval)::f eval.
+    compose : f : g
+        = (self~g eval)~f eval.
 }
 
-#symbol program =
+program =
 [
-   #var fs := (%"mathOp.sin[0]", %"mathOp.cos[0]", ()[ this power:3.0r ]).
-   #var gs := (%"mathOp.arcsin[0]", %"mathOp.arccos[0]", ()[ this power:(1.0r / 3) ]).
+   var fs := (%"mathOp.sin[0]", %"mathOp.cos[0]", [ ^ closure power:3.0r ]).
+   var gs := (%"mathOp.arcsin[0]", %"mathOp.arccos[0]", [ ^ closure power:(1.0r / 3) ]).
 
-   fs zip:gs &into: (:f:g)[ 0.5r compose:f:g ]
-        run &each:printingLn.
+   fs zip:gs by(:f:g)( 0.5r compose(f,g) );
+        forEach:printingLn.
 ].

Task/First-class-functions/FreeBASIC/first-class-functions.freebasic

@@ -0,0 +1,73 @@
+' FB 1.05.0 Win64
+
+#Include "crt/math.bi"  '' include math functions in C runtime library
+
+' Declare function pointer type
+' This implicitly assumes default StdCall calling convention on Windows
+Type Class2Func As Function(As Double) As Double
+
+' A couple of functions with the above prototype
+Function functionA(v As Double) As Double
+  Return v*v*v  '' cube of v
+End Function
+
+Function functionB(v As Double) As Double
+  Return Exp(Log(v)/3)  '' same as cube root of v which would normally be v ^ (1.0/3.0) in FB
+End Function
+
+' A function taking a function as an argument
+Function function1(f2 As Class2Func, val_ As Double) As Double
+  Return f2(val_)
+End Function
+
+' A function returning a function
+Function whichFunc(idx As Long) As Class2Func
+   Return IIf(idx < 4, @functionA, @functionB)
+End Function
+
+' Additional function needed to treat CDecl function pointer as StdCall
+' Get compiler warning otherwise
+Function cl2(f As Function CDecl(As Double) As Double) As Class2Func
+  Return CPtr(Class2Func, f)
+End Function
+
+' A list of functions
+' Using C Runtime library versions of trig functions as it doesn't appear
+' to be possible to apply address operator (@) to FB's built-in versions
+Dim funcListA(0 To 3) As Class2Func = {@functionA, cl2(@sin_),  cl2(@cos_), cl2(@tan_)}
+Dim funcListB(0 To 3) As Class2Func = {@functionB, cl2(@asin_), cl2(@acos_), cl2(@atan_)}
+
+' Composing Functions
+Function invokeComposed(f1 As Class2Func, f2 As Class2Func, val_ As double) As Double
+   Return f1(f2(val_))
+End Function
+
+Type Composition
+  As Class2Func f1, f2
+End Type
+
+Function compose(f1 As Class2Func, f2 As Class2Func) As Composition Ptr
+  Dim comp As Composition Ptr = Allocate(SizeOf(Composition))
+  comp->f1 = f1
+  comp->f2 = f2
+  Return comp
+End Function
+
+Function callComposed(comp As Composition Ptr, val_ As Double ) As Double
+  Return comp->f1(comp->f2(val_))
+End Function
+
+Dim ix As Integer
+Dim c As Composition Ptr
+
+Print "function1(functionA, 3.0) = "; CSng(function1(whichFunc(0), 3.0))
+Print
+For ix = 0 To 3
+  c = compose(funcListA(ix), funcListB(ix))
+  Print "Composition"; ix; "(0.9) = "; CSng(callComposed(c, 0.9))
+Next
+
+Deallocate(c)
+Print
+Print "Press any key to quit"
+Sleep

Task/First-class-functions/J/first-class-functions-3.j

@@ -0,0 +1,21 @@
+   train  =. (<'`:')(0:`)(,^:)&6   NB. Producing the function  train    corresponding to the functional `:6
+   inverse=. (<'^:')(0:`)(,^:)&_1  NB. Producing the function  inverse  corresponding to the functional ^:_1
+   compose=. (<'@:')(0:`)(,^:)     NB. Producing the function  compose  corresponding to the functional @:
+   an     =. <@:((,'0') ; ])       NB. Producing the atomic representation of a noun
+   of     =. train@:([ ; an)       NB. Evaluating a function for an argument
+   box    =. < @: train"0          NB. Producing a boxed list of the trains of the components
+
+   ]A =. box (1&o.)`(2&o.)`(^&3)   NB. Producing a boxed list containing the Sin, Cos and Cubic functions
+┌────┬────┬───┐
+│1&o.│2&o.│^&3│
+└────┴────┴───┘
+   ]B =. inverse &.> A             NB. Producing their inverses
+┌────────┬────────┬───────┐
+│1&o.^:_1│2&o.^:_1│^&3^:_1│
+└────────┴────────┴───────┘
+   ]BA=. B compose &.> A           NB. Producing the compositions of the functions and their inverses
+┌────────────────┬────────────────┬──────────────┐
+│1&o.^:_1@:(1&o.)│2&o.^:_1@:(2&o.)│^&3^:_1@:(^&3)│
+└────────────────┴────────────────┴──────────────┘
+   BA of &> 0.5                    NB. Evaluating the compositions at 0.5
+0.5 0.5 0.5

Task/First-class-functions/Kotlin/first-class-functions.kotlin

@@ -0,0 +1,12 @@
+// version 1.0.6
+
+fun compose(f: (Double) -> Double,  g: (Double) -> Double ): (Double) -> Double  = { f(g(it)) }
+
+fun cube(d: Double) = d * d * d
+
+fun main(args: Array<String>) {
+    val listA = listOf(Math::sin, Math::cos, ::cube)
+    val listB = listOf(Math::asin, Math::acos, Math::cbrt)
+    val x = 0.5
+    for (i in 0..2) println(compose(listA[i], listB[i])(x))
+}

Task/First-class-functions/Lambdatalk/first-class-functions.lambdatalk

@@ -0,0 +1,14 @@
+{def cube {lambda {:x} {pow :x 3}}}
+{def cuberoot {lambda {:x} {pow :x {/ 1 3}}}}
+{def compose {lambda {:f :g :x} {:f {:g :x}}}}
+{def fun sin cos cube}
+{def inv asin acos cuberoot}
+{def display {lambda {:i}
+  {br}{compose {nth :i {fun}}
+               {nth :i {inv}} 0.5}}}
+{map display {serie 0 2}}
+
+Output:
+0.5
+0.49999999999999994
+0.5000000000000001

Task/First-class-functions/NewLISP/first-class-functions.newlisp

@@ -0,0 +1,12 @@
+> (define (compose f g) (expand (lambda (x) (f (g x))) 'f 'g))
+(lambda (f g) (expand (lambda (x) (f (g x))) 'f 'g))
+> (define (cube x) (pow x 3))
+(lambda (x) (pow x 3))
+> (define (cube-root x) (pow x (div 1 3)))
+(lambda (x) (pow x (div 1 3)))
+> (define functions '(sin  cos  cube))
+(sin cos cube)
+> (define inverses  '(asin acos cube-root))
+(asin acos cube-root)
+> (map (fn (f g) ((compose f g) 0.5)) functions inverses)
+(0.5 0.5 0.5)

Task/First-class-functions/PostScript/first-class-functions.ps

@@ -0,0 +1,23 @@
+% PostScript has 'sin' and 'cos', but not these
+/asin { dup dup 1. add exch 1. exch sub mul sqrt atan } def
+/acos { dup dup 1. add exch 1. exch sub mul sqrt exch atan } def
+
+/cube { 3 exp } def
+/cuberoot { 1. 3. div exp } def
+
+/compose { % f g -> { g f }
+  [ 3 1 roll exch
+  % procedures are not executed when encountered directly
+  % insert an 'exec' after procedures, but not after operators
+  1 index type /operatortype ne { /exec cvx exch } if
+  dup type /operatortype ne { /exec cvx } if
+  ] cvx
+} def
+
+/funcs [ /sin load /cos load /cube load ] def
+/ifuncs [ /asin load /acos load /cuberoot load ] def
+
+0 1 funcs length 1 sub { /i exch def
+  ifuncs i get funcs i get compose
+  .5 exch exec ==
+} for

Task/First-class-functions/Sidef/first-class-functions.sidef

@@ -1,15 +1,15 @@
 func compose(f,g) {
     func (*args) {
-        f(g(args...));
+        f(g(args...))
     }
 }
 
-var cube  = func(a) { a.pow(3) };
-var croot = func(a) { a.root(3) };
+var cube  = func(a) { a.pow(3) }
+var croot = func(a) { a.root(3) }
 
-var flist1 = [Math.method(:sin), Math.method(:cos), cube];
-var flist2 = [Math.method(:asin), Math.method(:acos), croot];
+var flist1 = [Num.method(:sin),  Num.method(:cos),  cube]
+var flist2 = [Num.method(:asin), Num.method(:acos), croot]
 
-flist1.range.each { |i|
-    say compose(flist1[i], flist2[i])(0.5);
+for a,b (flist1 ~Z flist2) {
+    say compose(a, b)(0.5)
 }

Task/First-class-functions/Zkl/first-class-functions.zkl

@@ -0,0 +1,8 @@
+var a=T(fcn(x){ x.toRad().sin() },  fcn(x){ x.toRad().cos() },  fcn(x){ x*x*x} );
+var b=T(fcn(x){ x.asin().toDeg() }, fcn(x){ x.acos().toDeg() }, fcn(x){ x.pow(1.0/3) });
+
+var H=Utils.Helpers;
+var ab=b.zipWith(H.fcomp,a);  //-->list of deferred calculations
+ab.run(True,5.0); //-->L(5.0,5.0,5.0)
+
+a.run(True,5.0) //-->L(0.0871557,0.996195,125)