rsquaredacademy / descriptr
1
print_stats <- function(data) {
2 1
  n <- nchar(format(data$uss, nsmall = 2))
3 1
  width1 <- 52 + (2 * n)
4 1
  width2 <- as.integer(width1 / 2)
5 1
  width3 <- width2 - 5
6 1
  width4 <- width2 - 2
7

8 1
  col1 <- max(nchar(as.character(data$lowobs)))
9 1
  col2 <- max(nchar(as.character(data$highobs)))
10 1
  col3 <- max(nchar(as.character(data$lowobsi)))
11 1
  col4 <- max(nchar(as.character(data$highobsi)))
12 1
  v <- nchar("Value")
13 1
  ol <- max(col1, col2, col3, col4, v)
14 1
  gap <- width4 - (2 * ol)
15

16 1
  cat(
17 1
    formatc("Univariate Analysis", width1), "\n\n",
18 1
    formatl("N"), formatr(data$obs, n), formats(),
19 1
    formatl("Variance"), formatr(data$variance, n), "\n",
20 1
    formatl("Missing"), formatr(data$missing, n), formats(),
21 1
    formatl("Std Deviation"), formatr(data$stdev, n), "\n",
22 1
    formatl("Mean"), formatr(data$avg, n), formats(),
23 1
    formatl("Range"), formatr(data$range, n), "\n",
24 1
    formatl("Median"), formatr(data$median, n), formats(),
25 1
    formatl("Interquartile Range"), formatr(data$iqrange, n), "\n",
26 1
    formatl("Mode"), formatr(data$mode, n), formats(),
27 1
    formatl("Uncorrected SS"), formatr(data$uss, n), "\n",
28 1
    formatl("Trimmed Mean"), formatr(data$tavg, n), formats(),
29 1
    formatl("Corrected SS"), formatr(data$css, n), "\n",
30 1
    formatl("Skewness"), formatr(data$skew, n), formats(),
31 1
    formatl("Coeff Variation"), formatr(data$cvar, n), "\n",
32 1
    formatl("Kurtosis"), formatr(data$kurtosis, n), formats(),
33 1
    formatl("Std Error Mean"), formatr(data$sem, n), "\n\n",
34 1
    formatc("Quantiles", width1), "\n\n",
35 1
    formatc("Quantile", width2), formatc("Value", width2), "\n\n",
36 1
    formatc("Max       ", width2), formatnc(data$Max, width2), "\n",
37 1
    formatc("99%       ", width2), formatnc(data$per99, width2), "\n",
38 1
    formatc("95%       ", width2), formatnc(data$per95, width2), "\n",
39 1
    formatc("90%       ", width2), formatnc(data$per90, width2), "\n",
40 1
    formatc("Q3        ", width2), formatnc(data$per75, width2), "\n",
41 1
    formatc("Median    ", width2), formatnc(data$median, width2), "\n",
42 1
    formatc("Q1        ", width2), formatnc(data$per25, width2), "\n",
43 1
    formatc("10%       ", width2), formatnc(data$per10, width2), "\n",
44 1
    formatc("5%        ", width2), formatnc(data$per5, width2), "\n",
45 1
    formatc("1%        ", width2), formatnc(data$per1, width2), "\n",
46 1
    formatc("Min       ", width2), formatnc(data$min, width2), "\n\n",
47 1
    formatc("Extreme Values", width1), "\n\n",
48 1
    formatc("Low", width2), formatc("High", width2), "\n\n",
49 1
    formatol("Obs", ol), format_gap(gap), formatol("Value", ol), formats(),
50 1
    formatol("Obs", ol), format_gap(gap), formatol("Value", ol), "\n"
51
  )
52 1
  for (i in seq_len(5)) {
53 1
    cat(
54 1
      "", formatol(data$lowobsi[i], ol), format_gap(gap), formatol(data$lowobs[i], ol), formats(),
55 1
      formatol(data$highobsi[i], ol), format_gap(gap), formatol(data$highobs[i], ol), "\n"
56
    )
57
  }
58
}
59

