Running 'test-confusion_matrix.R' [0s]
  Running 'test-datasets.R' [1s]
  Running 'test-extract.R' [164s]
  Running 'test-file-check.R' [1s]
  Running 'test-frmt.R' [0s]
  Running 'test-frmtp.R' [0s]
  Running 'test-gmean_sd.R' [0s]
  Running 'test-lazyload.R' [1s]
  Running 'test-ll.R' [0s]
  Running 'test-logit.R' [154s]
  Running 'test-mean_ci.R' [163s]
  Running 'test-mean_sd.R' [167s]
  Running 'test-mean_se.R' [152s]
  Running 'test-median_iqr.R' [176s]
  Running 'test-n_perc.R' [169s]
  Running 'test-pkg_check.R' [0s]
  Running 'test-plots.R' [185s]
  Running 'test-qable.R' [152s]
  Running 'test-qkplot.R' [171s]
  Running 'test-qroc.R' [155s]
  Running 'test-set_diff.R' [0s]
  Running 'test-spin_comments.R' [0s]
  Running 'test-summary_table.R' [167s]
  Running 'test-traprule.R' [0s]
  Running 'test-utilities.R' [0s]
Running the tests in 'tests/test-extract.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > fit <- lm(mpg ~ wt + hp + drat, data = mtcars)
  > 
  > stopifnot(extract_fstat(fit) == "$F_{3, 28} = 47.88$")
  > stopifnot(extract_fpvalue(fit) == "$P < 0.0001$")
  > 
  > proc.time()
     user  system elapsed 
     0.29    0.06    0.34 
Running the tests in 'tests/test-logit.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > set.seed(42)
  > p <- runif(100)
  > 
  > stopifnot(all.equal(logit(p), log(p/(1-p))))
  > stopifnot(all.equal(invlogit(log(p/(1-p))), p))
  > 
  > x <- seq(-3, 3, length = 1001)
  > stopifnot(all.equal(invlogit(x), plogis(x)))
  > 
  > x <- seq(sqrt(.Machine$double.eps),  1 - sqrt(.Machine$double.eps), length = 1001)
  > stopifnot(all.equal(logit(x), qlogis(x)))
  > 
  > proc.time()
     user  system elapsed 
     0.29    0.09    0.37 
Running the tests in 'tests/test-mean_ci.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > # simple ci
  > stopifnot(
  +   all.equal(
  +               unclass(mean_ci(mtcars$mpg))
  +             ,
  +               c(mean(mtcars$mpg),
  +                 mean(mtcars$mpg) + qnorm(0.025)*sd(mtcars$mpg)/sqrt(nrow(mtcars)),
  +                 mean(mtcars$mpg) + qnorm(0.975)*sd(mtcars$mpg)/sqrt(nrow(mtcars)))
  +             , check.attributes = FALSE
  +   )
  + )
  > 
  > # Printing nicely
  > out <- capture.output(print(mean_ci(mtcars$mpg)))
  > stopifnot(grepl("20\\.09 \\(18\\.00, 22\\.18\\)", out))
  > 
  > out <- capture.output(print(mean_ci(mtcars$mpg), show_level = TRUE))
  > stopifnot(grepl("20.09 \\(95% CI: 18\\.00, 22.18\\)", out))
  > 
  > out <- capture.output(print(mean_ci(mtcars$mpg, alpha = 0.01), show_level = TRUE))
  > stopifnot(grepl("20.09 \\(99% CI: 17\\.35, 22\\.83\\)", out))
  > 
  > # Compare to the ci that comes form t.test
  > stopifnot(
  +           all.equal(
  +             t.test(mtcars$mpg)$conf.int,
  +             mean_ci(mtcars$mpg, qdist = stats::qt, qdist.args = list(df = 31))[2:3],
  +             check.attributes = FALSE
  +           ))
  > 
  > # simple ci with missing data
  > x <- mtcars$mpg
  > x[c(12, 14)] <- NA
  > 
  > stopifnot(
  +           all.equal(unclass(mean_ci(x, na_rm = TRUE)),
  +                     c(mean(x, na.rm = TRUE),
  +                       mean(x, na.rm = TRUE) + qnorm(0.025)*sd(x, na.rm = TRUE)/sqrt(sum(!is.na(x))),
  +                       mean(x, na.rm = TRUE) + qnorm(0.975)*sd(x, na.rm = TRUE)/sqrt(sum(!is.na(x))))
  +                     , check.attributes = FALSE)
  + )
  > 
  > # warnings
  > stopifnot(inherits(tryCatch(mean_ci(mtcars$mpg, na.rm = TRUE), warning = function(w) w), "warning"))
  > 
  > # errors
  > stopifnot(inherits(tryCatch(mean_ci(mtcars$mpg, transform = "exp"), error = function(e) e), "error"))
  > 
  > proc.time()
     user  system elapsed 
     0.31    0.04    0.34 
