R/utils.matrix.operations.R

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

#'
#' @export
set.cell <- function(x, row, col, item, DEBUG = FALSE) {
  if (is.null(x)) stop("x must be set")
  if (is.null(row)) stop("row must be set")
  if (is.null(col)) stop("col must be set")
  if (is.null(item)) stop("item must be set")
  if (row > nrow(x)) stop("row must be <= than nrow")
  if (col > ncol(x)) stop("col must be <= than ncol")

  x[row,col] <- item
  x
}

fill.matrix <- function(x,item="item", DEBUG = FALSE) {

  if (is.matrix(item)) {
    if (!equal.dim(x,item)) stop("'item' matrix size is wrong")
    else final.x <- item
  } else {
    if (length(item) == 1) final.x <- matrix(rep(item, times = length(as.matrix(x))), ncol = ncol(x))
    else if (length(item) == ncol(x)) final.x <- matrix(rep(item, times = nrow(x)), ncol = ncol(x), byrow = TRUE)
  }

  final.x
}

#..............................................................................
#                            ADDITION
#..............................................................................

#' @aliases add.col
#'
#' @export
add.column <- function(x, col="item", pos = 0, col.name = "col", DEBUG = FALSE) {
  # UseMethod("add.column")
  if (is.matrix(x)) x <- as.data.frame(x)
  if (!is.data.frame(x)) stop("'x' debe ser matrix o data.frame")

  total.row <- nrow(x)
  total.col <- ncol(x)

  if (length(col) == 1) col <- rep(col,times = total.row)
  else if (total.row != length(col)) stop("'col' debe tener tantos elementos como filas tiene 'x' o solo 1 elemento. TITLE?")

  names.orig <- names(x)
  if (pos <= 0) x <- cbind(col,x) #... al principio
  else if (pos >= total.col) x <- cbind(x,col) #... al final
  else if (pos < total.col) x <- cbind(x[,1:(pos - 1)],col,x[,pos:total.col])

  if (pos > 1) names(x)[1:(pos - 1)] <- names.orig[1:(pos - 1)]
  names(x)[pos] <- col.name
  if (pos == 0) names(x)[2:(total.col + 1)] <- names.orig[1:total.col]
  else names(x)[(pos + 1):(total.col + 1)] <- names.orig[pos:total.col]
  x
}

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



#' @export
add.row <- function(x, row="item", pos = 0, row.name = NULL, DEBUG = FALSE) {
  if (!is.null(rownames(x)) & !is.null(row.name)) rownames.originales <- rownames(x)

  total.row <- nrow(x)
  total.col <- ncol(x)

  if (DEBUG) cat("\n Items in row:",total.col, " ROW ITEMS:",length(row),"\n")

  if (length(row) == 1) row <- rep(row,times = total.col)
  else if (total.col != length(row)) stop("'row' debe tener tantos elementos como filas tiene 'x' o solo 1 elemento")

  if (pos <= 0) x <- rbind(row,x) #... al principio
  else if (pos >= total.row) x <- rbind(x,row) #... al final
  else if (pos < total.row) x <- rbind(x[1:(pos - 1),],row,x[pos:total.row,])

  if (exists("rownames.originales")) {
    rownames(x)[1:(pos - 1)] <- rownames.originales[1:(pos - 1)]
    rownames(x)[pos] <- row.name
    rownames(x)[(pos + 1):(total.row + 1)] <- rownames.originales[pos:total.row]
  }

  x
}




#' @export
set.row <- function(x, row="item", pos = 0, DEBUG = FALSE) {


  total.row <- nrow(x)
  total.col <- ncol(x)

  if (pos <= 0 | pos > total.row) stop("'pos' debe ser mayor de 0 y menor que el máximo número de filas de la matriz")

  if (length(row) == 1) row <- rep(row,times = total.col)
  else if (total.col != length(row)) stop("'row' debe tener tantos elementos como columnas tiene 'x' o solo 1 elemento")

  x[pos,] <- row
  x
}


#' @aliases set.col
#'
#' @export
set.column <- function(x, col="item", pos = 0, DEBUG = FALSE) {


  total.row <- nrow(x)
  total.col <- ncol(x)

  if (pos <= 0 | pos > total.col) stop("'pos' debe ser mayor de 0 y menor que el máximo número de columnas de la matriz")

  if (length(col) == 1) col <- rep(col,times = total.row)
  else if (!feR::equal.dim(x[,1],col)) stop("'col' debe tener tantos elementos como filas tiene 'x' o solo 1 elemento")

  x[,pos] <- col
  x
}

#' @rdname set.column
#' @export
set.col <- set.column