Rosetta Code

Permutations with repetitions: Difference between revisions

Page Discussion

Permutations with repetitions (view source)

Revision as of 09:37, 22 September 2018

1,141 bytes removed ,  5 years ago
Applescript →‎Strict evaluation of the whole set: updated
Line 15:
 
=={{header|AppleScript}}==
===Strict evaluation of the whole set===
Permutations with repetitions, using strict evaluation, generating the entire set (where system constraints permit) with some degree of efficiency. For lazy or interruptible evaluation, see the second example below.
 
<lang AppleScript>-- PERMUTATIONSe.g. WITHreplicateM(3, REPETITION{1, 2})) ---------------------------------------------->
-- {{1, 1, 1}, {1, 1, 2}, {1, 2, 1}, {1, 2, 2}, {2, 1, 1},
-- {2, 1, 2}, {2, 2, 1}, {2, 2, 2}}
 
-- permutationsWithRepetitionreplicateM :: Int -> [a] -> [[a]]
on permutationsWithRepetitionreplicateM(n, xs)
script go
if length of xs > 0 then
script cons
foldl1(curry(my cartesianProduct)'s |λ|(xs), replicate(n, xs))
on |λ|(a, bs)
else
{a} & bs
end if|λ|
end script
end permutationsWithRepetition
on |λ|(x)
if x ≤ 0 then
{{}}
else
liftA2List(cons, xs, |λ|(x - 1))
end if
end |λ|
end script
go's |λ|(n)
end replicateM
 
 
-- TEST ----------------------------------------------------------------------
on run
permutationsWithRepetitionreplicateM(2, {1, 2, 3})
--> {{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}
end run
 
 
-- GENERIC FUNCTIONS ---------------------------------------------------------
 
-- cartesianProductconcatMap :: [(a] -> [b]) -> [[a,] -> [b]]
on cartesianProductconcatMap(xsf, ysxs)
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
 
-- liftA2List :: (a -> b -> c) -> [a] -> [b] -> [c]
on liftA2List(f, xs, ys)
script
property g : mReturn(f)'s |λ|
on |λ|(x)
script
on |λ|(y)
{{g(x} &, y)}
end |λ|
end script
concatMap(result, ys)
end |λ|
end script
concatMap(result, xs)
end liftA2List
end cartesianProduct
 
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
script append
on |λ|(a, b)
a & b
end |λ|
end script
foldl(append, {}, map(f, xs))
end concatMap
 
-- curry :: (Script|Handler) -> Script
on curry(f)
script
on |λ|(a)
script
on |λ|(b)
|λ|(a, b) of mReturn(f)
end |λ|
end script
end |λ|
end script
end curry
 
-- 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
 
-- foldl1 :: (a -> a -> a) -> [a] -> a
on foldl1(f, xs)
if length of xs > 0 then
foldl(f, item 1 of xs, tail(xs))
else
{}
end if
end foldl1
 
-- 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 :: HandlerFirst-class m => (a -> b) -> m (a -> Scriptb)
on mReturn(f)
if class of f is script then
Line 125 ⟶ 92:
end script
end if
end mReturn</lang>
 
-- replicate :: Int -> a -> [a]
on replicate(n, a)
set out to {}
if n < 1 then return out
set dbl to {a}
repeat while (n > 1)
if (n mod 2) > 0 then set out to out & dbl
set n to (n div 2)
set dbl to (dbl & dbl)
end repeat
return out & dbl
end replicate
 
-- tail :: [a] -> [a]
on tail(xs)
if length of xs > 1 then
items 2 thru -1 of xs
else
{}
end if
end tail</lang>
{{Out}}
<lang AppleScript>{{1, 1}, {1, 2}, {1, 3}, {2, 1}, {2, 2}, {2, 3}, {3, 1}, {3, 2}, {3, 3}}</lang>
Hout
9,655

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/230086"