60
print_cross <- function(data) {
61 1
  p <- length(data$utility$var2_levels)
62 1
  q <- p + 2
63 1
  h <- p + 1
64 1
  r <- (h * 15) - 3
65 1
  f <- length(data$utility$var1_levels)
66 1
  g <- f + 2
67 1
  h <- p + 1
68

69 1
  col_names <- c(data$utility$varnames[1], data$utility$var2_levels, "Row Total")
70 1
  col_totals <- c("Column Total", data$utility$column_totals, data$utility$obs)
71

72 1
  cat(
73 1
    formatter("    Cell Contents\n"), "|---------------|\n", "|", formatter("Frequency"),
74 1
    "|\n", "|", formatter("Percent"), "|\n", "|", formatter("Row Pct"), "|\n",
75 1
    "|", formatter("Col Pct"), "|\n", "|---------------|\n\n", "Total Observations: ",
76 1
    data$utility$obs, "\n\n"
77
  )
78 1
  cat("-", rep("---------------", q), sep = "")
79 1
  cat("\n")
80 1
  cat(
81 1
    "|              |", format(data$utility$varnames[2], width = r, justify = "centre"),
82
    "|"
83
  )
84 1
  cat("\n")
85 1
  cat("-", rep("---------------", q), sep = "")
86 1
  cat("\n|")
87 1
  for (i in seq_along(col_names)) {
88 1
    cat(formatter(col_names[i]), "|")
89
  }
90 1
  cat("\n-", rep("---------------", q), sep = "")
91 1
  cat("\n")
92

93 1
  for (i in seq_len(f)) {
94 1
    cat("|")
95 1
    for (j in seq_len(q)) {
96 1
      cat(formatter(data$utility$twowaytable[i, j]), "|")
97
    }
98 1
    cat("\n")
99 1
    cat("|              |")
100 1
    for (j in seq_len(p)) {
101 1
      cat(formatter(data$utility$percent_table[i, j]), "|")
102
    }
103 1
    cat("              |")
104 1
    cat("\n")
105 1
    cat("|              |")
106 1
    for (j in seq_len(h)) {
107 1
      cat(formatter(data$utility$row_percent[i, j]), "|")
108
    }
109 1
    cat("\n")
110 1
    cat("|              |")
111 1
    for (j in seq_len(p)) {
112 1
      cat(formatter(data$utility$column_percent[i, j]), "|")
113
    }
114 1
    cat("              |")
115 1
    cat("\n-", rep("---------------", q), sep = "")
116 1
    cat("\n")
117
  }
118 1
  cat("|")
119 1
  for (i in seq_along(col_totals)) {
120 1
    cat(formatter(col_totals[i]), "|")
121
  }
122 1
  cat("\n")
123 1
  cat("|              |")
124 1
  for (i in seq_along(data$utility$percent_column)) {
125 1
    cat(formatter(data$utility$percent_column[i]), "|")
126
  }
127 1
  cat("              |")
128 1
  cat("\n-", rep("---------------", q), sep = "")
129 1
  cat("\n")
130
}
131

132

