Family Day update

Task/Permutations/AWK/permutations.awk

@@ -0,0 +1,46 @@
+# syntax: GAWK -f PERMUTATIONS.AWK [-v sep=x] [word]
+#
+# examples:
+#   REM all permutations on one line
+#   GAWK -f PERMUTATIONS.AWK
+#
+#   REM all permutations on a separate line
+#   GAWK -f PERMUTATIONS.AWK -v sep="\n"
+#
+#   REM use a different word
+#   GAWK -f PERMUTATIONS.AWK Gwen
+#
+#   REM command used for RosettaCode output
+#   GAWK -f PERMUTATIONS.AWK -v sep="\n" Gwen
+#
+BEGIN {
+    sep = (sep == "") ? " " : substr(sep,1,1)
+    str = (ARGC == 1) ? "abc" : ARGV[1]
+    printf("%s%s",str,sep)
+    leng = length(str)
+    for (i=1; i<=leng; i++) {
+      arr[i-1] = substr(str,i,1)
+    }
+    ana_permute(0)
+    exit(0)
+}
+function ana_permute(pos,  i,j,str) {
+    if (leng - pos < 2) { return }
+    for (i=pos; i<leng-1; i++) {
+      ana_permute(pos+1)
+      ana_rotate(pos)
+      for (j=0; j<=leng-1; j++) {
+        printf("%s",arr[j])
+      }
+      printf(sep)
+    }
+    ana_permute(pos+1)
+    ana_rotate(pos)
+}
+function ana_rotate(pos,  c,i) {
+    c = arr[pos]
+    for (i=pos; i<leng-1; i++) {
+      arr[i] = arr[i+1]
+    }
+    arr[leng-1] = c
+}

Task/Permutations/AppleScript/permutations-2.applescript

@@ -1,7 +1,7 @@
 to DoPermutations(aList, n)
-    --> Heaps's algorithm (Permutation by interchanging pairs) AppleScript by Jean.O.matiC
+    --> Heaps's algorithm (Permutation by interchanging pairs)
     if n = 1 then
-        tell (a reference to Permlist) to copy aList to its end
+        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
@@ -11,23 +11,22 @@ to DoPermutations(aList, n)
             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
+    return (a reference to PermList) as list
 end DoPermutations
 
 --> Example 1 (list of words)
