feR: Basic functions that I use all the time

.fable.create.lines <- function(x,lines = "lr", DEBUG = FALSE) {
  .fable.lines.check(x, lines)
  x.final <- attr(x,"FINAL")
  if (is.matrix(lines)) {
    tot.row <- nrow(lines)
    tot.col <- ncol(lines)

    if (tot.row == 3 & tot.col == 3) {
      first.col <- c(lines[1,1],rep(lines[2,1], times = (nrow(x.final) - 2) ), lines[3,1])
      middle.col <- c(lines[1,2],rep(lines[2,2], times = (nrow(x.final) - 2) ), lines[3,2])
      last.col <- c(lines[1,3],rep(lines[2,3], times = (nrow(x.final) - 2) ), lines[3,3])

      lines.matrix <- c(first.col, rep(middle.col, times = (ncol(x.final) - 2)), last.col)
      lines.matrix <- matrix(lines.matrix, ncol = ncol(x.final))
      return(lines.matrix)


    } else if (tot.row == nrow(x) & tot.col == ncol(x)) {
      return(lines)
    } else stop("If lines is a matrix it must either be 3x3 or the same dimmensions as x")
  } else {
    if (length(lines) == 1) return(fill.matrix(x.final, item = lines))
    else stop("If lines is not a matrix it must be 1 item long")
  }

}

#...............................................................................
#...............................................................................
# ADD LINES
#...............................................................................
#...............................................................................

#' @export
fable.add.lines.column <- function(x, pos = 0, lines = "copy", col.to.copy.lines = 2, DEBUG = FALSE) {
  .fable.lines.check(x, lines)

  if (lines == "copy") new.line <- attr(x,"LINES")[,col.to.copy.lines]
  else new.line <- lines

  attr(x,"LINES") <- add.col(attr(x,"LINES"),col = new.line, pos = pos, DEBUG = DEBUG)
  x <- .fable.lines.set.max.per.col(x)
  x
}

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

#' @export
fable.add.lines.row <- function(x, pos = 0, lines = "copy", row.to.copy.lines = 2, DEBUG = FALSE) {
  .fable.lines.check(x, lines)

  if (lines == "copy") new.line <- attr(x,"LINES")[row.to.copy.lines,]
  else new.line <- lines

  if (DEBUG) cat("\n[.fable.add.lines.col]New Line: ",new.line,", cols: ",ncol(attr(x,"LINES")),"\n")


  attr(x,"LINES") <- add.row(attr(x,"LINES"), row = new.line, pos = pos, DEBUG = DEBUG)
  x <- .fable.lines.set.max.per.col(x)
  x
}




#...............................................................................
#...............................................................................
# SET LINES
#...............................................................................
#...............................................................................

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

  attr(x,"LINES") <- set.col(attr(x,"LINES"), pos = pos, col = lines, DEBUG = DEBUG )
  x <- .fable.lines.set.max.per.col(x)
  x
}


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

  attr(x,"LINES") <- set.row(attr(x,"LINES"), pos = pos, row = lines, DEBUG = DEBUG )
  x <- .fable.lines.set.max.per.col(x)
  x
}



#...............................................................................
#...............................................................................
# SET LINES --- SINGLE CELL
#...............................................................................
#...............................................................................

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

  attr(x,"LINES") <- set.cell(attr(x,"LINES"), row = row, col = col, item = lines, DEBUG = DEBUG )
  x <- .fable.lines.set.max.per.col(x)
  x

}


#...............................................................................
#...............................................................................
# SET LINES --- WHOLE MATRIX
#...............................................................................
#...............................................................................

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

  attr(x,"LINES") <- fill.matrix(attr(x,"LINES") , item = lines, DEBUG = DEBUG)
  x <- .fable.lines.set.max.per.col(x)
  x
}

