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"}

Task/Permutations/FreeBASIC/permutations.freebasic

@@ -0,0 +1,52 @@
+' version 07-04-2017
+' compile with: fbc -s console
+
+' Heap's algorithm non-recursive
+Sub perms(n As Long)
+
+    Dim As ULong i, j, count = 1
+    Dim As ULong a(0 To n -1), c(0 To n -1)
+
+    For j = 0 To n -1
+        a(j) = j +1
+        Print a(j);
+    Next
+    Print " ";
+
+    i = 0
+    While i < n
+        If c(i) < i Then
+            If (i And 1) = 0 Then
+                Swap a(0), a(i)
+            Else
+                Swap a(c(i)), a(i)
+            End If
+            For j = 0 To n -1
+                Print a(j);
+            Next
+            count += 1
+            If count = 12 Then
+                Print
+                count = 0
+            Else
+                Print " ";
+            End If
+            c(i) += 1
+            i = 0
+        Else
+            c(i) = 0
+            i += 1
+        End If
+    Wend
+
+End Sub
+
+' ------=< MAIN >=------
+
+perms(4)
+
+' empty keyboard buffer
+While Inkey <> "" : Wend
+Print : Print "hit any key to end program"
+Sleep
+End

Task/Permutations/Glee/permutations-1.glee

