User:Coderjoe/Sandbox2: Difference between revisions
Content added Content deleted
No edit summary |
No edit summary |
||
Line 324: | Line 324: | ||
0.5 |
0.5 |
||
0.5</pre> |
0.5</pre> |
||
=={{header|PicoLisp}}== |
|||
<lang PicoLisp>(load "@lib/math.l") |
|||
(de compose (F G) |
|||
(curry (F G) (X) |
|||
(F (G X)) ) ) |
|||
(de cube (X) |
|||
(pow X 3.0) ) |
|||
(de cubeRoot (X) |
|||
(pow X 0.3333333) ) |
|||
(mapc |
|||
'((Fun Inv) |
|||
(prinl (format ((compose Inv Fun) 0.5) *Scl)) ) |
|||
'(sin cos cube) |
|||
'(asin acos cubeRoot) )</lang> |
|||
Output: |
|||
<pre>0.500001 |
|||
0.499999 |
|||
0.500000</pre> |
|||
=={{header|Prolog}}== |
|||
Works with SWI-Prolog and module lambda, written by <b>Ulrich Neumerkel</b> found here: http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/lambda.pl |
|||
<lang Prolog>:- use_module(library(lambda)). |
|||
compose(F,G, FG) :- |
|||
FG = \X^Z^(call(G,X,Y), call(F,Y,Z)). |
|||
cube(X, Y) :- |
|||
Y is X ** 3. |
|||
cube_root(X, Y) :- |
|||
Y is X ** (1/3). |
|||
first_class :- |
|||
L = [sin, cos, cube], |
|||
IL = [asin, acos, cube_root], |
|||
% we create the composed functions |
|||
maplist(compose, L, IL, Lst), |
|||
% we call the functions |
|||
maplist(call, Lst, [0.5,0.5,0.5], R), |
|||
% we display the results |
|||
maplist(writeln, R). |
|||
</lang> |
|||
Output : |
|||
<pre> ?- first_class. |
|||
0.5 |
|||
0.4999999999999999 |
|||
0.5000000000000001 |
|||
true. |
|||
</pre> |
|||
=={{header|Python}}== |
|||
<lang python>>>> # Some built in functions and their inverses |
|||
>>> from math import sin, cos, acos, asin |
|||
>>> # Add a user defined function and its inverse |
|||
>>> cube = lambda x: x * x * x |
|||
>>> croot = lambda x: x ** (1/3.0) |
|||
>>> # First class functions allow run-time creation of functions from functions |
|||
>>> # return function compose(f,g)(x) == f(g(x)) |
|||
>>> compose = lambda f1, f2: ( lambda x: f1(f2(x)) ) |
|||
>>> # first class functions should be able to be members of collection types |
|||
>>> funclist = [sin, cos, cube] |
|||
>>> funclisti = [asin, acos, croot] |
|||
>>> # Apply functions from lists as easily as integers |
|||
>>> [compose(inversef, f)(.5) for f, inversef in zip(funclist, funclisti)] |
|||
[0.5, 0.4999999999999999, 0.5] |
|||
>>></lang> |
|||
=={{header|R}}== |
|||
<lang R>cube <- function(x) x^3 |
|||
croot <- function(x) x^(1/3) |
|||
compose <- function(f, g) function(x){f(g(x))} |
|||
f1 <- c(sin, cos, cube) |
|||
f2 <- c(asin, acos, croot) |
|||
for(i in 1:3) { |
|||
print(compose(f1[[i]], f2[[i]])(.5)) |
|||
}</lang> |
|||
Alternatively: |
|||
<lang R> |
|||
sapply(mapply(compose,f1,f2),do.call,list(.5)) |
|||
</lang> |
|||
=={{header|REBOL}}== |
|||
<lang REBOL>REBOL [ |
|||
Title: "First Class Functions" |
|||
Author: oofoe |
|||
Date: 2009-12-05 |
|||
URL: http://rosettacode.org/wiki/First-class_functions |
|||
] |
|||
; Functions "foo" and "bar" are used to prove that composition |
|||
; actually took place by attaching their signatures to the result. |
|||
foo: func [x][reform ["foo:" x]] |
|||
bar: func [x][reform ["bar:" x]] |
|||
cube: func [x][x * x * x] |
|||
croot: func [x][power x 1 / 3] |
|||
; "compose" means something else in REBOL, so I "fashion" an alternative. |
|||
fashion: func [f1 f2][ |
|||
do compose/deep [func [x][(:f1) (:f2) x]]] |
|||
A: [foo sine cosine cube] |
|||
B: [bar arcsine arccosine croot] |
|||
while [not tail? A][ |
|||
fn: fashion get A/1 get B/1 |
|||
source fn ; Prove that functions actually got composed. |
|||
print [fn 0.5 crlf] |
|||
A: next A B: next B ; Advance to next pair. |
|||
]</lang> |
|||
=={{header|Ruby}}== |
|||
<lang ruby>irb(main):001:0> cube = proc {|x| x ** 3} |
|||
=> #<Proc:0xb7cac4b8@(irb):1> |
|||
irb(main):002:0> croot = proc {|x| x ** (1/3.0)} |
|||
=> #<Proc:0xb7ca40d8@(irb):2> |
|||
irb(main):003:0> compose = proc {|f,g| proc {|x| f[g[x]]}} |
|||
=> #<Proc:0xb7c9996c@(irb):3> |
|||
irb(main):004:0> funclist = [Math.method(:sin).to_proc, Math.method(:cos).to_proc, cube] |
|||
=> [#<Proc:0xb7c84be8@(irb):4>, #<Proc:0xb7c84bac@(irb):4>, #<Proc:0xb7cac4b8@(irb):1>] |
|||
irb(main):005:0> funclisti = [Math.method(:asin).to_proc, Math.method(:acos).to_proc, croot] |
|||
=> [#<Proc:0xb7c7a88c@(irb):5>, #<Proc:0xb7c7a850@(irb):5>, #<Proc:0xb7ca40d8@(irb):2>] |
|||
irb(main):006:0> funclist.zip(funclisti).map {|f,inversef| compose[inversef, f][0.5] } |
|||
=> [0.5, 0.5, 0.5]</lang> |
|||
=={{header|Scala}}== |
|||
<lang scala>def cube = (x:Double) => x*x*x |
|||
def cuberoot = (x:Double) => Math.pow(x,1.0/3) |
|||
def compose[A,B,C](f:B=>C,g:A=>B) = (x:A)=>f(g(x)) |
|||
def fun = List(Math.sin _, Math.cos _, cube) |
|||
def inv = List(Math.asin _, Math.acos _, cuberoot) |
|||
def comp = fun zip inv map Function.tupled(_ compose _) |
|||
comp.foreach(f=>println(f(0.5)))</lang> |
|||
Here's how you could add a composition operator to make that syntax prettier: |
|||
<lang scala>class SweetFunction[B,C](f:B=>C) { |
|||
def o[A](g:A=>B) = (x:A)=>f(g(x)) |
|||
} |
|||
implicit def sugarOnTop[A,B](f:A=>B) = new SweetFunction(f) |
|||
//and now you can do things like this |
|||
println((cube o cube o cuberoot)(0.5))</lang> |
|||
=={{header|Scheme}}== |
|||
<lang scheme>(define (compose f g) (lambda (x) (f (g x)))) |
|||
(define (cube x) (expt x 3)) |
|||
(define (cube-root x) (expt x (/ 1 3))) |
|||
(define function (list sin cos cube)) |
|||
(define inverse (list asin acos cube-root)) |
|||
(define x 0.5) |
|||
(define (go f g) |
|||
(if (not (or (null? f) |
|||
(null? g))) |
|||
(begin (display ((compose (car f) (car g)) x)) |
|||
(newline) |
|||
(go (cdr f) (cdr g))))) |
|||
(go function inverse)</lang> |
|||
Output: |
|||
0.5 |
|||
0.5 |
|||
0.5 |
|||
=={{header|Slate}}== |
|||
Compose is already defined in slate as (note the examples in the comment): |
|||
<lang slate>m@(Method traits) ** n@(Method traits) |
|||
"Answers a new Method whose effect is that of calling the first method |
|||
on the results of the second method applied to whatever arguments are passed. |
|||
This composition is associative, i.e. (a ** b) ** c = a ** (b ** c). |
|||
When the second method, n, does not take a *rest option or the first takes |
|||
more than one input, then the output is chunked into groups for its |
|||
consumption. E.g.: |
|||
#; `er ** #; `er applyTo: {'a'. 'b'. 'c'. 'd'} => 'abcd' |
|||
#; `er ** #name `er applyTo: {#a. #/}. => 'a/'" |
|||
[ |
|||
n acceptsAdditionalArguments \/ [m arity = 1] |
|||
ifTrue: |
|||
[[| *args | m applyTo: {n applyTo: args}]] |
|||
ifFalse: |
|||
[[| *args | |
|||
m applyTo: |
|||
([| :stream | |
|||
args do: [| *each | stream nextPut: (n applyTo: each)] |
|||
inGroupsOf: n arity] writingAs: {})]] |
|||
]. |
|||
#**`er asMethod: #compose: on: {Method traits. Method traits}.</lang> |
|||
used as: |
|||
<lang slate>n@(Number traits) cubed [n raisedTo: 3]. |
|||
n@(Number traits) cubeRoot [n raisedTo: 1 / 3]. |
|||
define: #forward -> {#cos `er. #sin `er. #cube `er}. |
|||
define: #reverse -> {#arcCos `er. #arcSin `er. #cubeRoot `er}. |
|||
define: #composedMethods -> (forward with: reverse collect: #compose: `er). |
|||
composedMethods do: [| :m | inform: (m applyWith: 0.5)].</lang> |
|||
=={{header|Smalltalk}}== |
|||
{{works with|GNU Smalltalk}} |
|||
<lang smalltalk>|forward reverse composer compounds| |
|||
"commodities" |
|||
Number extend [ |
|||
cube [ ^self raisedTo: 3 ] |
|||
]. |
|||
Number extend [ |
|||
cubeRoot [ ^self raisedTo: (1 / 3) ] |
|||
]. |
|||
forward := #( #cos #sin #cube ). |
|||
reverse := #( #arcCos #arcSin #cubeRoot ). |
|||
composer := [ :f :g | [ :x | f value: (g value: x) ] ]. |
|||
"let us create composed funcs" |
|||
compounds := OrderedCollection new. |
|||
1 to: 3 do: [ :i | |
|||
compounds add: ([ :j | composer value: [ :x | x perform: (forward at: j) ] |
|||
value: [ :x | x perform: (reverse at: j) ] ] value: i) |
|||
]. |
|||
compounds do: [ :r | (r value: 0.5) displayNl ].</lang> |
|||
Output: |
|||
<pre>0.4999999999999999 |
|||
0.5 |
|||
0.5000000000000001</pre> |
|||
=={{header|Standard ML}}== |
|||
<lang sml>- fun cube x = Math.pow(x, 3.0); |
|||
val cube = fn : real -> real |
|||
- fun croot x = Math.pow(x, 1.0 / 3.0); |
|||
val croot = fn : real -> real |
|||
- fun compose (f, g) = fn x => f (g x); (* this is already implemented in Standard ML as the "o" operator |
|||
= we could have written "fun compose (f, g) x = f (g x)" but we show this for clarity *) |
|||
val compose = fn : ('a -> 'b) * ('c -> 'a) -> 'c -> 'b |
|||
- val funclist = [Math.sin, Math.cos, cube]; |
|||
val funclist = [fn,fn,fn] : (real -> real) list |
|||
- val funclisti = [Math.asin, Math.acos, croot]; |
|||
val funclisti = [fn,fn,fn] : (real -> real) list |
|||
- ListPair.map (fn (f, inversef) => (compose (inversef, f)) 0.5) (funclist, funclisti); |
|||
val it = [0.5,0.5,0.500000000001] : real list</lang> |
|||
=={{header|Tcl}}== |
|||
The following is a transcript of an interactive session:<br> |
|||
{{works with|tclsh|8.5}} |
|||
<lang Tcl>% namespace path tcl::mathfunc ;# to import functions like abs() etc. |
|||
% proc cube x {expr {$x**3}} |
|||
% proc croot x {expr {$x**(1/3.)}} |
|||
% proc compose {f g} {list apply {{f g x} {{*}$f [{*}$g $x]}} $f $g} |
|||
% compose abs cube ;# returns a partial command, without argument |
|||
apply {{f g x} {{*}$f [{*}$g $x]}} abs cube |
|||
% {*}[compose abs cube] -3 ;# applies the partial command to argument -3 |
|||
27 |
|||
% set forward [compose [compose sin cos] cube] ;# omitting to print result |
|||
% set backward [compose croot [compose acos asin]] |
|||
% {*}$forward 0.5 |
|||
0.8372297964617733 |
|||
% {*}$backward [{*}$forward 0.5] |
|||
0.5000000000000017</lang> |
|||
Obviously, the ([[C]]) library implementation of some of the trigonometric functions (on which Tcl depends for its implementation) on the platform used for testing is losing a little bit of accuracy somewhere. |
|||
=={{header|TI-89 BASIC}}== |
|||
See the comments at [[Function as an Argument#TI-89 BASIC]] for more information on first-class functions or the lack thereof in TI-89 BASIC. In particular, it is not possible to do proper function composition, because functions cannot be passed as values nor be closures. |
|||
Therefore, this example does everything but the composition. |
|||
(Note: The names of the inverse functions may not display as intended unless you have the “TI Uni” font.) |
|||
<lang ti89b>Prgm |
|||
Local funs,invs,composed,x,i |
|||
Define rc_cube(x) = x^3 © Cannot be local variables |
|||
Define rc_curt(x) = x^(1/3) |
|||
Define funs = {"sin","cos","rc_cube"} |
|||
Define invs = {"sin","cos","rc_curt"} |
|||
Define x = 0.5 |
|||
Disp "x = " & string(x) |
|||
For i,1,3 |
|||
Disp "f=" & invs[i] & " g=" & funs[i] & " f(g(x))=" & string(#(invs[i])(#(funs[i])(x))) |
|||
EndFor |
|||
DelVar rc_cube,rc_curt © Clean up our globals |
|||
EndPrgm</lang> |
|||
=={{header|Ursala}}== |
|||
The algorithm is to zip two lists of functions into a list of pairs of functions, make |
|||
that a list of functions by composing each pair, "<code>gang</code>" the list of |
|||
functions into a single function returning a list, and apply it to the |
|||
argument 0.5. |
|||
<lang Ursala>#import std |
|||
#import flo |
|||
functions = <sin,cos,times^/~& sqr> |
|||
inverses = <asin,acos,math..cbrt> |
|||
#cast %eL |
|||
main = (gang (+)*p\functions inverses) 0.5</lang> |
|||
In more detail, |
|||
* <code>(+)*p\functions inverses</code> evaluates to <code>(+)*p(inverses,functions)</code> by definition of the reverse binary to unary combinator (<code>\</code>) |
|||
* This expression evaluates to <code>(+)*p(<asin,acos,math..cbrt>,<sin,cos,times^/~& sqr>)</code> by substitution. |
|||
* The zipping is indicated by the <code>p</code> suffix on the map operator, (<code>*</code>) so that <code>(+)*p</code> evaluates to <code>(+)* <(asin,sin),(acos,cos),(cbrt,times^/~& sqr)></code>. |
|||
* The composition (<code>(+)</code>) operator is then mapped over the resulting list of pairs of functions, to obtain the list of functions <code><asin+sin,acos+cos,cbrt+ times^/~& sqr></code>. |
|||
* <code>gang<aisn+sin,acos+cos,cbrt+ times^/~& sqr></code> expresses a function returning a list in terms of a list of functions. |
|||
output: |
|||
<pre><5.000000e-01,5.000000e-01,5.000000e-01></pre> |