First-class functions: Difference between revisions

← Older editNewer edit →
Content deleted Content added
Hout (talk | contribs)
9,659 edits
Line 240: Line 240:
<lang applescript>on run {}
<lang applescript>on run {}
set lstFn to {_sin, _cos, _cube}
set lstFn to {sin_, cos_, cube_}
set lstInvFn to {_asin, _acos, _croot}
set lstInvFn to {asin_, acos_, croot_}
-- Form a list of three composed function objects,
-- Form a list of three composed function objects,
Line 247: Line 247:
-- application of each composed function (base function composed with inverse) to 0.5
-- application of each composed function (base function composed with inverse) to 0.5
map(zipWith(mCompose, lstFn, lstInvFn), testWithHalf)
map(testWithHalf, zipWith(mCompose, lstFn, lstInvFn))
⚫
--> {0.5, 0.5, 0.5}
--> {0.5, 0.5, 0.5}
Line 254: Line 255:


on testWithHalf(mf)
on testWithHalf(mf)
mf's call(0.5)
mf's lambda(0.5)
end testWithHalf
end testWithHalf


Line 261: Line 262:
on mCompose(f, g)
on mCompose(f, g)
script
script
on call(x)
on lambda(x)
mReturn(f)'s call(mReturn(g)'s call(x))
mReturn(f)'s lambda(mReturn(g)'s lambda(x))
end call
end lambda
end script
end script
end mCompose
end mCompose


-- [a] -> (a -> b) -> [b]
-- map :: (a -> b) -> [a] -> [b]
on map(xs, f)
on map(f, xs)
set mf to mReturn(f)
set mf to mReturn(f)
⚫
⚫
set lst to {}
set lng to length of xs
set lng to length of xs
⚫
set lst to {}
repeat with i from 1 to lng
repeat with i from 1 to lng
set end of lst to mf's call(item i of xs, i, xs)
set end of lst to mf's lambda(item i of xs, i, xs)
end repeat
end repeat
return lst
return lst
end map
end map



-- zipWith generalises zip by zipping with the function given as the first argument,
-- zipWith generalises zip by zipping with the function given as the first argument,
-- instead of a tupling function
-- instead of a tupling function
-- (a -> b -> c) -> [a] -> [b] -> [c]
-- (a -> b -> c) -> [a] -> [b] -> [c]
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
on zipWith(f, xs, ys)
set lngX to length of xs
set lng to length of xs
set lngY to length of ys
if lng is not length of ys then return missing value
⚫
set lst to {}
if lngX > 0 and lngY > 0 then
⚫
set mf to mReturn(f)
⚫
set end of lst to mf's call(item 1 of xs, item 1 of ys)
if lngX > 1 and lngY > 1 then
set lst to lst & zipWith(f, items 2 thru -1 of xs, items 2 thru -1 of ys)
⚫
end if
end if
⚫
set mf to mReturn(f)
⚫
set lst to {}
repeat with i from 1 to lng
⚫
set end of lst to mf's lambda(item i of xs, item i of ys)
⚫
end repeat
return lst
return lst
end zipWith
end zipWith




-- An ordinary AppleScript handler function
-- An ordinary AppleScript handler function
Line 304: Line 302:
on mReturn(f)
on mReturn(f)
script
script
property call : f
property lambda : f
end script
end script
end mReturn
end mReturn


on _sin(r)
on sin:r
(do shell script "echo 's(" & r & ")' | bc -l") as real
(do shell script "echo 's(" & r & ")' | bc -l") as real
end _sin
end sin:


on _cos(r)
on cos:r
(do shell script "echo 'c(" & r & ")' | bc -l") as real
(do shell script "echo 'c(" & r & ")' | bc -l") as real
end _cos
end cos:


on _cube(x)
on cube:x
x ^ 3
x ^ 3
end _cube
end cube:


on _croot(x)
on croot:x
x ^ (1 / 3)
x ^ (1 / 3)
end _croot
end croot:


on _asin(r)
on asin:r
(do shell script "echo 'a(" & r & "/sqrt(1-" & r & "^2))' | bc -l") as real
(do shell script "echo 'a(" & r & "/sqrt(1-" & r & "^2))' | bc -l") as real
end _asin
end asin:


on _acos(r)
on acos:r
(do shell script "echo 'a(sqrt(1-" & r & "^2)/" & r & ")' | bc -l") as real
(do shell script "echo 'a(sqrt(1-" & r & "^2)/" & r & ")' | bc -l") as real
end _acos
end acos:
</lang>
</lang>


Retrieved from "https://rosettacode.org/wiki/First-class_functions"