Commit ⋅ rsquaredacademy/descriptr

  check_numeric(data, !! c_var, cvar_name)

  g_var <- rlang::quos(...)
  non_type <-
    data %>%
    dplyr::select(!!! g_var) %>%
    purrr::keep(purrr::negate(is.factor)) %>%
    colnames()
  gdata <- dplyr::select(data, !!! g_var)
  nums  <- unlist(lapply(gdata, is.numeric))
  non_type <- colnames(gdata[nums])

  error_message <- paste0("Below grouping variables are not categorical: \n",
                    paste("-", non_type, collapse = "\n"))

  if (length(non_type) > 0) {
  	rlang::abort(error_message)
  	stop(error_message)
  }

  cnames <-
    data %>%
    dplyr::select(!!! g_var) %>%
    purrr::keep(is.factor) %>%
    colnames()

  cats <- unlist(lapply(gdata, is.factor))
  cnames <- colnames(gdata[cats])

  data %>%
    dplyr::select(!!c_var, !!! g_var) %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    dplyr::mutate(
      Levels = interaction(!!! g_var)
    ) %>%

@@ -32,7 +32,7 @@

  }

  data %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    tidyr::gather(var, values) %>%
    dplyr::group_by(var) %>%
    dplyr::summarise_all(list(mean      = mean,

@@ -76,7 +76,7 @@

  }

  data %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    tidyr::gather(var, values) %>%
    dplyr::group_by(var) %>%
    dplyr::summarise_all(list(range     = ds_range,

@@ -120,7 +120,7 @@

  }

  data %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    tidyr::gather(var, values) %>%
    dplyr::group_by(var) %>%
    dplyr::summarise_all(

@@ -164,7 +164,7 @@

  }

  data %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    tidyr::gather(var, values) %>%
    dplyr::group_by(var) %>%
    dplyr::summarise_all(

@@ -206,7 +206,7 @@

  na_data <-
    data %>%
    dplyr::select(!! var) %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    dplyr::pull(1)

  tibble::tibble(type = c(rep("high", 5), rep("low", 5)),

@@ -269,58 +269,70 @@



#' @title Geometric Mean
#' @description Compute the geometric mean
#' @param x a numeric vector containing the values whose geometric mean is to be
#' computed
#' @description Computes the geometric mean
#' @param x a numeric vector
#' @param data a \code{data.frame} or \code{tibble}
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @param ... further arguments passed to or from other methods
#' #' @details Any NA values are stripped from \code{x} before computation
#' takes place.
#' @return Returns the geometric mean of \code{x}
#' @examples
#' ds_gmean(mtcars$mpg)
#' ds_gmean(mpg, mtcars)
#' @export
#' @seealso \code{\link{ds_hmean}} \code{\link[base]{mean}}
#'
ds_gmean <- function(x, na.rm = FALSE, ...) {
ds_gmean <- function(x, data = NULL, na.rm = FALSE, ...) {

  if (!is.numeric(x)) {
    stop("x must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Geometric mean can be calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
  }

  if (na.rm) {
    x <- stats::na.omit(x)
    z <- stats::na.omit(z)
  }

  prod(x) ^ (1 / length(x))
  prod(z) ^ (1 / length(z))

}

#' @title Harmonic Mean
#' @description Compute the harmonic mean
#' @param x a numeric vector containing the values whose harmonic mean is to be
#' computed
#' @description Computes the harmonic mean
#' @param x a numeric vector.
#' @param data a \code{data.frame} or \code{tibble}.
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @param ... further arguments passed to or from other methods
#' #' @details Any NA values are stripped from \code{x} before computation
#' takes place.
#' @return Returns the harmonic mean of \code{x}
#' @examples
#' ds_hmean(mtcars$mpg)
#' ds_hmean(mpg, mtcars)
#' @export
#' @seealso \code{\link{ds_gmean}} \code{\link[base]{mean}}
#'
ds_hmean <- function(x, na.rm = FALSE, ...) {
ds_hmean <- function(x, data = NULL, na.rm = FALSE, ...) {

  if (!is.numeric(x)) {
    stop("x must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Harmonic mean can be calculated only for numeric data. The variable you have selected is ", z_class, "."))
  }

  if (na.rm) {
    x <- stats::na.omit(x)
    z <- stats::na.omit(z)
  }

  length(x) / sum(sapply(x, div_by))
  length(z) / sum(sapply(z, div_by))

}


@@ -364,55 +376,71 @@


#' @title Range
#' @description Compute the range of a numeric vector
#' @param x a numeric vector
#' @param x a numeric vector or column name.
#' @param data a \code{data.frame} or \code{tibble}.
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @return Range of \code{x}
#' @examples
#' ds_range(mtcars$mpg)
#' ds_range(mpg, mtcars)
#' @seealso \code{\link[base]{range}}
#' @export
#'
ds_range <- function(x, na.rm = FALSE) {
ds_range <- function(x, data = NULL, na.rm = FALSE) {

  if (!is.numeric(x)) {
    stop("data must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (na.rm) {
    x <- stats::na.omit(x)
  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Range can be calculated only for numeric data. The variable you have selected is ", z_class, "."))
  }

  x %>%
    range() %>%
    diff()
  if (na.rm) {
    z <- stats::na.omit(z)
  }
  max(z) - min(z)

}



#' @title Kurtosis
#' @description Compute the kurtosis of a probability distribution.
#' @param x a numeric vector containing the values whose kurtosis is to be computed
#' @param x a numeric vector
#' @param data a \code{data.frame} or \code{tibble}
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @details Any NA values are stripped from \code{x} before computation
#' takes place.
#' @return Kurtosis of \code{x}
#' @examples
#' ds_kurtosis(mtcars$mpg)
#' ds_kurtosis(mpg, mtcars)
#' @seealso \code{ds_skewness}
#' @references Sheskin, D.J. (2000) Handbook of Parametric and Nonparametric Statistical Procedures, Second Edition. Boca Raton, Florida: Chapman & Hall/CRC.
#' @export
#'
ds_kurtosis <- function(x, na.rm = FALSE) {
ds_kurtosis <- function(x, data = NULL, na.rm = FALSE) {

  if (!is.numeric(x)) {
    stop("x must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Kurtosis is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
  }

  if (na.rm) {
    x <- stats::na.omit(x)
    z <- stats::na.omit(z)
  }

  n <- length(x)
  summation <- sums(x, 4)
  n <- length(z)
  summation <- sums(z, 4)
  part1 <- (n * (n + 1)) / ((n - 1) * (n - 2) * (n - 3))
  part2 <- (3 * (n - 1) ^ 2) / ((n - 2) * (n - 3))
  (part1 * summation) - part2

@@ -421,29 +449,36 @@


#' @title Skewness
#' @description Compute the skewness of a probability distribution.
#' @param x a numeric vector containing the values whose skewness is to be computed
#' @param x a numeric vector
#' @param data a \code{data.frame} or \code{tibble}
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @details Any NA values are stripped from \code{x} before computation
#' takes place.
#' @return Skewness of \code{x}
#' @examples
#' ds_skewness(mtcars$mpg)
#' ds_skewness(mpg, mtcars)
#' @seealso \code{kurtosis}
#' @references Sheskin, D.J. (2000) Handbook of Parametric and Nonparametric Statistical Procedures, Second Edition. Boca Raton, Florida: Chapman & Hall/CRC.
#' @export
#'
ds_skewness <- function(x, na.rm = FALSE) {
ds_skewness <- function(x, data = NULL, na.rm = FALSE) {

  if (!is.numeric(x)) {
    stop("x must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Skewness is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
  }

  if (na.rm) {
    x <- stats::na.omit(x)
    z <- stats::na.omit(z)
  }

  n <- length(x)
  summation <- sums(x, 3)
  n <- length(z)
  summation <- sums(z, 3)
  (n / ((n - 1) * (n - 2))) * summation

}

@@ -451,85 +486,104 @@

#' @title Mean Absolute Deviation
#' @description Compute the mean absolute deviation about the mean
#' @param x a numeric vector
#' @param data a \code{data.frame} or \code{tibble}
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @details The \code{stat_mdev} function computes the mean absolute deviation
#' @details The \code{ds_mdev} function computes the mean absolute deviation
#' about the mean. It is different from \code{mad} in \code{stats} package as
#' the statistic used to compute the deviations is not \code{median} but
#' \code{mean}. Any NA values are stripped from \code{x} before computation
#' takes place
#' @return Mean absolute deviation of \code{x}
#' @examples
#' ds_mdev(mtcars$mpg)
#' ds_mdev(mpg, mtcars)
#' @seealso \code{\link[stats]{mad}}
#' @export
#'
ds_mdev <- function(x, na.rm = FALSE) {
ds_mdev <- function(x, data = NULL, na.rm = FALSE) {

  if (!is.numeric(x)) {
    stop("x must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Mean absolute deviation is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
  }

  if (na.rm) {
    x <- stats::na.omit(x)
    z <- stats::na.omit(z)
  }

  m <- mean(x)
  sum(sapply(x, md_helper, m)) / length(x)
  m <- mean(z)
  sum(sapply(z, md_helper, m)) / length(z)

}


#' @title Coefficient of Variation
#' @description Compute the coefficient of variation
#' @param x a numeric vector containing the values whose mode is to be computed
#' @param x a numeric vector
#' @param data a \code{data.frame} or \code{tibble}
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @details Any NA values are stripped from \code{x} before computation
#' takes place.
#' @examples
#' ds_cvar(mtcars$mpg)
#' ds_cvar(mpg, mtcars)
#' @export
#'
ds_cvar <- function(x, na.rm = FALSE) {
ds_cvar <- function(x, data = NULL, na.rm = FALSE) {

  if (!is.numeric(x)) {
    stop("x must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Coefficient of variation is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
  }

  if (na.rm) {
    x <- stats::na.omit(x)
    z <- stats::na.omit(z)
  }

  (stats::sd(x) / mean(x)) * 100
  (stats::sd(z) / mean(z)) * 100

}

#' @title Corrected Sum of Squares
#' @description Compute the corrected sum of squares
#' @param x a numeric vector containing the values whose mode is to be computed
#' @param x a numeric vector.
#' @param data a \code{data.frame} or \code{tibble}.
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#' @details Any NA values are stripped from \code{x} before computation
#' takes place.
#' @return Corrected sum of squares of \code{x}
#' @examples
#' ds_css(mtcars$mpg)
#' ds_css(mpg, mtcars)
#' @export
#'
ds_css <- function(x, na.rm = FALSE) {
ds_css <- function(x, data = NULL, na.rm = FALSE) {

  if (!is.numeric(x)) {
    stop("x must be numeric")
  if (is.null(data)) {
    z <- x
  } else {
    y <- deparse(substitute(x))
    z <- data[[y]]
  }

  if (na.rm) {
    x <- stats::na.omit(x)
  if (!is.numeric(z)) {
    z_class <- class(z)
    stop(paste0("Corrected sum of squares can be calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
  }

  y <- mean(x)
  if (na.rm) {
    z <- stats::na.omit(z)
  }

  x %>%
    magrittr::subtract(y) %>%
    magrittr::raise_to_power(2) %>%
    sum()
  sum((z - mean(z)) ^ 2)

}


@@ -537,8 +591,6 @@

#' @description Returns index of values.
#' @param data a numeric vector
#' @param values a numeric vector containing the values whose index is returned
#' @details Any NA values are stripped from \code{data} and \code{values} before
#' computation takes place.
#' @return Index of the \code{values} in \code{data}. In case, \code{data} does
#' not contain \code{index}, \code{NULL} is returned.
#' @examples

@@ -565,7 +617,7 @@

    out <- c(out, k)
  }

  return(unique(out))
  unique(out)

}


@@ -4,15 +4,10 @@


  if (!interactive() || stats::runif(1) > 0.1) return()

  pkgs <- utils::available.packages()

  cran_version <-
    pkgs %>%
    magrittr::extract("descriptr", "Version") %>%
    package_version()

  pkgs          <- utils::available.packages()
  cran_version  <- package_version(pkgs["descriptr", "Version"])
  local_version <- utils::packageVersion("descriptr")
  behind_cran <- cran_version > local_version
  behind_cran   <- cran_version > local_version

  tips <- c(
    "Learn more about descriptr at https://github.com/rsquaredacademy/descriptr/.",

@@ -11,9 +11,7 @@

#'
ds_launch_shiny_app <- function() {

	rlang::inform("`ds_launch_shiny_app()` has been soft-deprecated and will be removed in the next release. In future, to launch the app, run the below code:\n 
	- install.packages('xplorerr')\n - xplorerr::app_descriptive()\n")

	check_suggests('xplorerr')
	check_suggests('haven')
	check_suggests('jsonlite')
	check_suggests('readr')

@@ -167,7 +167,7 @@

  group <-
    data %>%
    dplyr::select(!! var_1, !! var_2) %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    dplyr::group_by(!! var_1, !! var_2) %>%
    dplyr::summarise(count = dplyr::n())


@@ -179,7 +179,7 @@

  div_by <-
    data %>%
    dplyr::group_by(!! var_2) %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    dplyr::tally() %>%
    dplyr::pull(n)


@@ -187,7 +187,7 @@

  group2 <-
    data %>%
    dplyr::select(!! var_1, !! var_2) %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    dplyr::group_by(!! var_2, !! var_1) %>%
    dplyr::summarise(count = dplyr::n()) %>%
    dplyr::mutate(

@@ -1,26 +1,20 @@

formatter_freq <- function(x) {
  x %>%
    as.character() %>%
    format(width = 13, justify = "centre")
  return(format(as.character(x), width = 13, justify = "centre"))
}


formatter <- function(x) {
  x %>%
    as.character() %>%
    format(width = 13, justify = "right")
  return(format(as.character(x), width = 13, justify = "right"))
}

percent <- function(x, y) {
  out <- round((x / y) * 100, 2)
  return(out)
}


formata <- function(x, round, width, justify = "centre") {
  x %>%
    round(round) %>%
    as.character() %>%
    format(width = width, justify = justify)
  return(format(as.character(round(x, round)), width = width, justify = justify))
}

formatas <- function(x, round, width, justify = "centre") {

@@ -64,8 +58,8 @@



sums <- function(x, q) {
  avg <- mean(x)
  stdev <- stats::sd(x)
  avg    <- mean(x)
  stdev  <- stats::sd(x)
  result <- sum(sapply(x, standardize, avg, stdev, q))
  return(result)
}

@@ -99,9 +93,7 @@



formatl <- function(x) {
  x %>%
    format(nsmall = 2) %>%
    format(width = 20, justify = "left")
  return(format(format(x, nsmall = 2), width = 20, justify = "left"))
}

formatol <- function(x, w) {

@@ -110,32 +102,22 @@



formatr <- function(x, w) {
  x %>%
    rounda() %>%
    format(nsmall = 2, width = w, justify = "right")
  format(rounda(x), nsmall = 2, width = w, justify = "right")
}


formatc <- function(x, w) {
  if (is.numeric(x)) {
    ret <- x %>%
      round(2) %>%
      as.character(x) %>%
      format(width = w, justify = "centre")
    ret <- format(as.character(round(x, 2)), width = w, justify = "centre")
  } else {
    ret <- x %>%
      as.character(x) %>%
      format(width = w, justify = "centre")
    ret <- format(as.character(x), width = w, justify = "centre")
  }
  return(ret)
}


formatnc <- function(x, w) {
  x %>%
    round(2) %>%
    format(nsmall = 2) %>%
    format(width = w, justify = "centre")
  format(format(round(x, 2), nsmall = 2), width = w, justify = "centre")
}



@@ -235,14 +217,14 @@

seql <- function(mean, sd) {
  lmin <- mean - (5 * sd)
  lmax <- mean + (5 * sd)
  l <- seq(lmin, lmax, sd)
  l    <- seq(lmin, lmax, sd)
  return(l)
}

xmm <- function(mean, sd) {
  xmin <- mean - (5 * sd)
  xmax <- mean + (5 * sd)
  out <- c(xmin, xmax)
  out  <- c(xmin, xmax)
  return(out)
}


@@ -250,7 +232,7 @@

seqln <- function(mean, sd) {
  lmin <- mean - 3 * sd
  lmax <- mean + 3 * sd
  l <- seq(lmin, lmax, sd)
  l    <- seq(lmin, lmax, sd)
  return(l)
}


@@ -258,7 +240,7 @@

xmn <- function(mean, sd) {
  xmin <- mean - 3 * sd
  xmax <- mean + 3 * sd
  out <- c(xmin, xmax)
  out  <- c(xmin, xmax)
  return(out)
}


@@ -284,10 +266,7 @@

}

string_to_name <- function(x, index = 1) {
  x %>%
    magrittr::use_series(varnames) %>%
    magrittr::extract(index) %>%
    rlang::sym()
  rlang::sym(x$varnames[index])
}

#' @importFrom utils packageVersion menu install.packages

@@ -343,3 +322,11 @@

343	322		rlang::abort(msg)
344	323		}
345	324		}
	325	+
	326	+	ds_rule <- function(text = NULL) {
	327	+	con_wid <- options()$width
	328	+	text_len <- nchar(text) + 2
	329	+	dash_len <- (con_wid - text_len) / 2
	330	+	cat(paste(rep("-", dash_len)), ' ', text, ' ',
	331	+	paste(rep("-", dash_len)), sep = "")
	332	+	}

@@ -34,7 +34,7 @@

  }

  data %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    tidyr::gather(vars, values) %>%
    dplyr::group_by(vars) %>%
    dplyr::summarise_all(

@@ -31,6 +31,11 @@

#' @examples
#' # screen data
#' ds_screener(mtcarz)
#' ds_screener(airquality)
#'
#' # plot
#' x <- ds_screener(airquality)
#' plot(x)
#'
#' @export
#'

@@ -45,10 +50,10 @@

  rows     <- nrow(data)
  cols     <- ncol(data)
  varnames <- names(data)
  datatype <- purrr::map_chr(data, class)
  counts   <- purrr::map_int(data, length)
  nlev     <- purrr::map(data, nlevels)
  lev      <- purrr::map(data, levels)
  datatype <- sapply(data, class)
  counts   <- sapply(data, length)
  nlev     <- lapply(data, nlevels)
  lev      <- lapply(data, levels)

  for (i in seq_len(length(lev))) {
    if (is.null(lev[[i]])) {

@@ -56,32 +61,12 @@

    }
  }

  mvalues    <- purrr::map_int(data, function(z) sum(is.na(z)))

  mvaluesper <-
    mvalues %>%
      magrittr::divide_by(counts) %>%
      magrittr::multiply_by(100) %>%
      round(2)

  mtotal <-
    data %>%
    is.na() %>%
    sum()

  mtotalper <-
    mtotal %>%
    magrittr::divide_by(sum(counts)) %>%
    magrittr::multiply_by(100) %>%
    round(2)

  mrows <-
    data %>%
    stats::complete.cases() %>%
    `!` %>%
    sum()

  mcols <- sum(mvalues != 0)
  mvalues    <- sapply(data, function(z) sum(is.na(z)))
  mvaluesper <- round((mvalues / counts) * 100, 2)
  mtotal     <- sum(is.na(data))
  mtotalper  <- round((mtotal / sum(counts)) * 100, 2)
  mrows      <- sum(!stats::complete.cases(data))
  mcols      <- sum(mvalues != 0)

  result <- list(Rows          = rows,
                 Columns       = cols,

@@ -107,33 +92,22 @@

  print_screen(x)
}



#' @rdname ds_screener
#' @export
#'
plot.ds_screener <- function(x, ...) {

  dat  <- x$MissingPer
  ymax <- max(dat) * 1.5
  cols <- c("green", "red")[(dat > 10) + 1]

  h <- graphics::barplot(dat,
               main = "Missing Values (%)",
               xlab = "Column Names",
               ylab = "Percentage",
               col  = cols,
               ylim = c(0, ymax))

  graphics::legend("top",
          legend     = c("> 10%", "<= 10%"),
          fill       = c("red", "green"),
          horiz      = TRUE,
          title      = "% Missing",
          cex        = 0.5,
          text.width = 0.7)

  line_data <- cbind(h, as.vector(dat))
  graphics::text(line_data[, 1], line_data[, 2] + 2, as.vector(dat))
  `% Missing`  <- NULL
  mydat        <- data.frame(x = names(x$MissingPer), y = x$MissingPer)
  mydat$y      <- mydat$y / 100
  mydat$color  <- ifelse(mydat$y >= 0.1, ">= 10%", "< 10%")
  names(mydat) <- c("x", "y", "% Missing")

  ggplot2::ggplot(mydat) +
    ggplot2::geom_col(ggplot2::aes(x = stats::reorder(x, y), y = y, fill = `% Missing`)) +
    ggplot2::scale_y_continuous(labels = scales::percent_format()) +
    ggplot2::xlab("Column") + ggplot2::ylab("Percentage") +
    ggplot2::ggtitle("Missing Values (%)") +
    ggplot2::scale_fill_manual(values = c("green", "red"))

}

@@ -39,20 +39,19 @@

  num_var <- names(plot_data)

  for (i in num_var) {
    cat(cli::rule(center = paste0('Variable: ', i),
                  width = options()$width))

    ds_rule(paste0('Variable: ', i))
    cat('\n\n')
    cat(cli::rule(center = paste0('Summary Statistics'),
                  width = options()$width))
    ds_rule(paste0('Summary Statistics'))
    cat('\n\n')
    print(ds_summary_stats(data, i))
    cat('\n\n')
    cat(cli::rule(center = paste0('Frequency Distribution'),
                  width = options()$width))
    ds_rule(paste0('Frequency Distribution'))
    cat('\n\n')
    print(ds_freq_table(data, i))
    cat('\n\n\n')
  }

}

#' Tabulation

@@ -9,18 +9,19 @@

#' ds_summary_stats(mtcarz, mpg)
#'
#' @importFrom rlang !!
#' @importFrom stats na.omit
#'
#' @seealso \code{\link[base]{summary}} 
#' @seealso \code{\link[base]{summary}}
#' \code{\link{ds_freq_table}} \code{\link{ds_cross_table}}
#'
#' @export
#'
ds_summary_stats <- function(data, ...) {
  

  check_df(data)
  

  var <- rlang::quos(...)
  

  if (length(var) < 1) {
    is_num <- sapply(data, is.numeric)
    if (!any(is_num == TRUE)) {

@@ -33,21 +34,18 @@

    is_num <- sapply(data, is.numeric)
    if (!any(is_num == TRUE)) {
      rlang::abort("Data has no continuous variables.")
    }  
    }
  }
  

  col_names <- names(data)
  for (i in col_names) {
    cat(cli::rule(center = paste0('Variable: ', i), 
                  width = options()$width))
    ds_rule(paste0('Variable: ', i))
    cat('\n\n')
    print(ds_summary(data, i))
    cat('\n\n\n')
  }
  
}


}

ds_summary <- function(data, variable) UseMethod("ds_summary")


@@ -63,7 +61,7 @@

  sdata <-
    data %>%
    dplyr::pull(!! vary) %>%
    stats::na.omit()
    na.omit()

  low      <- ds_tailobs(sdata, 5, "low")
  high     <- ds_tailobs(sdata, 5, "high")

@@ -85,7 +83,7 @@

			     median   = stats::median(sdata),
			     mode     = ds_mode(sdata),
			     range    = ds_range(sdata),
			     min      = min(sdata), 
			     min      = min(sdata),
			     Max      = max(sdata),
			     iqrange  = stats::IQR(sdata),
			     per99    = stats::quantile(sdata, 0.99),

@@ -57,9 +57,11 @@

      ggplot2::ggplot(data = plot_data) +
      ggplot2::geom_point(ggplot2::aes(x = !! rlang::sym(x), y = !! rlang::sym(y)))
    myplots[[i]] <- p
    names(myplots)[[i]] <- paste(y, "v", x)
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -121,9 +123,11 @@

      ggplot2::geom_histogram(ggplot2::aes(x = !! rlang::sym(x)), bins = bins,
        fill = fill)
    myplots[[i]] <- p
    names(myplots)[[i]] <- x
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -183,9 +187,11 @@

      ggplot2::ggplot(data = plot_data) +
      ggplot2::geom_density(ggplot2::aes(x = !! rlang::sym(x)), color = color)
    myplots[[i]] <- p
    names(myplots)[[i]] <- x
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -244,9 +250,11 @@

      ggplot2::ggplot(data = plot_data) +
      ggplot2::geom_bar(ggplot2::aes(x = !! rlang::sym(x)), fill = fill)
    myplots[[i]] <- p
    names(myplots)[[i]] <- x
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -306,9 +314,11 @@

      ggplot2::geom_boxplot(ggplot2::aes(x = factor(1), y = !! rlang::sym(x))) +
      ggplot2::labs(x = ' ')
    myplots[[i]] <- p
    names(myplots)[[i]] <- x
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -374,9 +384,11 @@

      ggplot2::ggplot(data = plot_data) +
      ggplot2::geom_bar(ggplot2::aes(x = !! rlang::sym(x), fill = !! rlang::sym(y)))
    myplots[[i]] <- p
    names(myplots)[[i]] <- paste(y, "v", x)
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -442,9 +454,11 @@

      ggplot2::geom_bar(ggplot2::aes(x = !! rlang::sym(x), fill = !! rlang::sym(y)),
        position = 'dodge')
    myplots[[i]] <- p
    names(myplots)[[i]] <- paste(y, "v", x)
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -519,9 +533,11 @@

      ggplot2::ggplot(data = plot_data) +
      ggplot2::geom_boxplot(ggplot2::aes(x = !! rlang::sym(x), y = !! rlang::sym(y)))
    myplots[[i]] <- p
    names(myplots)[[i]] <- paste(y, "v", x)
  }

  if (print_plot) {
    check_suggests('gridExtra')
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
  } else {
    return(myplots)

@@ -93,7 +93,7 @@

  tidystats <-
    data %>%
    dplyr::select(!! g_var, !! c_var) %>%
    tidyr::drop_na() %>%
    na.omit() %>%
    dplyr::group_by(!! g_var) %>%
    dplyr::summarise(length = length(!! c_var), min = min(!! c_var),
              max = max(!! c_var), mean  = mean(!! c_var),

Files		•	•	•	Coverage
R	1,808	1,645	0	163	90.98%
Project Totals (19 files)	1,808	1,645	0	163	90.98%

Notifications are pending CI completion. Waiting for GitHub's status webhook to queue notifications. Push notifications now.

View CI Build Download

comment: false

coverage:
  status:
    project:
      default:
        target: auto
        threshold: 1%
        informational: true
    patch:
      default:
        target: auto
        threshold: 1%
        informational: true

Read the docs

Interact now

The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.

SVG

Learn more about the coverage sunburst graph

206	206		na_data <-
207	207		data %>%
208	208		dplyr::select(!! var) %>%
209		-	tidyr::drop_na() %>%
	209	+	na.omit() %>%
210	210		dplyr::pull(1)
211	211
212	212		tibble::tibble(type = c(rep("high", 5), rep("low", 5)),

269	269
270	270
271	271		#' @title Geometric Mean
272		-	#' @description Compute the geometric mean
273		-	#' @param x a numeric vector containing the values whose geometric mean is to be
274		-	#' computed
	272	+	#' @description Computes the geometric mean
	273	+	#' @param x a numeric vector
	274	+	#' @param data a \code{data.frame} or \code{tibble}
275	275		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
276	276		#' @param ... further arguments passed to or from other methods
277		-	#' #' @details Any NA values are stripped from \code{x} before computation
278		-	#' takes place.
279		-	#' @return Returns the geometric mean of \code{x}
280	277		#' @examples
281	278		#' ds_gmean(mtcars$mpg)
	279	+	#' ds_gmean(mpg, mtcars)
282	280		#' @export
283	281		#' @seealso \code{\link{ds_hmean}} \code{\link[base]{mean}}
284	282		#'
285		-	ds_gmean <- function(x, na.rm = FALSE, ...) {
	283	+	ds_gmean <- function(x, data = NULL, na.rm = FALSE, ...) {
286	284
287		-	if (!is.numeric(x)) {
288		-	stop("x must be numeric")
	285	+	if (is.null(data)) {
	286	+	z <- x
	287	+	} else {
	288	+	y <- deparse(substitute(x))
	289	+	z <- data[[y]]
	290	+	}
	291	+
	292	+	if (!is.numeric(z)) {
	293	+	z_class <- class(z)
	294	+	stop(paste0("Geometric mean can be calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
289	295		}
290	296
291	297		if (na.rm) {
292		-	x <- stats::na.omit(x)
	298	+	z <- stats::na.omit(z)
293	299		}
294	300
295		-	prod(x) ^ (1 / length(x))
	301	+	prod(z) ^ (1 / length(z))
296	302
297	303		}
298	304
299	305		#' @title Harmonic Mean
300		-	#' @description Compute the harmonic mean
301		-	#' @param x a numeric vector containing the values whose harmonic mean is to be
302		-	#' computed
	306	+	#' @description Computes the harmonic mean
	307	+	#' @param x a numeric vector.
	308	+	#' @param data a \code{data.frame} or \code{tibble}.
303	309		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
304	310		#' @param ... further arguments passed to or from other methods
305		-	#' #' @details Any NA values are stripped from \code{x} before computation
306		-	#' takes place.
307		-	#' @return Returns the harmonic mean of \code{x}
308	311		#' @examples
309	312		#' ds_hmean(mtcars$mpg)
	313	+	#' ds_hmean(mpg, mtcars)
310	314		#' @export
311	315		#' @seealso \code{\link{ds_gmean}} \code{\link[base]{mean}}
312	316		#'
313		-	ds_hmean <- function(x, na.rm = FALSE, ...) {
	317	+	ds_hmean <- function(x, data = NULL, na.rm = FALSE, ...) {
314	318
315		-	if (!is.numeric(x)) {
316		-	stop("x must be numeric")
	319	+	if (is.null(data)) {
	320	+	z <- x
	321	+	} else {
	322	+	y <- deparse(substitute(x))
	323	+	z <- data[[y]]
	324	+	}
	325	+
	326	+	if (!is.numeric(z)) {
	327	+	z_class <- class(z)
	328	+	stop(paste0("Harmonic mean can be calculated only for numeric data. The variable you have selected is ", z_class, "."))
317	329		}
318	330
319	331		if (na.rm) {
320		-	x <- stats::na.omit(x)
	332	+	z <- stats::na.omit(z)
321	333		}
322	334
323		-	length(x) / sum(sapply(x, div_by))
	335	+	length(z) / sum(sapply(z, div_by))
324	336
325	337		}
326	338

364	376
365	377		#' @title Range
366	378		#' @description Compute the range of a numeric vector
367		-	#' @param x a numeric vector
	379	+	#' @param x a numeric vector or column name.
	380	+	#' @param data a \code{data.frame} or \code{tibble}.
368	381		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
369	382		#' @return Range of \code{x}
370	383		#' @examples
371	384		#' ds_range(mtcars$mpg)
	385	+	#' ds_range(mpg, mtcars)
372	386		#' @seealso \code{\link[base]{range}}
373	387		#' @export
374	388		#'
375		-	ds_range <- function(x, na.rm = FALSE) {
	389	+	ds_range <- function(x, data = NULL, na.rm = FALSE) {
376	390
377		-	if (!is.numeric(x)) {
378		-	stop("data must be numeric")
	391	+	if (is.null(data)) {
	392	+	z <- x
	393	+	} else {
	394	+	y <- deparse(substitute(x))
	395	+	z <- data[[y]]
379	396		}
380	397
381		-	if (na.rm) {
382		-	x <- stats::na.omit(x)
	398	+	if (!is.numeric(z)) {
	399	+	z_class <- class(z)
	400	+	stop(paste0("Range can be calculated only for numeric data. The variable you have selected is ", z_class, "."))
383	401		}
384	402
385		-	x %>%
386		-	range() %>%
387		-	diff()
	403	+	if (na.rm) {
	404	+	z <- stats::na.omit(z)
	405	+	}
	406	+	max(z) - min(z)
388	407
389	408		}
390	409
	410	+
	411	+
391	412		#' @title Kurtosis
392	413		#' @description Compute the kurtosis of a probability distribution.
393		-	#' @param x a numeric vector containing the values whose kurtosis is to be computed
	414	+	#' @param x a numeric vector
	415	+	#' @param data a \code{data.frame} or \code{tibble}
394	416		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
395		-	#' @details Any NA values are stripped from \code{x} before computation
396		-	#' takes place.
397		-	#' @return Kurtosis of \code{x}
398	417		#' @examples
399	418		#' ds_kurtosis(mtcars$mpg)
	419	+	#' ds_kurtosis(mpg, mtcars)
400	420		#' @seealso \code{ds_skewness}
401	421		#' @references Sheskin, D.J. (2000) Handbook of Parametric and Nonparametric Statistical Procedures, Second Edition. Boca Raton, Florida: Chapman & Hall/CRC.
402	422		#' @export
403	423		#'
404		-	ds_kurtosis <- function(x, na.rm = FALSE) {
	424	+	ds_kurtosis <- function(x, data = NULL, na.rm = FALSE) {
405	425
406		-	if (!is.numeric(x)) {
407		-	stop("x must be numeric")
	426	+	if (is.null(data)) {
	427	+	z <- x
	428	+	} else {
	429	+	y <- deparse(substitute(x))
	430	+	z <- data[[y]]
	431	+	}
	432	+
	433	+	if (!is.numeric(z)) {
	434	+	z_class <- class(z)
	435	+	stop(paste0("Kurtosis is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
408	436		}
409	437
410	438		if (na.rm) {
411		-	x <- stats::na.omit(x)
	439	+	z <- stats::na.omit(z)
412	440		}
413	441
414		-	n <- length(x)
415		-	summation <- sums(x, 4)
	442	+	n <- length(z)
	443	+	summation <- sums(z, 4)
416	444		part1 <- (n * (n + 1)) / ((n - 1) * (n - 2) * (n - 3))
417	445		part2 <- (3 * (n - 1) ^ 2) / ((n - 2) * (n - 3))
418	446		(part1 * summation) - part2

421	449
422	450		#' @title Skewness
423	451		#' @description Compute the skewness of a probability distribution.
424		-	#' @param x a numeric vector containing the values whose skewness is to be computed
	452	+	#' @param x a numeric vector
	453	+	#' @param data a \code{data.frame} or \code{tibble}
425	454		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
426		-	#' @details Any NA values are stripped from \code{x} before computation
427		-	#' takes place.
428		-	#' @return Skewness of \code{x}
429	455		#' @examples
430	456		#' ds_skewness(mtcars$mpg)
	457	+	#' ds_skewness(mpg, mtcars)
431	458		#' @seealso \code{kurtosis}
432	459		#' @references Sheskin, D.J. (2000) Handbook of Parametric and Nonparametric Statistical Procedures, Second Edition. Boca Raton, Florida: Chapman & Hall/CRC.
433	460		#' @export
434	461		#'
435		-	ds_skewness <- function(x, na.rm = FALSE) {
	462	+	ds_skewness <- function(x, data = NULL, na.rm = FALSE) {
436	463
437		-	if (!is.numeric(x)) {
438		-	stop("x must be numeric")
	464	+	if (is.null(data)) {
	465	+	z <- x
	466	+	} else {
	467	+	y <- deparse(substitute(x))
	468	+	z <- data[[y]]
	469	+	}
	470	+
	471	+	if (!is.numeric(z)) {
	472	+	z_class <- class(z)
	473	+	stop(paste0("Skewness is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
439	474		}
440	475
441	476		if (na.rm) {
442		-	x <- stats::na.omit(x)
	477	+	z <- stats::na.omit(z)
443	478		}
444	479
445		-	n <- length(x)
446		-	summation <- sums(x, 3)
	480	+	n <- length(z)
	481	+	summation <- sums(z, 3)
447	482		(n / ((n - 1) * (n - 2))) * summation
448	483
449	484		}

451	486		#' @title Mean Absolute Deviation
452	487		#' @description Compute the mean absolute deviation about the mean
453	488		#' @param x a numeric vector
	489	+	#' @param data a \code{data.frame} or \code{tibble}
454	490		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
455		-	#' @details The \code{stat_mdev} function computes the mean absolute deviation
	491	+	#' @details The \code{ds_mdev} function computes the mean absolute deviation
456	492		#' about the mean. It is different from \code{mad} in \code{stats} package as
457	493		#' the statistic used to compute the deviations is not \code{median} but
458	494		#' \code{mean}. Any NA values are stripped from \code{x} before computation
459	495		#' takes place
460		-	#' @return Mean absolute deviation of \code{x}
461	496		#' @examples
462	497		#' ds_mdev(mtcars$mpg)
	498	+	#' ds_mdev(mpg, mtcars)
463	499		#' @seealso \code{\link[stats]{mad}}
464	500		#' @export
465	501		#'
466		-	ds_mdev <- function(x, na.rm = FALSE) {
	502	+	ds_mdev <- function(x, data = NULL, na.rm = FALSE) {
467	503
468		-	if (!is.numeric(x)) {
469		-	stop("x must be numeric")
	504	+	if (is.null(data)) {
	505	+	z <- x
	506	+	} else {
	507	+	y <- deparse(substitute(x))
	508	+	z <- data[[y]]
	509	+	}
	510	+
	511	+	if (!is.numeric(z)) {
	512	+	z_class <- class(z)
	513	+	stop(paste0("Mean absolute deviation is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
470	514		}
471	515
472	516		if (na.rm) {
473		-	x <- stats::na.omit(x)
	517	+	z <- stats::na.omit(z)
474	518		}
475	519
476		-	m <- mean(x)
477		-	sum(sapply(x, md_helper, m)) / length(x)
	520	+	m <- mean(z)
	521	+	sum(sapply(z, md_helper, m)) / length(z)
478	522
479	523		}
480	524
481	525
482	526		#' @title Coefficient of Variation
483	527		#' @description Compute the coefficient of variation
484		-	#' @param x a numeric vector containing the values whose mode is to be computed
	528	+	#' @param x a numeric vector
	529	+	#' @param data a \code{data.frame} or \code{tibble}
485	530		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
486		-	#' @details Any NA values are stripped from \code{x} before computation
487		-	#' takes place.
488	531		#' @examples
489	532		#' ds_cvar(mtcars$mpg)
	533	+	#' ds_cvar(mpg, mtcars)
490	534		#' @export
491	535		#'
492		-	ds_cvar <- function(x, na.rm = FALSE) {
	536	+	ds_cvar <- function(x, data = NULL, na.rm = FALSE) {
493	537
494		-	if (!is.numeric(x)) {
495		-	stop("x must be numeric")
	538	+	if (is.null(data)) {
	539	+	z <- x
	540	+	} else {
	541	+	y <- deparse(substitute(x))
	542	+	z <- data[[y]]
	543	+	}
	544	+
	545	+	if (!is.numeric(z)) {
	546	+	z_class <- class(z)
	547	+	stop(paste0("Coefficient of variation is calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
496	548		}
497	549
498	550		if (na.rm) {
499		-	x <- stats::na.omit(x)
	551	+	z <- stats::na.omit(z)
500	552		}
501	553
502		-	(stats::sd(x) / mean(x)) * 100
	554	+	(stats::sd(z) / mean(z)) * 100
503	555
504	556		}
505	557
506	558		#' @title Corrected Sum of Squares
507	559		#' @description Compute the corrected sum of squares
508		-	#' @param x a numeric vector containing the values whose mode is to be computed
	560	+	#' @param x a numeric vector.
	561	+	#' @param data a \code{data.frame} or \code{tibble}.
509	562		#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
510		-	#' @details Any NA values are stripped from \code{x} before computation
511		-	#' takes place.
512		-	#' @return Corrected sum of squares of \code{x}
513	563		#' @examples
514	564		#' ds_css(mtcars$mpg)
	565	+	#' ds_css(mpg, mtcars)
515	566		#' @export
516	567		#'
517		-	ds_css <- function(x, na.rm = FALSE) {
	568	+	ds_css <- function(x, data = NULL, na.rm = FALSE) {
518	569
519		-	if (!is.numeric(x)) {
520		-	stop("x must be numeric")
	570	+	if (is.null(data)) {
	571	+	z <- x
	572	+	} else {
	573	+	y <- deparse(substitute(x))
	574	+	z <- data[[y]]
521	575		}
522	576
523		-	if (na.rm) {
524		-	x <- stats::na.omit(x)
	577	+	if (!is.numeric(z)) {
	578	+	z_class <- class(z)
	579	+	stop(paste0("Corrected sum of squares can be calculated only for numeric data. The variable you have selected is of type ", z_class, "."))
525	580		}
526	581
527		-	y <- mean(x)
	582	+	if (na.rm) {
	583	+	z <- stats::na.omit(z)
	584	+	}
528	585
529		-	x %>%
530		-	magrittr::subtract(y) %>%
531		-	magrittr::raise_to_power(2) %>%
532		-	sum()
	586	+	sum((z - mean(z)) ^ 2)
533	587
534	588		}
535	589

23	23		check_numeric(data, !! c_var, cvar_name)
24	24
25	25		g_var <- rlang::quos(...)
26		-	non_type <-
27		-	data %>%
28		-	dplyr::select(!!! g_var) %>%
29		-	purrr::keep(purrr::negate(is.factor)) %>%
30		-	colnames()
	26	+	gdata <- dplyr::select(data, !!! g_var)
	27	+	nums <- unlist(lapply(gdata, is.numeric))
	28	+	non_type <- colnames(gdata[nums])
31	29
32	30		error_message <- paste0("Below grouping variables are not categorical: \n",
33	31		paste("-", non_type, collapse = "\n"))
34	32
35	33		if (length(non_type) > 0) {
36		-	rlang::abort(error_message)
	34	+	stop(error_message)
37	35		}
38	36
39		-	cnames <-
40		-	data %>%
41		-	dplyr::select(!!! g_var) %>%
42		-	purrr::keep(is.factor) %>%
43		-	colnames()
44		-
	37	+	cats <- unlist(lapply(gdata, is.factor))
	38	+	cnames <- colnames(gdata[cats])
45	39
46	40		data %>%
47	41		dplyr::select(!!c_var, !!! g_var) %>%
48		-	tidyr::drop_na() %>%
	42	+	na.omit() %>%
49	43		dplyr::mutate(
50	44		Levels = interaction(!!! g_var)
51	45		) %>%

537	591		#' @description Returns index of values.
538	592		#' @param data a numeric vector
539	593		#' @param values a numeric vector containing the values whose index is returned
540		-	#' @details Any NA values are stripped from \code{data} and \code{values} before
541		-	#' computation takes place.
542	594		#' @return Index of the \code{values} in \code{data}. In case, \code{data} does
543	595		#' not contain \code{index}, \code{NULL} is returned.
544	596		#' @examples

565	617		out <- c(out, k)
566	618		}
567	619
568		-	return(unique(out))
	620	+	unique(out)
569	621
570	622		}
571	623

4	4
5	5		if (!interactive() \|\| stats::runif(1) > 0.1) return()
6	6
7		-	pkgs <- utils::available.packages()
8		-
9		-	cran_version <-
10		-	pkgs %>%
11		-	magrittr::extract("descriptr", "Version") %>%
12		-	package_version()
13		-
	7	+	pkgs <- utils::available.packages()
	8	+	cran_version <- package_version(pkgs["descriptr", "Version"])
14	9		local_version <- utils::packageVersion("descriptr")
15		-	behind_cran <- cran_version > local_version
	10	+	behind_cran <- cran_version > local_version
16	11
17	12		tips <- c(
18	13		"Learn more about descriptr at https://github.com/rsquaredacademy/descriptr/.",

11	11		#'
12	12		ds_launch_shiny_app <- function() {
13	13
14		-	rlang::inform("`ds_launch_shiny_app()` has been soft-deprecated and will be removed in the next release. In future, to launch the app, run the below code:\n
15		-	- install.packages('xplorerr')\n - xplorerr::app_descriptive()\n")
16		-
	14	+	check_suggests('xplorerr')
17	15		check_suggests('haven')
18	16		check_suggests('jsonlite')
19	17		check_suggests('readr')

167	167		group <-
168	168		data %>%
169	169		dplyr::select(!! var_1, !! var_2) %>%
170		-	tidyr::drop_na() %>%
	170	+	na.omit() %>%
171	171		dplyr::group_by(!! var_1, !! var_2) %>%
172	172		dplyr::summarise(count = dplyr::n())
173	173

179	179		div_by <-
180	180		data %>%
181	181		dplyr::group_by(!! var_2) %>%
182		-	tidyr::drop_na() %>%
	182	+	na.omit() %>%
183	183		dplyr::tally() %>%
184	184		dplyr::pull(n)
185	185

187	187		group2 <-
188	188		data %>%
189	189		dplyr::select(!! var_1, !! var_2) %>%
190		-	tidyr::drop_na() %>%
	190	+	na.omit() %>%
191	191		dplyr::group_by(!! var_2, !! var_1) %>%
192	192		dplyr::summarise(count = dplyr::n()) %>%
193	193		dplyr::mutate(

1	1		formatter_freq <- function(x) {
2		-	x %>%
3		-	as.character() %>%
4		-	format(width = 13, justify = "centre")
	2	+	return(format(as.character(x), width = 13, justify = "centre"))
5	3		}
6	4
7	5
8	6		formatter <- function(x) {
9		-	x %>%
10		-	as.character() %>%
11		-	format(width = 13, justify = "right")
	7	+	return(format(as.character(x), width = 13, justify = "right"))
12	8		}
13	9
14	10		percent <- function(x, y) {
15	11		out <- round((x / y) * 100, 2)
	12	+	return(out)
16	13		}
17	14
18	15
19	16		formata <- function(x, round, width, justify = "centre") {
20		-	x %>%
21		-	round(round) %>%
22		-	as.character() %>%
23		-	format(width = width, justify = justify)
	17	+	return(format(as.character(round(x, round)), width = width, justify = justify))
24	18		}
25	19
26	20		formatas <- function(x, round, width, justify = "centre") {

64	58
65	59
66	60		sums <- function(x, q) {
67		-	avg <- mean(x)
68		-	stdev <- stats::sd(x)
	61	+	avg <- mean(x)
	62	+	stdev <- stats::sd(x)
69	63		result <- sum(sapply(x, standardize, avg, stdev, q))
70	64		return(result)
71	65		}

120	120		}
121	121
122	122		data %>%
123		-	tidyr::drop_na() %>%
	123	+	na.omit() %>%
124	124		tidyr::gather(var, values) %>%
125	125		dplyr::group_by(var) %>%
126	126		dplyr::summarise_all(

250	232		seqln <- function(mean, sd) {
251	233		lmin <- mean - 3 * sd
252	234		lmax <- mean + 3 * sd
253		-	l <- seq(lmin, lmax, sd)
	235	+	l <- seq(lmin, lmax, sd)
254	236		return(l)
255	237		}
256	238

258	240		xmn <- function(mean, sd) {
259	241		xmin <- mean - 3 * sd
260	242		xmax <- mean + 3 * sd
261		-	out <- c(xmin, xmax)
	243	+	out <- c(xmin, xmax)
262	244		return(out)
263	245		}
264	246

121	123		ggplot2::geom_histogram(ggplot2::aes(x = !! rlang::sym(x)), bins = bins,
122	124		fill = fill)
123	125		myplots[[i]] <- p
	126	+	names(myplots)[[i]] <- x
124	127		}
125	128
126	129		if (print_plot) {
	130	+	check_suggests('gridExtra')
127	131		gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
128	132		} else {
129	133		return(myplots)

99	93
100	94
101	95		formatl <- function(x) {
102		-	x %>%
103		-	format(nsmall = 2) %>%
104		-	format(width = 20, justify = "left")
	96	+	return(format(format(x, nsmall = 2), width = 20, justify = "left"))
105	97		}
106	98
107	99		formatol <- function(x, w) {

110	102
111	103
112	104		formatr <- function(x, w) {
113		-	x %>%
114		-	rounda() %>%
115		-	format(nsmall = 2, width = w, justify = "right")
	105	+	format(rounda(x), nsmall = 2, width = w, justify = "right")
116	106		}
117	107
118	108
119	109		formatc <- function(x, w) {
120	110		if (is.numeric(x)) {
121		-	ret <- x %>%
122		-	round(2) %>%
123		-	as.character(x) %>%
124		-	format(width = w, justify = "centre")
	111	+	ret <- format(as.character(round(x, 2)), width = w, justify = "centre")
125	112		} else {
126		-	ret <- x %>%
127		-	as.character(x) %>%
128		-	format(width = w, justify = "centre")
	113	+	ret <- format(as.character(x), width = w, justify = "centre")
129	114		}
130	115		return(ret)
131	116		}
132	117
133	118
134	119		formatnc <- function(x, w) {
135		-	x %>%
136		-	round(2) %>%
137		-	format(nsmall = 2) %>%
138		-	format(width = w, justify = "centre")
	120	+	format(format(round(x, 2), nsmall = 2), width = w, justify = "centre")
139	121		}
140	122
141	123

235	217		seql <- function(mean, sd) {
236	218		lmin <- mean - (5 * sd)
237	219		lmax <- mean + (5 * sd)
238		-	l <- seq(lmin, lmax, sd)
	220	+	l <- seq(lmin, lmax, sd)
239	221		return(l)
240	222		}
241	223
242	224		xmm <- function(mean, sd) {
243	225		xmin <- mean - (5 * sd)
244	226		xmax <- mean + (5 * sd)
245		-	out <- c(xmin, xmax)
	227	+	out <- c(xmin, xmax)
246	228		return(out)
247	229		}
248	230

284	266		}
285	267
286	268		string_to_name <- function(x, index = 1) {
287		-	x %>%
288		-	magrittr::use_series(varnames) %>%
289		-	magrittr::extract(index) %>%
290		-	rlang::sym()
	269	+	rlang::sym(x$varnames[index])
291	270		}
292	271
293	272		#' @importFrom utils packageVersion menu install.packages

31	31		#' @examples
32	32		#' # screen data
33	33		#' ds_screener(mtcarz)
	34	+	#' ds_screener(airquality)
	35	+	#'
	36	+	#' # plot
	37	+	#' x <- ds_screener(airquality)
	38	+	#' plot(x)
34	39		#'
35	40		#' @export
36	41		#'

45	50		rows <- nrow(data)
46	51		cols <- ncol(data)
47	52		varnames <- names(data)
48		-	datatype <- purrr::map_chr(data, class)
49		-	counts <- purrr::map_int(data, length)
50		-	nlev <- purrr::map(data, nlevels)
51		-	lev <- purrr::map(data, levels)
	53	+	datatype <- sapply(data, class)
	54	+	counts <- sapply(data, length)
	55	+	nlev <- lapply(data, nlevels)
	56	+	lev <- lapply(data, levels)
52	57
53	58		for (i in seq_len(length(lev))) {
54	59		if (is.null(lev[[i]])) {

56	61		}
57	62		}
58	63
59		-	mvalues <- purrr::map_int(data, function(z) sum(is.na(z)))
60		-
61		-	mvaluesper <-
62		-	mvalues %>%
63		-	magrittr::divide_by(counts) %>%
64		-	magrittr::multiply_by(100) %>%
65		-	round(2)
66		-
67		-	mtotal <-
68		-	data %>%
69		-	is.na() %>%
70		-	sum()
71		-
72		-	mtotalper <-
73		-	mtotal %>%
74		-	magrittr::divide_by(sum(counts)) %>%
75		-	magrittr::multiply_by(100) %>%
76		-	round(2)
77		-
78		-	mrows <-
79		-	data %>%
80		-	stats::complete.cases() %>%
81		-	`!` %>%
82		-	sum()
83		-
84		-	mcols <- sum(mvalues != 0)
	64	+	mvalues <- sapply(data, function(z) sum(is.na(z)))
	65	+	mvaluesper <- round((mvalues / counts) * 100, 2)
	66	+	mtotal <- sum(is.na(data))
	67	+	mtotalper <- round((mtotal / sum(counts)) * 100, 2)
	68	+	mrows <- sum(!stats::complete.cases(data))
	69	+	mcols <- sum(mvalues != 0)
85	70
86	71		result <- list(Rows = rows,
87	72		Columns = cols,

107	92		print_screen(x)
108	93		}
109	94
110		-
111		-
112	95		#' @rdname ds_screener
113	96		#' @export
114	97		#'
115	98		plot.ds_screener <- function(x, ...) {
116	99
117		-	dat <- x$MissingPer
118		-	ymax <- max(dat) * 1.5
119		-	cols <- c("green", "red")[(dat > 10) + 1]
120		-
121		-	h <- graphics::barplot(dat,
122		-	main = "Missing Values (%)",
123		-	xlab = "Column Names",
124		-	ylab = "Percentage",
125		-	col = cols,
126		-	ylim = c(0, ymax))
127		-
128		-	graphics::legend("top",
129		-	legend = c("> 10%", "<= 10%"),
130		-	fill = c("red", "green"),
131		-	horiz = TRUE,
132		-	title = "% Missing",
133		-	cex = 0.5,
134		-	text.width = 0.7)
135		-
136		-	line_data <- cbind(h, as.vector(dat))
137		-	graphics::text(line_data[, 1], line_data[, 2] + 2, as.vector(dat))
	100	+	`% Missing` <- NULL
	101	+	mydat <- data.frame(x = names(x$MissingPer), y = x$MissingPer)
	102	+	mydat$y <- mydat$y / 100
	103	+	mydat$color <- ifelse(mydat$y >= 0.1, ">= 10%", "< 10%")
	104	+	names(mydat) <- c("x", "y", "% Missing")
	105	+
	106	+	ggplot2::ggplot(mydat) +
	107	+	ggplot2::geom_col(ggplot2::aes(x = stats::reorder(x, y), y = y, fill = `% Missing`)) +
	108	+	ggplot2::scale_y_continuous(labels = scales::percent_format()) +
	109	+	ggplot2::xlab("Column") + ggplot2::ylab("Percentage") +
	110	+	ggplot2::ggtitle("Missing Values (%)") +
	111	+	ggplot2::scale_fill_manual(values = c("green", "red"))
138	112
139	113		}

39	39		num_var <- names(plot_data)
40	40
41	41		for (i in num_var) {
42		-	cat(cli::rule(center = paste0('Variable: ', i),
43		-	width = options()$width))
	42	+
	43	+	ds_rule(paste0('Variable: ', i))
44	44		cat('\n\n')
45		-	cat(cli::rule(center = paste0('Summary Statistics'),
46		-	width = options()$width))
	45	+	ds_rule(paste0('Summary Statistics'))
47	46		cat('\n\n')
48	47		print(ds_summary_stats(data, i))
49	48		cat('\n\n')
50		-	cat(cli::rule(center = paste0('Frequency Distribution'),
51		-	width = options()$width))
	49	+	ds_rule(paste0('Frequency Distribution'))
52	50		cat('\n\n')
53	51		print(ds_freq_table(data, i))
54	52		cat('\n\n\n')
55	53		}
	54	+
56	55		}
57	56
58	57		#' Tabulation

9	9		#' ds_summary_stats(mtcarz, mpg)
10	10		#'
11	11		#' @importFrom rlang !!
	12	+	#' @importFrom stats na.omit
12	13		#'
13		-	#' @seealso \code{\link[base]{summary}}
	14	+	#' @seealso \code{\link[base]{summary}}
14	15		#' \code{\link{ds_freq_table}} \code{\link{ds_cross_table}}
15	16		#'
16	17		#' @export
17	18		#'
18	19		ds_summary_stats <- function(data, ...) {
19		-
	20	+
20	21		check_df(data)
21		-
	22	+
22	23		var <- rlang::quos(...)
23		-
	24	+
24	25		if (length(var) < 1) {
25	26		is_num <- sapply(data, is.numeric)
26	27		if (!any(is_num == TRUE)) {

33	34		is_num <- sapply(data, is.numeric)
34	35		if (!any(is_num == TRUE)) {
35	36		rlang::abort("Data has no continuous variables.")
36		-	}
	37	+	}
37	38		}
38		-
	39	+
39	40		col_names <- names(data)
40	41		for (i in col_names) {
41		-	cat(cli::rule(center = paste0('Variable: ', i),
42		-	width = options()$width))
	42	+	ds_rule(paste0('Variable: ', i))
43	43		cat('\n\n')
44	44		print(ds_summary(data, i))
45	45		cat('\n\n\n')
46	46		}
47		-
48		-	}
49		-
50	47
	48	+	}
51	49
52	50		ds_summary <- function(data, variable) UseMethod("ds_summary")
53	51

63	61		sdata <-
64	62		data %>%
65	63		dplyr::pull(!! vary) %>%
66		-	stats::na.omit()
	64	+	na.omit()
67	65
68	66		low <- ds_tailobs(sdata, 5, "low")
69	67		high <- ds_tailobs(sdata, 5, "high")

85	83		median = stats::median(sdata),
86	84		mode = ds_mode(sdata),
87	85		range = ds_range(sdata),
88		-	min = min(sdata),
	86	+	min = min(sdata),
89	87		Max = max(sdata),
90	88		iqrange = stats::IQR(sdata),
91	89		per99 = stats::quantile(sdata, 0.99),

57	57		ggplot2::ggplot(data = plot_data) +
58	58		ggplot2::geom_point(ggplot2::aes(x = !! rlang::sym(x), y = !! rlang::sym(y)))
59	59		myplots[[i]] <- p
	60	+	names(myplots)[[i]] <- paste(y, "v", x)
60	61		}
61	62
62	63		if (print_plot) {
	64	+	check_suggests('gridExtra')
63	65		gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
64	66		} else {
65	67		return(myplots)

183	187		ggplot2::ggplot(data = plot_data) +
184	188		ggplot2::geom_density(ggplot2::aes(x = !! rlang::sym(x)), color = color)
185	189		myplots[[i]] <- p
	190	+	names(myplots)[[i]] <- x
186	191		}
187	192
188	193		if (print_plot) {
	194	+	check_suggests('gridExtra')
189	195		gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
190	196		} else {
191	197		return(myplots)

244	250		ggplot2::ggplot(data = plot_data) +
245	251		ggplot2::geom_bar(ggplot2::aes(x = !! rlang::sym(x)), fill = fill)
246	252		myplots[[i]] <- p
	253	+	names(myplots)[[i]] <- x
247	254		}
248	255
249	256		if (print_plot) {
	257	+	check_suggests('gridExtra')
250	258		gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
251	259		} else {
252	260		return(myplots)

306	314		ggplot2::geom_boxplot(ggplot2::aes(x = factor(1), y = !! rlang::sym(x))) +
307	315		ggplot2::labs(x = ' ')
308	316		myplots[[i]] <- p
	317	+	names(myplots)[[i]] <- x
309	318		}
310	319
311	320		if (print_plot) {
	321	+	check_suggests('gridExtra')
312	322		gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
313	323		} else {
314	324		return(myplots)

442	454		ggplot2::geom_bar(ggplot2::aes(x = !! rlang::sym(x), fill = !! rlang::sym(y)),
443	455		position = 'dodge')
444	456		myplots[[i]] <- p
	457	+	names(myplots)[[i]] <- paste(y, "v", x)
445	458		}
446	459
447	460		if (print_plot) {
	461	+	check_suggests('gridExtra')
448	462		gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
449	463		} else {
450	464		return(myplots)

519	533		ggplot2::ggplot(data = plot_data) +
520	534		ggplot2::geom_boxplot(ggplot2::aes(x = !! rlang::sym(x), y = !! rlang::sym(y)))
521	535		myplots[[i]] <- p
	536	+	names(myplots)[[i]] <- paste(y, "v", x)
522	537		}
523	538
524	539		if (print_plot) {
	540	+	check_suggests('gridExtra')
525	541		gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
526	542		} else {
527	543		return(myplots)

93	93		tidystats <-
94	94		data %>%
95	95		dplyr::select(!! g_var, !! c_var) %>%
96		-	tidyr::drop_na() %>%
	96	+	na.omit() %>%
97	97		dplyr::group_by(!! g_var) %>%
98	98		dplyr::summarise(length = length(!! c_var), min = min(!! c_var),
99	99		max = max(!! c_var), mean = mean(!! c_var),