From 5654d38c9e6feefc0daa010a618bb8f13e61516f Mon Sep 17 00:00:00 2001 From: Kai Gu Date: Thu, 12 Oct 2023 17:17:59 +0800 Subject: [PATCH] make the functions relevant to mcr package refreshed --- CRAN-SUBMISSION | 3 - DESCRIPTION | 1 + NAMESPACE | 5 + R/autoplot.R | 312 +++++++++--------- R/data.R | 3 +- R/mcr.R | 46 +-- R/package.R | 1 + R/pkg_class.R | 45 --- _pkgdown.yml | 5 +- inst/WORDLIST | 13 +- man/MCR-class.Rd | 42 --- man/autoplot.Rd | 56 ++++ man/calcBias.Rd | 37 +++ man/calcium.Rd | 3 - man/getCoefficients.Rd | 28 ++ man/mcreg.Rd | 73 ++++ man/platelet.Rd | 2 +- man/printSummary.Rd | 28 ++ ...toplot-mcresult-with-default-arguments.svg | 230 +++++++++++++ ...oplot-mcresult-with-multiple-arguments.svg | 229 +++++++++++++ tests/testthat/test-autoplot.R | 58 ++-- tests/testthat/test-mcr.R | 122 +++---- vignettes/mcradds.Rmd | 22 +- 23 files changed, 971 insertions(+), 393 deletions(-) delete mode 100644 CRAN-SUBMISSION delete mode 100644 man/MCR-class.Rd create mode 100644 man/calcBias.Rd create mode 100644 man/getCoefficients.Rd create mode 100644 man/mcreg.Rd create mode 100644 man/printSummary.Rd create mode 100644 tests/testthat/_snaps/autoplot/autoplot-mcresult-with-default-arguments.svg create mode 100644 tests/testthat/_snaps/autoplot/autoplot-mcresult-with-multiple-arguments.svg diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION deleted file mode 100644 index 60e3bc2..0000000 --- a/CRAN-SUBMISSION +++ /dev/null @@ -1,3 +0,0 @@ -Version: 1.0.1 -Date: 2023-09-25 06:19:37 UTC -SHA: bb2a16330c1eb3adae209c6149ca4bc6368514c5 diff --git a/DESCRIPTION b/DESCRIPTION index 24e3989..e62818e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,6 +27,7 @@ Imports: lifecycle, magrittr, methods, + mcr, pROC, purrr, stats, diff --git a/NAMESPACE b/NAMESPACE index fb72fb6..b64965a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,18 +6,22 @@ export(VCAinference) export(anovaVCA) export(aucTest) export(blandAltman) +export(calcBias) export(cat_with_newline) export(diagTab) export(dixon_outlier) export(esd.critical) +export(getCoefficients) export(h_difference) export(h_factor) export(h_fmt_est) export(h_fmt_num) export(h_fmt_range) export(h_summarize) +export(mcreg) export(nonparRI) export(pearsonTest) +export(printSummary) export(refInterval) export(robustRI) export(size_ci_corr) @@ -31,6 +35,7 @@ exportMethods(getAccuracy) exportMethods(getOutlier) import(checkmate) import(ggplot2) +import(mcr) import(methods) importFrom(DescTools,BinomCI) importFrom(VCA,VCAinference) diff --git a/R/autoplot.R b/R/autoplot.R index 7307a2b..970f04d 100644 --- a/R/autoplot.R +++ b/R/autoplot.R @@ -297,15 +297,14 @@ setMethod( #' @param legend.digits (`integer`)\cr the number of digits after the decimal point #' in the legend. #' -#' @seealso [MCR-class] or [mcr::mcreg()] to see the regression parameters. +#' @seealso [mcr::mcreg()] to see the regression parameters. #' #' @export #' #' @examples -#' \dontrun{ #' # Using the default arguments for regression plot #' data("platelet") -#' fit <- mcreg2( +#' fit <- mcreg( #' x = platelet$Comparative, y = platelet$Candidate, #' method.reg = "Deming", method.ci = "jackknife" #' ) @@ -318,157 +317,156 @@ setMethod( #' legend.title = FALSE, #' legend.digits = 4 #' ) -#' } -# setMethod( -# f = "autoplot", -# signature = c("MCR"), -# definition = function(object, -# color = "black", -# fill = "lightgray", -# size = 1.5, -# shape = 21, -# jitter = FALSE, -# identity = TRUE, -# identity.params = list(col = "gray", linetype = "dashed"), -# reg = TRUE, -# reg.params = list(col = "blue", linetype = "solid"), -# equal.axis = FALSE, -# legend.title = TRUE, -# legend.digits = 2, -# x.nbreak = NULL, -# y.nbreak = NULL, -# x.title = NULL, -# y.title = NULL, -# main.title = NULL) { -# assert_class(object, "MCR") -# assert_character(color) -# assert_character(fill) -# assert_number(size) -# assert_int(shape) -# assert_logical(jitter) -# assert_logical(reg) -# assert_logical(identity) -# assert_logical(equal.axis) -# assert_logical(legend.title) -# assert_int(legend.digits) -# assert_int(x.nbreak, null.ok = TRUE) -# assert_int(x.nbreak, null.ok = TRUE) -# assert_subset(names(identity.params), c("col", "linetype")) -# assert_subset(names(reg.params), c("col", "linetype")) -# -# df <- object@data %>% na.omit() -# xrange <- range(df[["x"]]) -# yrange <- range(df[["y"]]) -# -# slope <- formatC(object@coef[2], format = "f", legend.digits) -# intercept <- formatC(object@coef[1], format = "f", legend.digits) -# fm_text <- paste0("Y = ", slope, " * X + ", intercept) -# -# p <- ggplot(data = df, aes(x = .data$x, y = .data$y)) -# -# if (jitter) { -# p <- p + geom_point( -# position = "jitter", color = color, fill = fill, -# size = size, shape = shape -# ) -# } else { -# p <- p + geom_point( -# color = color, fill = fill, -# size = size, shape = shape -# ) -# } -# -# if (reg) { -# p <- p + -# geom_abline( -# aes( -# slope = as.numeric(slope), intercept = as.numeric(intercept), -# linetype = fm_text, color = fm_text -# ), -# key_glyph = draw_key_path -# ) -# } -# -# if (identity) { -# p <- p + -# geom_abline( -# aes( -# slope = 1, intercept = 0, -# linetype = "Identity", color = "Identity" -# ), -# key_glyph = draw_key_path -# ) -# } -# -# legend_title <- paste0( -# object@regmeth, " RegressionFit", " (n=", nrow(object@data), ")" -# ) -# shapes <- stats::setNames( -# c( -# ifelse(is.null(reg.params[["linetype"]]), 1, reg.params[["linetype"]]), -# ifelse(is.null(identity.params[["linetype"]]), 1, identity.params[["linetype"]]) -# ), -# c(fm_text, "Identity") -# ) -# cols <- stats::setNames( -# c( -# ifelse(is.null(reg.params[["col"]]), 1, reg.params[["col"]]), -# ifelse(is.null(identity.params[["col"]]), 1, identity.params[["col"]]) -# ), -# c(fm_text, "Identity") -# ) -# p <- p + -# scale_linetype_manual( -# name = legend_title, -# values = shapes -# ) + -# scale_color_manual( -# name = legend_title, -# values = cols -# ) -# -# p <- p + ggplot2::labs( -# x = object@mnames[1], y = object@mnames[2], title = main.title -# ) -# -# if (equal.axis) { -# max_axis <- max(xrange[2] + diff(xrange) * 0.1, yrange[2] + diff(yrange) * 0.1) -# p <- p + -# scale_x_continuous( -# limits = c(0, max_axis), -# breaks = if (is.null(x.nbreak)) scales::pretty_breaks(6) else waiver(), -# n.breaks = x.nbreak -# ) + -# scale_y_continuous( -# limits = c(0, max_axis), -# breaks = if (is.null(y.nbreak)) scales::pretty_breaks(6) else waiver(), -# n.breaks = y.nbreak -# ) -# } else { -# p <- p + -# scale_x_continuous( -# limits = c(0, xrange[2] + diff(xrange) * 0.1), -# breaks = if (is.null(x.nbreak)) scales::pretty_breaks(6) else waiver(), -# n.breaks = x.nbreak -# ) + -# scale_y_continuous( -# limits = c(0, yrange[2] + diff(yrange) * 0.1), -# breaks = if (is.null(y.nbreak)) scales::pretty_breaks(6) else waiver(), -# n.breaks = y.nbreak -# ) -# } -# -# p + -# theme_light() + -# theme( -# legend.position = c(0.02, 0.98), -# legend.justification = c("left", "top"), -# legend.background = element_rect(fill = "transparent"), -# legend.title = if (!legend.title) element_blank(), -# plot.title = element_text(hjust = 0.5), -# axis.title.x = element_text(size = 12, margin = margin(c(5, 0, 0, 0))), -# axis.title.y = element_text(size = 12, margin = margin(c(0, 5, 0, 0))), -# plot.margin = margin(c(15, 15, 10, 10)) -# ) -# } -# ) +setMethod( + f = "autoplot", + signature = c("MCResult"), + definition = function(object, + color = "black", + fill = "lightgray", + size = 1.5, + shape = 21, + jitter = FALSE, + identity = TRUE, + identity.params = list(col = "gray", linetype = "dashed"), + reg = TRUE, + reg.params = list(col = "blue", linetype = "solid"), + equal.axis = FALSE, + legend.title = TRUE, + legend.digits = 2, + x.nbreak = NULL, + y.nbreak = NULL, + x.title = NULL, + y.title = NULL, + main.title = NULL) { + assert_class(object, "MCResult") + assert_character(color) + assert_character(fill) + assert_number(size) + assert_int(shape) + assert_logical(jitter) + assert_logical(reg) + assert_logical(identity) + assert_logical(equal.axis) + assert_logical(legend.title) + assert_int(legend.digits) + assert_int(x.nbreak, null.ok = TRUE) + assert_int(x.nbreak, null.ok = TRUE) + assert_subset(names(identity.params), c("col", "linetype")) + assert_subset(names(reg.params), c("col", "linetype")) + + df <- object@data %>% na.omit() + xrange <- range(df[["x"]]) + yrange <- range(df[["y"]]) + + slope <- formatC(object@glob.coef[2], format = "f", legend.digits) + intercept <- formatC(object@glob.coef[1], format = "f", legend.digits) + fm_text <- paste0("Y = ", slope, " * X + ", intercept) + + p <- ggplot(data = df, aes(x = .data$x, y = .data$y)) + + if (jitter) { + p <- p + geom_point( + position = "jitter", color = color, fill = fill, + size = size, shape = shape + ) + } else { + p <- p + geom_point( + color = color, fill = fill, + size = size, shape = shape + ) + } + + if (reg) { + p <- p + + geom_abline( + aes( + slope = as.numeric(slope), intercept = as.numeric(intercept), + linetype = fm_text, color = fm_text + ), + key_glyph = draw_key_path + ) + } + + if (identity) { + p <- p + + geom_abline( + aes( + slope = 1, intercept = 0, + linetype = "Identity", color = "Identity" + ), + key_glyph = draw_key_path + ) + } + + legend_title <- paste0( + object@regmeth, " RegressionFit", " (n=", nrow(object@data), ")" + ) + shapes <- stats::setNames( + c( + ifelse(is.null(reg.params[["linetype"]]), 1, reg.params[["linetype"]]), + ifelse(is.null(identity.params[["linetype"]]), 1, identity.params[["linetype"]]) + ), + c(fm_text, "Identity") + ) + cols <- stats::setNames( + c( + ifelse(is.null(reg.params[["col"]]), 1, reg.params[["col"]]), + ifelse(is.null(identity.params[["col"]]), 1, identity.params[["col"]]) + ), + c(fm_text, "Identity") + ) + p <- p + + scale_linetype_manual( + name = legend_title, + values = shapes + ) + + scale_color_manual( + name = legend_title, + values = cols + ) + + p <- p + ggplot2::labs( + x = object@mnames[1], y = object@mnames[2], title = main.title + ) + + if (equal.axis) { + max_axis <- max(xrange[2] + diff(xrange) * 0.1, yrange[2] + diff(yrange) * 0.1) + p <- p + + scale_x_continuous( + limits = c(0, max_axis), + breaks = if (is.null(x.nbreak)) scales::pretty_breaks(6) else waiver(), + n.breaks = x.nbreak + ) + + scale_y_continuous( + limits = c(0, max_axis), + breaks = if (is.null(y.nbreak)) scales::pretty_breaks(6) else waiver(), + n.breaks = y.nbreak + ) + } else { + p <- p + + scale_x_continuous( + limits = c(0, xrange[2] + diff(xrange) * 0.1), + breaks = if (is.null(x.nbreak)) scales::pretty_breaks(6) else waiver(), + n.breaks = x.nbreak + ) + + scale_y_continuous( + limits = c(0, yrange[2] + diff(yrange) * 0.1), + breaks = if (is.null(y.nbreak)) scales::pretty_breaks(6) else waiver(), + n.breaks = y.nbreak + ) + } + + p + + theme_light() + + theme( + legend.position = c(0.02, 0.98), + legend.justification = c("left", "top"), + legend.background = element_rect(fill = "transparent"), + legend.title = if (!legend.title) element_blank(), + plot.title = element_text(hjust = 0.5), + axis.title.x = element_text(size = 12, margin = margin(c(5, 0, 0, 0))), + axis.title.y = element_text(size = 12, margin = margin(c(0, 5, 0, 0))), + plot.margin = margin(c(15, 15, 10, 10)) + ) + } +) diff --git a/R/data.R b/R/data.R index 8108ffa..ec5b90d 100644 --- a/R/data.R +++ b/R/data.R @@ -12,7 +12,7 @@ #' \item{Candidate}{Measurements from candidate analyzer} #' } #' @source CLSI-EP09 A3 Appendix H, Table H2 is cited in this data set. -#' @seealso From `mcr` package, `creatinine` data set contains data with with serum and plasma +#' @seealso From `mcr` package, [mcr::creatinine] data set contains data with with serum and plasma #' creatinin measurements in mg/dL for each sample. "platelet" @@ -49,7 +49,6 @@ #' \item{Group}{Sex group of target subjects} #' } #' @source CLSI-EP28A3 Table 4. is cited in this data set. -#' @seealso [mcradds::platelet]. "calcium" #' Nonparametric Rank Number of Reference Interval diff --git a/R/mcr.R b/R/mcr.R index 02114ea..f6a6949 100644 --- a/R/mcr.R +++ b/R/mcr.R @@ -16,9 +16,10 @@ #' method.reg = "Deming", method.ci = "jackknife" #' ) #' printSummary(fit) -# printSummary <- function(...) { -# mcr::printSummary(...) -# } +printSummary <- function(...) { + mcr::printSummary(...) +} + # getCoefficients ---- #' Get Regression Coefficients @@ -37,9 +38,10 @@ #' method.reg = "Deming", method.ci = "jackknife" #' ) #' getCoefficients(fit) -# getCoefficients <- function(...) { -# mcr::getCoefficients(...) -# } +getCoefficients <- function(...) { + mcr::getCoefficients(...) +} + # mcreg ---- #' Comparison of Two Measurement Methods Using Regression Analysis @@ -61,30 +63,10 @@ #' ) #' printSummary(fit) #' getCoefficients(fit) -# mcreg <- function(...) { -# mcr::mcreg(...) -# } +mcreg <- function(...) { + mcr::mcreg(...) +} -#' @rdname mcreg -#' @aliases mcreg -#' -#' @export -#' @examples -#' -#' # use `MCR` class instead of `MCResult` class in `mcr` package -#' mcreg2( -#' x = platelet$Comparative, y = platelet$Candidate, -#' method.reg = "Deming", method.ci = "jackknife" -#' ) -# mcreg2 <- function(...) { -# fit <- mcr::mcreg(...) -# MCR( -# data = fit@data, -# coef = fit@glob.coef, -# mnames = fit@mnames, -# regmeth = fit@regmeth -# ) -# } # calcBias ---- #' Systematical Bias Between Reference Method and Test Method @@ -109,6 +91,6 @@ #' calcBias(fit, x.levels = c(30, 200)) #' calcBias(fit, x.levels = c(30, 200), type = "proportional") #' calcBias(fit, x.levels = c(30, 200), type = "proportional", percent = FALSE) -# calcBias <- function(...) { -# mcr::calcBias(...) -# } +calcBias <- function(...) { + mcr::calcBias(...) +} diff --git a/R/package.R b/R/package.R index 1cfa590..b4057aa 100644 --- a/R/package.R +++ b/R/package.R @@ -7,6 +7,7 @@ #' @import checkmate #' @import ggplot2 #' @import methods +#' @import mcr #' @importFrom stats qt na.omit terms qnorm uniroot complete.cases #' quantile setNames pnorm cor.test median as.formula #' @importFrom purrr map_chr diff --git a/R/pkg_class.R b/R/pkg_class.R index aff8feb..8963949 100644 --- a/R/pkg_class.R +++ b/R/pkg_class.R @@ -272,48 +272,3 @@ tpROC <- function(testROC, refROC, method, H0, stat) { testROC = testROC, refROC = refROC, method = method, H0 = H0, stat = stat ) } - -# MCR-class ---- - -#' Method Comparison Regression Class -#' -#' @description `r lifecycle::badge("experimental")` -#' -#' The `MCR` class serves as a simplified version of `MCResult` from `mcr` package. -#' As the `mcr` package are not available in CRAN, this class is took as the temporary -#' replacement of it, which only contains the some necessaries for `autoplot`. -#' -#' @slot data data -#' @slot coef coef -#' @slot mnames mnames -#' @slot regmeth regmeth -#' -#' @rdname MCR-class -#' @aliases MCR -setClass( - "MCR", - slots = c( - data = "data.frame", - coef = "numeric", - mnames = "character", - regmeth = "character" - ) -) - -# MCR-constructors ---- - -#' @rdname MCR-class -#' -#' @param data (`data.frame`)\cr original data. -#' @param coef (`numeric`)\cr a numeric vector contains slope and intercept. -#' @param mnames (`character`)\cr name of X and Y assays, default are 'Method1' -#' and 'Method2' if you have not defined them in `mcreg` function. -#' @param regmeth (`character`)\cr name of regression. -#' -#' @return An object of class `MCR`. -#' -MCR <- function(data, coef, mnames, regmeth) { - new("MCR", - data = data, coef = coef, mnames = mnames, regmeth = regmeth - ) -} diff --git a/_pkgdown.yml b/_pkgdown.yml index 4c7c2e0..6491d3e 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -15,7 +15,6 @@ reference: - BAsummary - RefInt - tpROC - - MCR - title: Internal Helper Functions contents: - cat_with_newline @@ -53,6 +52,10 @@ reference: - size_ci_corr - diagTab - blandAltman + - printSummary + - getCoefficients + - mcreg + - calcBias - pearsonTest - spearmanTest - ESD_test diff --git a/inst/WORDLIST b/inst/WORDLIST index 42fdce0..d4cd2d5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -26,9 +26,11 @@ Jen LDL Liu LoA +MCResult MCTab MMEs McCulloch +NBins NCSS NMPA NMPA's @@ -36,8 +38,11 @@ NOBOUND NSCLC Newcombe OxLDL +PBequi PDL PROC +PaBa +PaBaLarge QC'ed RandomEffects Reproducibility @@ -46,6 +51,7 @@ SampleSize Satterthwaite Searle Statist +Theil VC VCA VCoriginal @@ -59,11 +65,11 @@ ananlysis apa ci clopper -coef confInt creatinin dL eg +equivariant et fontface gb @@ -75,7 +81,6 @@ linewidth lipoprotein loa magrittr -mnames nlr npa npv @@ -88,12 +93,14 @@ pearson plr ppa ppv +quasilinear quations refInt refROC -regmeth +regmethod repo reproducibility +rng roxygen sas satterthwaite diff --git a/man/MCR-class.Rd b/man/MCR-class.Rd deleted file mode 100644 index 44002a5..0000000 --- a/man/MCR-class.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg_class.R -\docType{class} -\name{MCR-class} -\alias{MCR-class} -\alias{MCR} -\title{Method Comparison Regression Class} -\usage{ -MCR(data, coef, mnames, regmeth) -} -\arguments{ -\item{data}{(\code{data.frame})\cr original data.} - -\item{coef}{(\code{numeric})\cr a numeric vector contains slope and intercept.} - -\item{mnames}{(\code{character})\cr name of X and Y assays, default are 'Method1' -and 'Method2' if you have not defined them in \code{mcreg} function.} - -\item{regmeth}{(\code{character})\cr name of regression.} -} -\value{ -An object of class \code{MCR}. -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - -The \code{MCR} class serves as a simplified version of \code{MCResult} from \code{mcr} package. -As the \code{mcr} package are not available in CRAN, this class is took as the temporary -replacement of it, which only contains the some necessaries for \code{autoplot}. -} -\section{Slots}{ - -\describe{ -\item{\code{data}}{data} - -\item{\code{coef}}{coef} - -\item{\code{mnames}}{mnames} - -\item{\code{regmeth}}{regmeth} -}} - diff --git a/man/autoplot.Rd b/man/autoplot.Rd index 53172c4..1d23953 100644 --- a/man/autoplot.Rd +++ b/man/autoplot.Rd @@ -3,6 +3,7 @@ \name{autoplot} \alias{autoplot} \alias{autoplot,BAsummary-method} +\alias{autoplot,MCResult-method} \title{Generate a \code{ggplot} for Bland-Altman Plot and Regression Plot} \usage{ autoplot(object, ...) @@ -30,6 +31,27 @@ autoplot(object, ...) y.title = NULL, main.title = NULL ) + +\S4method{autoplot}{MCResult}( + object, + color = "black", + fill = "lightgray", + size = 1.5, + shape = 21, + jitter = FALSE, + identity = TRUE, + identity.params = list(col = "gray", linetype = "dashed"), + reg = TRUE, + reg.params = list(col = "blue", linetype = "solid"), + equal.axis = FALSE, + legend.title = TRUE, + legend.digits = 2, + x.nbreak = NULL, + y.nbreak = NULL, + x.title = NULL, + y.title = NULL, + main.title = NULL +) } \arguments{ \item{object}{(\code{BAsummary}, \code{MCResult})\cr input, depending on which function @@ -73,6 +95,23 @@ breaks of x-axis and y-axis.} \item{x.title, y.title, main.title}{(\code{string})\cr the x-axis, y-axis and main title of plot.} + +\item{identity}{(\code{logical})\cr whether to add identity line, default is TRUE.} + +\item{identity.params, reg.params}{(\code{list})\cr parameters (color, linetype) +for the argument 'identity' and 'reg'; eg. identity.params = list(col = "gray", +linetype = "dashed").} + +\item{reg}{(\code{logical})\cr whether to add regression line where the slope and +intercept are obtained from \code{\link[mcr:mcreg]{mcr::mcreg()}} function, default is TRUE.} + +\item{equal.axis}{(\code{logical})\cr whether to adjust the ranges of x-axis and y-axis +are identical. If \code{equal.axis = TRUE}, x-axis will be equal to y-axis.} + +\item{legend.title}{(\code{logical})\cr whether to present the title in the legend.} + +\item{legend.digits}{(\code{integer})\cr the number of digits after the decimal point +in the legend.} } \value{ A \code{ggplot} based Bland-Altman plot or regression plot that can be @@ -129,7 +168,24 @@ autoplot(object, x.title = "Mean of Test and Reference Methods", y.title = "Reference - Test" ) +# Using the default arguments for regression plot +data("platelet") +fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" +) +autoplot(fit) + +# Only present the regression line and alter the color and shape. +autoplot(fit, + identity = FALSE, + reg.params = list(col = "grey", linetype = "dashed"), + legend.title = FALSE, + legend.digits = 4 +) } \seealso{ \code{\link[=h_difference]{h_difference()}} to see the type details. + +\code{\link[mcr:mcreg]{mcr::mcreg()}} to see the regression parameters. } diff --git a/man/calcBias.Rd b/man/calcBias.Rd new file mode 100644 index 0000000..9ae7cc8 --- /dev/null +++ b/man/calcBias.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcr.R +\name{calcBias} +\alias{calcBias} +\title{Systematical Bias Between Reference Method and Test Method} +\usage{ +calcBias(...) +} +\arguments{ +\item{...}{ + Arguments passed on to \code{\link[mcr:MCResult.calcBias]{mcr::calcBias}} + \describe{ + \item{\code{.Object}}{object of class "MCResult".} + }} +} +\value{ +Bis and corresponding confidence interval for the specific medical +decision levels (\code{x.levels}). +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A copy from \link[mcr:MCResult.calcBias]{mcr::calcBias} in \code{mcr} package +} +\examples{ +data(platelet) +fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" +) +calcBias(fit, x.levels = c(30, 200)) +calcBias(fit, x.levels = c(30, 200), type = "proportional") +calcBias(fit, x.levels = c(30, 200), type = "proportional", percent = FALSE) +} +\seealso{ +\code{\link[mcr:MCResult.calcBias]{mcr::calcBias()}} +} diff --git a/man/calcium.Rd b/man/calcium.Rd index ef2dee7..ca8f82d 100644 --- a/man/calcium.Rd +++ b/man/calcium.Rd @@ -24,7 +24,4 @@ calcium This example \code{\link{calcium}} can be used to compute the reference range of Calcium in 240 medical students by sex. } -\seealso{ -\link{platelet}. -} \keyword{datasets} diff --git a/man/getCoefficients.Rd b/man/getCoefficients.Rd new file mode 100644 index 0000000..28483c7 --- /dev/null +++ b/man/getCoefficients.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcr.R +\name{getCoefficients} +\alias{getCoefficients} +\title{Get Regression Coefficients} +\usage{ +getCoefficients(...) +} +\arguments{ +\item{...}{ + Arguments passed on to \code{\link[mcr:MCResult.getCoefficients]{mcr::getCoefficients}} + \describe{ + \item{\code{.Object}}{object of class "MCResult".} + }} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A copy from \link[mcr:MCResult.getCoefficients]{mcr::getCoefficients} in \code{mcr} package +} +\examples{ +data(platelet) +fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" +) +getCoefficients(fit) +} diff --git a/man/mcreg.Rd b/man/mcreg.Rd new file mode 100644 index 0000000..108c70e --- /dev/null +++ b/man/mcreg.Rd @@ -0,0 +1,73 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcr.R +\name{mcreg} +\alias{mcreg} +\title{Comparison of Two Measurement Methods Using Regression Analysis} +\usage{ +mcreg(...) +} +\arguments{ +\item{...}{ + Arguments passed on to \code{\link[mcr:mcreg]{mcr::mcreg}} + \describe{ + \item{\code{x}}{measurement values of reference method, or two column matrix.} + \item{\code{y}}{measurement values of test method.} + \item{\code{error.ratio}}{ratio between squared measurement errors of reference and +test method, necessary for Deming regression (Default 1).} + \item{\code{alpha}}{value specifying the 100(1-alpha)\% confidence level for confidence intervals (Default is 0.05).} + \item{\code{mref.name}}{name of reference method (Default "Method1").} + \item{\code{mtest.name}}{name of test Method (Default "Method2").} + \item{\code{sample.names}}{names of cases (Default "S##").} + \item{\code{method.reg}}{regression method. It is possible to choose between five regression methods: +\code{"LinReg"} - ordinary least square regression.\cr +\code{"WLinReg"} - weighted ordinary least square regression.\cr +\code{"Deming"} - Deming regression.\cr +\code{"WDeming"} - weighted Deming regression.\cr +\code{"TS"} - Theil-Sen regression.\cr +\code{"PBequi"} - equivariant Passing-Bablok regression.\cr +\code{"PaBa"} - Passing-Bablok regression.\cr +\code{"PaBaLarge"} - approximative Passing-Bablok regression for large datasets, operating on \code{NBins} classes of constant slope angle which each slope + is classified to instead of building the complete triangular matrix of all N*N/2 slopes.} + \item{\code{method.ci}}{method of confidence interval calculation. The function +contains four basic methods for calculation of confidence intervals for regression coefficients. + \code{"analytical"} - with parametric method.\cr + \code{"jackknife"} - with leave one out resampling.\cr + \code{"bootstrap"} - with ordinary non-parametric bootstrap resampling.\cr + \code{"nested bootstrap"} - with ordinary non-parametric bootstrap resampling.\cr} + \item{\code{method.bootstrap.ci}}{bootstrap based confidence interval estimation method.} + \item{\code{nsamples}}{number of bootstrap samples.} + \item{\code{nnested}}{number of nested bootstrap samples.} + \item{\code{rng.seed}}{integer number that sets the random number generator seed for bootstrap sampling. If set to NULL currently in the R session used RNG setting will be used.} + \item{\code{rng.kind}}{type of random number generator for bootstrap sampling. Only used when rng.seed is specified, see set.seed for details.} + \item{\code{iter.max}}{maximum number of iterations for weighted Deming iterative algorithm.} + \item{\code{threshold}}{numerical tolerance for weighted Deming iterative algorithm convergence.} + \item{\code{na.rm}}{remove measurement pairs that contain missing values (Default is FALSE).} + \item{\code{NBins}}{number of bins used when 'reg.method="PaBaLarge"' to classify each slope in one of 'NBins' bins covering the range of all slopes} + \item{\code{slope.measure}}{angular measure of pairwise slopes used for exact PaBa regression (see below for details).\cr +\code{"radian"} - for data sets with even sample numbers median slope is calculated as average of two central slope angles.\cr +\code{"tangent"} - for data sets with even sample numbers median slope is calculated as average of two central slopes (tan(angle)).\cr} + \item{\code{methodlarge}}{Boolean. This parameter applies only to regmethod="PBequi" and "TS". +If TRUE, a quasilinear algorithm is used. +If FALSE, a quadratic algorithm is used which is faster for less than several hundred data pairs.} + }} +} +\value{ +A regression fit model. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A copy from \link[mcr:mcreg]{mcr::mcreg} in \code{mcr} package +} +\examples{ +data(platelet) +fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" +) +printSummary(fit) +getCoefficients(fit) +} +\seealso{ +\code{\link[mcr:mcreg]{mcr::mcreg()}} +} diff --git a/man/platelet.Rd b/man/platelet.Rd index d7a3582..16c7315 100644 --- a/man/platelet.Rd +++ b/man/platelet.Rd @@ -25,7 +25,7 @@ This example \code{\link{platelet}} can be used to create a data set comparing Platelet results from two analyzers in cells. } \seealso{ -From \code{mcr} package, \code{creatinine} data set contains data with with serum and plasma +From \code{mcr} package, \link[mcr:creatinine]{mcr::creatinine} data set contains data with with serum and plasma creatinin measurements in mg/dL for each sample. } \keyword{datasets} diff --git a/man/printSummary.Rd b/man/printSummary.Rd new file mode 100644 index 0000000..c4ab97b --- /dev/null +++ b/man/printSummary.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mcr.R +\name{printSummary} +\alias{printSummary} +\title{Print Summary of a Regression Analysis} +\usage{ +printSummary(...) +} +\arguments{ +\item{...}{ + Arguments passed on to \code{\link[mcr:MCResult.printSummary]{mcr::printSummary}} + \describe{ + \item{\code{.Object}}{object of type "MCResult".} + }} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +A copy from \link[mcr:MCResult.printSummary]{mcr::printSummary} in \code{mcr} package +} +\examples{ +data(platelet) +fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" +) +printSummary(fit) +} diff --git a/tests/testthat/_snaps/autoplot/autoplot-mcresult-with-default-arguments.svg b/tests/testthat/_snaps/autoplot/autoplot-mcresult-with-default-arguments.svg new file mode 100644 index 0000000..74af939 --- /dev/null +++ b/tests/testthat/_snaps/autoplot/autoplot-mcresult-with-default-arguments.svg @@ -0,0 +1,230 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +200 +400 +600 +800 +1000 +1200 +1400 + + + + + + + + + + + + + + + + +0 +200 +400 +600 +800 +1000 +1200 +1400 +Method1 +Method2 + +Deming RegressionFit (n=120) + + + + + + +Identity +Y = 1.01 * X + 4.34 + + diff --git a/tests/testthat/_snaps/autoplot/autoplot-mcresult-with-multiple-arguments.svg b/tests/testthat/_snaps/autoplot/autoplot-mcresult-with-multiple-arguments.svg new file mode 100644 index 0000000..d7a17d8 --- /dev/null +++ b/tests/testthat/_snaps/autoplot/autoplot-mcresult-with-multiple-arguments.svg @@ -0,0 +1,229 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0 +200 +400 +600 +800 +1000 +1200 +1400 + + + + + + + + + + + + + + + + +0 +200 +400 +600 +800 +1000 +1200 +1400 +Method1 +Method2 + + + + + + + +Identity +Y = 1.031 * X + 3.189 + + diff --git a/tests/testthat/test-autoplot.R b/tests/testthat/test-autoplot.R index 4c2d9ec..4d65a49 100644 --- a/tests/testthat/test-autoplot.R +++ b/tests/testthat/test-autoplot.R @@ -31,33 +31,33 @@ test_that("autoplot works as expected for BAsummary class with multiple argument vdiffr::expect_doppelganger("autoplot_BAsummary with multiple arguments", result) }) -# test_that("autoplot works as expected for MCResult class with default arguments", { -# data(creatinine, package = "mcr") -# object <- mcreg2( -# x = platelet$Comparative, y = platelet$Candidate, -# method.reg = "Deming", method.ci = "jackknife" -# ) -# -# result <- autoplot(object) -# vdiffr::expect_doppelganger("autoplot_MCResult with default arguments", result) -# }) +test_that("autoplot works as expected for MCResult class with default arguments", { + data(creatinine, package = "mcr") + object <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" + ) + + result <- autoplot(object) + vdiffr::expect_doppelganger("autoplot_MCResult with default arguments", result) +}) + +test_that("autoplot works as expected for MCResult class with multiple arguments", { + data(creatinine, package = "mcr") + object <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "PaBa", method.ci = "bootstrap" + ) -# test_that("autoplot works as expected for MCResult class with multiple arguments", { -# data(creatinine, package = "mcr") -# object <- mcreg2( -# x = platelet$Comparative, y = platelet$Candidate, -# method.reg = "PaBa", method.ci = "bootstrap" -# ) -# -# result <- autoplot( -# object, -# identity.params = list(col = "blue", linetype = "solid"), -# reg.params = list(col = "red", linetype = "solid"), -# equal.axis = TRUE, -# legend.title = FALSE, -# legend.digits = 3, -# x.title = "Reference", -# y.title = "Test" -# ) -# vdiffr::expect_doppelganger("autoplot_MCResult with multiple arguments", result) -# }) + result <- autoplot( + object, + identity.params = list(col = "blue", linetype = "solid"), + reg.params = list(col = "red", linetype = "solid"), + equal.axis = TRUE, + legend.title = FALSE, + legend.digits = 3, + x.title = "Reference", + y.title = "Test" + ) + vdiffr::expect_doppelganger("autoplot_MCResult with multiple arguments", result) +}) diff --git a/tests/testthat/test-mcr.R b/tests/testthat/test-mcr.R index 064ccc8..8e2f17c 100644 --- a/tests/testthat/test-mcr.R +++ b/tests/testthat/test-mcr.R @@ -1,71 +1,71 @@ # mcreg ---- -# test_that("mcreg works as expected with Deming regression", { -# data(platelet) -# fit <- mcreg( -# x = platelet$Comparative, y = platelet$Candidate, -# method.reg = "Deming", method.ci = "jackknife" -# ) -# expect_class(fit, "MCResultJackknife") -# object <- matrix( -# c( -# 4.335885, 1.568968372, 1.2289002, 7.442869, -# 1.012951, 0.009308835, 0.9945175, 1.031386 -# ), -# nrow = 2, -# byrow = TRUE, -# dimnames = list( -# c("Intercept", "Slope"), -# c("EST", "SE", "LCI", "UCI") -# ) -# ) -# expect_equal(fit@para, object, tolerance = 0.00001) -# }) +test_that("mcreg works as expected with Deming regression", { + data(platelet) + fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" + ) + expect_class(fit, "MCResultJackknife") + object <- matrix( + c( + 4.335885, 1.568968372, 1.2289002, 7.442869, + 1.012951, 0.009308835, 0.9945175, 1.031386 + ), + nrow = 2, + byrow = TRUE, + dimnames = list( + c("Intercept", "Slope"), + c("EST", "SE", "LCI", "UCI") + ) + ) + expect_equal(fit@para, object, tolerance = 0.00001) +}) # getCoefficients ---- -# test_that("getCoefficients works as expected with default settings", { -# data(platelet) -# fit <- mcreg( -# x = platelet$Comparative, y = platelet$Candidate, -# method.reg = "Deming", method.ci = "jackknife" -# ) -# object <- matrix( -# c( -# 4.335885, 1.568968372, 1.2289002, 7.442869, -# 1.012951, 0.009308835, 0.9945175, 1.031386 -# ), -# nrow = 2, -# byrow = TRUE, -# dimnames = list( -# c("Intercept", "Slope"), -# c("EST", "SE", "LCI", "UCI") -# ) -# ) -# expect_equal(getCoefficients(fit), object, tolerance = 0.00001) -# }) +test_that("getCoefficients works as expected with default settings", { + data(platelet) + fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" + ) + object <- matrix( + c( + 4.335885, 1.568968372, 1.2289002, 7.442869, + 1.012951, 0.009308835, 0.9945175, 1.031386 + ), + nrow = 2, + byrow = TRUE, + dimnames = list( + c("Intercept", "Slope"), + c("EST", "SE", "LCI", "UCI") + ) + ) + expect_equal(getCoefficients(fit), object, tolerance = 0.00001) +}) # calcBias ---- -# test_that("calcBias works as expected with default settings", { -# data(platelet) -# fit <- mcreg( -# x = platelet$Comparative, y = platelet$Candidate, -# method.reg = "Deming", method.ci = "jackknife" -# ) -# object <- matrix( -# c( -# 30, 4.724429, 1.378232, 1.995155, 7.453704, -# 200, 6.926183, 1.288534, 4.374535, 9.477832 -# ), -# nrow = 2, -# byrow = TRUE, -# dimnames = list( -# c("X1", "X2"), -# c("Level", "Bias", "SE", "LCI", "UCI") -# ) -# ) -# expect_equal(calcBias(fit, x.levels = c(30, 200)), object, tolerance = 0.00001) -# }) +test_that("calcBias works as expected with default settings", { + data(platelet) + fit <- mcreg( + x = platelet$Comparative, y = platelet$Candidate, + method.reg = "Deming", method.ci = "jackknife" + ) + object <- matrix( + c( + 30, 4.724429, 1.378232, 1.995155, 7.453704, + 200, 6.926183, 1.288534, 4.374535, 9.477832 + ), + nrow = 2, + byrow = TRUE, + dimnames = list( + c("X1", "X2"), + c("Level", "Bias", "SE", "LCI", "UCI") + ) + ) + expect_equal(calcBias(fit, x.levels = c(30, 200)), object, tolerance = 0.00001) +}) diff --git a/vignettes/mcradds.Rmd b/vignettes/mcradds.Rmd index 54b779b..80a55d7 100644 --- a/vignettes/mcradds.Rmd +++ b/vignettes/mcradds.Rmd @@ -71,7 +71,7 @@ The data sets with different purposes used in this vignette are: ```{r} data("qualData") data("platelet") -# data(creatinine, package = "mcr") +data(creatinine, package = "mcr") data("calcium") data("ldlroc") data("PDL1RP") @@ -188,9 +188,7 @@ tb %>% getAccuracy(ref = "nr", nr_ci = "wilson") Regression agreement is a very important criteria in method comparison trials that can be achieved by `mcr` package that has provided a series of regression methods, such as 'Deming', 'Passing-Bablok',' weighted Deming' and so on. The main and key functions have been wrapped in the `mcradds`, such as `mcreg`, `getCoefficients` and `calcBias`. If you would like to utilize the entire functions in `mcr` package, just adding the specific package name in front of each of them, like `mcr::calcBias()`, so that it looks the function is called from `mcr` package. -Please to be noted that the `mcr` package is not available in CRAN, so the `mcreg` or `mcreg2` function can not be used temporarily. - -```{r eval = FALSE} +```{r} # Deming regression fit <- mcreg( x = platelet$Comparative, y = platelet$Candidate, @@ -204,9 +202,7 @@ getCoefficients(fit) Once you have obtained this regression equation, whether 'Deming' or 'Passing-Bablok', you can use it to estimate the bias in medical decision level. Suppose that you know the medical decision level of one assay is `30`, obviously this is a make-up number. Then you can use the `fit` object above to estimate the bias using `calcBias` function. -Please to be noted that the `mcr` package is not available in CRAN, so the `calcBias` function can not be used temporarily. - -```{r eval = FALSE} +```{r} # absolute bias. calcBias(fit, x.levels = c(30)) @@ -252,7 +248,7 @@ out$stat out$outmat # 4E approach -ba2 <- blandAltman(x = platelet$Comparative, y = platelet$Candidate) +ba2 <- blandAltman(x = creatinine$serum.crea, y = creatinine$plasma.crea) out2 <- getOutlier(ba2, method = "4E") out2$stat out2$outmat @@ -449,12 +445,10 @@ autoplot( ### Regression plot -To generate the regression plot, you should create the object from `mcreg()` function and then call `autoplot` straightforward. +To generate the regression plot, you should create the object from `mcreg()` function and then call `autoplot` straightforward. -Please to be noted that the `mcr` package is not available in CRAN, so the `mcreg` or `mcreg2` function can not be used temporarily. - -```{r eval = FALSE} -fit <- mcreg2( +```{r} +fit <- mcreg( x = platelet$Comparative, y = platelet$Candidate, method.reg = "PaBa", method.ci = "bootstrap" ) @@ -463,7 +457,7 @@ autoplot(fit) More arguments can be used as shown below. -```{r eval = FALSE} +```{r} autoplot( fit, identity.params = list(col = "blue", linetype = "solid"),