R/combn_limited.r

In markanewman/mndredge: Data dredging in R

#' @keywords internal
#'
combn_limited <- function (x, m, limit) 
{
  # code origionaly from `View(combn)` then modified to be fit for purpose
  
  stopifnot(
    x %>% is.vector(mode="character"),
    m %>% is.numeric(),
    m > 0,
    limit %>% is.numeric(),
    limit > 0)
  
  n <- x %>% length() %>% as.integer()
  stopifnot(n >= m)

  m <- m %>% as.integer()
  limit <- limit %>% as.integer()
  
  e <- 0
  h <- m
  a <- seq_len(m)
  r <- x[a]

  count <- min(limit, choose(n, m) %>% round() %>% as.integer())
  out <- matrix(r, nrow = m, ncol = count)
  
  if(count == 1) { return(out) }
  
  i <- 2L
  nmmp1 <- n - m + 1L
  while (a[1L] != nmmp1) {
    if (e < n - h) {
      h <- 1L
      e <- a[m]
      j <- 1L
    }
    else {
      e <- a[m - h]
      h <- h + 1L
      j <- 1L:h
    }
    a[m - h + j] <- e + j
    r <- x[a]
    out[, i] <- r
    if(i == count) { return(out) }
    i <- i + 1L
  }
  
  out
}