133
print_cross2 <- function(data) {
134

135
  # output formatting
136 1
  p <- length(data$variable_levels)
137 1
  q <- p + 2
138 1
  h <- p + 1
139 1
  r <- (h * 15) - 3
140 1
  f <- length(data$row_name)
141 1
  g <- f + 2
142 1
  h <- p + 1
143 1
  tu <- q * 15
144

145 1
  cat(format(paste(data$variable_names[1], "vs", data$variable_names[2]), width = tu, justify = "centre"), "\n")
146 1
  cat("-", rep("---------------", q), sep = "")
147 1
  cat("\n")
148 1
  cat("|              |", format(data$variable_names[2], width = r, justify = "centre"), "|")
149 1
  cat("\n")
150 1
  cat("-", rep("---------------", q), sep = "")
151 1
  cat("\n|")
152 1
  for (i in seq_along(data$column_names)) {
153 1
    cat(formatter(data$column_names[i]), "|")
154
  }
155 1
  cat("\n-", rep("---------------", q), sep = "")
156 1
  cat("\n")
157

158 1
  for (i in seq_len(f)) {
159 1
    cat("|")
160 1
    for (j in seq_len(q)) {
161 1
      cat(formatter(data$twowaytable[i, j]), "|")
162
    }
163 1
    cat("\n")
164 1
    cat("|              |")
165 1
    for (j in seq_len(p)) {
166 1
      cat(formatter(data$percent_table[i, j]), "|")
167
    }
168 1
    cat("              |")
169 1
    cat("\n")
170 1
    cat("|              |")
171 1
    for (j in seq_len(h)) {
172 1
      cat(formatter(data$row_percent[i, j]), "|")
173
    }
174 1
    cat("\n")
175 1
    cat("|              |")
176 1
    for (j in seq_len(p)) {
177 1
      cat(formatter(data$column_percent[i, j]), "|")
178
    }
179 1
    cat("              |")
180 1
    cat("\n-", rep("---------------", q), sep = "")
181 1
    cat("\n")
182
  }
183 1
  cat("|")
184 1
  for (i in seq_along(data$column_totals)) {
185 1
    cat(formatter(data$column_totals[i]), "|")
186
  }
187 1
  cat("\n")
188 1
  cat("|              |")
189 1
  for (i in seq_along(data$percent_column)) {
190 1
    cat(formatter(data$percent_column[i]), "|")
191
  }
192 1
  cat("              |")
193 1
  cat("\n-", rep("---------------", q), sep = "")
194 1
  cat("\n\n\n")
195
}
196

197

198
print_screen <- function(x) {
199 1
  columns <- c("  Column Name  ", "  Data Type  ", "  Levels  ", "  Missing  ", "  Missing (%)  ")
200 1
  len_col <- as.vector(sapply(columns, nchar))
201 1
  xlev <- lapply(x$levels, paste, collapse = " ") %>%
202 1
    lapply(nchar) %>%
203 1
    unlist() %>%
204 1
    max()
205
  # If there are several classes, join them into one string:
206 1
  x$Types <- lapply(x$Types, paste, collapse = ", ")
207 1
  lengths <- list(x$Variables, x$Types, xlev, x$Missing, x$MissingPer)
208 1
  n <- length(columns)
209 1
  nlist <- list()
210 1
  for (i in seq_len(n)) {
211 1
    nlist[[i]] <- max(len_col[i], max(sapply(lengths[[i]], nchar)))
212
  }
213 1
  clengths <- unlist(nlist)
214 1
  clengths[3] <- max(10, xlev)
215 1
  dash <- sum(clengths) + 6
216 1
  cat(rep("-", dash), sep = "")
217 1
  cat("\n|")
218 1
  for (i in seq_len(n)) {
219 1
    cat(format(columns[i], width = clengths[i], justify = "centre"), "|", sep = "")
220
  }
221 1
  cat("\n", rep("-", dash), sep = "")
222 1
  cat("\n")
223 1
  for (i in seq_len(x$Columns)) {
224 1
    cat(
225 1
      "|", format(x$Variables[i], width = clengths[1], justify = "centre"), "|",
226 1
      format(x$Types[i], width = clengths[2], justify = "centre"), "|",
227 1
      format(paste(x$levels[[i]], collapse = " "), width = clengths[3], justify = "centre"), "|",
228 1
      format(as.character(x$Missing[i]), width = clengths[4], justify = "centre"), "|",
229 1
      format(as.character(x$MissingPer[i]), width = clengths[5], justify = "centre"), "|\n", sep = ""
230
    )
231
  }
232 1
  cat(rep("-", dash), sep = "")
233 1
  cat("\n\n")
234 1
  cat(
235 1
    " Overall Missing Values          ", x$MissingTotal, "\n", "Percentage of Missing Values    ", x$MissingTotPer, "%\n",
236 1
    "Rows with Missing Values        ", x$MissingRows, "\n", "Columns With Missing Values     ", x$MissingCols, "\n"
237
  )
238
}
239

