September 2017 Update

Task/Permutations/AppleScript/permutations-1.applescript

@@ -1,15 +1,17 @@
+-- PERMUTATIONS --------------------------------------------------------------
+
 -- permutations :: [a] -> [[a]]
 on permutations(xs)
     script firstElement
-        on lambda(x)
+        on |λ|(x)
             script tailElements
-                on lambda(ys)
-                    {x & ys}
-                end lambda
+                on |λ|(ys)
+                    {{x} & ys}
+                end |λ|
             end script
 
             concatMap(tailElements, permutations(|delete|(x, xs)))
-        end lambda
+        end |λ|
     end script
 
     if length of xs > 0 then
@@ -20,77 +22,65 @@ on permutations(xs)
 end permutations
 
 
--- TEST
+-- TEST ----------------------------------------------------------------------
 on run
 
-    return permutations({1, 2, 3})
     permutations({"aardvarks", "eat", "ants"})
 
 end run
 
 
-
--- GENERIC LIBRARY FUNCTIONS
+-- GENERIC FUNCTIONS ---------------------------------------------------------
 
 -- concatMap :: (a -> [b]) -> [a] -> [b]
 on concatMap(f, xs)
-    script append
-        on lambda(a, b)
-            a & b
-        end lambda
-    end script
-
-    foldl(append, {}, map(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|
+
 -- 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 lambda(item i of xs, i, xs)
+            set end of lst to |λ|(item i of xs, i, xs)
         end repeat
         return lst
     end tell
 end map
 
--- 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 lambda(v, item i of xs, i, xs)
-        end repeat
-        return v
-    end tell
-end foldl
-
--- delete :: a -> [a] -> [a]
-on |delete|(x, xs)
-    script Eq
-        on lambda(a, b)
-            a = b
-        end lambda
-    end script
-
-    deleteBy(Eq, x, xs)
-end |delete|
-
--- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
-on deleteBy(fnEq, x, xs)
-    if length of xs > 0 then
-        set {h, t} to uncons(xs)
-        if lambda(x, h) of mReturn(fnEq) then
-            t
-        else
-            {h} & deleteBy(fnEq, x, t)
-        end if
+-- 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 deleteBy
+end mReturn
 
 -- uncons :: [a] -> Maybe (a, [a])
 on uncons(xs)
@@ -100,15 +90,3 @@ on uncons(xs)
         missing value
     end if
 end uncons
-
--- 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 lambda : f
-        end script
-    end if
-end mReturn

Task/Permutations/AppleScript/permutations-2.applescript

@@ -0,0 +1,43 @@
+to DoPermutations(aList, n)
+    --> Heaps's algorithm (Permutation by interchanging pairs) AppleScript by Jean.O.matiC
+    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
+            set i to i + 1
+        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"}