First-class functions: Difference between revisions

Line 240:
<lang applescript>on run {}
set lstFn to {_sinsin_, _coscos_, _cubecube_}
set lstInvFn to {_asinasin_, _acosacos_, _crootcroot_}
-- Form a list of three composed function objects,
Line 247:
-- application of each composed function (base function composed with inverse) to 0.5
map(testWithHalf, zipWith(mCompose, lstFn, lstInvFn), testWithHalf)
--> {0.5, 0.5, 0.5}
Line 254 ⟶ 255:
 
on testWithHalf(mf)
mf's calllambda(0.5)
end testWithHalf
 
Line 261 ⟶ 262:
on mCompose(f, g)
script
on calllambda(x)
mReturn(f)'s calllambda(mReturn(g)'s calllambda(x))
end calllambda
end script
end mCompose
 
-- [a]map ->:: (a -> b) -> [a] -> [b]
on map(xsf, fxs)
set mf to mReturn(f)
set lst to {}
set lng to length of xs
set lst to {}
repeat with i from 1 to lng
set end of lst to mf's calllambda(item i of xs, i, xs)
end repeat
return lst
end map
 
 
-- zipWith generalises zip by zipping with the function given as the first argument,
-- instead of a tupling function
-- (a -> b -> c) -> [a] -> [b] -> [c]
-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
set lngXlng to length of xs
setif lngYlng tois 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 calllambda(item 1i of xs, item 1i of ys)
end ifrepeat
return lst
end zipWith
 
 
 
-- An ordinary AppleScript handler function
Line 304 ⟶ 302:
on mReturn(f)
script
property calllambda : f
end script
end mReturn
 
on _sin(sin:r)
(do shell script "echo 's(" & r & ")' | bc -l") as real
end _sinsin:
 
on _cos(cos:r)
(do shell script "echo 'c(" & r & ")' | bc -l") as real
end _coscos:
 
on _cube(cube:x)
x ^ 3
end _cubecube:
 
on _croot(croot:x)
x ^ (1 / 3)
end _crootcroot:
 
on _asin(asin:r)
(do shell script "echo 'a(" & r & "/sqrt(1-" & r & "^2))' | bc -l") as real
end _asinasin:
 
on _acos(acos:r)
(do shell script "echo 'a(sqrt(1-" & r & "^2)/" & r & ")' | bc -l") as real
end _acosacos:
</lang>
 
9,659

edits