240

241
print_fcont <- function(data) {
242

243 1
  blen <-
244 1
    data %>%
245 1
    use_series(utility) %>%
246 1
    use_series(breaks) %>%
247 1
    nchar() %>%
248 1
    max()
249

250 1
  blen2 <-
251 1
    blen %>%
252 1
    multiply_by(2) %>%
253 1
    add(4)
254

255 1
  flen <-
256 1
    data %>%
257 1
    use_series(utility) %>%
258 1
    use_series(frequency) %>%
259 1
    nchar() %>%
260 1
    max() %>%
261 1
    max(9)
262

263 1
  clen <-
264 1
    data %>%
265 1
    use_series(utility) %>%
266 1
    use_series(cumulative) %>%
267 1
    nchar() %>%
268 1
    max() %>%
269 1
    max(13)
270

271 1
  total <- blen2 + flen + clen + 39
272 1
  dash <- total - 2
273

274 1
  col_names <- c("Bins", " Frequency", " Cum Frequency", " Percent", " Cum Percent")
275 1
  col_widths <- c(blen2, flen, clen, 13, 13)
276 1
  len_names <- 5
277

278 1
  cat(format(paste("Variable:", data$utility$varname), width = total, justify = "centre"), "\n")
279 1
  cat("|")
280 1
  cat(rep("-", dash), sep = "")
281 1
  cat("|\n")
282 1
  cat("|")
283 1
  for (i in seq_len(len_names)) {
284 1
    cat(format(col_names[i], width = col_widths[i], justify = "centre"), "|", sep = " ")
285
  }
286 1
  cat("\n|")
287 1
  cat(rep("-", dash), sep = "")
288 1
  cat("|")
289 1
  for (i in seq_len(data$utility$bins)) {
290 1
    k <- i + 1
291 1
    cat(
292 1
      "\n|", formata(data$utility$breaks[i], 1, blen), "-", formata(data$utility$breaks[k], 1, blen), "|",
293 1
      formata(data$utility$frequency[i], 2, flen), "|", formata(data$utility$cumulative[i], 2, clen), "|",
294 1
      formata(data$utility$percent[i], 2, 12), "|", formata(data$utility$cum_percent[i], 2, 12), "|"
295
    )
296 1
    cat("\n|")
297 1
    cat(rep("-", dash), sep = "")
298 1
    cat("|")
299
  }
300 1
  cat("\n")
301 1
  nlen <- blen * 2 + 4
302 1
  if (data$utility$na_count > 0) {
303 0
    na_percent <- format((data$utility$na_count / data$utility$n) * 100, nsmall = 2)
304 0
    cat("|", format("Missing", width = nlen, justify = "centre"))
305 0
    cat("|", format(as.character(round(data$utility$na_count, 2)), width = flen, justify = "centre"))
306 0
    cat(" |",  format("-", width = clen, justify = "centre"))
307 0
    cat(" |", format(as.character(na_percent), width = 12, justify = "centre"))
308 0
    cat(" |", format("-", width = 12, justify = "centre"))
309 0
    cat(" |")
310 0
    cat("\n|")
311 0
    cat(rep("-", dash), sep = "")
312 0
    cat("|\n")
313
  }
314 1
  cat("|", format("Total", width = nlen, justify = "centre"))
315 1
  cat("|", format(as.character(data$utility$n), width = flen, justify = "centre"))
316 1
  cat(" |",  format("-", width = clen, justify = "centre"))
317 1
  cat(" |", format("100.00", width = 12, justify = "centre"))
318 1
  cat(" |", format("-", width = 12, justify = "centre"))
319 1
  cat(" |")
320 1
  cat("\n|")
321 1
  cat(rep("-", dash), sep = "")
322 1
  cat("|")
323
}
324

