# This file is automatically generated, you probably don't want to edit this
stagemigrationOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"stagemigrationOptions",
inherit = jmvcore::Options,
public = list(
initialize = function(
oldStage = NULL,
newStage = NULL,
survivalTime = NULL,
event = NULL,
eventLevel = NULL,
plotMigration = TRUE,
survivalPlotType = "separate",
showCI = FALSE,
showWillRogers = TRUE, ...) {
super$initialize(
package="ClinicoPath",
name="stagemigration",
requiresData=TRUE,
...)
private$..oldStage <- jmvcore::OptionVariable$new(
"oldStage",
oldStage,
suggested=list(
"ordinal",
"nominal"),
permitted=list(
"factor"))
private$..newStage <- jmvcore::OptionVariable$new(
"newStage",
newStage,
suggested=list(
"ordinal",
"nominal"),
permitted=list(
"factor"))
private$..survivalTime <- jmvcore::OptionVariable$new(
"survivalTime",
survivalTime,
suggested=list(
"continuous"),
permitted=list(
"numeric"))
private$..event <- jmvcore::OptionVariable$new(
"event",
event,
suggested=list(
"ordinal",
"nominal",
"continuous"),
permitted=list(
"factor",
"numeric"))
private$..eventLevel <- jmvcore::OptionLevel$new(
"eventLevel",
eventLevel,
variable="(event)")
private$..plotMigration <- jmvcore::OptionBool$new(
"plotMigration",
plotMigration,
default=TRUE)
private$..survivalPlotType <- jmvcore::OptionList$new(
"survivalPlotType",
survivalPlotType,
options=list(
"separate",
"sidebyside"),
default="separate")
private$..showCI <- jmvcore::OptionBool$new(
"showCI",
showCI,
default=FALSE)
private$..showWillRogers <- jmvcore::OptionBool$new(
"showWillRogers",
showWillRogers,
default=TRUE)
self$.addOption(private$..oldStage)
self$.addOption(private$..newStage)
self$.addOption(private$..survivalTime)
self$.addOption(private$..event)
self$.addOption(private$..eventLevel)
self$.addOption(private$..plotMigration)
self$.addOption(private$..survivalPlotType)
self$.addOption(private$..showCI)
self$.addOption(private$..showWillRogers)
}),
active = list(
oldStage = function() private$..oldStage$value,
newStage = function() private$..newStage$value,
survivalTime = function() private$..survivalTime$value,
event = function() private$..event$value,
eventLevel = function() private$..eventLevel$value,
plotMigration = function() private$..plotMigration$value,
survivalPlotType = function() private$..survivalPlotType$value,
showCI = function() private$..showCI$value,
showWillRogers = function() private$..showWillRogers$value),
private = list(
..oldStage = NA,
..newStage = NA,
..survivalTime = NA,
..event = NA,
..eventLevel = NA,
..plotMigration = NA,
..survivalPlotType = NA,
..showCI = NA,
..showWillRogers = NA)
)
stagemigrationResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"stagemigrationResults",
inherit = jmvcore::Group,
active = list(
todo = function() private$.items[["todo"]],
migrationSummary = function() private$.items[["migrationSummary"]],
stageDistribution = function() private$.items[["stageDistribution"]],
migrationTable = function() private$.items[["migrationTable"]],
survivalComparison = function() private$.items[["survivalComparison"]],
stagingPerformance = function() private$.items[["stagingPerformance"]],
migrationPlot = function() private$.items[["migrationPlot"]],
survivalPlot = function() private$.items[["survivalPlot"]],
concordancePlot = function() private$.items[["concordancePlot"]]),
private = list(),
public=list(
initialize=function(options) {
super$initialize(
options=options,
name="",
title="Stage Migration Analysis",
refs=list(
"survival",
"survminer",
"ggalluvial",
"willrogers"))
self$add(jmvcore::Html$new(
options=options,
name="todo",
title="Welcome",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel")))
self$add(jmvcore::Table$new(
options=options,
name="migrationSummary",
title="Migration Summary",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel"),
columns=list(
list(
`name`="statistic",
`title`="Statistic",
`type`="text"),
list(
`name`="value",
`title`="Value",
`type`="text"))))
self$add(jmvcore::Table$new(
options=options,
name="stageDistribution",
title="Stage Distribution Comparison",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel"),
columns=list(
list(
`name`="stage",
`title`="Stage",
`type`="text"),
list(
`name`="oldCount",
`title`="Original Count",
`type`="integer"),
list(
`name`="oldPct",
`title`="Original %",
`type`="text"),
list(
`name`="newCount",
`title`="New Count",
`type`="integer"),
list(
`name`="newPct",
`title`="New %",
`type`="text"),
list(
`name`="change",
`title`="Change",
`type`="text"))))
self$add(jmvcore::Table$new(
options=options,
name="migrationTable",
title="Stage Migration Matrix",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel"),
columns=list()))
self$add(jmvcore::Table$new(
options=options,
name="survivalComparison",
title="Prognostic Performance Comparison",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel"),
columns=list(
list(
`name`="metric",
`title`="Metric",
`type`="text"),
list(
`name`="oldValue",
`title`="Original System",
`type`="text"),
list(
`name`="newValue",
`title`="New System",
`type`="text"),
list(
`name`="change",
`title`="Change",
`type`="text"))))
self$add(jmvcore::Table$new(
options=options,
name="stagingPerformance",
title="Will Rogers Phenomenon Analysis",
visible="(showWillRogers)",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel",
"showWillRogers"),
columns=list(
list(
`name`="stage",
`title`="Stage",
`type`="text"),
list(
`name`="stayedN",
`title`="Unchanged N",
`type`="integer"),
list(
`name`="stayedMedian",
`title`="Unchanged Median",
`type`="text"),
list(
`name`="migratedN",
`title`="Migrated N",
`type`="integer"),
list(
`name`="migratedMedian",
`title`="Migrated Median",
`type`="text"),
list(
`name`="pValue",
`title`="p-value",
`type`="text",
`format`="pvalue"))))
self$add(jmvcore::Image$new(
options=options,
name="migrationPlot",
title="Stage Migration Flow",
width=700,
height=500,
renderFun=".migrationPlot",
visible="(plotMigration)",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel",
"plotMigration")))
self$add(jmvcore::Image$new(
options=options,
name="survivalPlot",
title="Survival Comparison",
width=800,
height=600,
renderFun=".survivalPlot",
visible="(plotMigration)",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel",
"plotMigration",
"survivalPlotType",
"showCI")))
self$add(jmvcore::Image$new(
options=options,
name="concordancePlot",
title="Concordance Index Comparison",
width=600,
height=400,
renderFun=".concordancePlot",
visible="(plotMigration)",
clearWith=list(
"oldStage",
"newStage",
"survivalTime",
"event",
"eventLevel",
"plotMigration")))}))
stagemigrationBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"stagemigrationBase",
inherit = jmvcore::Analysis,
public = list(
initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
super$initialize(
package = "ClinicoPath",
name = "stagemigration",
version = c(0,0,3),
options = options,
results = stagemigrationResults$new(options=options),
data = data,
datasetId = datasetId,
analysisId = analysisId,
revision = revision,
pause = NULL,
completeWhenFilled = FALSE,
requiresMissings = FALSE,
weightsSupport = 'auto')
}))
#' Stage Migration Analysis
#'
#' Analyzes staging system changes and the "Will Rogers Phenomenon" in disease
#' staging. This analysis compares staging distributions before and after a
#' staging system change, quantifies stage migration, and evaluates changes in
#' prognostic performance.
#'
#' @examples
#' \donttest{
#' # Example analyzing migration between TNM staging editions:
#' # stagemigration(
#' # data = patient_data,
#' # oldStage = "tnm7_stage",
#' # newStage = "tnm8_stage",
#' # survivalTime = "follow_up_months",
#' # event = "death_status",
#' # eventLevel = "Dead"
#' # )
#'}
#' @param data The dataset containing staging and survival information.
#' @param oldStage The original staging variable. This represents the staging
#' system used before the revision or change (e.g., TNM 7th edition).
#' @param newStage The new staging variable. This represents the revised or
#' changed staging system (e.g., TNM 8th edition).
#' @param survivalTime The survival or follow-up time variable. This should be
#' a numeric variable representing time in consistent units (e.g., months).
#' @param event The event indicator variable. This can be a factor or numeric
#' variable indicating whether the event of interest (e.g., death) occurred.
#' @param eventLevel The level of the event variable that indicates the event
#' occurred. This is required if the event variable is a factor.
#' @param plotMigration Enable to display an alluvial/Sankey plot visualizing
#' stage migration patterns. This plot shows how patients move between stages
#' in the old and new systems.
#' @param survivalPlotType Controls how survival curves are displayed for
#' comparing staging systems. "Separate" shows full KM plots for each system,
#' while "Side by side" focuses on direct stage comparisons.
#' @param showCI Enable to display 95\% confidence intervals around survival
#' curves.
#' @param showWillRogers Enable to perform detailed analysis of the Will
#' Rogers phenomenon. This will compare survival within stages between
#' patients who migrated and those who didn't.
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$todo} \tab \tab \tab \tab \tab a html \cr
#' \code{results$migrationSummary} \tab \tab \tab \tab \tab a table \cr
#' \code{results$stageDistribution} \tab \tab \tab \tab \tab a table \cr
#' \code{results$migrationTable} \tab \tab \tab \tab \tab a table \cr
#' \code{results$survivalComparison} \tab \tab \tab \tab \tab a table \cr
#' \code{results$stagingPerformance} \tab \tab \tab \tab \tab a table \cr
#' \code{results$migrationPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$survivalPlot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$concordancePlot} \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$migrationSummary$asDF}
#'
#' \code{as.data.frame(results$migrationSummary)}
#'
#' @export
stagemigration <- function(
data,
oldStage,
newStage,
survivalTime,
event,
eventLevel,
plotMigration = TRUE,
survivalPlotType = "separate",
showCI = FALSE,
showWillRogers = TRUE) {
if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("stagemigration requires jmvcore to be installed (restart may be required)")
if ( ! missing(oldStage)) oldStage <- jmvcore::resolveQuo(jmvcore::enquo(oldStage))
if ( ! missing(newStage)) newStage <- jmvcore::resolveQuo(jmvcore::enquo(newStage))
if ( ! missing(survivalTime)) survivalTime <- jmvcore::resolveQuo(jmvcore::enquo(survivalTime))
if ( ! missing(event)) event <- jmvcore::resolveQuo(jmvcore::enquo(event))
if (missing(data))
data <- jmvcore::marshalData(
parent.frame(),
`if`( ! missing(oldStage), oldStage, NULL),
`if`( ! missing(newStage), newStage, NULL),
`if`( ! missing(survivalTime), survivalTime, NULL),
`if`( ! missing(event), event, NULL))
for (v in oldStage) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
for (v in newStage) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
options <- stagemigrationOptions$new(
oldStage = oldStage,
newStage = newStage,
survivalTime = survivalTime,
event = event,
eventLevel = eventLevel,
plotMigration = plotMigration,
survivalPlotType = survivalPlotType,
showCI = showCI,
showWillRogers = showWillRogers)
analysis <- stagemigrationClass$new(
options = options,
data = data)
analysis$run()
analysis$results
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.