R/see.R

In fschaffner/Xplorer: Convenient Data Exploration

#' Display Variable Details
#' @description This function displays the following details of variable:
#' \itemize{
#'  \item{attributes (i.e. useful to inspect labels)}
#'  \item{class, typeof, mode, storage.mode}
#'  \item{table (frequency and percentage of values)}
#'  \item{summary statistics}
#' }
#' See is an S3 generic and currently works with objects of class 'character', 'factor', 'numeric', 'data.frame', 'labelled', 'haven_labelled', 'POSIXct' and 'Date'.
#'
#' @param x The object to be displayed in the console.
#' @keywords see codebook
#' @import utils
#' @examples
#' see(mtcars$mpg)

# sjmisc::descr() has great inspiration: https://strengejacke.github.io/sjmisc/reference/descr.html

# NEED TO ADD A METHOD FOR CLASS LOGICAL!!!!!
# This does not work:
#> log <- c(TRUE, FALSE)
#> see(log)



#' @export
see <- function (x) {
  UseMethod("see")
}

#' @export
see.default <- function (x) {
  if (!inherits(x, "character") & !inherits(x, "factor") & !inherits(x, "numeric") &
      !inherits(x, "data.frame") & !inherits(x, "labelled")) {
    c <- class(x)
    message("see() currently features S3 generic methods for objects of class 'character', 'factor', 'numeric', 'data.frame', 'labelled', 'haven_labelled', 'POSIXct' and 'Date'. \n\n",
        deparse(substitute(x)), " is of class '", c, "'. Hence, the following output is generated by: \n\nstr(",
        deparse(substitute(x)), ")\nstructure(", deparse(substitute(x)), ")\nsummary(",
        deparse(substitute(x)), ")", sep = "");
    cat("\n"); paste(utils::str(x)); cat("\n\n"); print(structure(x)); cat("\n\n"); print(summary(x))
  }
}

#' @export
see.character <- function (x) {
  if (is.null(attributes(x))) {
    a <- data.frame("No attributes stored for this variable.")
    names(a) <- NULL
  }
  if (!is.null(attributes(x))) {
    a <- attributes(x)
  }
  Class <- class(x)
  Typeof <- typeof(x)
  Mode <- mode(x)
  Storage.mode <- storage.mode(x)
  b <- data.frame(Class, Typeof, Mode, Storage.mode)
  Frequency <- table(x)
  Percent <- round((prop.table(table(x)) * 100), digits =  2)
  c <- cbind(Frequency,Percent)
  N <- length(na.omit(x))
  Missings <- sum(is.na(x))
  Distinct.values <- length(table(x))
  d <- data.frame(N, Missings, Distinct.values)
  print(a, row.names = FALSE); cat("\n\n"); print(b, row.names = FALSE); cat("\n\n");
  print(c); cat("\n\n"); print(d, row.names = FALSE)
}

#' @export
see.factor <- function (x) {
  if (is.null(attributes(x))) {
    a <- data.frame("No attributes stored for this variable.")
    names(a) <- NULL
  }
  if (!is.null(attributes(x))) {
    a <- attributes(x)
  }
  Class <- class(x)
  Typeof <- typeof(x)
  Mode <- mode(x)
  Storage.mode <- storage.mode(x)
  b <- data.frame(Class, Typeof, Mode, Storage.mode)
  Frequency <- table(x)
  Percent <- round((prop.table(table(x)) * 100), digits =  2)
  c <- cbind(Frequency,Percent)
  N <- length(na.omit(x))
  Missings <- sum(is.na(x))
  Distinct.values <- length(table(x))
  d <- data.frame(N, Missings, Distinct.values)
  print(a, row.names = FALSE); cat("\n\n"); print(b, row.names = FALSE); cat("\n\n");
  print(c); cat("\n\n"); print(d, row.names = FALSE)
}

#' @export
see.numeric <- function(x) {
  if (is.null(attributes(x))) {
    a <- data.frame("No attributes stored for this variable.")
    names(a) <- NULL
  }
  if (!is.null(attributes(x))) {
    a <- attributes(x)
  }
  Class <- class(x)
  Typeof <- typeof(x)
  Mode <- mode(x)
  Storage.mode <- storage.mode(x)
  b <- data.frame(Class, Typeof, Mode, Storage.mode)
  Frequency <- table(x)
  Percent <- round((prop.table(table(x)) * 100), digits = 2)
  c <- cbind(Frequency,Percent)
  N <- length(na.omit(x))
  Missings <- sum(is.na(x))
  Mean <- mean(x, na.rm = TRUE)
  Median <- median(x, na.rm = TRUE)
  Std.Deviation <- sd(x, na.rm = TRUE)
  Variance <- var(x, na.rm = TRUE)
  Min <- suppressWarnings(min(x, na.rm = TRUE)) # silent = TRUE avoids warning message if min is Inf due to all values missing, but returns 1 instead of Inf!

  if (is.infinite(Min)) Min <- NA
  Max <- suppressWarnings(max(x, na.rm = TRUE))

  if (is.infinite(Max)) Max <- NA
  Distinct.values <- length(table(x))

  if (is.na(Mean) & is.na(Median)) {
    Mean <- NA
    Median <- NA
    d <- data.frame(N, Missings, Distinct.values, Min, Max, Mean, Median, Std.Deviation, Variance)    #print("Mean and Median are NA")
  }
  else if (Mean > Median) d <- data.frame(N, Missings, Distinct.values, Min, Max, Median, Mean, Std.Deviation, Variance)
  else d <- data.frame(N, Missings, Distinct.values, Min, Max, Mean, Median, Std.Deviation, Variance)

  print(a, row.names = FALSE); cat("\n\n"); print(b, row.names = FALSE); cat("\n\n");
  print(c, row.names = FALSE); cat("\n\n"); print(d, row.names = FALSE)
}

#' @export
see.data.frame <- function(x) {
  Class <- class(x)
  Typeof <- typeof(x)
  Mode <- mode(x)
  Storage.mode <- storage.mode(x)
  a <- data.frame(Class, Typeof, Mode, Storage.mode)
  Variables <- ncol(x)
  Observations <- nrow(x)
  b <- data.frame(Variables, Observations)
  c <- names(x)
  print(a, row.names = FALSE); cat("\n\n"); print(b, row.names = FALSE); cat("\n\n"); print(c, row.names = FALSE)
}

#' @export
see.labelled <- function(x) {
  if (is.character(x)) see.character(x)
  if (is.factor(x)) see.factor(x)
  if (is.numeric(x)) see.numeric(x)
  if (is.data.frame(x)) see.data.frame(x)
}

#' @export
see.haven_labelled <- function(x) {
  if (is.character(x)) see.character(x)
  if (is.factor(x)) see.factor(x)
  if (is.numeric(x)) see.numeric(x)
  if (is.data.frame(x)) see.data.frame(x)
}

#' @export
see.POSIXct <- function(x) {
  see.numeric(x)
}

#' @export
see.Date <- function(x) {
  see.numeric(x)
}

#' @export
#' @rdname see
codebook <- function(x) {
  see(x)
}