R/utils.fable.row_span.R

In feranpre/feR: Basic functions that I use all the time

#...............................................................................
#...............................................................................
# ADD ROW_SPAN
#...............................................................................
#...............................................................................

#' @export
fable.add.row_span.column <- function(x, pos = 0,  row_span = "center", DEBUG = FALSE) {
  .fable.row_span.check(x, row_span)
  attr(x,"ROW.SPAN") <- add.col(attr(x,"ROW.SPAN"),col = row_span, pos = pos, DEBUG = DEBUG)
  x
}

#' @rdname fable.add.row_span.column
#' @export
fable.add.row_span.col <- fable.add.row_span.column


#' @export
fable.add.row_span.row <- function(x, pos = 0,  row_span = "center", DEBUG = FALSE) {
  .fable.row_span.check(x, row_span)
  attr(x,"ROW.SPAN") <- add.row(attr(x,"ROW.SPAN"), row = row_span, pos = pos, DEBUG = DEBUG)
  x
}




#...............................................................................
#...............................................................................
# SET ROW_SPAN
#...............................................................................
#...............................................................................

#' @export
fable.set.row_span.col <- function(x, pos, row_span, DEBUG = FALSE) {
  if (is.null(x)) stop("x must be set")
  .fable.row_span.check(x, row_span)

  attr(x,"ROW.SPAN") <- set.col(attr(x,"ROW.SPAN"), pos = pos, col = row_span, DEBUG = DEBUG )
  # x <- .fable.lines.update(x)
  x
}

#' @export
fable.set.row_span.row <- function(x, pos, row_span, DEBUG = FALSE) {
  if (is.null(x)) stop("x must be set")
  .fable.row_span.check(x, row_span)

  attr(x,"ROW.SPAN") <- set.row(attr(x,"ROW.SPAN"), pos = pos, row = row_span, DEBUG = DEBUG )
  # x <- .fable.lines.update(x)
  x
}



#...............................................................................
#...............................................................................
# SET ROW_SPAN --- SINGLE CELL
#...............................................................................
#...............................................................................

#' @export
fable.set.row_span.cell <- function(x, row, col, row_span, DEBUG = F) {
  if (is.null(x)) stop("x must be set")
  .fable.row_span.check(x, row_span)

  attr(x,"ROW.SPAN") <- set.cell(attr(x,"ROW.SPAN"), row = row, col = col, item = row_span, DEBUG = DEBUG )
  x

}


#...............................................................................
#...............................................................................
# SET ROW_SPAN --- WHOLE MATRIX
#...............................................................................
#...............................................................................
#' @export
fable.set.row_span <- function(x, row_span = "right", DEBUG = FALSE) {
  if (is.null(x)) stop("x must be set")
  .fable.row_span.check(x, row_span)

  attr(x,"ROW.SPAN") <- fill.matrix(attr(x,"ROW.SPAN") , item = row_span, DEBUG = DEBUG)
  x
}


#...............................................................................
#...............................................................................
# ROW_SPAN OPTIONS & CHECKS
#...............................................................................
#...............................................................................

.fable.row_span.check <- function(x, row_span) {
  .fable.check(x)
  .fable.check.row_span(row_span)
}


#' @export
is.valid.fable.row_span <- function(row_span) {
  if (is.null(row_span)) return(FALSE)
  if (is.numeric(row_span)) return(TRUE)
  return(FALSE)
}


.fable.check.row_span <- function(row_span, stop.on.error = TRUE) {
  if (!is.valid.fable.row_span(row_span)) {
    m <- paste0("row_span must be an interger", collapse = ",")
    if (stop.on.error) stop(m)
    message(m)
  }
}