R/all_perms_given_shape.R

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

`allpermslike` <- function(o){ #   allpermslike(as.cycle("(1,2)(3,4)(5,6,7,8)"))
  x <- lapply(unclass(as.cycle(o))[[1]],FUN = allcyc)
  xlen <- unlist(lapply(x,length))
  xseq <- sapply(xlen,seq_len,simplify=FALSE)
  e <- as.matrix(expand.grid(xseq))
  out <- nullcycle
  for(i in seq_len(nrow(e))){
    jj <- id
    for(j in seq_len(ncol(e))){
      jj <- jj + x[[j]][e[i,j]]
    }
    out <- c(out,jj)
  }
  return(out)
}

`some_perms_shape` <- function(shape){  # some_perms_shape(c(2,2,4))
  M <- listParts(shape)
  do.call("c",lapply(seq_along(M),function(i){as.cycle(unclass(M[[i]]))}))
}

`all_cyclic_shuffles` <- function(o){  # all_cyclic_shuffles(cyc_len(3:5))
  o <- as.cycle(o)
  do.call("c",lapply(seq_along(o),function(i){allpermslike(o[i])}))
}

`all_perms_shape` <- function(shape){# all_perms_shape(c(2,2,3))
    all_cyclic_shuffles(some_perms_shape(shape))
}