@@ -0,0 +1,7 @@
+$$ n !! k    dyadic: Permutations for k out of n elements (in this case k = n)
+$$ #s        monadic: number of elements in s
+$$ ,,        monadic: expose with space-lf separators
+$$ s[n]      index n of s
+
+'Hello' 123 7.9 '•'=>s;
+s[s# !! (s#)],,

Task/Permutations/Glee/permutations-2.glee

@@ -0,0 +1,24 @@
+Hello 123 7.9 •
+Hello 123 • 7.9
+Hello 7.9 123 •
+Hello 7.9 • 123
+Hello • 123 7.9
+Hello • 7.9 123
+123 Hello 7.9 •
+123 Hello • 7.9
+123 7.9 Hello •
+123 7.9 • Hello
+123 • Hello 7.9
+123 • 7.9 Hello
+7.9 Hello 123 •
+7.9 Hello • 123
+7.9 123 Hello •
+7.9 123 • Hello
+7.9 • Hello 123
+7.9 • 123 Hello
+• Hello 123 7.9
+• Hello 7.9 123
+• 123 Hello 7.9
+• 123 7.9 Hello
+• 7.9 Hello 123
+• 7.9 123 Hello

Task/Permutations/JavaScript/permutations-4.js

@@ -1,39 +1,35 @@
 (function () {
+    'use strict';
 
     // permutations :: [a] -> [[a]]
-    function permutations(xs) {
-        return xs.length ? (concatMap(
-            function (x) {
-                return concatMap(
-                    function (ys) {
-                        return ([[x].concat(ys)]);
-                    }, permutations(delete1(x, xs)))
-            }, xs)) : [[]]
-    }
+    var permutations = function (xs) {
+        return xs.length ? concatMap(function (x) {
+            return concatMap(function (ys) {
+                return [[x].concat(ys)];
+            }, permutations(delete_(x, xs)));
+        }, xs) : [[]];
+    };
 
-
-    // GENERIC LIBRARY FUNCTIONS
+    // GENERIC FUNCTIONS
 
     // concatMap :: (a -> [b]) -> [a] -> [b]
-    function concatMap(f, xs) {
+    var concatMap = function (f, xs) {
         return [].concat.apply([], xs.map(f));
-    }
+    };
 
-    // delete first instance of a in [a]
-    // delete1 :: a -> [a] -> [a]
-    function delete1(x, xs) {
+    // delete :: Eq a => a -> [a] -> [a]
+    var delete_ = function (x, xs) {
         return deleteBy(function (a, b) {
             return a === b;
         }, x, xs);
-    }
+    };
 
     // deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a]
-    function deleteBy(fnEq, x, xs) {
-        return xs.length ? fnEq(x, xs[0]) ? xs.slice(1) : [xs[0]]
-            .concat(deleteBy(fnEq, x, xs.slice(1))) : [];
-    }
-
-
-    return permutations(['Aardvarks', 'eat', 'ants'])
+    var deleteBy = function (f, x, xs) {
+        return xs.length > 0 ? f(x, xs[0]) ? xs.slice(1) :
+        [xs[0]].concat(deleteBy(f, x, xs.slice(1))) : [];
+    };
 
+    // TEST
+    return permutations(['Aardvarks', 'eat', 'ants']);
 })();

Task/Permutations/JavaScript/permutations-6.js

@@ -1,19 +1,38 @@
-(function (lst) {
+(() => {
     'use strict';
 
-    const permutations = (xs) => xs.length ? (
-            flatMap((x) => flatMap((xs) => [[x].concat(xs)],
-                permutations(del(x, xs))), xs)
-        ) : [[]],
+    // permutations :: [a] -> [[a]]
+    const permutations = xs =>
+        xs.length ? concatMap(x => concatMap(ys => [
+                [x].concat(ys)
+            ],
+            permutations(delete_(x, xs))), xs) : [
+            []
+        ];
 
-        flatMap = (f, xs) => [].concat.apply([], xs.map(f)),
+    // GENERIC FUNCTIONS
 
-        del = (x, xs) => xs.length ? x === xs[0] ? (
-            xs.slice(1)
-        ) : [xs[0]].concat(del(x, xs.slice(1))
+    // concatMap :: (a -> [b]) -> [a] -> [b]
+    const concatMap = (f, xs) => [].concat.apply([], xs.map(f));
+    //
+    // // delete :: Eq a => a -> [a] -> [a]
+    // const delete_ = (x, xs) =>
+    //     deleteBy((a, b) => a === b, x, xs);
+
+    // delete_ :: Eq a => a -> [a] -> [a]
+    const delete_ = (x, xs) =>
+        xs.length > 0 ? (
+            (x === xs[0]) ? (
+                xs.slice(1)
+            ) : [xs[0]].concat(delete_(x, xs.slice(1)))
         ) : [];
 
+    // range :: Int -> Int -> [Int]
+    const range = (m, n) =>
+        Array.from({
+            length: Math.floor(n - m) + 1
+        }, (_, i) => m + i);
 
-    return permutations(lst);
-
-})(["Aardvarks", "eat", "ants"]);
+    // TEST
+    return permutations(['Aardvarks', 'eat', 'ants']);
+})();

Task/Permutations/Kotlin/permutations.kotlin

@@ -0,0 +1,22 @@
+// version 1.1.2
+
+fun <T> permute(input: List<T>): List<List<T>> {
+    if (input.size == 1) return listOf(input)
+    val perms = mutableListOf<List<T>>()
+    val toInsert = input[0]
+    for (perm in permute(input.drop(1))) {
+        for (i in 0..perm.size) {
+            val newPerm = perm.toMutableList()
+            newPerm.add(i, toInsert)
+            perms.add(newPerm)
+        }
+    }
+    return perms
+}
+
+fun main(args: Array<String>) {
+    val input = listOf('a', 'b', 'c', 'd')
+    val perms = permute(input)
+    println("There are ${perms.size} permutations of $input, namely:\n")
+    for (perm in perms) println(perm)
+}

Task/Permutations/PHP/permutations.php

@@ -1,4 +1,3 @@
-//Author Gavryushin Ivan @dcc0
 <?php
 $b="0123";
 $a=strrev($b);

Task/Permutations/R/permutations-2.r

@@ -0,0 +1,11 @@
+# list of the vectors by inserting x in s at position 0...end.
+linsert <- function(x,s) lapply(0:length(s), function(k) append(s,x,k))
+
+# list of all permutations of 1:n
+perm <- function(n){
+    if (n == 1) list(1)
+    else unlist(lapply(perm(n-1), function(s) linsert(n,s)),
+                recursive = F)}
+
+# permutations of a vector s
+permutation <- function(s) unique(lapply(perm(length(s)), function(i) s[i]))

Task/Permutations/R/permutations-3.r

@@ -0,0 +1,18 @@
+> permutation(letters[1:3])
+[[1]]
+[1] "c" "b" "a"
+
+[[2]]
+[1] "b" "c" "a"
+
+[[3]]
+[1] "b" "a" "c"
+
+[[4]]
+[1] "c" "a" "b"
+
+[[5]]
+[1] "a" "c" "b"
+
+[[6]]
+[1] "a" "b" "c"

Task/Permutations/Ruby/permutations-2.rb

@@ -1,37 +0,0 @@
-class Array
-  # Yields distinct permutations of _self_ to the block.
-  # This method requires that all array elements be Comparable.
-  def distinct_permutation  # :yields: _ary_
-    # If no block, return an enumerator. Works with Ruby 1.8.7.
-    block_given? or return enum_for(:distinct_permutation)
-
-    copy = self.sort
-    yield copy.dup
-    return if size < 2
-
-    while true
-      # from: "The Art of Computer Programming" by Donald Knuth
-      j = size - 2;
-      j -= 1 while j > 0 && copy[j] >= copy[j+1]
-      if copy[j] < copy[j+1]
-        l = size - 1
-        l -= 1 while copy[j] >= copy[l]
-        copy[j] , copy[l] = copy[l] , copy[j]
-        copy[j+1..-1] = copy[j+1..-1].reverse
-        yield copy.dup
-      else
-        break
-      end
-    end
-  end
-end
-
-permutations = []
-[1,1,2].distinct_permutation do |p| permutations << p end
-p permutations
-# => [[1, 1, 2], [1, 2, 1], [2, 1, 1]]
-
-if RUBY_VERSION >= "1.8.7"
-  p [1,1,2].distinct_permutation.to_a
-  # => [[1, 1, 2], [1, 2, 1], [2, 1, 1]]
-end

Task/Permutations/Rust/permutations-1.rust

@@ -0,0 +1,34 @@
+struct QuickPerm<T> {
+    idxs: Vec<usize>,
+    elems: Vec<T>,
+    idx: usize,
+}
+
+impl<T: Clone> QuickPerm<T>  {
+    fn new(elems: Vec<T>) -> Self {
+        QuickPerm { idxs: (0..elems.len()+1).collect(), elems: elems, idx: 1 }
+    }
+}
+
+impl<T: Clone> Iterator for QuickPerm<T> {
+    type Item = Vec<T>;
+    fn next(&mut self) -> Option<Self::Item> {
+        if self.idx == self.elems.len() { return None; }
+
+        self.idxs[self.idx] -= 1;
+        let other = if self.idx % 2 == 1 { self.idxs[self.idx] } else { 0 };
+        self.elems.swap(self.idx, other);
+        self.idx = 1;
+        while self.idxs[self.idx] == 0 {
+            self.idxs[self.idx] = self.idx;
+            self.idx += 1;
+        }
+        Some(self.elems.clone())
+    }
+}
+
+fn main() {
+    for perm in QuickPerm::new(vec![1,2,3]) {
+        println!("{:?}", perm);
+    }
+}

Task/Permutations/Rust/permutations-2.rust

@@ -0,0 +1,25 @@
+use std::collections::VecDeque;
+fn permute<T, F: Fn(&[T])>(used: &mut Vec<T>, unused: &mut VecDeque<T>, action: &F) {
+    if unused.is_empty() {
+        action(used);
+    } else {
+        for _ in 0..unused.len() {
+            used.push(unused.pop_front().unwrap());
+            permute(used, unused, action);
+            unused.push_back(used.pop().unwrap());
+        }
+    }
+}
+
+// Same as the vec! macro, but for VecDeques as well
+macro_rules! vec_deque {
+    ($($item:expr),*) => {{
+        let mut deque = ::std::collections::VecDeque::new();
+        $(deque.push_back($item);)*
+        deque
+    }}
+}
+
+fn main() {
+    permute(&mut Vec::new(), &mut vec_deque![1,2,3], &|perm| println!("{:?}", perm));
+}

Task/Permutations/Stata/permutations-1.stata

@@ -0,0 +1 @@
+perm 4

Task/Permutations/Stata/permutations-2.stata

@@ -0,0 +1,49 @@
+program perm
+	local n=`1'
+	local r=1
+	forv i=1/`n' {
+		local r=`r'*`i'
+	}
+	clear
+	qui set obs `r'
+	forv i=1/`n' {
+		gen p`i'=0
+	}
+	mata: genperm()
+end
+
+mata
+void genperm() {
+	real scalar n, i, j, k, s, p
+	real rowvector u
+	st_view(a=., ., .)
+	n = cols(a)
+	u = 1..n
+	p = 1
+	do {
+		a[p++, .] = u
+		i = n
+		for (i = n; i > 1; i--) {
+			if (u[i-1] < u[i]) break
+		}
+		if (i > 1) {
+			j = i
+			k = n
+			while (j < k) {
+				s = u[j]
+				u[j] = u[k]
+				u[k] = s
+				j++
+				k--
+			}
+			
+			s = u[i-1]
+			j = i
+			for (j = i; u[j] < s; j++) {
+			}
+			u[i-1] = u[j]
+			u[j] = s
+		}
+	} while (i > 1)
+}
+end

Task/Permutations/Zkl/permutations.zkl

@@ -0,0 +1,8 @@
+zkl: Utils.Helpers.permute("rose").apply("concat")
+L("rose","roes","reos","eros","erso","reso","rseo","rsoe","sroe","sreo",...)
+
+zkl: Utils.Helpers.permute("rose").len()
+24
+
+zkl: Utils.Helpers.permute(T(1,2,3,4))
+L(L(1,2,3,4),L(1,2,4,3),L(1,4,2,3),L(4,1,2,3),L(4,1,3,2),L(1,4,3,2),L(1,3,4,2),L(1,3,2,4),...)