Showing 12 of 83 files from the diff.
Other files ignored by Codecov
README.md has changed.
docs/index.html has changed.
man/mtcarz.Rd has changed.
man/ds_gmean.Rd has changed.
docs/authors.html has changed.
man/ds_cvar.Rd has changed.
man/ds_range.Rd has changed.
R/dist-binomial.R was deleted.
.Rbuildignore has changed.
R/dist-t.R was deleted.
man/ds_css.Rd has changed.
man/ds_mdev.Rd has changed.
docs/CONDUCT.html has changed.
man/descriptr.Rd has changed.
man/hsb.Rd has changed.
NAMESPACE has changed.
appveyor.yml was deleted.
man/ds_hmean.Rd has changed.
man/ds_rindex.Rd has changed.
README.Rmd has changed.
R/dist-f.R was deleted.
R/dist-normal.R was deleted.
DESCRIPTION has changed.
codecov.yml has changed.
man/dist_t.Rd was deleted.
NEWS.md has changed.
.travis.yml was deleted.

@@ -23,29 +23,23 @@
Loading
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
    ) %>%

@@ -32,7 +32,7 @@
Loading
32 32
  }
33 33
34 34
  data %>%
35 -
    tidyr::drop_na() %>%
35 +
    na.omit() %>%
36 36
    tidyr::gather(var, values) %>%
37 37
    dplyr::group_by(var) %>%
38 38
    dplyr::summarise_all(list(mean      = mean,
@@ -76,7 +76,7 @@
Loading
76 76
  }
77 77
78 78
  data %>%
79 -
    tidyr::drop_na() %>%
79 +
    na.omit() %>%
80 80
    tidyr::gather(var, values) %>%
81 81
    dplyr::group_by(var) %>%
82 82
    dplyr::summarise_all(list(range     = ds_range,
@@ -120,7 +120,7 @@
Loading
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(
@@ -164,7 +164,7 @@
Loading
164 164
  }
165 165
166 166
  data %>%
167 -
    tidyr::drop_na() %>%
167 +
    na.omit() %>%
168 168
    tidyr::gather(var, values) %>%
169 169
    dplyr::group_by(var) %>%
170 170
    dplyr::summarise_all(
@@ -206,7 +206,7 @@
Loading
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,58 +269,70 @@
Loading
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,55 +376,71 @@
Loading
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,29 +449,36 @@
Loading
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,85 +486,104 @@
Loading
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
@@ -537,8 +591,6 @@
Loading
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,7 +617,7 @@
Loading
565 617
    out <- c(out, k)
566 618
  }
567 619
568 -
  return(unique(out))
620 +
  unique(out)
569 621
570 622
}
571 623

@@ -4,15 +4,10 @@
Loading
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,9 +11,7 @@
Loading
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,7 +167,7 @@
Loading
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,7 +179,7 @@
Loading
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,7 +187,7 @@
Loading
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,26 +1,20 @@
Loading
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,8 +58,8 @@
Loading
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
}
@@ -99,9 +93,7 @@
Loading
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,32 +102,22 @@
Loading
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,14 +217,14 @@
Loading
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
@@ -250,7 +232,7 @@
Loading
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,7 +240,7 @@
Loading
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
@@ -284,10 +266,7 @@
Loading
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
@@ -343,3 +322,11 @@
Loading
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 @@
Loading
34 34
  }
35 35
36 36
  data %>%
37 -
    tidyr::drop_na() %>%
37 +
    na.omit() %>%
38 38
    tidyr::gather(vars, values) %>%
39 39
    dplyr::group_by(vars) %>%
40 40
    dplyr::summarise_all(

@@ -31,6 +31,11 @@
Loading
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,10 +50,10 @@
Loading
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,32 +61,12 @@
Loading
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,33 +92,22 @@
Loading
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,20 +39,19 @@
Loading
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,18 +9,19 @@
Loading
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,21 +34,18 @@
Loading
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,7 +61,7 @@
Loading
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,7 +83,7 @@
Loading
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,9 +57,11 @@
Loading
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)
@@ -121,9 +123,11 @@
Loading
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)
@@ -183,9 +187,11 @@
Loading
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,9 +250,11 @@
Loading
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,9 +314,11 @@
Loading
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)
@@ -374,9 +384,11 @@
Loading
374 384
      ggplot2::ggplot(data = plot_data) +
375 385
      ggplot2::geom_bar(ggplot2::aes(x = !! rlang::sym(x), fill = !! rlang::sym(y)))
376 386
    myplots[[i]] <- p
387 +
    names(myplots)[[i]] <- paste(y, "v", x)
377 388
  }
378 389
379 390
  if (print_plot) {
391 +
    check_suggests('gridExtra')
380 392
    gridExtra::marrangeGrob(myplots, nrow = 2, ncol = 2)
381 393
  } else {
382 394
    return(myplots)
@@ -442,9 +454,11 @@
Loading
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,9 +533,11 @@
Loading
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,7 +93,7 @@
Loading
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),
Files Coverage
R 90.98%
Project Totals (19 files) 90.98%
Notifications are pending CI completion. Waiting for GitHub's status webhook to queue notifications. Push notifications now.
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
        informational: true
10
    patch:
11
      default:
12
        target: auto
13
        threshold: 1%
14
        informational: true
Sunburst
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.
Icicle
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.
Grid
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.
Loading