rsquaredacademy / descriptr
1 1
freq_table2 <- function(data, name) UseMethod("freq_table2")
2

3
freq_table2.default <- function(data, name) {
4

5 1
  var_name <- name
6

7 1
  dat <-
8 1
    data %>%
9 1
    dplyr::select(name) %>%
10 1
    dplyr::pull(1) %>%
11 1
    na.omit()
12

13 1
  if (!is.factor(dat)) {
14 0
    stop("Data must be categorical/qualitative.", call. = FALSE)
15
  }
16

17 1
  cq          <- unique(sort(dat))
18 1
  result      <- as.vector(table(dat))
19 1
  level_names <- levels(dat)
20 1
  data_len    <- length(dat)
21 1
  len         <- length(result)
22 1
  cum         <- cumsum(result)
23 1
  per         <- percent(result, data_len)
24 1
  cum_per     <- percent(cum, data_len)
25

26 1
  ftable <- tibble::tibble(
27 1
    Levels          = level_names,
28 1
    Frequency       = result,
29 1
    `Cum Frequency` = cum,
30 1
    Percent         = per,
31 1
    `Cum Percent`   = cum_per
32
  )
33

34 1
  na_count <-
35 1
    data %>%
36 1
    dplyr::pull(name) %>%
37 1
    is.na() %>%
38 1
    sum()
39

40 1
  n_obs <-
41 1
    data %>%
42 1
    dplyr::pull(name) %>%
43 1
    length()
44

45 1
  if (na_count > 0) {
46 0
    na_data <- dplyr::pull(data, !! varyable)
47

48 0
    var_count <-
49 0
      na_data %>%
50 0
      table() %>%
51 0
      as.vector() %>%
52 0
      sum()
53

54 0
    na_freq <- n_obs - var_count
55
  } else {
56 1
    na_freq <- 0
57
  }
58

59 1
  result <- list(
60 1
    ftable   = ftable,
61 1
    varname  = var_name,
62 1
    na_count = na_freq,
63 1
    n        = n_obs
64
  )
65

66 1
  class(result) <- "freq_table2"
67 1
  return(result)
68
}
69

70

71
print.freq_table2 <- function(x, ...) {
72 1
  print_ftable2(x)
73
}

Read our documentation on viewing source code .

Loading