langs a-z

Task/Function-composition/Nemerle/function-composition.nemerle

@@ -0,0 +1,17 @@
+using System;
+using System.Console;
+using System.Math;
+
+module Composition
+{
+    Compose[T](f : T -> T, g : T -> T, x : T) : T
+    {
+        f(g(x))
+    }
+
+    Main() : void
+    {
+        def SinAsin = Compose(Sin, Asin, _);
+        WriteLine(SinAsin(0.5));
+    }
+}

Task/Function-composition/NewLISP/function-composition.newlisp

@@ -0,0 +1,4 @@
+> (define (compose f g) (expand (lambda (x) (f (g x))) 'f 'g))
+(lambda (f g) (expand (lambda (x) (f (g x))) 'f 'g))
+> ((compose sin asin) 0.5)
+0.5

Task/Function-composition/OCaml/function-composition-1.ocaml

@@ -0,0 +1 @@
+let compose f g x = f (g x)

Task/Function-composition/OCaml/function-composition-2.ocaml

@@ -0,0 +1,6 @@
+# let compose f g x = f (g x);;
+val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
+# let sin_asin = compose sin asin;;
+val sin_asin : float -> float = <fun>
+# sin_asin 0.5;;
+- : float = 0.5

Task/Function-composition/Objeck/function-composition.objeck

@@ -0,0 +1,29 @@
+bundle Default {
+  class Test {
+    @f : static : (Int) ~ Int;
+    @g : static : (Int) ~ Int;
+
+    function : Main(args : String[]) ~ Nil {
+      compose := Composer(F(Int) ~ Int, G(Int) ~ Int);
+      compose(13)->PrintLine();
+    }
+
+    function : F(a : Int) ~ Int {
+      return a + 14;
+    }
+
+    function : G(a : Int) ~ Int {
+      return a + 15;
+    }
+
+    function : Compose(x : Int) ~ Int {
+      return @f(@g(x));
+    }
+
+    function : Composer(f : (Int) ~ Int, g : (Int) ~ Int) ~ (Int) ~ Int {
+      @f := f;
+      @g := g;
+      return Compose(Int) ~ Int;
+    }
+  }
+}

Task/Function-composition/Objective-C/function-composition-1.m

@@ -0,0 +1,119 @@
+#include <Foundation/Foundation.h>
+
+// the protocol of objects that can behave "like function"
+@protocol FunctionCapsule <NSObject>
+-(id)computeWith: (id)x;
+@end
+
+
+// a commodity for "encapsulating" double f(double)
+typedef double (*func_t)(double);
+@interface FunctionCaps : NSObject <FunctionCapsule>
+{
+  func_t function;
+}
++(id)capsuleFor: (func_t)f;
+-(id)initWithFunc: (func_t)f;
+@end
+
+@implementation FunctionCaps
+-(id)initWithFunc: (func_t)f
+{
+  if ((self = [self init])) {
+    function = f;
+  }
+  return self;
+}
++(id)capsuleFor: (func_t)f
+{
+  return [[[self alloc] initWithFunc: f] autorelease];
+}
+-(id)computeWith: (id)x
+{
+  return [NSNumber numberWithDouble: function([x doubleValue])];
+}
+@end
+
+
+// the "functions" composer
+@interface FunctionComposer : NSObject <FunctionCapsule>
+{
+  id<FunctionCapsule> funcA;
+  id<FunctionCapsule> funcB;
+}
++(id) createCompositeFunctionWith: (id<FunctionCapsule>)A and: (id<FunctionCapsule>)B;
+-(id) initComposing: (id<FunctionCapsule>)A with: (id<FunctionCapsule>)B;
+@end
+
+@implementation FunctionComposer
++(id) createCompositeFunctionWith: (id<FunctionCapsule>)A and: (id<FunctionCapsule>)B
+{
+  return [[[self alloc] initComposing: A with: B] autorelease];
+}
+
+-(id) init
+{
+  [self release];
+  @throw [NSException exceptionWithName:NSInternalInconsistencyException
+                                 reason:@"FunctionComposer: init with initComposing!"
+                               userInfo:nil];
+  return nil;
+}
+
+-(id) initComposing: (id<FunctionCapsule>)A with: (id<FunctionCapsule>)B
+{
+  if ((self = [super init])) {
+    if ( [A respondsToSelector: @selector(computeWith:)] &&
+         [B respondsToSelector: @selector(computeWith:)] ) {
+      funcA = [A retain]; funcB = [B retain];
+      return self;
+    }
+    NSLog(@"FunctionComposer: cannot compose functions not responding to protocol FunctionCapsule!");
+    [self release];
+  }
+  return nil;
+}
+
+-(id)computeWith: (id)x
+{
+  return [funcA computeWith: [funcB computeWith: x]];
+}
+
+-(void) dealloc
+{
+  [funcA release];
+  [funcB release];
+  [super dealloc];
+}
+@end
+
+
+// functions outside...
+double my_f(double x)
+{
+  return x+1.0;
+}
+
+double my_g(double x)
+{
+  return x*x;
+}
+
+
+int main()
+{
+  NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
+
+  id<FunctionCapsule> funcf = [FunctionCaps capsuleFor: my_f];
+  id<FunctionCapsule> funcg = [FunctionCaps capsuleFor: my_g];
+
+  id<FunctionCapsule> composed = [FunctionComposer
+		                   createCompositeFunctionWith: funcf and: funcg];
+
+  printf("g(2.0) = %lf\n", [[funcg computeWith: [NSNumber numberWithDouble: 2.0]] doubleValue]);
+  printf("f(2.0) = %lf\n", [[funcf computeWith: [NSNumber numberWithDouble: 2.0]] doubleValue]);
+  printf("f(g(2.0)) = %lf\n", [[composed computeWith: [NSNumber numberWithDouble: 2.0]] doubleValue]);
+
+  [pool release];
+  return 0;
+}