-set [SourceList, Permlist] to [{"Good", "Johnny", "Be"}, {}]
+set [SourceList, PermList] to [{"Good", "Johnny", "Be"}, {}]
 DoPermutations(SourceList, SourceList's length)
---> result (value of Permlist)
+--> 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"}, {}]
+set [SourceList, PermList] to [{"X", "Y", "Z"}, {}]
 DoPermutations(SourceList, SourceList's length)
---> result (value of Permlist)
+--> result (value of PermList)
 {"XYZ", "YXZ", "ZXY", "XZY", "YZX", "ZYX"}
 
 --> Example 3 (Integers)

Task/Permutations/Common-Lisp/permutations-3.lisp

@@ -0,0 +1,14 @@
+(defun heap-permutations (seq)
+  (let ((permutations nil))
+    (labels ((permute (seq k)
+	       (if (= k 1)
+		   (push seq permutations)
+		   (progn
+		     (permute seq (1- k))
+		     (loop for i from 0 below (1- k) do
+			  (if (evenp k)
+			      (rotatef (elt seq i) (elt seq (1- k)))
+			      (rotatef (elt seq 0) (elt seq (1- k))))
+			  (permute seq (1- k)))))))
+      (permute seq (length seq))
+      permutations)))

Task/Permutations/Lobster/permutations.lobster

@@ -0,0 +1,132 @@
+// Lobster implementation of the (very fast) Go example
+// http://rosettacode.org/wiki/Permutations#Go
+// implementing the plain changes (bell ringers) algorithm, using a recursive function
+// https://en.wikipedia.org/wiki/Steinhaus–Johnson–Trotter_algorithm
+
+def permr(s, f):
+    if s.length == 0:
+        f(s)
+        return
+    def rc(np: int):
+        if np == 1:
+            f(s)
+            return
+        let np1 = np - 1
+        let pp = s.length - np1
+        rc(np1) // recurs prior swaps
+        var i = pp
+        while i > 0:
+            // swap s[i], s[i-1]
+            let t = s[i]
+            s[i] = s[i-1]
+            s[i-1] = t
+            rc(np1) // recurs swap
+            i -= 1
+        let w = s[0]
+        for(pp): s[_] = s[_+1]
+        s[pp] = w
+    rc(s.length)
+
+// Heap's recursive method https://en.wikipedia.org/wiki/Heap%27s_algorithm
+
+def permh(s, f):
+    def rc(k: int):
+        if k <= 1:
+            f(s)
+        else:
+            // Generate permutations with kth unaltered
+            // Initially k == length(s)
+            rc(k-1)
+            // Generate permutations for kth swapped with each k-1 initial
+            for(k-1) i:
+                // Swap choice dependent on parity of k (even or odd)
+                 // zero-indexed, the kth is at k-1
+                if (k & 1) == 0:
+                    let t = s[i]
+                    s[i] = s[k-1]
+                    s[k-1] = t
+                else:
+                    let t = s[0]
+                    s[0] = s[k-1]
+                    s[k-1] = t
+                rc(k-1)
+    rc(s.length)
+
+// iterative Boothroyd method
+
+import std
+
+def permi(xs, f):
+    var d = 1
+    let c = map(xs.length): 0
+    f(xs)
+    while true:
+        while d > 1:
+            d -= 1
+            c[d] = 0
+        while c[d] >= d:
+            d += 1
+            if d >= xs.length:
+                return
+        let i = if (d & 1) == 1: c[d] else: 0
+        let t = xs[i]
+        xs[i] = xs[d]
+        xs[d] = t
+        f(xs)
+        c[d] = c[d] + 1
+
+// next lexicographical permutation
+// to get all permutations the initial input `a` must be in sorted order
+// returns false when input `a` is in reverse sorted order
+
+def next_lex_perm(a):
+    def swap(i, j):
+        let t = a[i]
+        a[i] = a[j]
+        a[j] = t
+    let n = a.length
+    /* 1. Find the largest index k such that a[k] < a[k + 1]. If no such
+          index exists, the permutation is the last permutation. */
+    var k = n - 1
+    while k > 0 and a[k-1] >= a[k]: k--
+    if k == 0: return false
+    k -= 1
+    /* 2. Find the largest index l such that a[k] < a[l]. Since k + 1 is
+       such an index, l is well defined */
+    var l = n - 1
+    while a[l] <= a[k]: l--
+    /* 3. Swap a[k] with a[l] */
+    swap(k, l)
+    /* 4. Reverse the sequence from a[k + 1] to the end */
+    k += 1
+    l = n - 1
+    while l > k:
+        swap(k, l)
+        l -= 1
+        k += 1
+    return true
+
+var se = [0, 1, 2, 3] //, 4, 5, 6, 7, 8, 9, 10]
+
+print "Iterative lexicographical permuter"
+
+print se
+while next_lex_perm(se): print se
+
+print "Recursive plain changes iterator"
+
+se = [0, 1, 2, 3]
+
+permr(se): print(_)
+
+print "Recursive Heap\'s iterator"
+
+se = [0, 1, 2, 3]
+
+permh(se): print(_)
+
+print "Iterative Boothroyd iterator"
+
+se = [0, 1, 2, 3]
+
+permi(se): print(_)

Task/Permutations/Lua/permutations-3.lua

@@ -0,0 +1,41 @@
+#!/usr/bin/env luajit
+-- Iterative version
+local function ipermgen(a,b)
+    if a==0 then return end
+    local taken = {} local slots = {}
+    for i=1,a do slots[i]=0 end
+    for i=1,b do taken[i]=false end
+    local index = 1
+    while index > 0 do repeat
+        repeat slots[index] = slots[index] + 1
+        until slots[index] > b or not taken[slots[index]]
+        if slots[index] > b then
+            slots[index] = 0
+            index = index - 1
+            if index > 0 then
+                taken[slots[index]] = false
+            end
+            break
+        else
+            taken[slots[index]] = true
+        end
+        if index == a then
+			coroutine.yield(slots)
+            taken[slots[index]] = false
+            break
+        end
+        index = index + 1
+    until true end
+end
+local function iperm(a)
+	local co=coroutine.create(function() ipermgen(a,a) end)
+	return function()
+		local code,res=coroutine.resume(co)
+			return res
+		end
+end
+
+local a=arg[1] and tonumber(arg[1]) or 3
+for p in iperm(a) do
+	print(table.concat(p, " "))
+end

Task/Permutations/Shen/permutations-1.shen

@@ -0,0 +1,18 @@
+(define permute
+[] -> []
+[X] -> [[X]]
+X -> (permute-helper [] X))
+
+(define permute-helper
+_ [] -> []
+Done [X|Rest] -> (append (prepend-all X (permute (append Done Rest))) (permute-helper [X|Done] Rest))
+)
+
+(define prepend-all
+_ [] -> []
+X [Next|Rest] -> [[X|Next]|(prepend-all X Rest)]
+)
+
+(set *maximum-print-sequence-size* 50)
+
+(permute [a b c d])

Task/Permutations/Shen/permutations-2.shen

@@ -0,0 +1,4 @@
+(define permute-helper
+_ [] -> []
+Done [X|Rest] -> (append (prepend-all X (permute (append Done Rest))) (permute-helper (append Done [X]) Rest))
+)