R/mod_normal_utils.R

In loadeR: Load Data for Analysis System

#' Normal plot
#'
#' @param data a numeric column of a data.frame.
#' @param colorbar a color for the bars.
#' @param colorline a color for the line.
#' @param nombres a character vector of length 2 specifying the titles to use on legend.
#'
#' @author Diego Jimenez <diego.jimenez@promidat.com>
#' @return echarts4r plot.
#' @export e_histnormal
#' @import echarts4r
#' @importFrom graphics hist
#' @importFrom stats dnorm sd
#' @examples
#' e_histnormal(iris$Sepal.Length)
#' 
e_histnormal <- function(data, colorbar = "steelblue", colorline = "gray",
                         nombres = c("Histograma", "Curva Normal")) {
  h <- hist(data, plot = FALSE)
  x <- seq(min(h$mids, na.rm = TRUE), max(h$mids, na.rm = TRUE), length = length(h$mids))
  promedio <- mean(data, na.rm = TRUE)
  desviacion <- sd(data, na.rm = TRUE)
  normalidad <- dnorm(x, promedio, desviacion)
  
  d <- diff(h$breaks)[1]
  
  distribu <- data.frame(
    x = h$mids, d = h$density, n = normalidad,
    name = paste0("(", h$mids - d / 2, " - ", h$mids + d / 2, ")")
  )
  
  distribu |> e_charts(x) |> e_bar(d, name = nombres[1]) |> 
    e_line(n, name = nombres[2]) |> e_x_axis(scale = TRUE) |>
    e_axis_labels(x = "", y = "Densidad") |> 
    e_color(c(colorbar, colorline)) |> e_tooltip() |> 
    e_datazoom(show = FALSE) |> e_show_loading()
}

#' Qplot + Qline
#'
#' @param data a numeric column of a data.frame.
#' @param colorpoint a color for the points.
#' @param colorline a color for the line.
#'
#' @author Diego Jimenez <diego.jimenez@promidat.com>
#' @return echarts4r plot.
#' @export e_qq
#' @import echarts4r
#' @importFrom stats qnorm qqnorm quantile
#' @examples
#' e_qq(iris$Sepal.Length)
#' 
e_qq <- function(data, colorpoint = "steelblue", colorline = "gray") {
  data <- data.frame(qqnorm(data, plot = FALSE))
  
  y <- quantile(data$y, c(0.25, 0.75), names = FALSE, na.rm = TRUE)
  x <- qnorm(c(0.25, 0.75))
  slope <- diff(y)/diff(x)
  int <- y[1L] - slope * x[1L]
  
  data$z <- data$x * slope + int
  data <- round(data, 3)
  
  data |> e_charts(x) |> e_scatter(y, name = "QQplot", symbol_size = 8) |>
    e_line(z, name = "QQline", symbol = 'none') |> e_x_axis(scale = TRUE) |>
    e_y_axis(scale = TRUE) |> e_tooltip() |> e_datazoom(show = FALSE) |> 
    e_color(c(colorpoint, colorline)) |> e_show_loading()
}

#' Data.frame with normal test values.
#'
#' @param data a data.frame object only with the numeric columns.
#'
#' @author Diego Jimenez <diego.jimenez@promidat.com>
#' @return A data.frame.
#' @export dfnormal
#' @importFrom stats complete.cases pchisq pnorm shapiro.test
#' @examples
#' dfnormal(iris[, -5])
#' 
dfnormal <- function(data) {
  data    <- var.numericas(data)
  fisher  <- sapply(data, function(i) fisher.calc(i))
  pearson <- sapply(data, function(i) pearson.test(i))
  lillie  <- sapply(data, function(i) lillie.test(i))
  cvm     <- sapply(data, function(i) cvm.test(i))
  shapiro <- sapply(data, function(i) shapiro.test(i)$p.value)
  
  data.frame(cbind(fisher, pearson, lillie, cvm, shapiro))
}