134 lines
2.8 KiB
AppleScript
134 lines
2.8 KiB
AppleScript
----------------------- PERMUTATIONS -----------------------
|
|
|
|
-- permutations :: [a] -> [[a]]
|
|
on permutations(xs)
|
|
script go
|
|
on |λ|(x, a)
|
|
script
|
|
on |λ|(ys)
|
|
script infix
|
|
on |λ|(n)
|
|
if ys ≠ {} then
|
|
take(n, ys) & {x} & drop(n, ys)
|
|
else
|
|
{x}
|
|
end if
|
|
end |λ|
|
|
end script
|
|
map(infix, enumFromTo(0, (length of ys)))
|
|
end |λ|
|
|
end script
|
|
concatMap(result, a)
|
|
end |λ|
|
|
end script
|
|
foldr(go, {{}}, xs)
|
|
end permutations
|
|
|
|
|
|
--------------------------- TEST ---------------------------
|
|
on run
|
|
|
|
permutations({1, 2, 3})
|
|
|
|
--> {{1, 2, 3}, {2, 1, 3}, {2, 3, 1}, {1, 3, 2}, {3, 1, 2}, {3, 2, 1}}
|
|
end run
|
|
|
|
|
|
------------------------- GENERIC --------------------------
|
|
|
|
-- 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
|
|
|
|
|
|
-- drop :: Int -> [a] -> [a]
|
|
on drop(n, xs)
|
|
if n < length of xs then
|
|
items (1 + n) thru -1 of xs
|
|
else
|
|
{}
|
|
end if
|
|
end drop
|
|
|
|
|
|
-- enumFromTo :: Int -> Int -> [Int]
|
|
on enumFromTo(m, n)
|
|
if m ≤ n then
|
|
set lst to {}
|
|
repeat with i from m to n
|
|
set end of lst to i
|
|
end repeat
|
|
return lst
|
|
else
|
|
return {}
|
|
end if
|
|
end enumFromTo
|
|
|
|
|
|
-- foldr :: (a -> b -> b) -> b -> [a] -> b
|
|
on foldr(f, startValue, xs)
|
|
tell mReturn(f)
|
|
set v to startValue
|
|
set lng to length of xs
|
|
repeat with i from lng to 1 by -1
|
|
set v to |λ|(item i of xs, v, i, xs)
|
|
end repeat
|
|
return v
|
|
end tell
|
|
end foldr
|
|
|
|
|
|
-- 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
|
|
|
|
|
|
-- 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
|
|
|
|
|
|
-- min :: Ord a => a -> a -> a
|
|
on min(x, y)
|
|
if y < x then
|
|
y
|
|
else
|
|
x
|
|
end if
|
|
end min
|
|
|
|
|
|
-- take :: Int -> [a] -> [a]
|
|
-- take :: Int -> String -> String
|
|
on take(n, xs)
|
|
if 0 < n then
|
|
items 1 thru min(n, length of xs) of xs
|
|
else
|
|
{}
|
|
end if
|
|
end take
|