Nothing
# This file is automatically generated, you probably don't want to edit this
jmvagreeOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"jmvagreeOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
method1 = NULL,
method2 = NULL,
ciWidth = 95,
agreeWidth = 95,
testValue = 2,
CCC = TRUE,
plotbland = TRUE,
plotcon = FALSE,
plotcheck = FALSE,
prop_bias = FALSE,
xlabel = "Average of Both Methods",
ylabel = "Difference between Methods", ...) {
super$initialize(
package="SimplyAgree",
name="jmvagree",
requiresData=TRUE,
...)
private$..method1 <- jmvcore::OptionVariable$new(
"method1",
method1,
suggested=list(
"continuous"),
permitted=list(
"numeric"),
rejectInf=FALSE)
private$..method2 <- jmvcore::OptionVariable$new(
"method2",
method2,
suggested=list(
"continuous"),
permitted=list(
"numeric"),
rejectInf=FALSE)
private$..ciWidth <- jmvcore::OptionNumber$new(
"ciWidth",
ciWidth,
min=50,
max=99.9,
default=95)
private$..agreeWidth <- jmvcore::OptionNumber$new(
"agreeWidth",
agreeWidth,
min=50,
max=99.9,
default=95)
private$..testValue <- jmvcore::OptionNumber$new(
"testValue",
testValue,
default=2)
private$..CCC <- jmvcore::OptionBool$new(
"CCC",
CCC,
default=TRUE)
private$..plotbland <- jmvcore::OptionBool$new(
"plotbland",
plotbland,
default=TRUE)
private$..plotcon <- jmvcore::OptionBool$new(
"plotcon",
plotcon,
default=FALSE)
private$..plotcheck <- jmvcore::OptionBool$new(
"plotcheck",
plotcheck,
default=FALSE)
private$..prop_bias <- jmvcore::OptionBool$new(
"prop_bias",
prop_bias,
default=FALSE)
private$..xlabel <- jmvcore::OptionString$new(
"xlabel",
xlabel,
default="Average of Both Methods")
private$..ylabel <- jmvcore::OptionString$new(
"ylabel",
ylabel,
default="Difference between Methods")
self$.addOption(private$..method1)
self$.addOption(private$..method2)
self$.addOption(private$..ciWidth)
self$.addOption(private$..agreeWidth)
self$.addOption(private$..testValue)
self$.addOption(private$..CCC)
self$.addOption(private$..plotbland)
self$.addOption(private$..plotcon)
self$.addOption(private$..plotcheck)
self$.addOption(private$..prop_bias)
self$.addOption(private$..xlabel)
self$.addOption(private$..ylabel)
}),
active = list(
method1 = function() private$..method1$value,
method2 = function() private$..method2$value,
ciWidth = function() private$..ciWidth$value,
agreeWidth = function() private$..agreeWidth$value,
testValue = function() private$..testValue$value,
CCC = function() private$..CCC$value,
plotbland = function() private$..plotbland$value,
plotcon = function() private$..plotcon$value,
plotcheck = function() private$..plotcheck$value,
prop_bias = function() private$..prop_bias$value,
xlabel = function() private$..xlabel$value,
ylabel = function() private$..ylabel$value),
private = list(
..method1 = NA,
..method2 = NA,
..ciWidth = NA,
..agreeWidth = NA,
..testValue = NA,
..CCC = NA,
..plotbland = NA,
..plotcon = NA,
..plotcheck = NA,
..prop_bias = NA,
..xlabel = NA,
..ylabel = NA)
)
jmvagreeResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"jmvagreeResults",
inherit = jmvcore::Group,
active = list(
text = function() private$.items[["text"]],
blandtab = function() private$.items[["blandtab"]],
ccctab = function() private$.items[["ccctab"]],
plotba = function() private$.items[["plotba"]],
plotcon = function() private$.items[["plotcon"]],
plotcheck = function() private$.items[["plotcheck"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="Simple Agreement Analysis")
self$add(jmvcore::Html$new(
options=options,
name="text",
refs=list(
"SimplyAgree")))
self$add(jmvcore::Table$new(
options=options,
name="blandtab",
title="Bland-Altman Limits of Agreement",
rows=3,
columns=list(
list(
`name`="var",
`title`="",
`type`="text"),
list(
`name`="estimate",
`title`="Estimate",
`type`="number"),
list(
`name`="lowerci",
`title`="Lower C.I.",
`type`="number"),
list(
`name`="upperci",
`title`="Upper C.I",
`type`="number"))))
self$add(jmvcore::Table$new(
options=options,
name="ccctab",
title="Concordance Correlation Coefficient",
visible="(CCC)",
rows=1,
columns=list(
list(
`name`="var",
`title`="",
`type`="text"),
list(
`name`="estimate",
`title`="Estimate",
`type`="number"),
list(
`name`="lowerci",
`title`="Lower C.I.",
`type`="number"),
list(
`name`="upperci",
`title`="Upper C.I",
`type`="number"))))
self$add(jmvcore::Image$new(
options=options,
name="plotba",
title="Bland-Altman Plot",
visible="(plotbland)",
renderFun=".plotba",
width=450,
height=400))
self$add(jmvcore::Image$new(
options=options,
name="plotcon",
title="Line-of-Identity Plot",
visible="(plotcon)",
renderFun=".plotcon",
width=450,
height=400))
self$add(jmvcore::Image$new(
options=options,
name="plotcheck",
title="Check Assumptions",
visible="(plotcheck)",
renderFun=".plotcheck",
width=550,
height=450))}))
jmvagreeBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"jmvagreeBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "SimplyAgree",
name = "jmvagree",
version = c(1,0,0),
options = options,
results = jmvagreeResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE)
}))
#' Simple Agreement Analysis
#'
#'
#' @param data Data
#' @param method1 Name of column containing 1st Vector of data
#' @param method2 Name of column containing Vector of data
#' @param ciWidth a number between 50 and 99.9 (default: 95), the width of
#' confidence intervals
#' @param agreeWidth a number between 50 and 99.9 (default: 95), the width of
#' agreement limits
#' @param testValue a number specifying the limit of agreement
#' @param CCC \code{TRUE} or \code{FALSE} (default), produce CCC table
#' @param plotbland \code{TRUE} or \code{FALSE} (default), for Bland-Altman
#' plot
#' @param plotcon \code{TRUE} or \code{FALSE} (default), for Bland-Altman plot
#' @param plotcheck \code{TRUE} or \code{FALSE} (default), assumptions plots
#' @param prop_bias \code{TRUE} or \code{FALSE}
#' @param xlabel The label for the x-axis on the BA plot
#' @param ylabel The label for the y-axis on the BA plot
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$text} \tab \tab \tab \tab \tab a html \cr
#' \code{results$blandtab} \tab \tab \tab \tab \tab a table \cr
#' \code{results$ccctab} \tab \tab \tab \tab \tab a table \cr
#' \code{results$plotba} \tab \tab \tab \tab \tab an image \cr
#' \code{results$plotcon} \tab \tab \tab \tab \tab an image \cr
#' \code{results$plotcheck} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$blandtab$asDF}
#'
#' \code{as.data.frame(results$blandtab)}
#'
#' @export
jmvagree <- function(
data,
method1,
method2,
ciWidth = 95,
agreeWidth = 95,
testValue = 2,
CCC = TRUE,
plotbland = TRUE,
plotcon = FALSE,
plotcheck = FALSE,
prop_bias = FALSE,
xlabel = "Average of Both Methods",
ylabel = "Difference between Methods") {
if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("jmvagree requires jmvcore to be installed (restart may be required)")
if ( ! missing(method1)) method1 <- jmvcore::resolveQuo(jmvcore::enquo(method1))
if ( ! missing(method2)) method2 <- jmvcore::resolveQuo(jmvcore::enquo(method2))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(method1), method1, NULL),
`if`( ! missing(method2), method2, NULL))
options <- jmvagreeOptions$new(
method1 = method1,
method2 = method2,
ciWidth = ciWidth,
agreeWidth = agreeWidth,
testValue = testValue,
CCC = CCC,
plotbland = plotbland,
plotcon = plotcon,
plotcheck = plotcheck,
prop_bias = prop_bias,
xlabel = xlabel,
ylabel = ylabel)
analysis <- jmvagreeClass$new(
options = options,
data = data)
analysis$run()
analysis$results
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.