@alldritt’s thoughts in a previous thread:
Using map, filter and reduce or fold in Applescript
reminded me that:
- If I were to add a fourth generic function to the basic map filter fold toolkit, it would be concatMap, and that
- I hadn’t mentioned the capture of closure values in the pattern of passing script objects to these functions.
concatMap is almost identical to map, but it additionally concatenates the list of values produced by mapping.
This allows it to provide a kind of filtering. If a handler or script that is passed to it
- wraps each return value in a list, and
- for some values returns an empty list,
then concatenation eliminates those empty values.
The simplest use would be as a combination of map and filter - both transforming and occasionally pruning out each element in a list.
If we nest a few concatMaps, passing scripts to them (rather than handlers), and capturing closure values into those scripts, we can use this (transform + perhaps eliminate) pattern to write an AppleScript version of a list comprehension.
For example, how many Pythagorean triples can we find using only the integers from 1 to 25 ?
-- pythagoreanTriples :: Int -> [(Int, Int, Int)]
on pythagoreanTriples(n)
script x
on |λ|(x)
script y
on |λ|(y)
script z
on |λ|(z)
if x * x + y * y = z * z then
{{x, y, z}}
else
{}
end if
end |λ|
end script
concatMap(z, enumFromTo(1 + y, n))
end |λ|
end script
concatMap(y, enumFromTo(1 + x, n))
end |λ|
end script
concatMap(x, enumFromTo(1, n))
end pythagoreanTriples
-- TEST -----------------------------------------------------------------------
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)}
pythagoreanTriples(25)
--> {{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17},
-- {9, 12, 15}, {12, 16, 20}, {15, 20, 25}}
end run
-- GENERIC FUNCTIONS ----------------------------------------------------------
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set acc to {}
tell mReturn(f)
repeat with x in xs
set acc to acc & |λ|(contents of x)
end repeat
end tell
return acc
end concatMap
-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
if n < m then
set d to -1
else
set d to 1
end if
set lst to {}
repeat with i from m to n by d
set end of lst to i
end repeat
return lst
end enumFromTo
-- 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 |λ| : f
end script
end if
end mReturn
We can also combine concatMap with the capture of closure values to define a generic cartesianProduct handler.
First a trivial example, and then a more useful one:
Simple example
on run
cartesianProduct({"Important", "Unimportant"}, {"Urgent", "Not urgent"})
--> {{"Important", "Urgent"}, {"Important", "Not urgent"}, {"Unimportant", "Urgent"}, {"Unimportant", "Not urgent"}}
cartesianProduct({"Alpha", "Beta", "Gamma"}, {1, 2, 3, 4})
--> {{"Alpha", 1}, {"Alpha", 2}, {"Alpha", 3}, {"Alpha", 4}, {"Beta", 1}, {"Beta", 2}, {"Beta", 3}, {"Beta", 4}, {"Gamma", 1}, {"Gamma", 2}, {"Gamma", 3}, {"Gamma", 4}}
end run
-- cartesianProduct :: [a] -> [b] -> [(a, b)]
on cartesianProduct(xs, ys)
script
on |λ|(x)
script
on |λ|(y)
{{x, y}}
end |λ|
end script
concatMap(result, ys)
end |λ|
end script
concatMap(result, xs)
end cartesianProduct
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lng to length of xs
set acc to {}
tell mReturn(f)
repeat with i from 1 to lng
set acc to acc & |λ|(item i of xs, i, xs)
end repeat
end tell
return acc
end concatMap
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
More useful example (looking at the grid of (clipboard types) * (alternative representations) in the current clipboard)
use framework "Foundation"
use framework "Appkit"
use scripting additions
-- INSPECTING DIFFERENT TYPES OF DATA ON THE CLIPBOARD
-- showClipBoard :: () -> Record
on showClipboard()
set ca to current application
set pBoard to ca's NSPasteboard's generalPasteboard
set clipTypes to (item 1 of (pBoard's pasteboardItems as list))'s types as list
set types to {"propertyList", "string", "data"}
script dataFor
on |λ|(accumulator, bundleType)
set {bundleID, k} to bundleType
if k = "string" then
set v to pBoard's stringForType:bundleID
else if k = "propertyList" then
set v to pBoard's propertyListForType:bundleID
else -- "data"
set v to ca's NSString's alloc()'s ¬
initWithData:(pBoard's dataForType:bundleID) ¬
encoding:(ca's NSUTF8StringEncoding)
end if
if v is missing value then
accumulator
else
recordInsert(accumulator, bundleID & " as " & k, v)
end if
end |λ|
end script
foldl(dataFor, {name:""}, cartesianProduct(clipTypes, types))
end showClipboard
-- TEST ------------------------------------------------------------------
on run
showClipboard()
end run
-- GENERIC FUNCTIONS -----------------------------------------------------
-- cartesianProduct :: [a] -> [b] -> [(a, b)]
on cartesianProduct(xs, ys)
script
on |λ|(x)
script
on |λ|(y)
{{x, y}}
end |λ|
end script
concatMap(result, ys)
end |λ|
end script
concatMap(result, xs)
end cartesianProduct
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set acc to {}
tell mReturn(f)
repeat with x in xs
set acc to acc & |λ|(contents of x)
end repeat
end tell
return acc
end concatMap
-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
tell mReturn(f)
set v to startValue
set lng to length of xs
repeat with i from 1 to lng
set v to |λ|(v, item i of xs, i, xs)
end repeat
return v
end tell
end foldl
-- recordInsert :: Dict -> k -> v -> Dict
on recordInsert(rec, k, v)
set ca to current application
set nsDct to (ca's NSMutableDictionary's dictionaryWithDictionary:rec)
nsDct's setValue:v forKey:(k as string)
item 1 of ((ca's NSArray's arrayWithObject:nsDct) as list)
end recordInsert
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
and, of course, the capture of closure values can be useful with any of these functions.
Again, a trivial example, this time with map:
use AppleScript version "2.4" -- Yosemite (10.10) or later
use framework "Foundation"
use scripting additions
on run
set fp to filePath("~/Desktop")
script fullPath
on |λ|(x)
fp & "/" & x & ".txt"
end |λ|
end script
map(fullPath, {"alpha", "beta", "gamma"})
end run
-- filePath :: String -> FilePath
on filePath(s)
(stringByStandardizingPath of ¬
(current application's ¬
NSString's stringWithString:(s))) as string
end filePath
-- 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 |λ|(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 :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
if class of f is script then
f
else
script
property |λ| : f
end script
end if
end mReturn
