tri_index.R

upper_left <- function(n, diag = TRUE, byrow = FALSE) {
  x <- seq.int(n)
  tmp1 <- sequence(rev(x))
  tmp2 <- rep(x, rev(x))
  out <- if (byrow) {
    cbind(row = tmp2, col = tmp1)
  } else {
    cbind(row = tmp1, col = tmp2)
  }
  if (diag) out else out[rowSums(out) != n + 1, ]
}

upper_right <- function(n, diag = TRUE, byrow = FALSE) {
  x <- seq.int(n)
  out <- if (byrow) {
    cbind(row = rep(x, rev(x)), 
          col = unlist(lapply(x, ":", n), use.names = FALSE))
  } else {
    cbind(row = sequence(x), col = rep(x, x))
  }
  if (diag) out else out[out[, "row"] != out[, "col"], ]
}

lower_left <- function(n, diag = TRUE, byrow = FALSE) {
  x <- seq.int(n)
  out <- if (byrow) {
    cbind(row = rep(x, x), col = sequence(x))
  } else {
    cbind(row = unlist(lapply(x, ":", n), use.names = FALSE), 
          col = rep(x, rev(x)))
  }
  if (diag) out else out[out[, "row"] != out[, "col"], ]
}

lower_right <- function(n, diag = TRUE, byrow = FALSE) {
  x <- seq.int(n)
  t1 <- rep(x, x)
  t2 <- unlist(lapply(rev(x), ":", n), use.names = FALSE)
  out <- if (byrow) {
    cbind(row = t1, col = t2)
  } else {
    cbind(row = t2, col = t1)
  }
  if (diag) out else out[rowSums(out) != n + 1, ]
}

tri_index <- function(n, pos = "ur", diag = TRUE, byrow = FALSE) {
  if (!pos %in% c("ur", "lr", "ul", "ll")) stop("pos must be either ur, lr, ul, or ll")
  FUN <- match.fun(switch(pos, 
                          ur = "upper_right",
                          lr = "lower_right",
                          ul = "upper_left",
                          ll = "lower_left"))
  FUN(n, diag = diag, byrow = byrow)
}