Jump to content

Monads/List monad: Difference between revisions

→‎{{header|AppleScript}}: Some simplification - normalised argument sequence in a couple of higher-order functions
(→‎{{header|AppleScript}}: Some simplification - normalised argument sequence in a couple of higher-order functions)
Line 15:
We can use a list monad in AppleScript to express set comprehension for the Pythagorean triples, but the lack of nestable first class (and anonymous) functions means that the closure can only be achieved using script objects, which makes the idiom rather less direct and transparent. AppleScript is creaking at the seams here.
 
<lang AppleScript>on run
 
on run
-- Pythagorean triples drawn from integers in the range [1..n]
-- {(x, y, z) | x <- [1..n], y <- [x+1..n], z <- [y+1..n], (x^2 + y^2 = z^2)}
Line 27 ⟶ 25:
end run
 
-- pythagoreanTriples :: Int -> [(Int, Int, Int)]
 
on pythagoreanTriples(maxInteger)
script mflambdaX
propertyon n : maxIntegerlambda(x)
script lambdaY
on lambdaXlambda(xy)
set mf to my closure's mf script lambdaZ
bind(range(1 + x, mf's n), mClosure(mf's lambdaY, {x:x, mf:mf}) on lambda(z)
if x * x + y * y = z * z then
end lambdaX
return my unit([x, y, z])
on lambdaY(y) else
set mf to my closure's mf []
bind(range(1 + y, mf's n), mClosure(mf's lambdaZ, {x:x of my closure, y:y})) end if
end lambdaYlambda
end script
on lambdaZ(z)
set x to my closure's x bind(lambdaZ, range(1 + y, maxInteger))
set y to my closure'send ylambda
end script
if x * x + y * y = z * z then
return my unit([x, y, z])
else
return []
end if
bind(lambdaY, range(1 + x, maxInteger))
end lambdaZ
end lambdaXlambda
end script
return bind(lambdaX, range(1, maxInteger), mClosure(mf's lambdaX, {mf:mf}))
end pythagoreanTriples
 
 
-- LIBRARYMONADIC FUNCTIONS (for list monad)
 
-- Monadic bind for lists is simply ConcatMap
-- which applies a function f directly to each value in the list,
-- and returns the set of results as a concat-flattened list
 
-- [a] -> (a -> [b]) -> [b]
on-- bind :: (xs,a f-> [b]) -> [a] -> [b]
on mapbind(xsf, fxs)
reduce(map(xs, f), my concat, {})
-- [a]concat ->:: (a -> b)a -> [ba]
script concat
propertyon lambda(a, : fb)
elsea & b
end lambdaZlambda
end repeatscript
foldl(concat, {}, map(f, xs))
end bind
 
-- Monadic return/unit/inject for lists: just wraps a value in a list
-- a -> [a]
on unit(a)
Line 76 ⟶ 78:
end unit
 
 
-- [a] -> (a -> b) -> [b]
-- GENERIC LIBRARY FUNCTIONS
on map(xs, f)
 
-- [map :: (a] -> (ab) -> [ba]) -> [b]
on rangemap(mf, nxs)
set mf to mReturn(f)
set lng to length of xs
Line 87 ⟶ 92:
end map
 
 
-- list, function, initial accumulator value
-- thefoldl arguments:: available(a to-> theb function-> f(a,) x,-> i,a l)-> are[b] -> a
on foldl(f, startValue, xs)
-- v: current accumulator value
-- x: current item in list
-- i: [ 1-based index in list ] optional
-- l: [ a reference to the list itself ] optional
-- [a] -> (a -> b) -> b -> [b]
on reduce(xs, f, startValue)
set mf to mReturn(f)
Line 103:
end repeat
return v
end reducefoldl
 
-- arange :: Int -> aInt -> [aInt]
on concatrange(am, bn)
aif &n b< m then
set lstd to {}-1
end concat
else
 
set end of lstd to i + base1
 
end if
-- Function - > inherited name space -> Script object
set baselst to m - 1{}
-- Handler -> Record -> Script
repeat with i from 1m to lngn by d
on mClosure(f, recBindings)
set end of lst to i
script
end repeat
property closure : recBindings
return []lst
property lambda : f
end scriptrange
end mClosure
 
-- Script | Handler -> Script
Line 130 ⟶ 129:
end if
end mReturn
 
-- m..n
on range(m, n)
set lng to (n - m) + 1
set base to m - 1
set lst to {}
repeat with i from 1 to lng
set end of lst to i + base
end repeat
return lst
end range
 
</lang>
Line 146 ⟶ 134:
{{Out}}
 
<prelang AppleScript>{{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17}, {9, 12, 15}, {12, 16, 20}, {15, 20, 25}}</prelang>
 
=={{header|Clojure}}==
9,655

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.