RosettaCodeData/Task/Permutations/AppleScript/permutations-1.applescript

93 lines
1.9 KiB
AppleScript
Raw Normal View History

2017-09-23 10:01:46 +02:00
-- PERMUTATIONS --------------------------------------------------------------
2016-12-05 22:15:40 +01:00
-- permutations :: [a] -> [[a]]
on permutations(xs)
script firstElement
2017-09-23 10:01:46 +02:00
on |λ|(x)
2016-12-05 22:15:40 +01:00
script tailElements
2017-09-23 10:01:46 +02:00
on |λ|(ys)
{{x} & ys}
end |λ|
2016-12-05 22:15:40 +01:00
end script
concatMap(tailElements, permutations(|delete|(x, xs)))
2017-09-23 10:01:46 +02:00
end |λ|
2016-12-05 22:15:40 +01:00
end script
if length of xs > 0 then
concatMap(firstElement, xs)
else
{{}}
end if
end permutations
2017-09-23 10:01:46 +02:00
-- TEST ----------------------------------------------------------------------
2016-12-05 22:15:40 +01:00
on run
permutations({"aardvarks", "eat", "ants"})
end run
2017-09-23 10:01:46 +02:00
-- GENERIC FUNCTIONS ---------------------------------------------------------
2016-12-05 22:15:40 +01:00
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
2017-09-23 10:01:46 +02:00
set lst to {}
set lng to length of xs
2016-12-05 22:15:40 +01:00
tell mReturn(f)
repeat with i from 1 to lng
2017-09-23 10:01:46 +02:00
set lst to (lst & |λ|(contents of item i of xs, i, xs))
2016-12-05 22:15:40 +01:00
end repeat
end tell
2017-09-23 10:01:46 +02:00
return lst
end concatMap
2016-12-05 22:15:40 +01:00
-- delete :: a -> [a] -> [a]
on |delete|(x, xs)
if length of xs > 0 then
set {h, t} to uncons(xs)
2017-09-23 10:01:46 +02:00
if x = h then
2016-12-05 22:15:40 +01:00
t
else
2017-09-23 10:01:46 +02:00
{h} & |delete|(x, t)
2016-12-05 22:15:40 +01:00
end if
else
{}
end if
2017-09-23 10:01:46 +02:00
end |delete|
2016-12-05 22:15:40 +01:00
2017-09-23 10:01:46 +02:00
-- 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
2016-12-05 22:15:40 +01:00
-- 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
2017-09-23 10:01:46 +02:00
property |λ| : f
2016-12-05 22:15:40 +01:00
end script
end if
end mReturn
2017-09-23 10:01:46 +02:00
-- uncons :: [a] -> Maybe (a, [a])
on uncons(xs)
if length of xs > 0 then
{item 1 of xs, rest of xs}
else
missing value
end if
end uncons