325

326
print_ftable <- function(x) {
327 1
  nr <- nrow(x$ftable)
328 1
  nc <- ncol(x$ftable)
329 1
  w1 <- max(nchar("Levels"), nchar(x$ftable$Levels), nchar("Missing"))
330 1
  w2 <- max(nchar("Frequency"), nchar(x$ftable$Frequency), nchar(x$utility$na_count))
331 1
  w3 <- max(nchar("Cum Frequency"), nchar(x$ftable$`Cum Frequency`))
332 1
  w <- sum(w1, w2, w3, 26, 16)
333 1
  cat(format(paste("Variable:", x$utility$varname), width = w, justify = "centre"), "\n")
334 1
  cat(rep("-", w), sep = "")
335 1
  cat("\n")
336 1
  cat(format("Levels", width = w1, justify = "centre"), fs(),
337 1
      format("Frequency", width = w2, justify = "centre"), fs(),
338 1
      format("Cum Frequency", width = w3, justify = "centre"), fs(),
339 1
      format("Percent", width = 13, justify = "centre"), fs(),
340 1
      format("Cum Percent", width = 13, justify = "centre"), "\n")
341 1
  cat(rep("-", w), sep = "")
342 1
  for (i in seq_len(nr)) {
343 1
    cat("\n")
344 1
    cat(format(as.character(x$ftable$Levels[i]), width = w1, justify = "centre"), fs(),
345 1
      format(as.character(x$ftable$Frequency[i]), width = w2, justify = "centre"), fs(),
346 1
      format(as.character(x$ftable$`Cum Frequency`[i]), width = w3, justify = "centre"), fs(),
347 1
      format(as.character(x$ftable$Percent[i]), width = 13, justify = "centre"), fs(),
348 1
      format(as.character(x$ftable$`Cum Percent`[i]), width = 13, justify = "centre")
349
    )
350 1
    cat("\n")
351 1
    cat(rep("-", w), sep = "")
352
  }
353 1
  cat("\n")
354 1
  if (x$utility$na_count > 0) {
355 0
    na_percent <- format((x$utility$na_count / x$n) * 100, nsmall = 2)
356 0
    cat(format("Missing", width = w1, justify = "centre"), fs(),
357 0
        format(as.character(x$utility$na_count), width = w2, justify = "centre"), fs(),
358 0
        format("-", width = w3, justify = "centre"), fs(),
359 0
        format(as.character(na_percent), width = 13, justify = "centre"), fs(),
360 0
        format("-", width = 13, justify = "centre"))
361 0
    cat("\n")
362 0
    cat(rep("-", w), sep = "")
363 0
    cat("\n")
364
  }
365 1
  cat(format("Total", width = w1, justify = "centre"), fs(),
366 1
      format(as.character(x$utility$n), width = w2, justify = "centre"), fs(),
367 1
      format("-", width = w3, justify = "centre"), fs(),
368 1
      format("100.00", width = 13, justify = "centre"), fs(),
369 1
      format("-", width = 13, justify = "centre"))
370 1
  cat("\n")
371 1
  cat(rep("-", w), sep = "")
372 1
  cat("\n\n")
373
}
374

375

