115 lines
4.7 KiB
AppleScript
115 lines
4.7 KiB
AppleScript
-- 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})
|