Monads/List monad: Difference between revisions

Content added Content deleted
(→‎{{header|AppleScript}}: Some simplification - normalised argument sequence in a couple of higher-order functions)
Line 15: 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.
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>
<lang AppleScript>on run

on run
-- Pythagorean triples drawn from integers in the range [1..n]
-- 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)}
-- {(x, y, z) | x <- [1..n], y <- [x+1..n], z <- [y+1..n], (x^2 + y^2 = z^2)}
Line 27: Line 25:
end run
end run


-- pythagoreanTriples :: Int -> [(Int, Int, Int)]

on pythagoreanTriples(maxInteger)
on pythagoreanTriples(maxInteger)
script mf
script lambdaX
property n : maxInteger
on lambda(x)
script lambdaY
on lambdaX(x)
on lambda(y)
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
⚫
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 lambdaY
end lambda
end script
on lambdaZ(z)
set x to my closure's x
bind(lambdaZ, range(1 + y, maxInteger))
set y to my closure's y
end lambda
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 lambda
end script
end script
return bind(range(1, maxInteger), mClosure(mf's lambdaX, {mf:mf}))
bind(lambdaX, range(1, maxInteger))
end pythagoreanTriples
end pythagoreanTriples




-- LIBRARY FUNCTIONS
-- MONADIC FUNCTIONS (for list monad)


-- Monadic bind for lists is simply ConcatMap
-- Monadic bind for lists is simply ConcatMap
-- which applies a function f directly to each value in the list,
-- which applies a function f directly to each value in the list,
-- and returns the set of results as a concat-flattened list
-- and returns the set of results as a concat-flattened list

⚫
-- [a] -> (a -> [b]) -> [b]
on bind(xs, f)
-- bind :: (a -> [b]) -> [a] -> [b]
⚫
on bind(f, xs)
reduce(map(xs, f), my concat, {})
⚫
-- concat :: a -> a -> [a]
⚫
script concat
⚫
on lambda(a, b)
⚫
a & b
⚫
end lambda
⚫
end script
⚫
foldl(concat, {}, map(f, xs))
end bind
end bind


-- Monadic return/unit/inject for lists just wraps a value in a list
-- Monadic return/unit/inject for lists: just wraps a value in a list
-- a -> [a]
-- a -> [a]
on unit(a)
on unit(a)
Line 76: Line 78:
end unit
end unit



⚫
-- [a] -> (a -> b) -> [b]
-- GENERIC LIBRARY FUNCTIONS
⚫
on map(xs, f)

⚫
-- map :: (a -> b) -> [a] -> [b]
⚫
on map(f, xs)
set mf to mReturn(f)
set mf to mReturn(f)
set lng to length of xs
set lng to length of xs
Line 87: Line 92:
end map
end map



-- list, function, initial accumulator value
-- the arguments available to the function f(a, x, i, l) are
-- foldl :: (a -> b -> a) -> a -> [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)
set mf to mReturn(f)
Line 103: Line 103:
end repeat
end repeat
return v
return v
end reduce
end foldl


-- a -> a -> [a]
-- range :: Int -> Int -> [Int]
on concat(a, b)
on range(m, n)
a & b
if n < m then
⚫
set d to -1
end concat
else

⚫
set d to 1

⚫
end if
-- Function - > inherited name space -> Script object
⚫
set lst to {}
-- Handler -> Record -> Script
⚫
repeat with i from m to n by d
on mClosure(f, recBindings)
set end of lst to i
⚫
script
end repeat
property closure : recBindings
⚫
return lst
⚫
property lambda : f
end script
end range
end mClosure


-- Script | Handler -> Script
-- Script | Handler -> Script
Line 130: Line 129:
end if
end if
end mReturn
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>
</lang>
Line 146: Line 134:
{{Out}}
{{Out}}


<pre>{{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17}, {9, 12, 15}, {12, 16, 20}, {15, 20, 25}}</pre>
<lang 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}}</lang>


=={{header|Clojure}}==
=={{header|Clojure}}==
Retrieved from "https://rosettacode.org/wiki/Monads/List_monad"