feR: Basic functions that I use all the time

#' @export
print.feR_describe_numeric <- function(obj, raw=FALSE) {
  if (raw) {
    message("RAW")
    print(knitr::kable(obj))
    return()
  }
  digits <- attr(obj, "digits")
  show.markdown.division <- attr(obj, "show.markdown.division")
  markdown.division.prefix <- attr(obj, "markdown.division.prefix")

  stats <- c()
  print.values <- c()
  for (v in names(obj)) {
    value <- obj[1, v]
    if (is.numeric(value)) value <- round(value, digits = digits)

    stats <- c(stats, v)
    print.values <- c(print.values,value)
  }


  x.final <- data.frame(stats = stats, value = print.values)

  if (show.markdown.division) cat("\n", markdown.division.prefix,
                                  " Descripción de **", attr(obj, "x.name"),
                                  "**\n", sep = "")
  print(knitr::kable(x.final, caption = attr(obj, "x.name")))

  # cat("\n decimals ",decimals,"\n")
  # print(toString(obj))
  # print(attr(obj, "p.norm"))
  if (is.numeric(obj$norm.p.value) & !is.na(obj$norm.p.value)) {
    p.val <- round(obj$norm.p.value,digits = (digits + 1))
    zeroes <- paste0(rep(0,digits),collapse = "")
    p.val <- round(obj$norm.p.value,digits = digits)
    if (p.val == 0) p.val <- paste0("<0.",zeroes,"1")
  } else {
    p.val <- NA
  }

  if ("nor.test" %in% names(attributes(obj))) {
    n.test <- attr(obj,"nor.test")
    if ("p.sig" %in% names(attributes(n.test))) {
      norm = (n.test$p.value < attr(n.test,"p.sig"))
      cat("\nNormality test:", n.test$test,
          "; p.value:", n.test$p.val, ";",ifelse(norm, " Does not follow a normal distribution",
                                                               " Follows a normal distribution"),"\n", sep = "")

    } else {
      cat("\nNormality test:", n.test$test,
          "; p.value:", n.test$p.val, "\n", sep = "")

    }
  }
}


#' @export
print.feR_describe_numeric_list <- function(obj) {

  digits <- attr(obj, "digits")
  show.markdown.division <- attr(obj, "show.markdown.division")
  markdown.division.prefix <- attr(obj, "markdown.division.prefix")
  show.general <- !is.null(attr(obj, "result.general"))


  rownames(obj) <- obj$group
  obj$group <- NULL

  if (show.markdown.division) cat("\n",markdown.division.prefix,
                                  " Descripción de **", attr(obj, "x.name"),
                                  "** por **",
                                  attr(obj, "y.name"), "**\n", sep = "")



  if (show.general) {
    if (show.markdown.division) cat("\n", paste0(markdown.division.prefix,"#"),
                                    " Descripción general de ", attr(obj, "x.name"), "\n", sep = "")
    obj.general <- attr(obj, "result.general")

    attr(obj.general, "show.markdown.division") <- FALSE
    print(obj.general)
  }

  for (v in names(obj)) {
    value <- obj[, v]
    if (is.numeric(value)) obj[, v] <- round(value, digits = digits)
  }

  result <- t(obj)

  if (show.markdown.division & show.general) cat("\n",paste0(markdown.division.prefix,"#"),
                                  " Descripción de **", attr(obj, "x.name"),
                                  "** por grupos de **",
                                  attr(obj, "y.name"), "**\n", sep = "")


  print(knitr::kable(result, caption = paste(attr(obj, "x.name"), "vs", attr(obj, "y.name"))))
  for (g in names(attr(obj, "nor.test"))) {
    # print(attr(obj, "norm.p.value")[[g]])
    if ("norm.p.value" %in% names(attributes(obj))) {
      p.norm <- attr(obj, "norm.p.value")[[g]]
      if (is.numeric(p.norm) & !is.na(p.norm)) {
        p.val <- round(p.norm,digits = (digits + 1))
        if (p.val == 0) p.val <- paste0("<0.",rep(0,digits),1) #<------------------------------------ diferenciar entre p.val y p.val texto
        else p.val <- round(p.norm,digits = digits)
      } else {
        p.val <- p.norm
      }
      cat("\nNormality test ", g, ":", attr(obj, "nor.test")[[g]],
          "; p.value:", p.val, "\n")
    }
  }
}




