I still have my original scripts. The first is based directly on an algorithm in a document by Robert Sedgewick, the link to which at the top of the script still works!:
-- A port to AppleScript of "Improved version of Heap's method (recursive)"
-- found in Robert Sedgewick's PDF document "Permutation Generation Methods"
-- <http://www.cs.princeton.edu/~rs/talks/perms.pdf>
-- Sedgewick's version recurses directly to the first three items in the list,
-- whose six possible combinations are added to the collection without further
-- recursion, presumably to combine speed with a convenient recursion exit. Any
-- further items are added into the permutation process as the recursion retreats,
-- each change of value in the current rightmost item being accompanied by all
-- possible arrangements of the items to its left. Changes to the rightmost item
-- are effected thus: at recursion levels handling an odd number of list items, the
-- rightmost item is exchanged with the leftmost item only; at recursion levels
-- handling an even number of list items, the rightmost item is exchanged with each
-- of the preceding items in turn, starting with the leftmost.
--
-- This script special-cases lists of less than three items.
on allPermutations(theList)
script o
property workList : missing value
property permutations : {}
property r : count theList -- index of the rightmost item
on prmt(n)
-- n is the index of the rightmost list item affected by this iteration
-- and thus also the number of list items affected by this iteration (1 thru n)
if n = 3 then
-- These six permutations are hard-coded to reduce low-level recursion
copy my workList to the end of my permutations
set {v1, v2, v3} to my workList
set item 2 of my workList to v1
set item 1 of my workList to v2
copy my workList to the end of my permutations
set item 1 of my workList to v3
set item 3 of my workList to v2
copy my workList to the end of my permutations
set item 1 of my workList to v1
set item 2 of my workList to v3
copy my workList to the end of my permutations
set item 1 of my workList to v2
set item 3 of my workList to v1
copy my workList to the end of my permutations
set item 1 of my workList to v3
set item 2 of my workList to v2
copy my workList to the end of my permutations
else
-- Precalculate some values for the repeat
set nMinus1 to n - 1 -- parameter for next-level recursions
set nIsEven to (n mod 2 = 0) -- true if n is even
set x to 1 -- the default index with which to swap if n is odd
-- Get all permutations of items 1 thru (n - 1) with the current item n
prmt(nMinus1)
-- Repeat with successive values of item n
repeat with i from 1 to nMinus1
-- If n is even, swap items n and i, otherwise default to swapping items n and 1
if nIsEven then set x to i
tell item x of my workList
set item x of my workList to item n of my workList
set item n of my workList to it
end tell
prmt(nMinus1)
end repeat
end if
end prmt
end script
if o's r < 3 then
-- Special-case lists of less than three items
copy theList to the beginning of o's permutations
if o's r is 2 then set the end of o's permutations to the reverse of the beginning of o's permutations
else
-- Otherwise use the recursive handler
copy theList to o's workList
o's prmt(o's r)
end if
return o's permutations
end allPermutations
allPermutations({1, 2, 3, 4, 5})
But I prefer this one, a modification which permutes from the right instead of from the left, giving a more ordered appearance to the results (for those of us who normally read from left to right):
-- A port to AppleScript of "Improved version of Heap's method (recursive)"
-- found in Robert Sedgewick's PDF document "Permutation Generation Methods"
-- <http://www.cs.princeton.edu/~rs/talks/perms.pdf>
--
-- This version attempts to produces a slightly more "sorted" result than
-- Sedgewick's, by recursing directly to the *last* three items in the list, whose
-- six possible combinations are added to the collection without further recursion.
-- Any preceding items are added into the permutation process as the recursion
-- retreats, each change of value in the current leftmost item being accompanied by
-- all possible arrangements of the items to its right. Changes to the leftmost
-- item are effected thus: at recursion levels handling an odd number of list
-- items, the leftmost item is exchanged with the rightmost item only; at recursion
-- levels handling an even number of list items, the leftmost item is exchanged
-- with each of the following items in turn, starting with the rightmost.
--
-- This script special-cases lists of less than three items.
on allPermutations(theList)
script o
property workList : missing value
property permutations : {}
property r : count theList -- index of the rightmost item
property m : r - 1 -- index of the middle item of the last three
on prmt(l)
-- l is the index of the leftmost item affected by this iteration
set n to r - l + 1 -- n is the number of list items affected by this iteration (l thru r)
if n = 3 then
-- These six permutations are hard-coded to reduce low-level recursion
copy my workList to the end of my permutations
set {v1, v2, v3} to items l thru r of my workList
set item m of my workList to v3
set item r of my workList to v2
copy my workList to the end of my permutations
set item l of my workList to v2
set item r of my workList to v1
copy my workList to the end of my permutations
set item m of my workList to v1
set item r of my workList to v3
copy my workList to the end of my permutations
set item l of my workList to v3
set item r of my workList to v2
copy my workList to the end of my permutations
set item m of my workList to v2
set item r of my workList to v1
copy my workList to the end of my permutations
else
-- Precalculate some values for the repeat
set lPlus1 to l + 1 -- parameter for next-level recursions
set nIsEven to (n mod 2 = 0) -- true if n is even
set x to r -- the default index with which to swap if n is odd
-- Get all permutations of items (l +1) thru r with the current item l
prmt(lPlus1)
-- Repeat with successive values of item l
repeat with i from r to lPlus1 by -1
-- If n is even, swap items l and i, otherwise default to swapping items l and r
if nIsEven then set x to i
tell item x of my workList
set item x of my workList to item l of my workList
set item l of my workList to it
end tell
prmt(lPlus1)
end repeat
end if
end prmt
end script
if o's r < 3 then
-- Special-case lists of less than three items
copy theList to the beginning of o's permutations
if o's r is 2 then set the end of o's permutations to the reverse of the beginning of o's permutations
else
-- Otherwise use the recursive handler
copy theList to o's workList
o's prmt(1)
end if
return o's permutations
end allPermutations
allPermutations({1, 2, 3, 4, 5})
No doubt Shane will produce an ASObjC version ere long.