#...............................................................................
#...............................................................................
# SET LINES --- WHOLE MATRIX
#...............................................................................
#...............................................................................
#' @export
fable.fill.lines <- function(x, lines.colIni = "lr", lines.colMid = "r", lines.colEnd = "r") {
  if (is.null(x)) stop("x must be set")
  .fable.lines.check(x, lines.colIni)
  .fable.lines.check(x, lines.colMid)
  .fable.lines.check(x, lines.colEnd)

  total.col <- ncol(x)
  if (total.col >= 3) row = c(lines.colIni,rep(lines.colMid, times = (total.col - 2)),lines.colEnd)
  else if (total.col == 2) row = c(lines.colIni,lines.colEnd)
  else if (total.col == 1) row = lines.colIni
  else stop("matrix must have at least 1 column")

  matrix(rep(row, times = nrow(x)), ncol = total.col, byrow = T)
}


#...............................................................................
#...............................................................................
# UPDATE THE MATRIX BASED ON ROW_SPAN CONTENT
#...............................................................................
#...............................................................................
.fable.lines.update <- function(x) {
  if (is.null(x)) stop("x must be set")
  .fable.lines.check(x, "lr")

  row_span <- attr(x,"ROW.SPAN")
  lines <- attr(x,"LINES")

  if ((nrow(row_span)  != nrow(lines)) |
      (ncol(row_span)  != ncol(lines)) ) stop("Las dimensiones de ROW.SPAN y de LINES son diferentes")


  for (r in seq(nrow(lines))) {
    for (c in seq(ncol(lines))) {
#
#       if ((c + 1) <= ncol(lines)) is_next_span_0 <- (row_span[r,(c + 1)] == 0)
#       else is_next_span_0 <- FALSE

      is_span_0 <- row_span[r,c] == 0
      is_span_over_1 <- row_span[r,c] > 1

      if (is_span_0) {
        if (c < ncol(lines)) lines[r,c] <- gsub("r", "", lines[r,c])
        lines[r,c] <- gsub("l", "", lines[r,c])
      } else if (is_span_over_1) lines[r,c] <- gsub("r", "", lines[r,c])
    }
  }

  attr(x,"LINES") <- lines
  x <- .fable.lines.set.max.per.col(x)
  x
}


.fable.lines.set.max.per.col <- function(x) {
  if (is.null(x)) stop("x must be set")
  .fable.lines.check(x, "lr")

  lines <- attr(x,"LINES")
  max_lines_per_col <- c()
  for (c in seq(ncol(lines))) {
    max_lines_per_col <- c(max_lines_per_col, paste(unique(unlist(strsplit(unique(lines[,c]),""))),collapse = "") )
  }

  attr(x,"MAX_LINES_PER_COL")  <- max_lines_per_col
  x
}


.fable.lines.has.line.in.row <- function(x, row = 1, line = "l") {
  if (is.null(x)) stop("x must be set")
  .fable.lines.check(x, line)

  l <- attr(x,"LINES")[row,]
  l <- paste(unique(unlist(l)),collapse = "")
  return(grepl(line,l, fixed = TRUE))

}

#...............................................................................
#...............................................................................
# LINES OPTIONS & CHECKS
#...............................................................................
#...............................................................................

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


#' @export
fable.lines.options <- function() {
  base <- c("l","r","t","b")


  return(base)
}

#' @export
is.valid.fable.lines <- function(lines) {
  if (is.null(lines)) return(FALSE)

  if (length(lines) == 1) if (lines == "copy") return(TRUE)


  op <- fable.lines.options()
  unique.chars <- feR::unique_chars(lines)

  for (c in unique.chars) {
    if (!(c %in% op)) return(FALSE)
  }
  return(TRUE)
}


.fable.check.lines <- function(lines, stop.on.error = TRUE) {
  if (!is.valid.fable.lines(lines)) {
    m <- paste0("lines must be one of: ",paste0(fable.lines.options(), collapse = ","))
    if (stop.on.error) stop(m)
    message(m)
  }
}