September Morn Update

Task/Permutations/R/permutations-1.r

@@ -1,48 +1,35 @@
-next.perm <- function(p) {
-  n <- length(p)
-  i <- n - 1
-  r = T
-  for (i in seq(n - 1, 1)) {
-    if (p[i] < p[i + 1]) {
-      r = F
-      break
+next.perm <- function(a) {
+  n <- length(a)
+  i <- n
+  while (i > 1 && a[i - 1] >= a[i]) i <- i - 1
+  if (i == 1) {
+    NULL
+  } else {
+    j <- i
+    k <- n
+    while (j < k) {
+      s <- a[j]
+      a[j] <- a[k]
+      a[k] <- s
+      j <- j + 1
+      k <- k - 1
     }
-  }
-
-  j <- i + 1
-  k <- n
-  while (j < k) {
-    x <- p[j]
-    p[j] <- p[k]
-    p[k] <- x
-    j <- j + 1
-    k <- k - 1
-  }
-
-  if(r) return(NULL)
-
-  j <- n
-  while (p[j] > p[i]) j <- j - 1
-  j <- j + 1
-
-  x <- p[i]
-  p[i] <- p[j]
-  p[j] <- x
-  return(p)
-}
-
-print.perms <- function(n) {
-  p <- 1:n
-  while (!is.null(p)) {
-    cat(p, "\n")
-    p <- next.perm(p)
+    s <- a[i - 1]
+    j <- i
+    while (a[j] <= s) j <- j + 1
+    a[i - 1] <- a[j]
+    a[j] <- s
+    a
   }
 }
 
-print.perms(3)
-# 1 2 3
-# 1 3 2
-# 2 1 3
-# 2 3 1
-# 3 1 2
-# 3 2 1
+perm <- function(n) {
+  e <- NULL
+  a <- 1:n
+  repeat {
+    e <- cbind(e, a)
+    a <- next.perm(a)
+    if (is.null(a)) break
+  }
+  unname(e)
+}

Task/Permutations/R/permutations-2.r

@@ -1,11 +1,5 @@
-# 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]))
+> perm(3)
+     [,1] [,2] [,3] [,4] [,5] [,6]
+[1,]    1    1    2    2    3    3
+[2,]    2    3    1    3    1    2
+[3,]    3    2    3    1    2    1

Task/Permutations/R/permutations-3.r

@@ -1,18 +1,11 @@
-> permutation(letters[1:3])
-[[1]]
-[1] "c" "b" "a"
+# 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))
 
-[[2]]
-[1] "b" "c" "a"
+# 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)}
 
-[[3]]
-[1] "b" "a" "c"
-
-[[4]]
-[1] "c" "a" "b"
-
-[[5]]
-[1] "a" "c" "b"
-
-[[6]]
-[1] "a" "b" "c"
+# permutations of a vector s
+permutation <- function(s) lapply(perm(length(s)), function(i) s[i])

Task/Permutations/R/permutations-4.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"