Data update

Task/Function-composition/00-META.yaml

@@ -1,3 +1,2 @@
 ---
 from: http://rosettacode.org/wiki/Function_composition
-note: Higher-order functions

Task/Function-composition/00-TASK.txt

@@ -1,16 +1 @@
-;Task:
-Create a function, <span style="font-family:serif">compose</span>, &nbsp; whose two arguments &nbsp; <span style="font-family:serif">''f''</span> &nbsp; and &nbsp; <span style="font-family:serif">''g''</span>, &nbsp; are both functions with one argument. 
-
-
-The result of <span style="font-family:serif">compose</span> is to be a function of one argument, (lets call the argument &nbsp; <span style="font-family:serif">''x''</span>), &nbsp; which works like applying function &nbsp; <span style="font-family:serif"> ''f'' </span> &nbsp; to the result of applying function &nbsp; <span style="font-family:serif"> ''g'' </span> &nbsp; to &nbsp; <span style="font-family:serif"> ''x''</span>.
-
-
-;Example:
-  <span style="font-family:serif">compose(''f'', ''g'') (''x'') = ''f''(''g''(''x''))</span>
-
-
-Reference: [[wp:Function composition (computer science)|Function composition]]
-
-Hint: In some languages, implementing <span style="font-family:serif">compose</span> correctly requires creating a [[wp:Closure (computer science)|closure]].
-<br><br>
 

Task/Function-composition/Ada/function-composition-1.adb

@@ -0,0 +1,13 @@
+generic
+   type Argument is private;
+package Functions is
+   type Primitive_Operation is not null
+      access function (Value : Argument) return Argument;
+   type Func (<>) is private;
+   function "*" (Left : Func; Right : Argument) return Argument;
+   function "*" (Left : Func; Right : Primitive_Operation) return Func;
+   function "*" (Left, Right : Primitive_Operation) return Func;
+   function "*" (Left, Right : Func) return Func;
+private
+   type Func is array (Positive range <>) of Primitive_Operation;
+end Functions;

Task/Function-composition/Ada/function-composition-2.adb

@@ -0,0 +1,25 @@
+package body Functions is
+   function "*" (Left : Func; Right : Argument) return Argument is
+   Result : Argument := Right;
+   begin
+      for I in reverse Left'Range loop
+         Result := Left (I) (Result);
+      end loop;
+      return Result;
+   end "*";
+
+   function "*" (Left, Right : Func) return Func is
+   begin
+      return Left & Right;
+   end "*";
+
+   function "*" (Left : Func; Right : Primitive_Operation) return Func is
+   begin
+      return Left & (1 => Right);
+   end "*";
+
+   function "*" (Left, Right : Primitive_Operation) return Func is
+   begin
+      return (Left, Right);
+   end "*";
+end Functions;

Task/Function-composition/Ada/function-composition-3.adb

