aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

8
Task/First-class-functions/00DESCRIPTION
View file

@ -5,8 +5,14 @@ A language has [[wp:First-class function|first-class functions]] if it can do ea
* Use functions as arguments to other functions
* Use functions as return values of other functions
<br>
;Task:
Write a program to create an ordered collection ''A'' of functions of a real number. At least one function should be built-in and at least one should be user-defined; try using the sine, cosine, and cubing functions. Fill another collection ''B'' with the inverse of each function in ''A''. Implement function composition as in [[Functional Composition]]. Finally, demonstrate that the result of applying the composition of each function in ''A'' and its inverse in ''B'' to a value, is the original value. <small>(Within the limits of computational accuracy)</small>.
(A solution need not actually call the collections "A" and "B". These names are only used in the preceding paragraph for clarity.)
C.f. [[First-class Numbers]]
;Related task:
[[First-class Numbers]]
<br><br>

56
Task/First-class-functions/AppleScript/first-class-functions-1.applescript Normal file
View file

@ -0,0 +1,56 @@
-- Compose two functions, where each function is
-- a script object with a call(x) handler.
on compose(f, g)
script
on call(x)
f's call(g's call(x))
end call
end script
end compose
script increment
on call(n)
n + 1
end call
end script
script decrement
on call(n)
n - 1
end call
end script
script twice
on call(x)
x * 2
end call
end script
script half
on call(x)
x / 2
end call
end script
script cube
on call(x)
x ^ 3
end call
end script
script cuberoot
on call(x)
x ^ (1 / 3)
end call
end script
set functions to {increment, twice, cube}
set inverses to {decrement, half, cuberoot}
set answers to {}
repeat with i from 1 to 3
set end of answers to ¬
compose(item i of inverses, ¬
item i of functions)'s ¬
call(0.5)
end repeat
answers -- Result: {0.5, 0.5, 0.5}

104
Task/First-class-functions/AppleScript/first-class-functions-2.applescript Normal file
View file

@ -0,0 +1,104 @@
on run {}
set lstFn to {sin_, cos_, cube_}
set lstInvFn 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))
--> {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
end script
end mCompose
-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
tell mReturn(f)
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)
end repeat
return lst
end tell
end map
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then
f
else
script
property lambda : 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
end zipWith
-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b)
on cond(bool, f, g)
if bool then
f
else
g
end if
end cond
on sin:r
(do shell script "echo 's(" & r & ")' | bc -l") as real
end sin:
on cos:r
(do shell script "echo 'c(" & r & ")' | bc -l") as real
end cos:
on cube:x
x ^ 3
end cube:
on croot:x
x ^ (1 / 3)
end croot:
on asin:r
(do shell script "echo 'a(" & r & "/sqrt(1-" & r & "^2))' | bc -l") as real
end asin:
on acos:r
(do shell script "echo 'a(sqrt(1-" & r & "^2)/" & r & ")' | bc -l") as real
end acos:

1
Task/First-class-functions/AppleScript/first-class-functions-3.applescript Normal file
View file

@ -0,0 +1 @@
{0.5, 0.5, 0.5}

56
Task/First-class-functions/AppleScript/first-class-functions.applescript
View file

@ -1,56 +0,0 @@
-- Compose two functions, where each function is
-- a script object with a call(x) handler.
on compose(f, g)
script
on call(x)
f's call(g's call(x))
end call
end script
end compose
script increment
on call(n)
n + 1
end call
end script
script decrement
on call(n)
n - 1
end call
end script
script twice
on call(x)
x * 2
end call
end script
script half
on call(x)
x / 2
end call
end script
script cube
on call(x)
x ^ 3
end call
end script
script cuberoot
on call(x)
x ^ (1 / 3)
end call
end script
set functions to {increment, twice, cube}
set inverses to {decrement, half, cuberoot}
set answers to {}
repeat with i from 1 to 3
set end of answers to ¬
compose(item i of inverses, ¬
item i of functions)'s ¬
call(0.5)
end repeat
answers -- Result: {0.5, 0.5, 0.5}

