rsquaredacademy / descriptr
1
ds_freq_factor <- function(data, variable) {
2

3 1
  check_df(data)
4 1
  var_name <- deparse(substitute(variable))
5 1
  varyable <- rlang::enquo(variable)
6 1
  check_factor(data, !! varyable, var_name)
7

8 1
  fdata <-
9 1
    data %>%
10 1
    dplyr::pull(!! varyable) %>%
11 1
    na.omit()
12

13 1
  var_name <-
14 1
    data %>%
15 1
    dplyr::select(!! varyable) %>%
16 1
    names()
17

18 1
  cq <-
19 1
    fdata %>%
20 1
    sort() %>%
21 1
    unique()
22

23 1
  result <-
24 1
    fdata %>%
25 1
    table() %>%
26 1
    as.vector()
27

28 1
  level_names <- levels(fdata)
29 1
  data_len    <- length(fdata)
30 1
  len         <- length(result)
31 1
  cum         <- cumsum(result)
32 1
  per         <- percent(result, data_len)
33 1
  cum_per     <- percent(cum, data_len)
34

35 1
  ftable <- tibble::tibble(
36 1
    Levels          = level_names,
37 1
    Frequency       = result,
38 1
    `Cum Frequency` = cum,
39 1
    Percent         = per,
40 1
    `Cum Percent`   = cum_per
41
  )
42

43 1
  na_count <-
44 1
    data %>%
45 1
    dplyr::pull(!! varyable) %>%
46 1
    is.na() %>%
47 1
    sum()
48

49 1
  n_obs <-
50 1
    data %>%
51 1
    dplyr::pull(!! varyable) %>%
52 1
    length()
53

54 1
  if (na_count > 0) {
55 0
    na_data <- dplyr::pull(data, !! varyable)
56

57 0
    var_count <-
58 0
      na_data %>%
59 0
      table() %>%
60 0
      as.vector() %>%
61 0
      sum()
62

63 0
    na_freq <- n_obs - var_count
64
  } else {
65 1
    na_freq <- 0
66
  }
67

68 1
  utility <- list(varname  = var_name,
69 1
                  data     = data,
70 1
                  na_count = na_freq,
71 1
                  n        = n_obs)
72

73 1
  result <- list(
74 1
    ftable  = ftable,
75 1
    utility = utility
76
  )
77

78 1
  return(result)
79
}
80

81

82
plot_ds_freq_factor <- function(x, ...) {
83

84 1
  x_lab <-
85 1
    x %>%
86 1
    use_series(utility) %>%
87 1
    use_series(varname) %>%
88 1
    extract(1)
89

90 1
  k <-
91 1
    x %>%
92 1
    use_series(utility) %>%
93 1
    use_series(varname) %>%
94 1
    extract(1) %>%
95 1
    rlang::sym()
96

97 1
  p <-
98 1
    x %>%
99 1
    use_series(utility) %>%
100 1
    use_series(data) %>%
101 1
    dplyr::select(x = !! k) %>%
102 1
    ggplot() +
103 1
    geom_bar(aes(x = x), fill = "blue") +
104 1
    xlab(x_lab) + ylab("Count") +
105 1
    ggtitle(paste("Bar plot of", x_lab))
106

107 1
  return(p)
108

109
}

Read our documentation on viewing source code .

Loading