R/allcyc.R

In RobinHankin/permutations: The Symmetric Group: Permutations of a Finite Set

`allcycn` <- function(n) {
  out <- matrix(0, factorial(n - 1), n)
  index <- 1
  CyclicPermut2 <- function(i, p) {
    j <- i + 1
    x <- p[i]
    if (i < n) { # 'n' available via lexical scope
      while (j <= n) {
        p[i] <- p[j]
        p[j] <- x
        CyclicPermut2(i + 1, p) # recursive
        p[j] <- p[i]
        j <- j + 1
      } # while loop closes
      p[i] <- x
    } else {
      out[index, ] <<- p
      index <<- index + 1
    }
  } # definition of CyclicPermut() closes
  CyclicPermut2(1, seq_len(n))
  return(as.word(out))
}

`allcyc` <- function(s) {
  capply(allcycn(length(s)), function(x) {
    s[x]
  })
}

`r1cyc` <- function(len, vec) {
  out <- sample(vec, len)
  for (i in seq_len(len - 1)) {
    j <- sample(seq(from = i + 1, to = len), 1)
    swap <- out[i]
    out[i] <- out[j]
    out[j] <- swap
  }
  return(out)
}

`rcyc` <- function(n, len, r = len) {
  out <- matrix(0, n, r)
  for (i in seq_len(n)) {
    out[i, ] <- as.word(as.cycle(r1cyc(len, seq_len(r))), r)
  }
  return(as.cycle(out))
}

`rgs1` <- function(s) {
  n <- seq_len(sum(s))
  s <- s[s > 1]
  out <- id
  for (i in s) {
    vec <- sample(n, i, replace = FALSE)
    out <- out + as.cycle(r1cyc(i, vec))
    n <- n[!(n %in% vec)]
  }
  return(out)
}

`rgivenshape` <- function(n, s, size = sum(s)) {
  if (length(n) > 1) {
    return(Recall(n = 1, s = n))
  }
  out <- rep(id, n)
  s <- c(s, rep(1, size - sum(s)))
  for (i in seq_len(n)) {
    out[i] <- rgs1(s)
  }
  return(out)
}