.feR_describe_factor.pipe.fable <- function(obj) {
  digits <- attr(obj, "digits")

  table.format.prefix = attr(obj,"table.format.prefix")
  table.format.sufix = attr(obj,"table.format.sufix")
  table.format.sep = attr(obj,"table.format.sep")
  table.format.n = attr(obj,"table.format.n")
  table.format.row = attr(obj,"table.format.row")
  table.format.col = attr(obj,"table.format.col")
  as.percentage = attr(obj,"as.percentage")


  result_n <- attr(obj,"n")



  # print(names(attributes(obj)))
  if (!is.null(attr(obj, "y.name"))) {
    has_rows <- !is.null(attr(obj,"prop.row"))
    has_cols <- !is.null(attr(obj,"prop.col"))


    # cat("rows: ",has_rows," cols: ", has_cols,"\n")

    if (has_rows & has_cols) {
      result <- feR:::.paste.proportions(result_n,
                                         rows = attr(obj,"prop.row"),
                                         cols = attr(obj,"prop.col"),
                                         format.prefix = table.format.prefix,
                                         format.sufix = table.format.sufix,
                                         format.sep = table.format.sep,
                                         format.n = table.format.n,
                                         format.row = table.format.row,
                                         format.col = table.format.col,
                                         as.percentage = as.percentage
      )
    } else if (has_rows & !has_cols)  {
      result <- feR:::.paste.proportions(result_n,
                                         rows = attr(obj,"prop.row"),
                                         format.prefix = table.format.prefix,
                                         format.sufix = table.format.sufix,
                                         format.sep = table.format.sep,
                                         format.n = table.format.n,
                                         format.row = table.format.row,
                                         format.col = table.format.col,
                                         as.percentage = as.percentage
      )
    } else if (has_cols & !has_rows)  {
      result <- feR:::.paste.proportions(result_n,
                                         cols = attr(obj,"prop.col"),
                                         format.prefix = table.format.prefix,
                                         format.sufix = table.format.sufix,
                                         format.sep = table.format.sep,
                                         format.n = table.format.n,
                                         format.row = table.format.row,
                                         format.col = table.format.col,
                                         as.percentage = as.percentage
      )
    } else result <- feR:::.paste.proportions(result_n)


    #.... fin de tabla con DOS variables
  } else {
    #... hacer tabla con una sola variable
    return(as.data.frame(obj))
  }
}


#'
#' @export
#'
#'
print.feR_describe_factor <- function(obj) {


  show.title <- ifelse("show.title" %in% names(attributes(obj)), attr(obj, "show.title"), FALSE)
  markdown.title.prefix <- attr(obj, "markdown.title.prefix")

  total.by.row <- ifelse("total.by.row" %in% names(attributes(obj)), attr(obj, "total.by.row"), FALSE)
  total.by.column <- ifelse("total.by.column" %in% names(attributes(obj)), attr(obj, "total.by.column"), FALSE)


  #--------------------------------- GET FULL ARGUMENTS LIST--------------------
  # passed.args <- attributes(obj)
  # print(passed.args)
  # if (!missing(x)) passed.args$x <- x
  # if (!missing(y)) passed.args$y <- y
  # if (is.null(x.name)) passed.args$x.name = feR:::.var.name(deparse(substitute(x)))
  # if (is.null(y.name)) passed.args$y.name =  feR:::.var.name(deparse(substitute(y)))
  #-----------------------------------------------------------------------------
  # final.args <- get.fun.args(passed.args, "fable")
  #-----------------------------------------------------------------------------

  #-----------------------------------------------------------------------------


  x.name <- attr(obj, "x.name")
  y.var = ("y.name" %in% names(attributes(obj)))
  if (y.var)  {
    y.name <- attr(obj, "y.name")
    titulo <- paste0(x.name, "** vs **", y.name)
  } else {
    titulo <- paste(x.name)
  }

  if (show.title) cat("\n",paste0(markdown.title.prefix,"#")," Descripción de **",titulo,"** \n\n",sep = "")

  #--------------------------------- GET FULL ARGUMENTS LIST--------------------
  fun.args <- formals(fable)
  fun.args$... <- NULL
  passed.args <- attributes(obj)
  final.args <- as.list(modifyList(fun.args, passed.args))
  final.args <- final.args[names(final.args) %in% names(fun.args)]
  final.args <- lapply(final.args, eval)
  final.args$x <- obj
  final.args$END.RECURSION = TRUE
  #-----------------------------------------------------------------------------

  if (final.args$DEBUG) print(as.data.frame(obj))

  fable.args <- final.args[ !(names(final.args) %in% c("x","y") )]

  tabla.merged <- .feR_describe_factor.pipe.fable(obj)

  final.args$x <- tabla.merged

  ft <- do.call(feR:::.fable,final.args)
  # print(ft)
  if (y.var) {
    if (final.args$colnames) {
      new.line <- c(rep(" ", times = ncol(attr(ft,"FINAL")) - (1 + as.numeric(total.by.row))),y.name,rep(" ", times = as.numeric(total.by.row)))
      ft <- feR::fable.add.row(ft, row = new.line , pos = 0, row.to.copy.lines = 3)

      if(final.args$rownames) ft <- feR::fable.set.cell(ft, row = 1, col = 1, item = x.name)
      print(ft)

      ft <- feR::fable.merge.cells(ft, colIni = (1 + as.numeric(total.by.column)), colEnd = (ncol(attr(ft,"FINAL")) - as.numeric(total.by.row)), align = "center", lines = "r")
      print(ft)
    }
  }

  print(ft)

}






#' @export
print.feR_describe_data_frame <- function(obj) {
  for (x in obj) {
    print(x)
  }

}