Task/Function-composition/Objective-C/function-composition-2.m

@@ -0,0 +1,42 @@
+#include <Foundation/Foundation.h>
+
+typedef id (^Function)(id);
+
+// a commodity for "encapsulating" double f(double)
+typedef double (*func_t)(double);
+Function encapsulate(func_t f) {
+  return [[^(id x) { return [NSNumber numberWithDouble: f([x doubleValue])]; } copy] autorelease];
+}
+
+Function compose(Function a, Function b) {
+  return [[^(id x) { return a(b(x)); } copy] autorelease];
+}
+
+// functions outside...
+double my_f(double x)
+{
+  return x+1.0;
+}
+
+double my_g(double x)
+{
+  return x*x;
+}
+
+
+int main()
+{
+  NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
+
+  Function f = encapsulate(my_f);
+  Function g = encapsulate(my_g);
+
+  Function composed = compose(f, g);
+
+  printf("g(2.0) = %lf\n", [g([NSNumber numberWithDouble: 2.0]) doubleValue]);
+  printf("f(2.0) = %lf\n", [f([NSNumber numberWithDouble: 2.0]) doubleValue]);
+  printf("f(g(2.0)) = %lf\n", [composed([NSNumber numberWithDouble: 2.0]) doubleValue]);
+
+  [pool release];
+  return 0;
+}

Task/Function-composition/Octave/function-composition.octave

@@ -0,0 +1,6 @@
+function r = compose(f, g)
+  r = @(x) f(g(x));
+endfunction
+
+r = compose(@exp, @sin);
+r(pi/3)

Task/Function-composition/Order/function-composition.order

@@ -0,0 +1,4 @@
+#include <order/interpreter.h>
+
+#define ORDER_PP_DEF_8comp ORDER_PP_FN( \
+8fn(8F, 8G, 8fn(8X, 8ap(8F, 8ap(8G, 8X)))) )

Task/Function-composition/Oz/function-composition.oz

@@ -0,0 +1,10 @@
+declare
+  fun {Compose F G}
+     fun {$ X}
+        {F {G X}}
+     end
+  end
+
+  SinAsin = {Compose Float.sin Float.asin}
+in
+  {Show {SinAsin 0.5}}

Task/Function-composition/PARI-GP/function-composition-1.pari