6
Task/First-class-functions/Common-Lisp/first-class-functions-1.lisp
View file

@ -3,11 +3,11 @@
(defun cube-root (x) (expt x (/ 3)))
(loop with value = 0.5
for function in (list #'sin #'cos #'cube )
for func in (list #'sin #'cos #'cube )
for inverse in (list #'asin #'acos #'cube-root)
for composed = (compose inverse function)
for composed = (compose inverse func)
do (format t "~&(~A ∘ ~A)(~A) = ~A~%"
inverse
function
func
value
(funcall composed value)))

19
Task/First-class-functions/Elena/first-class-functions.elena Normal file
View file

@ -0,0 +1,19 @@
#import system.
#import system'routines.
#import system'math.
#import extensions'routines.
#class(extension)op
{
#method compose : f : g
= (self::g eval)::f eval.
}
#symbol 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) ]).
fs zip:gs &into: (:f:g)[ 0.5r compose:f:g ]
run &each:printingLn.
].

14
Task/First-class-functions/Elixir/first-class-functions.elixir Normal file
View file

@ -0,0 +1,14 @@
defmodule First_class_functions do
def task(val) do
as = [&:math.sin/1, &:math.cos/1, fn x -> x * x * x end]
bs = [&:math.asin/1, &:math.acos/1, fn x -> :math.pow(x, 1/3) end]
Enum.zip(as, bs)
|> Enum.each(fn {a,b} -> IO.puts compose([a,b], val) end)
end
defp compose(funs, x) do
Enum.reduce(funs, x, fn f,acc -> f.(acc) end)
end
end
First_class_functions.task(0.5)

2
Task/First-class-functions/GAP/first-class-functions.gap
View file

@ -18,7 +18,7 @@ ApplyList := function(u, x)
return v;
end;
# Inverse and Sqrt are in the built-in library. Note that GAP doesn't have real numbers nor floating point numbers. Therefore, Sqrt yields values in cyclotomic fields.
# Inverse and Sqrt are in the built-in library. Note that Sqrt yields values in cyclotomic fields.
# For example,
# gap> Sqrt(7);
# E(28)^3-E(28)^11-E(28)^15+E(28)^19-E(28)^23+E(28)^27

26
Task/First-class-functions/Haskell/first-class-functions.hs
View file

@ -1,8 +1,18 @@
Prelude> let cube x = x ^ 3
Prelude> let croot x = x ** (1/3)
Prelude> let compose f g = \x -> f (g x) -- this is already implemented in Haskell as the "." operator
Prelude> -- we could have written "let compose f g x = f (g x)" but we show this for clarity
Prelude> let funclist = [sin, cos, cube]
Prelude> let funclisti = [asin, acos, croot]
Prelude> zipWith (\f inversef -> (compose inversef f) 0.5) funclist funclisti
[0.5,0.4999999999999999,0.5]
cube :: Floating a => a -> a
cube x = x ** 3.0
croot :: Floating a => a -> a
croot x = x ** (1/3)
-- compose already exists in Haskell as the `.` operator
-- compose :: (a -> b) -> (b -> c) -> a -> c
-- compose f g = \x -> g (f x)
funclist :: Floating a => [a -> a]
funclist = [sin, cos, cube ]
invlist :: Floating a => [a -> a]
invlist = [asin, acos, croot]
main :: IO ()
main = print $ zipWith (\f i -> f . i $ 0.5) funclist invlist

8
Task/First-class-functions/Oz/first-class-functions.oz → Task/First-class-functions/Oz/first-class-functions-1.oz
View file

@ -1,12 +1,12 @@
declare
fun {Compose F G}
fun {$ X}
{F {G X}}
end
fun {$ X}
{F {G X}}
end
end
fun {Cube X} X*X*X end
fun {Cube X} {Number.pow X 3.0} end
fun {CubeRoot X} {Number.pow X 1.0/3.0} end

3
Task/First-class-functions/Oz/first-class-functions-2.oz Normal file
View file

@ -0,0 +1,3 @@
0.5
0.5
0.5

113
Task/First-class-functions/REXX/first-class-functions.rexx
View file

@ -1,62 +1,59 @@
/*REXX pgm demonstrating first-class functions (as a list of functions).*/
A = 'd2x square sin cos' /*list of functions to test. */
B = 'x2d sqrt Asin Acos' /*inverse functions of the above.*/
w=digits() /*W=width of numbers to be shown.*/
do j=1 for words(A); say /*do functions: A,B collections.*/
say center("number",w) center('function',3*w+1) center("inverse",4*w)
say copies("─",w) copies("─",3*w+1) copies("─",4*w)
if j<2 then call test j, 20 60 500 /*x2d,d2x; integers only.*/
else call test j, 0 0.5 1 2 /*all else, floating pt. */
/*REXX program demonstrates first─class functions (as a list of the names of functions).*/
A = 'd2x square sin cos' /*a list of functions to demonstrate.*/
B = 'x2d sqrt Asin Acos' /*the inverse functions of above list. */
w=digits() /*W: width of numbers to be displayed.*/
/* [↓] collection of A & B functions*/
do j=1 for words(A); say; say /*step through the list; 2 blank lines*/
say center("number",w) center('function', 3*w+1) center("inverse", 4*w)
say copies("─" ,w) copies("─", 3*w+1) copies("─", 4*w)
if j<2 then call test j, 20 60 500 /*functions X2D, D2X: integers only. */
else call test j, 0 0.5 1 2 /*all other functions: floating point.*/
end /*j*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────subroutines (functions)───────────────────*/
Acos: procedure; arg x; if x<-1|x>1 then call AcosErr; return .5*pi()-Asin(x)
r2r: return arg(1) // (2*pi()) /*normalize radians ──► 1 unit circle*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
Acos: procedure; parse arg x; if x<-1|x>1 then call AcosErr; return .5*pi()-Asin(x)
r2r: return arg(1) // (pi()*2) /*normalize radians ──► 1 unit circle*/
square: return arg(1) ** 2
pi: pi=3.14159265358979323846264338327950288419716939937510582097494459230; return pi
tellErr: say; say '*** error! ***'; say; say arg(1); say; exit 13
tanErr: call tellErr 'tan('||x") causes division by zero, X=" ||x
AsinErr: call tellErr 'Asin(x), X must be in the range of -1 ──► +1, X=' ||x
AcosErr: call tellErr 'Acos(x), X must be in the range of -1 ──► +1, X=' ||x
Asin: procedure; arg x; if x<-1 | x>1 then call AsinErr; s=x*x
if abs(x)>=.7 then return sign(x)*Acos(sqrt(1-s)); z=x; o=x; p=z
do j=2 by 2; o=o*s*(j-1)/j; z=z+o/(j+1); if z=p then leave; p=z; end
return z
cos: procedure; parse arg x; x=r2r(x); a=abs(x); hpi=pi*.5
numeric fuzz min(6,digits()-3); if a=pi() then return -1
if a=hpi | a=hpi*3 then return 0 ; if a=pi()/3 then return .5
if a=pi()*2/3 then return -.5; return .sinCos(1,1,-1)
sin: procedure; arg x; x=r2r(x); numeric fuzz min(5,digits()-3)
if abs(x)=pi() then return 0; return .sinCos(x,x,1)
tanErr: call tellErr 'tan(' || x") causes division by zero, X=" || x
AsinErr: call tellErr 'Asin(x), X must be in the range of -1 ──► +1, X=' || x
AcosErr: call tellErr 'Acos(x), X must be in the range of -1 ──► +1, X=' || x
/*──────────────────────────────────────────────────────────────────────────────────────*/
Asin: procedure; parse arg x; if x<-1 | x>1 then call AsinErr; s=x*x
if abs(x)>=.7 then return sign(x)*Acos(sqrt(1-s)); z=x; o=x; p=z
do j=2 by 2; o=o*s*(j-1)/j; z=z+o/(j+1); if z=p then leave; p=z; end
return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
cos: procedure; parse arg x; x=r2r(x); a=abs(x); Hpi=pi*.5
numeric fuzz min(6,digits()-3); if a=pi() then return -1
if a=Hpi | a=Hpi*3 then return 0 ; if a=pi()/3 then return .5
if a=pi()*2/3 then return -.5; return .sinCos(1,1,-1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
sin: procedure; parse arg x; x=r2r(x); numeric fuzz min(5, digits()-3)
if abs(x)=pi() then return 0; return .sinCos(x,x,1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
.sinCos: parse arg z 1 p,_,i; x=x*x
do k=2 by 2; _=-_*x/(k*(k+i));z=z+_;if z=p then leave;p=z;end; return z
invoke: parse arg fn,v; q='"'; if datatype(v,'N') then q=
_=fn || '('q||v||q')'; interpret 'func='_; return func
pi: pi=3.141592653589793238462643383279502884197169399375105820974944 ||,
5923078164062862; return pi
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
numeric digits d; return (g/1)i /*make complex if X < 0.*/
test: procedure expose A B w; parse arg fu,xList /*xList=bunch of #s*/
do k=1 for words(xList); x=word(xList,k)
numeric digits digits()+5 /*higher precision.*/
fun=word(A,fu); funV=invoke(fun,x) ; funInvoke=_
inv=word(B,fu); invV=invoke(inv,funV); invInvoke=_
numeric digits digits()-5 /*restore precision*/
if datatype(funV,'N') then funV=funV/1 /*round to digits()*/
if datatype(invV,'N') then invV=invV/1 /*round to digits()*/
say center(x,w) right(funInvoke,2*w)'='left(funV,w),
right(invInvoke,3*w)'='left(invV,w)
end /*k*/
return
do k=2 by 2; _=-_*x/(k*(k+i)); z=z+_; if z=p then leave; p=z; end; return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
invoke: parse arg fn,v; q='"'; if datatype(v,"N") then q=
_=fn || '('q || v || q")"; interpret 'func='_; return func
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form
numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
h=d+6; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
numeric digits d; return g/1
/*──────────────────────────────────────────────────────────────────────────────────────*/
test: procedure expose A B w; parse arg fu,xList; d=digits() /*xList: numbers. */
do k=1 for words(xList); x=word(xList, k)
numeric digits d+5 /*higher precision.*/
fun=word(A, fu); funV=invoke(fun, x) ; fun@=_
inv=word(B, fu); invV=invoke(inv, funV); inv@=_
numeric digits d /*restore precision*/
if datatype(funV, 'N') then funV=funV/1 /*round to digits()*/
if datatype(invV, 'N') then invV=invV/1 /*round to digits()*/
say center(x, w) right(fun@, 2*w)'='left(left('', funV>=0)funV, w),
right(inv@, 3*w)'='left(left('', invV>=0)invV, w)
end /*k*/
return

24
Task/First-class-functions/Rust/first-class-functions.rust Normal file
View file

@ -0,0 +1,24 @@
#![feature(conservative_impl_trait)]
fn main() {
let cube = |x: f64| x.powi(3);
let cube_root = |x: f64| x.powf(1.0 / 3.0);
let flist : [&Fn(f64) -> f64; 3] = [&cube , &f64::sin , &f64::cos ];
let invlist: [&Fn(f64) -> f64; 3] = [&cube_root, &f64::asin, &f64::acos];
let result = flist.iter()
.zip(&invlist)
.map(|(f,i)| compose(f,i)(0.5))
.collect::<Vec<_>>();
println!("{:?}", result);
}
fn compose<'a, F, G, T, U, V>(f: F, g: G) -> impl 'a + Fn(T) -> V
where F: 'a + Fn(T) -> U,
G: 'a + Fn(U) -> V,
{
move |x| g(f(x))
}

4
Task/First-class-functions/SuperCollider/first-class-functions.supercollider Normal file
View file

@ -0,0 +1,4 @@
a = [sin(_), cos(_), { |x| x ** 3 }];
b = [asin(_), acos(_), { |x| x ** (1/3) }];
c = a.collect { |x, i| x <> b[i] };
c.every { |x| x.(0.5) - 0.5 < 0.00001 }