376
print_ftable2 <- function(x) {
377 1
  nr <- nrow(x$ftable)
378 1
  nc <- ncol(x$ftable)
379 1
  w1 <- max(nchar("Levels"), nchar(x$ftable$Levels), nchar("Missing"))
380 1
  w2 <- max(nchar("Frequency"), nchar(x$ftable$Frequency), nchar(x$na_count))
381 1
  w3 <- max(nchar("Cum Frequency"), nchar(x$ftable$`Cum Frequency`))
382 1
  w <- sum(w1, w2, w3, 26, 16)
383 1
  cat(format(paste("Variable:", x$varname), width = w, justify = "centre"), "\n")
384 1
  cat(rep("-", w), sep = "")
385 1
  cat("\n")
386 1
  cat(format("Levels", width = w1, justify = "centre"), fs(),
387 1
      format("Frequency", width = w2, justify = "centre"), fs(),
388 1
      format("Cum Frequency", width = w3, justify = "centre"), fs(),
389 1
      format("Percent", width = 13, justify = "centre"), fs(),
390 1
      format("Cum Percent", width = 13, justify = "centre"), "\n")
391 1
  cat(rep("-", w), sep = "")
392 1
  for (i in seq_len(nr)) {
393 1
    cat("\n")
394 1
    cat(format(as.character(x$ftable$Levels[i]), width = w1, justify = "centre"), fs(),
395 1
        format(as.character(x$ftable$Frequency[i]), width = w2, justify = "centre"), fs(),
396 1
        format(as.character(x$ftable$`Cum Frequency`[i]), width = w3, justify = "centre"), fs(),
397 1
        format(as.character(x$ftable$Percent[i]), width = 13, justify = "centre"), fs(),
398 1
        format(as.character(x$ftable$`Cum Percent`[i]), width = 13, justify = "centre")
399
    )
400 1
    cat("\n")
401 1
    cat(rep("-", w), sep = "")
402
  }
403 1
  cat("\n")
404 1
  if (x$na_count > 0) {
405 0
    na_percent <- format((x$na_count / x$n) * 100, nsmall = 2)
406 0
    cat(format("Missing", width = w1, justify = "centre"), fs(),
407 0
        format(as.character(x$na_count), width = w2, justify = "centre"), fs(),
408 0
        format("-", width = w3, justify = "centre"), fs(),
409 0
        format(as.character(na_percent), width = 13, justify = "centre"), fs(),
410 0
        format("-", width = 13, justify = "centre"))
411 0
    cat("\n")
412 0
    cat(rep("-", w), sep = "")
413 0
    cat("\n")
414
  }
415 1
  cat(format("Total", width = w1, justify = "centre"), fs(),
416 1
      format(as.character(x$n), width = w2, justify = "centre"), fs(),
417 1
      format("-", width = w3, justify = "centre"), fs(),
418 1
      format("100.00", width = 13, justify = "centre"), fs(),
419 1
      format("-", width = 13, justify = "centre"))
420 1
  cat("\n")
421 1
  cat(rep("-", w), sep = "")
422 1
  cat("\n\n")
423
}
424

425

426
print_group <- function(data) {
427 1
  line <- 23
428 1
  n <- 21
429 1
  n_names <- max(nchar(data$stats[2, c(-1)]))
430 1
  n_uss <- max(nchar(data$stats[12, c(-1)]))
431 1
  w <- max(n_names, n_uss) + 2
432 1
  cola <- ncol(data$stats)
433 1
  col <- cola - 1
434 1
  ow <- 23 * cola - col
435 1
  row <- nrow(data$stats)
436

437 1
  cat(format(paste(data$yvar, "by", data$xvar), width = ow, justify = "centre"), "\n")
438 1
  cat(rep("-", ow), sep = "", "\n")
439 1
  cat("|")
440 1
  for (i in seq_len(cola)) {
441 1
    cat(format(colnames(data$stats)[i], width = n, justify = "right"), "|", sep = "")
442
  }
443 1
  cat("\n")
444 1
  cat(rep("-", ow), sep = "", "\n")
445 1
  for (i in seq_len(row)) {
446 1
    cat("|")
447 1
    for (j in seq_len(cola)) {
448 1
      cat(format(data$stats[i, j], width = n, justify = "right"), "|", sep = "")
449
    }
450 1
    cat("\n")
451
  }
452 1
  cat(rep("-", ow), sep = "", "\n")
453
}

Read our documentation on viewing source code .

Loading