R Under development (unstable) (2024-10-14 r87233 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > 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> > > ################################################################################ > 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 8.60 0.62 9.17