Running the tests in 'tests/test-mean_sd.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > m <- mean(mtcars$mpg)
  > s <- sd(mtcars$mpg)
  > 
  > # basic formatting
  > stopifnot(
  +   identical(
  +     mean_sd(mtcars$mpg) # should default to LaTeX markup
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " $\\pm$ " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_sd(mtcars$mpg, denote_sd = "paren")
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " (" %s% qwraps2::frmt(s, digits = 2) %s% ")"
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_sd(mtcars$mpg, markup = "markdown")
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_sd(mtcars$mpg, show_n = "always", markup = "markdown")
  +     ,
  +     qwraps2::frmt(nrow(mtcars)) %s% "; " %s% qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_sd(c(mtcars$mpg,NA), na_rm = TRUE, show_n = "always", markup = "markdown")
  +     ,
  +     qwraps2::frmt(nrow(mtcars)) %s% "; " %s% qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_sd(c(mtcars$mpg, NA), na_rm = TRUE, show_n = "never", markup = "markdown")
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > 
  > # error if show_n is not as expected
  > stopifnot(inherits(tryCatch(mean_sd(mtcars$mpg, show_n = TRUE), error = function(e) e), "error"))
  > 
  > # warning if na.rm is used instead of na_rm
  > stopifnot(inherits(tryCatch(mean_sd(mtcars$mpg, na.rm = TRUE), warning = function(w) w), "warning"))
  > 
  > proc.time()
     user  system elapsed 
     0.29    0.06    0.34 
Running the tests in 'tests/test-mean_se.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > m <- mean(mtcars$mpg)
  > s <- sd(mtcars$mpg) / sqrt(nrow(mtcars))
  > 
  > # basic formatting
  > stopifnot(
  +   identical(
  +     mean_se(mtcars$mpg) # should default to LaTeX markup
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " $\\pm$ " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_se(mtcars$mpg, denote_sd = "paren")
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " (" %s% qwraps2::frmt(s, digits = 2) %s% ")"
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_se(mtcars$mpg, markup = "markdown")
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_se(mtcars$mpg, show_n = "always", markup = "markdown")
  +     ,
  +     qwraps2::frmt(nrow(mtcars)) %s% "; " %s% qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_se(c(mtcars$mpg,NA), na_rm = TRUE, show_n = "always", markup = "markdown")
  +     ,
  +     qwraps2::frmt(nrow(mtcars)) %s% "; " %s% qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > stopifnot(
  +   identical(
  +     mean_se(c(mtcars$mpg, NA), na_rm = TRUE, show_n = "never", markup = "markdown")
  +     ,
  +     qwraps2::frmt(m, digits = 2) %s% " &plusmn; " %s% qwraps2::frmt(s, digits = 2)
  +   )
  + )
  > 
  > # error if show_n is not as expected
  > stopifnot(inherits(tryCatch(mean_se(mtcars$mpg, show_n = TRUE), error = function(e) e), "error"))
  > 
  > # warning if na.rm is used instead of na_rm
  > stopifnot(inherits(tryCatch(mean_se(mtcars$mpg, na.rm = TRUE), warning = function(w) w), "warning"))
  > 
  > proc.time()
     user  system elapsed 
     0.31    0.04    0.34 
Running the tests in 'tests/test-median_iqr.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > # basic formatting
  > stopifnot(identical(median_iqr(mtcars$mpg), "19.20 (15.43, 22.80)"))
  > 
  > # warning given if show_n is not as expected
  > stopifnot(inherits(tryCatch(median_iqr(mtcars$mpg, show_n = TRUE), error = function(e) e), "error"))
  > 
  > # show n with no missing data
  > mpg <- mtcars$mpg
  > stopifnot(identical(median_iqr(mpg, show_n = "always"), paste0(nrow(mtcars), "; 19.20 (15.43, 22.80)")))
  > stopifnot(identical(median_iqr(mpg, show_n = "ifNA"), "19.20 (15.43, 22.80)"))
  > stopifnot(identical(median_iqr(mpg, show_n = "never"), "19.20 (15.43, 22.80)"))
  > 
  > # show n with missing data
  > mpg[c(3, 12)] <- NA_real_
  > 
  > stopifnot(identical(median_iqr(mpg, show_n = "always", na_rm = TRUE), paste0(nrow(mtcars) - 2, "; 19.20 (15.27, 22.48)")))
  > stopifnot(identical(median_iqr(mpg, show_n = "ifNA", na_rm = TRUE), "30; 19.20 (15.27, 22.48)"))
  > stopifnot(identical(median_iqr(mpg, show_n = "never", na_rm = TRUE), "19.20 (15.27, 22.48)"))
  > 
  > # non logical na_rm errors
  > x <- c(1, NA, 2:10)
  > stopifnot(inherits(tryCatch(median_iqr(x, na_rm = "Yes"), error = function(e) e, warning = function(w) w), "error"))
  > stopifnot(inherits(tryCatch(median_iqr(x, na.rm = "Yes"), error = function(e) e, warning = function(w) w), "warning"))
  > stopifnot(inherits(tryCatch(suppressWarnings(median_iqr(x, na.rm = "Yes")), error = function(e) e), "error"))
  > 
  > # missing value will result in an error
  > x <- c(1, NA, 2:10)
  > stopifnot(inherits(tryCatch(median_iqr(x), error = function(e) e, warning = function(w) w), "error"))
  > 
  > 
  > proc.time()
     user  system elapsed 
     0.29    0.06    0.35 
Running the tests in 'tests/test-n_perc.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > # basic formatting
  > stopifnot(identical(n_perc(mtcars2$cyl == 6),  "7 (21.88\\%)"))
  > stopifnot(identical(n_perc0(mtcars2$cyl == 6), "7 (22)"))
  > stopifnot(identical(perc_n(mtcars2$cyl == 6), paste0("21.88\\% (n = ", nrow(mtcars2), ")")))
  > 
  > # errors with bad arguments
  > stopifnot(inherits(tryCatch(n_perc(mtcars2$cyl), error = function(e) e), "error"))
  > stopifnot(inherits(tryCatch(n_perc(mtcars2$cyl == 6, na_rm = "please"), error = function(e) e), "error"))
  > stopifnot(inherits(tryCatch(n_perc(mtcars2$cyl == 6, show_denom = "please"), error = function(e) e), "error"))
  > stopifnot(inherits(tryCatch(n_perc(mtcars2$cyl == 6, show_symbol = "please"), error = function(e) e), "error"))
  > stopifnot(inherits(tryCatch(n_perc(mtcars2$cyl == 6, markup = "please"), error = function(e) e), "error"))
  > 
  > 
  > # warning if na.rm used instead of na_rm
  > stopifnot(inherits(tryCatch(n_perc(mtcars2$cyl == 6, na.rm = TRUE), warning = function(w) w), "warning"))
  > stopifnot(inherits(tryCatch(perc_n(mtcars2$cyl == 6, na.rm = TRUE), warning = function(w) w), "warning"))
  > stopifnot(inherits(tryCatch(n_perc0(mtcars2$cyl == 6, na.rm = TRUE), warning = function(w) w), "warning"))
  > 
  > # with missing data
  > x <- mtcars2$cyl == 6
  > x[c(3, 13)] <- NA
  > 
  > stopifnot(identical(n_perc(x), "NA/30 ( NA\\%)"))
  > stopifnot(identical(n_perc0(x), "NA (NA)"))
  > stopifnot(identical(perc_n(x), " NA\\% (n = 30 non-missing)"))
  > 
  > stopifnot(identical(n_perc(x, na_rm = TRUE), "7/30 (23.33\\%)"))
  > stopifnot(identical(n_perc0(x, na_rm = TRUE), "7 (23)"))
  > stopifnot(identical(perc_n(x, na_rm = TRUE), "23.33\\% (n = 30 non-missing)"))
  > 
  > stopifnot(identical(n_perc(x, na_rm = TRUE, show_denom = "never"), "7 (23.33\\%)"))
  > stopifnot(identical(n_perc0(x, na_rm = TRUE, show_denom = "never"), "7 (23)"))
  > stopifnot(identical(perc_n(x, na_rm = TRUE, show_denom = "never"), "23.33\\% (n = 30 non-missing)"))
  > 
  > stopifnot(identical(n_perc(x, na_rm = TRUE, show_denom = "always"), "7/30 (23.33\\%)"))
  > stopifnot(identical(n_perc0(x, na_rm = TRUE, show_denom = "always"), "7/30 (23)"))
  > stopifnot(identical(perc_n(x, na_rm = TRUE, show_denom = "always"), "23.33\\% (n = 30 non-missing)"))
  > 
  > stopifnot(identical(n_perc(x, na_rm = TRUE, show_denom = "ifNA"), "7/30 (23.33\\%)"))
  > stopifnot(identical(n_perc0(x, na_rm = TRUE, show_denom = "ifNA"), "7/30 (23)"))
  > stopifnot(identical(perc_n(x, na_rm = TRUE, show_denom = "ifNA"), "23.33\\% (n = 30 non-missing)"))
  > 
  > # show denom with no missing data
  > x <- mtcars2$cyl == 6
  > 
  > stopifnot(identical(n_perc(mtcars2$cyl == 6, show_denom = "always"),  "7/32 (21.88\\%)"))
  > stopifnot(identical(n_perc0(mtcars2$cyl == 6, show_denom = "always"), "7/32 (22)"))
  > stopifnot(identical(perc_n(mtcars2$cyl == 6, show_denom = "always"), paste0("21.88\\% (n = ", nrow(mtcars2), " non-missing)")))
  > 
  > 
  > proc.time()
     user  system elapsed 
     0.29    0.03    0.31 
Running the tests in 'tests/test-plots.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > # it is very difficult to build good tests for plots as the rendered plot needs
  > # to viewed by a human.  These tests are just to make sure that the underlying
  > # code is generating the same basic thing.  A human inspection of the examples
  > # and vignettes is highly recommended.
  > #
  > # This testing script can be thought of as a sneaky way to get the examples for
  > # plots into the code coverage based on only tests.
  > 
  > ################################################################################
  > #                                extract legend                                #
  > e <- new.env()
  > example("ggplot2_extract_legend", local = e, ask = FALSE)
  
  ggp2__> # a simple plot
  ggp2__> my_plot <-
  ggp2__+   ggplot2::ggplot(mtcars) +
  ggp2__+   ggplot2::aes(x = wt, y = mpg, color = wt, shape = factor(cyl)) +
  ggp2__+   ggplot2::geom_point()
  
  ggp2__> my_plot
  
  ggp2__> # extract the legend.  the return object is a list with two elements, the first
  ggp2__> # element is the legend, the second is the original plot sans legend.
  ggp2__> temp <- ggplot2_extract_legend(my_plot)
  
  ggp2__> # view just the legend.  This can be done via a call to the object or using
  ggp2__> # plot or print.
  ggp2__> temp
  
  ggp2__> plot(temp[[1]])
  
  ggp2__> # the original plot without the legened
  ggp2__> plot(temp[[2]])
  > ls(envir = e)
  [1] "my_plot" "temp"   
  > 
  > stopifnot(identical(names(e$temp), c("legend", "plot")))
  > 
  > ################################################################################
  > e_qacf <- new.env()
  > example("qacf", local = e_qacf, ask = FALSE)
  
  qacf> # Generate a random data set
  qacf> set.seed(42)
  
  qacf> n <- 250
  
  qacf> x1 <- x2 <- x3 <- x4 <- vector('numeric', length = n)
  
  qacf> x1[1] <- runif(1)
  
  qacf> x2[1] <- runif(1)
  
  qacf> x3[1] <- runif(1)
  
  qacf> x4[1] <- runif(1)
  
  qacf> # white noise
  qacf> Z_1 <- rnorm(n, 0, 1)
  
  qacf> Z_2 <- rnorm(n, 0, 2)
  
  qacf> Z_3 <- rnorm(n, 0, 5)
  
  qacf> for(i in 2:n)
  qacf+ {
  qacf+   x1[i] <- x1[i-1] + Z_1[i] - Z_1[i-1] + x4[i-1] - x2[i-1]
  qacf+   x2[i] <- x2[i-1] - 2 * Z_2[i] + Z_2[i-1] - x4[i-1]
  qacf+   x3[i] <- x3[i-1] + x2[i-1] + 0.2 * Z_3[i] + Z_3[i-1]
  qacf+   x4[i] <- x4[i-1] + runif(1, 0.5, 1.5) * x4[i-1]
  qacf+ }
  
  qacf> testdf <- data.frame(x1, x2, x3, x4)
  
  qacf> # qacf plot for one variable
  qacf> qacf(testdf$x1)
  
  qacf> qacf(testdf$x1, show_sig = TRUE)
  
  qacf> # more than one variable
  qacf> qacf(testdf)
  
  qacf> qacf(testdf, show_sig = TRUE)
  > 
  > ################################################################################
  > e_qroc <- new.env()
  > example("qroc", local = e_qroc, ask = FALSE)
  
  qroc> #########################################################
  qroc> # Example 1
  qroc> 
  qroc> df <-
  qroc+   data.frame(
  qroc+       truth = c(1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0)
  qroc+     , pred  = c(1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 0)
  qroc+   )
  
  qroc> cm <- confusion_matrix(df$truth, df$pred)
  
  qroc> qroc(cm)
  
  qroc> qprc(cm)
  
  qroc> #########################################################
  qroc> # Getting a ROC or PRC plot from a glm object:
  qroc> 
  qroc> mod <- glm(
  qroc+   formula = spam ~ word_freq_our + word_freq_over + capital_run_length_total
  qroc+ , data = spambase
  qroc+ , family = binomial()
  qroc+ )
  
  qroc> qroc(mod)
  
  qroc> qprc(mod)
  
  qroc> #########################################################
  qroc> # View the vignette for more examples
  qroc> ## Not run: 
  qroc> ##D vignette("qwraps2-graphics")
  qroc> ## End(Not run)
  qroc> 
  qroc> 
  qroc> 
  qroc> 
  Warning messages:
  1: In ggplot2::geom_segment(ggplot2::aes(x = 0, y = 0, xend = 1, yend = 1),  :
    All aesthetics have length 1, but the data has 4 rows.
  ℹ Did you mean to use `annotate()`?
  2: In ggplot2::geom_segment(ggplot2::aes(x = 0, y = 0, xend = 1, yend = 1),  :
    All aesthetics have length 1, but the data has 2235 rows.
  ℹ Did you mean to use `annotate()`?
  > 
  > ################################################################################
  > e_qkmp <- new.env()
  > example("qkmplot", local = e_qkmp, ask = FALSE)
  
  qkmplt> require(survival)
  Loading required package: survival
  
  qkmplt> leukemia.surv <- survival::survfit(survival::Surv(time, status) ~ x, data = survival::aml)
  
  qkmplt> qkmplot(leukemia.surv, conf_int = TRUE)
  
  qkmplt> qkmplot_bulid_data_frame(leukemia.surv)
     time n.risk n.event n.censor       surv     upper      lower          strata
  2     0     11       0        0 1.00000000 1.0000000 1.00000000    x=Maintained
  3     9     11       1        0 0.90909091 1.0000000 0.75413385    x=Maintained
  4    13     10       1        1 0.81818182 1.0000000 0.61924899    x=Maintained
  5    18      8       1        0 0.71590909 1.0000000 0.48842629    x=Maintained
  6    23      7       1        0 0.61363636 0.9991576 0.37686706    x=Maintained
  7    28      6       0        1 0.61363636 0.9991576 0.37686706    x=Maintained
  8    31      5       1        0 0.49090909 0.9455850 0.25485995    x=Maintained
  9    34      4       1        0 0.36818182 0.8752607 0.15487712    x=Maintained
  10   45      3       0        1 0.36818182 0.8752607 0.15487712    x=Maintained
  11   48      2       1        0 0.18409091 0.9435258 0.03591790    x=Maintained
  12  161      1       0        1 0.18409091 0.9435258 0.03591790    x=Maintained
  1     0     12       0        0 1.00000000 1.0000000 1.00000000 x=Nonmaintained
  13    5     12       2        0 0.83333333 1.0000000 0.64703699 x=Nonmaintained
  14    8     10       2        0 0.66666667 0.9946254 0.44684608 x=Nonmaintained
  15   12      8       1        0 0.58333333 0.9409980 0.36161371 x=Nonmaintained
  16   16      7       0        1 0.58333333 0.9409980 0.36161371 x=Nonmaintained
  17   23      6       1        0 0.48611111 0.8833192 0.26751825 x=Nonmaintained
  18   27      5       1        0 0.38888889 0.8157357 0.18539653 x=Nonmaintained
  19   30      4       1        0 0.29166667 0.7408220 0.11483115 x=Nonmaintained
  20   33      3       1        0 0.19444444 0.6642237 0.05692155 x=Nonmaintained
  21   43      2       1        0 0.09722222 0.6195486 0.01525653 x=Nonmaintained
  22   45      1       1        0 0.00000000        NA         NA x=Nonmaintained
  
  qkmplt> qrmst(leukemia.surv) # NaN for rmst.se in Nonmaintained strata as last observation is an event
                           strata     rmst     rmtl  rmst.se tau
  x=Maintained       x=Maintained 27.79773 17.20227 4.935448  45
  x=Nonmaintained x=Nonmaintained 18.22222 26.77778      NaN  45
  
  qkmplt> qrmst(leukemia.surv, 44)
                           strata     rmst     rmtl  rmst.se tau
  x=Maintained       x=Maintained 27.42955 16.57045 4.916218  44
  x=Nonmaintained x=Nonmaintained 18.31944 25.68056 4.183813  44
  
  qkmplt> # pbc examples
  qkmplt> pbc_fit <-
  qkmplt+   survival::survfit(
  qkmplt+       formula = survival::Surv(time, status > 0) ~ trt
  qkmplt+     , data = pbc
  qkmplt+     , subset = !is.na(trt)
  qkmplt+   )
  
  qkmplt> qkmplot(pbc_fit)
  
  qkmplt> qkmplot(pbc_fit, conf_int = TRUE)
  
  qkmplt> qrmst(pbc_fit)
        strata     rmst     rmtl  rmst.se  tau
  trt=1  trt=1 2755.835 1767.165 138.3484 4523
  trt=2  trt=2 2811.100 1711.900 142.7538 4523
  
  qkmplt> qrmst(pbc_fit)
        strata     rmst     rmtl  rmst.se  tau
  trt=1  trt=1 2755.835 1767.165 138.3484 4523
  trt=2  trt=2 2811.100 1711.900 142.7538 4523
  Warning message:
  Removed 1 row containing non-finite outside the scale range
  (`stat_step_ribbon()`). 
  > 
  > ################################################################################
  > e_qba <- new.env()
  > example("qblandaltman", local = e_qba, ask = FALSE)
  
  qblndl> data(pefr)
  
  qblndl> pefr_m1 <-
  qblndl+   cbind("Large" = pefr[pefr$measurement == 1 & pefr$meter == "Wright peak flow meter", "pefr"],
  qblndl+         "Mini"  = pefr[pefr$measurement == 1 & pefr$meter == "Mini Wright peak flow meter", "pefr"])
  
  qblndl> # The Bland Altman plot plots the average value on the x-axis and the
  qblndl> # difference in the measurements on the y-axis:
  qblndl> qblandaltman(pefr_m1) +
  qblndl+   ggplot2::xlim(0, 800) +
  qblndl+   ggplot2::ylim(-100, 100) +
  qblndl+   ggplot2::xlab("Average of two meters") +
  qblndl+   ggplot2::ylab("Difference in the measurements")
  > 
  > ################################################################################
  > #                                 End of File                                  #
  > ################################################################################
  > 
  > proc.time()
     user  system elapsed 
    13.07    1.29   14.35 
Running the tests in 'tests/test-qable.R' failed.
Complete output:
  > library(qwraps2)
  > set.seed(42)
  > 
  > ################################################################################
  > # testing attributes
  > x <- qable(mtcars2[, c("mpg", "disp")], markup = "latex")
  > stopifnot(
  +   identical(
  +     attributes(x)
  +     ,
  +     list(dim = c(32L, 3L), dimnames = list(NULL, c("", "mpg", "disp")), class = "qwraps2_qable", qable_args = list(rtitle = "", rgroup = numeric(0), rnames = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31", "32"), cnames = c("", "mpg", "disp"), markup = "latex", kable_args = list()))
  +   )
  + )
  > 
  > ################################################################################
  > # simple output tests
  > output_latex <- capture.output(print(qable(mtcars2, markup = "latex")))
  > output_markdown <- capture.output(print(qable(mtcars2, markup = "markdown")))
  > 
  > # simple print test
  > stopifnot(any(grepl("142E\\ \\&\\ 21\\.4", output_latex)))
  > stopifnot(any(grepl("142E\\ +\\|21\\.4", output_markdown)))
  > 
  > # error for unexpected markup language
  > test <- tryCatch(qable(mtcars2, markup = "rts"), error = function(e) e)
  > stopifnot(inherits(test, "error"))
  > 
  > 
  > # rtitle
  > out <- capture.output(print(qable(mtcars[1, ], rtitle = "user defined rtitle")))
  > stopifnot(grepl("^user\\ defined\\ rtitle", out[4]))
  > out <- capture.output(print(qable(mtcars[1, ], markup = "markdown", rtitle = "user defined rtitle")))
  > stopifnot(grepl("^\\|user\\ defined\\ rtitle", out[3]))
  > 
  > # rgroups
  > make <- sub("^(\\w+)\\s?(.*)$", "\\1", rownames(mtcars))
  > make <- c(table(make))
  > output <- capture.output(print(qable(mtcars[sort(rownames(mtcars)), ], rgroup = make)))
  > 
  > any(grepl("\\\\bf\\{Volvo\\}\\ \\&\\ ~", output))
  [1] TRUE
  > any(grepl("~~\\ Volvo\\ 142E\\ \\&\\ 21\\.4", output))
  [1] TRUE
  > 
  > output <- capture.output(print(qable(mtcars[sort(rownames(mtcars)), ], rgroup = make, markup = "markdown")))
  > 
  > stopifnot(any(grepl("\\*\\*\\Volvo\\*\\*", output)))
  > stopifnot(any(grepl("\\&nbsp;\\&nbsp;\\ Volvo", output)))
  > 
  > ################################################################################
  > # Test cbind
  > qtab_1 <- qable(mtcars[sort(rownames(mtcars)), c("mpg", "cyl")], rgroup = make, kable_args = list(caption = "1"))
  > qtab_2 <- qable(mtcars[sort(rownames(mtcars)), c("disp", "hp", "drat")], rgroup = make, kable_args = list(caption = "2"))
  > qtab_0 <- qable(mtcars[sort(rownames(mtcars)), c("mpg", "cyl", "disp", "hp", "drat")], rgroup = make, kable_args = list(caption = "1"))
  > 
  > # the number of column of each of these tables should be one more than the
  > # number of columns of the data.frame passed.  the "extra" column is the row
  > # grouping and names.
  > stopifnot(identical(ncol(qtab_1), 3L))
  > stopifnot(identical(ncol(qtab_2), 4L))
  > stopifnot(identical(ncol(qtab_0), 6L))
  > 
  > # qtab_1 and qtab_2 should join together to be identical to qtab_0
  > stopifnot(identical(cbind(qtab_1, qtab_2), qtab_0))
  > 
  > # should be able to cbind on a vector of values
  > out <- cbind(qtab_1, a_number = rnorm(nrow(qtab_1)))
  > stopifnot(identical(colnames(out), c("", "mpg", "cyl", "a_number")))
  > 
  > # should be able to cbind on a vector of values as a matrix
  > out <- cbind(qtab_1, a_number = matrix(rnorm(nrow(qtab_1)), ncol = 1))
  > stopifnot(identical(colnames(out), c("", "mpg", "cyl", "a_number")))
  > 
  > # or even another matrix
  > out <- cbind(qtab_1, a = matrix(rnorm(3 * nrow(qtab_1)), ncol = 3))
  > stopifnot(identical(colnames(out), c("", "mpg", "cyl", "a1", "a2", "a3")))
  > 
  > # error if nrows are not the same, or if a vector length is different from the
  > # nrow of the first element
  > test <-
  +   tryCatch(
  +            cbind(qtab_1, qtab_1_2, a_number = rnorm(nrow(qtab_1) - 1)),
  +            error = function(e) e)
  > stopifnot(identical(inherits(test, "simpleError"), TRUE))
  > 
  > test <-
  +   tryCatch(
  +            cbind(qtab_1, qtab_1_2[1:3, ]),
  +            error = function(e) e)
  > stopifnot(identical(inherits(test, "simpleError"), TRUE))
  > 
  > # there should be an error if the row groups are not identical
  > m <- make; names(m) <- toupper(names(m))
  > qtab_1_2 <- qable(mtcars[, c("mpg", "cyl")], rgroup = m)
  > test <- tryCatch(cbind(qtab_1, qtab_1_2), error = function(e) e)
  > stopifnot(identical(inherits(test, "simpleError"), TRUE))
  > 
  > qtab_1_3 <- qable(mtcars[, c("mpg", "cyl")], rgroup = sample(make))
  > test <- tryCatch(cbind(qtab_1, qtab_1_3), error = function(e) e)
  > stopifnot(identical(inherits(test, "simpleError"), TRUE))
  > 
  > # the attributes of the object from cbind should  be those of the first object
  > # passed in
  > stopifnot(identical(attributes(qtab_2)$qable_args$kable_args, list(caption = "2")))
  > stopifnot(identical(attributes(qtab_1)$qable_args$kable_args, list(caption = "1")))
  > stopifnot(identical(attributes(cbind(qtab_1, qtab_2))$qable_args$kable_args, list(caption = "1")))
  > stopifnot(identical(attributes(cbind(qtab_2, qtab_1))$qable_args$kable_args, list(caption = "2")))
  > 
  > ################################################################################
  > # testing rbind
  > m1 <- mtcars2[grepl("^M", mtcars2$make), ]
  > m1 <- m1[order(m1$make, m1$model), ]
  > m2 <- mtcars2[!grepl("^M", mtcars2$make), ]
  > m2 <- m2[order(m2$make, m2$model), ]
  > 
  > rg1 <- c(table(m1$make))
  > rg2 <- c(table(m2$make))
  > m <- rbind(m1, m2)
  > rg <- c(table(m$make))
  > rg <- rg[c(names(rg1), names(rg2))]
  > 
  > stopifnot(isTRUE(
  +   all.equal(
  +     rbind(qable(m1, rgroup = rg1), qable(m2, rgroup = rg2))
  +     ,
  +     qable(m, rgroup = rg)
  +     )
  +   )
  + )
  > 
  > ################################################################################
  > ##                                End of File                                 ##
  > ################################################################################
  > 
  > proc.time()
     user  system elapsed 
     0.39    0.07    0.45 
Running the tests in 'tests/test-qkplot.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > # error is non-survfit object is passed to qkmplot_bulid_data_frame
  > fit <- lm(mpg ~ wt, data = mtcars)
  > test <- tryCatch(qkmplot_bulid_data_frame(fit), error = function(e) e)
  > stopifnot(inherits(test, "error"))
  > 
  > proc.time()
     user  system elapsed 
     0.31    0.06    0.35 
Running the tests in 'tests/test-qroc.R' failed.
Complete output:
  > library(qwraps2)
  > 
  > proc.time()
     user  system elapsed 
     0.28    0.06    0.32 
Running the tests in 'tests/test-summary_table.R' failed.
Complete output:
  > library(qwraps2)
  > qs <- qsummary(mtcars2[c("cyl", "cyl_factor", "cyl_character")])
  > 
  > stopifnot(identical(qs[["cyl"]],
  +                     list("minimum"      = ~ qwraps2::frmt(min(cyl)),
  +                          "median (IQR)" = ~ qwraps2::median_iqr(cyl),
  +                          "mean (sd)"    = ~ qwraps2::mean_sd(cyl),
  +                          "maximum"      = ~ qwraps2::frmt(max(cyl)))))
  > 
  > stopifnot(identical(qs[["cyl_factor"]],
  +                   list("6 cylinders" = ~ qwraps2::n_perc(cyl_factor == "6 cylinders", digits = 0, show_symbol = FALSE),
  +                        "4 cylinders" = ~ qwraps2::n_perc(cyl_factor == "4 cylinders", digits = 0, show_symbol = FALSE),
  +                        "8 cylinders" = ~ qwraps2::n_perc(cyl_factor == "8 cylinders", digits = 0, show_symbol = FALSE))))
  > 
  > stopifnot(identical(qs[["cyl_character"]],
  +                   list("4 cylinders" = ~ qwraps2::n_perc(cyl_character == "4 cylinders", digits = 0, show_symbol = FALSE),
  +                        "6 cylinders" = ~ qwraps2::n_perc(cyl_character == "6 cylinders", digits = 0, show_symbol = FALSE),
  +                        "8 cylinders" = ~ qwraps2::n_perc(cyl_character == "8 cylinders", digits = 0, show_symbol = FALSE))))
  > 
  > # expect warnings
  > temp <- dplyr::group_by(mtcars, am, vs)
  > 
  > test <- tryCatch(summary_table(temp), warning = function(w) w)
  > stopifnot(identical(inherits(test, "warning"), TRUE) &
  +           identical(grepl("grouped_df detected", test$message), TRUE))
  > 
  > test <- tryCatch(summary_table(temp, by = "am"), warning = function(w) w)
  > stopifnot(identical(inherits(test, "warning"), TRUE) &
  +           identical(grepl("You've passed", test$message), TRUE))
  > 
  > # dplyr::group_by equivalent output
  > out1 <- capture.output(suppressWarnings(summary_table(temp)))
  > out2 <- capture.output(summary_table(mtcars, by = c("am", "vs")))
  > stopifnot(identical(out1, out2))
  > 
  > 
  > ################################################################################
  > # check the number of columns is as expected for summary tables
  > stab <- summary_table(mtcars, by = c("am", "vs"))
  > stopifnot(identical(ncol(stab), 5L))
  > 
  > stab_am <- summary_table(mtcars, by = "am")
  > stab_vs <- summary_table(mtcars, by = "vs")
  > stab_cbind <- cbind(stab_am, stab_vs)
  > stopifnot(identical(ncol(stab_am) + ncol(stab_vs) - 1L, ncol(stab_cbind)))
  > 
  > ################################################################################
  > # check that the print method will update the attributes
  > stab <- summary_table(mtcars[, c("mpg", "cyl", "am")], by = c("am"), qable_args = list(rtitle = "RTITLE"))
  > attributes(stab)
  $dim
  [1] 15  3
  
  $dimnames
  $dimnames[[1]]
  NULL
  
  $dimnames[[2]]
  [1] "RTITLE"     "0 (N = 19)" "1 (N = 13)"
  
  
  $qable_args
  $qable_args$rtitle
  [1] "RTITLE"
  
  $qable_args$rgroup
  mpg cyl  am 
    4   4   4 
  
  $qable_args$rnames
   [1] "minimum"      "median (IQR)" "mean (sd)"    "maximum"      "minimum"     
   [6] "median (IQR)" "mean (sd)"    "maximum"      "minimum"      "median (IQR)"
  [11] "mean (sd)"    "maximum"     
  
  $qable_args$cnames
  [1] "RTITLE"     "0 (N = 19)" "1 (N = 13)"
  
  $qable_args$markup
  [1] "latex"
  
  $qable_args$kable_args
  list()
  
  
  $class
  [1] "qwraps2_summary_table" "qwraps2_qable"        
  
  > 
  > 
  > ################################################################################
  > ##                                End of File                                 ##
  > ################################################################################
  > 
  > proc.time()
     user  system elapsed 
     1.56    0.18    1.75