@@ -0,0 +1,5 @@
+compose(f, g)={
+  x -> f(g(x))
+};
+
+compose(x->sin(x),x->cos(x)(1)

Task/Function-composition/PARI-GP/function-composition-2.pari

@@ -0,0 +1 @@
+compose(sin,cos)(1)

Task/Function-composition/Perl-6/function-composition-1.pl6

@@ -0,0 +1,3 @@
+sub infix:<∘> (&f, &g --> Block) {
+    -> $args { f g |$args }
+}

Task/Function-composition/Perl-6/function-composition-2.pl6

@@ -0,0 +1,3 @@
+sub triple($n) { 3 * $n }
+my &f = &triple ∘ &prefix:<-> ∘ { $^n + 2 };
+say &f(5); # Prints "-21".

Task/Function-composition/PostScript/function-composition.ps

@@ -0,0 +1,7 @@
+/square { dup mul } def
+/plus1  { 1 add } def
+/sqPlus1{ square plus1 } def
+
+% if the task really demands we make a function called "compose", well
+/compose { def } def      % so now we can say:
+/sqPlus1 { square plus1 } compose

Task/Function-composition/PureBasic/function-composition.purebasic

@@ -0,0 +1,23 @@
+;Declare how our function looks like
+Prototype.i Func(Arg.i)
+
+; Make a procedure that composes any functions of type "Func"
+Procedure Compose(*a.Func,*b.Func, x)
+  ProcedureReturn *a(*b(x))
+EndProcedure
+
+; Just a procedure fitting "Func"
+Procedure f(n)
+  ProcedureReturn 2*n
+EndProcedure
+
+; Yet another procedure fitting "Func"
+Procedure g(n)
+  ProcedureReturn n+1
+EndProcedure
+
+;- Test it
+X=Random(100)
+Title$="With x="+Str(x)
+Body$="Compose(f(),g(), x) ="+Str(Compose(@f(),@g(),X))
+MessageRequester(Title$,Body$)

Task/Function-composition/Purity/function-composition.purity

@@ -0,0 +1 @@
+data compose = f => g => $f . $g

Task/Function-composition/Qi/function-composition-1.qi

@@ -0,0 +1,5 @@
+(define compose
+  F G -> (/. X
+             (F (G X))))
+
+((compose (+ 1) (+ 2)) 3)   \ (Outputs 6) \

Task/Function-composition/Qi/function-composition-2.qi

@@ -0,0 +1,3 @@
+(define compose F G X -> (F (G X)))
+
+(((compose (+ 1)) (+ 2)) 3)  \ (Outputs 6) \

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

@@ -0,0 +1,16 @@
+REBOL [
+	Title: "Functional Composition"
+	Author: oofoe
+	Date: 2009-12-06
+	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/Slate/function-composition.slate

@@ -0,0 +1 @@
+[| :x | x + 1] ** [| :x | x squared] applyTo: {3}

Task/Function-composition/Standard-ML/function-composition-1.ml

@@ -0,0 +1 @@
+fun compose (f, g) x = f (g x)

Task/Function-composition/Standard-ML/function-composition-2.ml

@@ -0,0 +1,6 @@
+- fun compose (f, g) x = f (g x);
+val compose = fn : ('a -> 'b) * ('c -> 'a) -> 'c -> 'b
+- val sin_asin = compose (Math.sin, Math.asin);
+val sin_asin = fn : real -> real
+- sin_asin 0.5;
+val it = 0.5 : real

Task/Function-composition/UNIX-Shell/function-composition-1.sh

@@ -0,0 +1,9 @@
+compose() {
+	eval "$1() { $3 | $2; }"
+}
+
+downvowel() { tr AEIOU aeiou; }
+upcase() { tr a-z A-Z; }
+compose c downvowel upcase
+echo 'Cozy lummox gives smart squid who asks for job pen.' | c
+# => CoZY LuMMoX GiVeS SMaRT SQuiD WHo aSKS FoR JoB PeN.

Task/Function-composition/UNIX-Shell/function-composition-2.sh

@@ -0,0 +1,9 @@
+fn compose f g {
+	result @ {$g | $f}
+}
+
+fn downvowel {tr AEIOU aeiou}
+fn upcase {tr a-z A-Z}
+fn-c = <={compose $fn-downvowel $fn-upcase}
+echo 'Cozy lummox gives smart squid who asks for job pen.' | c
+# => CoZY LuMMoX GiVeS SMaRT SQuiD WHo aSKS FoR JoB PeN.

Task/Function-composition/UNIX-Shell/function-composition-3.sh

@@ -0,0 +1,9 @@
+fn compose f g {
+	result @ x {result <={$f <={$g $x}}}
+}
+
+fn downvowel x {result `` '' {tr AEIOU aeiou <<< $x}}
+fn upcase x {result `` '' {tr a-z A-Z <<< $x}}
+fn-c = <={compose $fn-downvowel $fn-upcase}
+echo <={c 'Cozy lummox gives smart squid who asks for job pen.'}
+# => CoZY LuMMoX GiVeS SMaRT SQuiD WHo aSKS FoR JoB PeN.

Task/Function-composition/Ursala/function-composition-1.ursala

@@ -0,0 +1 @@
+compose("f","g") "x" = "f" "g" "x"

Task/Function-composition/Ursala/function-composition-2.ursala

@@ -0,0 +1,4 @@
+#import nat
+#cast %n
+
+test =  compose(successor,double) 3

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

@@ -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.vbscript

@@ -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)