@@ -0,0 +1,12 @@
+with Ada.Numerics.Elementary_Functions;  use Ada.Numerics.Elementary_Functions;
+with Ada.Text_IO;                        use Ada.Text_IO;
+with Functions;
+
+procedure Test_Compose is
+   package Float_Functions is new Functions (Float);
+   use Float_Functions;
+
+   Sin_Arcsin : Func := Sin'Access * Arcsin'Access;
+begin
+   Put_Line (Float'Image (Sin_Arcsin * 0.5));
+end Test_Compose;

Task/Function-composition/Emacs-Lisp/function-composition-1.el

@@ -0,0 +1,7 @@
+;; lexical-binding: t
+(defun compose (f g)
+  (lambda (x)
+    (funcall f (funcall g x))))
+
+(let ((func (compose '1+ '1+)))
+  (funcall func 5)) ;=> 7

Task/Function-composition/Emacs-Lisp/function-composition-2.el

@@ -0,0 +1,5 @@
+(defun compose (f g)
+  `(lambda (x) (,f (,g x))))
+
+(let ((func (compose '1+ '1+)))
+  (funcall func 5)) ;=> 7

Task/Function-composition/Emacs-Lisp/function-composition-3.el

@@ -0,0 +1,5 @@
+(defmacro compose (f g)
+  `(lambda (x) (,f (,g x))))
+
+(let ((func (compose 1+ 1+)))
+  (funcall func 5)) ;=> 7

Task/Function-composition/Odin/function-composition.odin

@@ -0,0 +1,25 @@
+package main
+
+import "core:fmt"
+import "core:math"
+
+Compositor :: struct($ARG, $INTER, $RET: typeid) {
+	func1: #type proc "contextless" (_: ARG) -> INTER,
+	func2: #type proc "contextless" (_: INTER) -> RET,
+}
+
+compose :: proc(
+	f: #type proc "contextless" (_: $INTER) -> $RET,
+	g: #type proc "contextless" (_: $ARG) -> INTER,
+) -> Compositor(ARG, RET, INTER) {
+	return {g, f}
+}
+
+call :: proc(c: Compositor($ARG, $INTER, $RET), arg: ARG) -> RET {
+	return c.func1(c.func2(arg))
+}
+
+main :: proc() {
+	comp := compose(math.sin_f64, math.asin_f64) // have to use specific functions. Odin's polymorphism doesn't play nice with procedure groups
+	fmt.println(call(comp, 0.5)) // prints 0.5
+}

Task/Function-composition/Pluto/function-composition.pluto

@@ -0,0 +1,7 @@
+local function compose(f, g) return |x| -> f(g(x)) end
+
+local function double(x) return 2 * x end
+
+local function add_one(x) return x + 1 end
+
+print(compose(double, add_one)(3))

Task/Function-composition/PowerShell/function-composition-1.ps1

@@ -0,0 +1,7 @@
+function g ($x) {
+    $x + $x
+}
+function f ($x) {
+    $x*$x*$x
+}
+f (g 1)

Task/Function-composition/PowerShell/function-composition-2.ps1

@@ -0,0 +1,4 @@
+function fg (${function:f}, ${function:g}, $x) {
+    f (g $x)
+}
+fg f g 1

Task/Function-composition/Rebol/function-composition-1.rebol

@@ -0,0 +1,14 @@
+Rebol [
+	Title: "Functional Composition"
+	URL: http://rosettacode.org/wiki/Functional_Composition
+]
+
+; "compose" means something else in Rebol, therefore I use a 'compose-functions name.
+
+compose-functions: func [
+    {compose the given functions F and G}
+    f [any-function!]
+    g [any-function!]
+] [
+    func [x] compose [(:f) (:g) x]
+]

Task/Function-composition/Rebol/function-composition-2.rebol

@@ -0,0 +1,8 @@
+foo: func [x] [reform ["foo:" x]]
+bar: func [x] [reform ["bar:" x]]
+
+foo-bar: compose-functions :foo :bar
+print ["Composition of foo and bar:"  mold foo-bar "test"]
+
+sin-asin: compose-functions :sine :arcsine
+print [crlf "Composition of sine and arcsine:" sin-asin 0.5]

Task/Function-composition/Red/function-composition.red

@@ -0,0 +1,18 @@
+Red [ "Compose Two or Any Number of Functions - Hinjolicious" ]
+
+; to show the codes
+demo: function [s b] [print ["^/==" s "==^/"] print mold/only b do b]
+
+demo "Compose two functions" [
+comp-func: function ['f 'g] [function [x] compose [(get f) (get g) x]]
+sin-cos: comp-func sin cos
+print sin-cos 0.5
+]
+
+demo "Compose any number of functions" [
+comp-funcs: function [ff] [
+	function [x] compose append collect [foreach e ff [keep (get e)]] 'x
+]
+log-sin-cos: comp-funcs [log-e sin cos]
+print log-sin-cos 0.5
+]

Task/Function-composition/VBScript/function-composition-1.vbs

@@ -0,0 +1,18 @@
+option explicit
+class closure
+
+	private composition
+	
+	sub compose( f1, f2 )
+		composition = f2 & "(" & f1 & "(p1))"
+	end sub
+	
+	public default function apply( p1 )
+		apply = eval( composition )
+	end function
+	
+	public property get formula
+		formula = composition
+	end property
+	
+end class

Task/Function-composition/VBScript/function-composition-2.vbs

@@ -0,0 +1,26 @@
+dim c
+set c = new closure
+
+c.compose "ucase", "lcase"
+wscript.echo c.formula
+wscript.echo c("dog")
+
+c.compose "log", "exp"
+wscript.echo c.formula
+wscript.echo c(12.3)
+
+function inc( n )
+	inc = n + 1
+end function
+
+c.compose "inc", "inc"
+wscript.echo c.formula
+wscript.echo c(12.3)
+
+function twice( n )
+	twice = n * 2
+end function
+
+c.compose "twice", "inc"
+wscript.echo c.formula
+wscript.echo c(12.3)