aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

87
Task/Permutations/AppleScript/permutations-1.applescript Normal file
View file

@ -0,0 +1,87 @@
----------------------- PERMUTATIONS -----------------------
-- permutations :: [a] -> [[a]]
on permutations(xs)
script go
on |λ|(xs)
script h
on |λ|(x)
script ts
on |λ|(ys)
{{x} & ys}
end |λ|
end script
concatMap(ts, go's |λ|(|delete|(x, xs)))
end |λ|
end script
if {} ≠ xs then
concatMap(h, xs)
else
{{}}
end if
end |λ|
end script
go's |λ|(xs)
end permutations
--------------------------- TEST ---------------------------
on run
permutations({"aardvarks", "eat", "ants"})
end run
-------------------- GENERIC FUNCTIONS ---------------------
-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
set lst to {}
set lng to length of xs
tell mReturn(f)
repeat with i from 1 to lng
set lst to (lst & |λ|(contents of item i of xs, i, xs))
end repeat
end tell
return lst
end concatMap
-- delete :: a -> [a] -> [a]
on |delete|(x, xs)
if length of xs > 0 then
set {h, t} to uncons(xs)
if x = h then
t
else
{h} & |delete|(x, t)
end if
else
{}
end if
end |delete|
-- 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
-- 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

42
Task/Permutations/AppleScript/permutations-2.applescript Normal file
View file

@ -0,0 +1,42 @@
to DoPermutations(aList, n)
--> Heaps's algorithm (Permutation by interchanging pairs)
if n = 1 then
tell (a reference to PermList) to copy aList to its end
-- or: copy aList as text (for concatenated results)
else
repeat with i from 1 to n
DoPermutations(aList, n - 1)
if n mod 2 = 0 then -- n is even
tell aList to set [item i, item n] to [item n, item i] -- swaps items i and n of aList
else
tell aList to set [item 1, item n] to [item n, item 1] -- swaps items 1 and n of aList
end if
end repeat
end if
return (a reference to PermList) as list
end DoPermutations
--> Example 1 (list of words)
set [SourceList, PermList] to [{"Good", "Johnny", "Be"}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of PermList)
{{"Good", "Johnny", "Be"}, {"Johnny", "Good", "Be"}, {"Be", "Good", "Johnny"}, ¬
{"Good", "Be", "Johnny"}, {"Johnny", "Be", "Good"}, {"Be", "Johnny", "Good"}}
--> Example 2 (characters with concatenated results)
set [SourceList, PermList] to [{"X", "Y", "Z"}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of PermList)
{"XYZ", "YXZ", "ZXY", "XZY", "YZX", "ZYX"}
--> Example 3 (Integers)
set [SourceList, Permlist] to [{1, 2, 3}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of Permlist)
{{1, 2, 3}, {2, 1, 3}, {3, 1, 2}, {1, 3, 2}, {2, 3, 1}, {3, 2, 1}}
--> Example 4 (Integers with concatenated results)
set [SourceList, Permlist] to [{1, 2, 3}, {}]
DoPermutations(SourceList, SourceList's length)
--> result (value of Permlist)
{"123", "213", "312", "132", "231", "321"}

133
Task/Permutations/AppleScript/permutations-3.applescript Normal file
View file

@ -0,0 +1,133 @@
----------------------- 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

114
Task/Permutations/AppleScript/permutations-4.applescript Normal file
View file

@ -0,0 +1,114 @@
-- Translation of "Improved version of Heap's method (recursive)" found in
-- Robert Sedgewick's PDF document "Permutation Generation Methods"
-- <https://www.cs.princeton.edu/~rs/talks/perms.pdf>
on allPermutations(theList)
script o
-- Work list and precalculated indices for its last four items (assuming that many).
property workList : missing value --(Set to a copy of theList below.)
property r : (count theList)
property rMinus1 : r - 1
property rMinus2 : r - 2
property rMinus3 : r - 3
-- Output list and traversal index.
property output : {}
property p : 1
-- Recursive handler.
on prmt(l)
-- Is the range length covered by this recursion level even?
set rangeLenEven to ((r - l) mod 2 = 1)
-- Tail call elimination repeat. Gives way to hard-coding for the lowest three levels.
repeat with l from l to rMinus3
-- Recursively permute items (l + 1) thru r of the work list.
set lPlus1 to l + 1
prmt(lPlus1)
-- And again after swaps of item l with each of the items to its right
-- (if the range l to r is even) or with the rightmost item r - l times
-- (if the range length is odd). The "recursion" after the last swap will
-- instead be the next iteration of this tail call elimination repeat.
if (rangeLenEven) then
repeat with swapIdx from r to (lPlus1 + 1) by -1
tell my workList's item l
set my workList's item l to my workList's item swapIdx
set my workList's item swapIdx to it
end tell
prmt(lPlus1)
end repeat
set swapIdx to lPlus1
else
repeat (r - lPlus1) times
tell my workList's item l
set my workList's item l to my workList's item r
set my workList's item r to it
end tell
prmt(lPlus1)
end repeat
set swapIdx to r
end if
tell my workList's item l
set my workList's item l to my workList's item swapIdx
set my workList's item swapIdx to it
end tell
set rangeLenEven to (not rangeLenEven)
end repeat
-- Store a copy of the work list's current state.
set my output's item p to my workList's items
-- Then five more with the three rightmost items permuted.
set v1 to my workList's item rMinus2
set v2 to my workList's item rMinus1
set v3 to my workList's end
set my workList's item rMinus1 to v3
set my workList's item r to v2
set my output's item (p + 1) to my workList's items
set my workList's item rMinus2 to v2
set my workList's item r to v1
set my output's item (p + 2) to my workList's items
set my workList's item rMinus1 to v1
set my workList's item r to v3
set my output's item (p + 3) to my workList's items
set my workList's item rMinus2 to v3
set my workList's item r to v2
set my output's item (p + 4) to my workList's items
set my workList's item rMinus1 to v2
set my workList's item r to v1
set my output's item (p + 5) to my workList's items
set p to p + 6
end prmt
end script
if (o's r < 3) then
-- Fewer than three items in the input list.
copy theList to o's output's beginning
if (o's r is 2) then set o's output's end to theList's reverse
else
-- Otherwise prepare a list to hold (factorial of input list length) permutations …
copy theList to o's workList
set factorial to 2
repeat with i from 3 to o's r
set factorial to factorial * i
end repeat
set o's output to makeList(factorial, missing value)
-- … and call o's recursive handler.
o's prmt(1)
end if
return o's output
end allPermutations
on makeList(limit, filler)
if (limit < 1) then return {}
script o
property lst : {filler}
end script
set counter to 1
repeat until (counter + counter > limit)
set o's lst to o's lst & o's lst
set counter to counter + counter
end repeat
if (counter < limit) then set o's lst to o's lst & o's lst's items 1 thru (limit - counter)
return o's lst
end makeList
return allPermutations({1, 2, 3, 4})

1
Task/Permutations/AppleScript/permutations-5.applescript Normal file
View file

@ -0,0 +1 @@
{{1, 2, 3, 4}, {1, 2, 4, 3}, {1, 3, 4, 2}, {1, 3, 2, 4}, {1, 4, 2, 3}, {1, 4, 3, 2}, {2, 4, 3, 1}, {2, 4, 1, 3}, {2, 3, 1, 4}, {2, 3, 4, 1}, {2, 1, 4, 3}, {2, 1, 3, 4}, {3, 1, 2, 4}, {3, 1, 4, 2}, {3, 2, 4, 1}, {3, 2, 1, 4}, {3, 4, 1, 2}, {3, 4, 2, 1}, {4, 3, 2, 1}, {4, 3, 1, 2}, {4, 2, 1, 3}, {4, 2, 3, 1}, {4, 1, 3, 2}, {4, 1, 2, 3}}