R/swimmerplot2.h.R

Defines functions swimmerplot2

Documented in swimmerplot2

# This file is automatically generated, you probably don't want to edit this

swimmerplot2Options <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "swimmerplot2Options",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            patientID = NULL,
            startTime = NULL,
            endTime = NULL,
            status = NULL,
            markerData = FALSE,
            markerVar = NULL,
            markerTime = NULL,
            showArrows = FALSE,
            arrowFilter = NULL,
            sortSubjects = "id",
            laneWidth = 2,
            markerSize = 5,
            useDarkTheme = FALSE,
            customTitle = "Swimmer Plot",
            xLabel = "Time",
            yLabel = "Subject ID", ...) {

            super$initialize(
                package="ClinicoPath",
                name="swimmerplot2",
                requiresData=TRUE,
                ...)

            private$..patientID <- jmvcore::OptionVariable$new(
                "patientID",
                patientID,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "numeric",
                    "factor",
                    "id"))
            private$..startTime <- jmvcore::OptionVariable$new(
                "startTime",
                startTime,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..endTime <- jmvcore::OptionVariable$new(
                "endTime",
                endTime,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..status <- jmvcore::OptionVariable$new(
                "status",
                status,
                suggested=list(
                    "nominal",
                    "ordinal"),
                permitted=list(
                    "factor"))
            private$..markerData <- jmvcore::OptionBool$new(
                "markerData",
                markerData,
                default=FALSE)
            private$..markerVar <- jmvcore::OptionVariable$new(
                "markerVar",
                markerVar,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..markerTime <- jmvcore::OptionVariable$new(
                "markerTime",
                markerTime,
                suggested=list(
                    "continuous"),
                permitted=list(
                    "numeric"))
            private$..showArrows <- jmvcore::OptionBool$new(
                "showArrows",
                showArrows,
                default=FALSE)
            private$..arrowFilter <- jmvcore::OptionVariable$new(
                "arrowFilter",
                arrowFilter,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..sortSubjects <- jmvcore::OptionList$new(
                "sortSubjects",
                sortSubjects,
                options=list(
                    "id",
                    "duration",
                    "status"),
                default="id")
            private$..laneWidth <- jmvcore::OptionNumber$new(
                "laneWidth",
                laneWidth,
                default=2,
                min=0.1,
                max=10)
            private$..markerSize <- jmvcore::OptionNumber$new(
                "markerSize",
                markerSize,
                default=5,
                min=1,
                max=20)
            private$..useDarkTheme <- jmvcore::OptionBool$new(
                "useDarkTheme",
                useDarkTheme,
                default=FALSE)
            private$..customTitle <- jmvcore::OptionString$new(
                "customTitle",
                customTitle,
                default="Swimmer Plot")
            private$..xLabel <- jmvcore::OptionString$new(
                "xLabel",
                xLabel,
                default="Time")
            private$..yLabel <- jmvcore::OptionString$new(
                "yLabel",
                yLabel,
                default="Subject ID")

            self$.addOption(private$..patientID)
            self$.addOption(private$..startTime)
            self$.addOption(private$..endTime)
            self$.addOption(private$..status)
            self$.addOption(private$..markerData)
            self$.addOption(private$..markerVar)
            self$.addOption(private$..markerTime)
            self$.addOption(private$..showArrows)
            self$.addOption(private$..arrowFilter)
            self$.addOption(private$..sortSubjects)
            self$.addOption(private$..laneWidth)
            self$.addOption(private$..markerSize)
            self$.addOption(private$..useDarkTheme)
            self$.addOption(private$..customTitle)
            self$.addOption(private$..xLabel)
            self$.addOption(private$..yLabel)
        }),
    active = list(
        patientID = function() private$..patientID$value,
        startTime = function() private$..startTime$value,
        endTime = function() private$..endTime$value,
        status = function() private$..status$value,
        markerData = function() private$..markerData$value,
        markerVar = function() private$..markerVar$value,
        markerTime = function() private$..markerTime$value,
        showArrows = function() private$..showArrows$value,
        arrowFilter = function() private$..arrowFilter$value,
        sortSubjects = function() private$..sortSubjects$value,
        laneWidth = function() private$..laneWidth$value,
        markerSize = function() private$..markerSize$value,
        useDarkTheme = function() private$..useDarkTheme$value,
        customTitle = function() private$..customTitle$value,
        xLabel = function() private$..xLabel$value,
        yLabel = function() private$..yLabel$value),
    private = list(
        ..patientID = NA,
        ..startTime = NA,
        ..endTime = NA,
        ..status = NA,
        ..markerData = NA,
        ..markerVar = NA,
        ..markerTime = NA,
        ..showArrows = NA,
        ..arrowFilter = NA,
        ..sortSubjects = NA,
        ..laneWidth = NA,
        ..markerSize = NA,
        ..useDarkTheme = NA,
        ..customTitle = NA,
        ..xLabel = NA,
        ..yLabel = NA)
)

swimmerplot2Results <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "swimmerplot2Results",
    inherit = jmvcore::Group,
    active = list(
        todo = function() private$.items[["todo"]],
        summary = function() private$.items[["summary"]],
        mydataview = function() private$.items[["mydataview"]],
        dataView = function() private$.items[["dataView"]],
        plot = function() private$.items[["plot"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Swimmer Plot 2",
                refs=list(
                    "ClinicoPathJamoviModule",
                    "ggswim"))
            self$add(jmvcore::Html$new(
                options=options,
                name="todo",
                title="Instructions"))
            self$add(jmvcore::Table$new(
                options=options,
                name="summary",
                title="Summary Statistics",
                rows=0,
                columns=list(
                    list(
                        `name`="status", 
                        `title`="Status Category", 
                        `type`="text"),
                    list(
                        `name`="n", 
                        `title`="n", 
                        `type`="integer"),
                    list(
                        `name`="percent", 
                        `title`="%", 
                        `type`="number", 
                        `format`="percent"))))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="mydataview",
                title="mydataview"))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="dataView",
                title="Data Preview"))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot",
                title="Swimmer Plot",
                width=800,
                height=500,
                renderFun=".plot",
                requiresData=TRUE,
                clearWith=list(
                    "patientID",
                    "startTime",
                    "endTime",
                    "status",
                    "markerVar",
                    "markerTime",
                    "markerData",
                    "showArrows",
                    "arrowFilter",
                    "sortSubjects",
                    "laneWidth",
                    "markerSize",
                    "useDarkTheme",
                    "customTitle",
                    "xLabel",
                    "yLabel")))}))

swimmerplot2Base <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "swimmerplot2Base",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = "ClinicoPath",
                name = "swimmerplot2",
                version = c(0,0,3),
                options = options,
                results = swimmerplot2Results$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE,
                requiresMissings = FALSE,
                weightsSupport = 'auto')
        }))

#' Swimmer Plot 2
#'
#' Creates a swimmer plot to visualize subject response data over time.
#'
#' @examples
#' \donttest{
#' data <- data.frame(
#'     patient_id = c("PT001", "PT001", "PT002", "PT002"),
#'     start_time = c(0, 3, 0, 4),
#'     end_time = c(3, 7, 4, 8),
#'     event_type = c("Treatment Start", "Dose Modification", "Treatment Start", "Follow-up"),
#'     response_status = c("PR", "CR", "SD", "PR"),
#'     on_study = c(FALSE, TRUE, FALSE, TRUE)
#' )
#' swimmerplot2(
#'     data = data,
#'     patientID = "patient_id",
#'     startTime = "start_time",
#'     endTime = "end_time",
#'     status = "response_status",
#'     markerData = TRUE,
#'     markerVar = "event_type"
#' )
#'}
#' @param data The data as a data frame in long format where each row
#'   represents a time segment.
#' @param patientID Variable containing subject/patient identifiers.
#' @param startTime Start time variable for each lane segment (also used as
#'   marker position by default).
#' @param endTime End time variable for each lane segment.
#' @param status Response or status variable to color lanes.
#' @param markerData Whether to include event markers at the start time of
#'   each segment.
#' @param markerVar Variable indicating the type of event to be displayed as
#'   markers.
#' @param markerTime Optional separate time variable for marker positions. If
#'   not specified, start time is used.
#' @param showArrows Show arrows at the end of lanes to indicate ongoing
#'   status.
#' @param arrowFilter Boolean variable indicating which subjects should have
#'   arrows (TRUE = show arrow).
#' @param sortSubjects How to sort subjects in the plot.
#' @param laneWidth .
#' @param markerSize .
#' @param useDarkTheme .
#' @param customTitle .
#' @param xLabel .
#' @param yLabel .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$todo} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$summary} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$mydataview} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$dataView} \tab \tab \tab \tab \tab a preformatted \cr
#'   \code{results$plot} \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$summary$asDF}
#'
#' \code{as.data.frame(results$summary)}
#'
#' @export
swimmerplot2 <- function(
    data,
    patientID,
    startTime,
    endTime,
    status,
    markerData = FALSE,
    markerVar,
    markerTime,
    showArrows = FALSE,
    arrowFilter,
    sortSubjects = "id",
    laneWidth = 2,
    markerSize = 5,
    useDarkTheme = FALSE,
    customTitle = "Swimmer Plot",
    xLabel = "Time",
    yLabel = "Subject ID") {

    if ( ! requireNamespace("jmvcore", quietly=TRUE))
        stop("swimmerplot2 requires jmvcore to be installed (restart may be required)")

    if ( ! missing(patientID)) patientID <- jmvcore::resolveQuo(jmvcore::enquo(patientID))
    if ( ! missing(startTime)) startTime <- jmvcore::resolveQuo(jmvcore::enquo(startTime))
    if ( ! missing(endTime)) endTime <- jmvcore::resolveQuo(jmvcore::enquo(endTime))
    if ( ! missing(status)) status <- jmvcore::resolveQuo(jmvcore::enquo(status))
    if ( ! missing(markerVar)) markerVar <- jmvcore::resolveQuo(jmvcore::enquo(markerVar))
    if ( ! missing(markerTime)) markerTime <- jmvcore::resolveQuo(jmvcore::enquo(markerTime))
    if ( ! missing(arrowFilter)) arrowFilter <- jmvcore::resolveQuo(jmvcore::enquo(arrowFilter))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(patientID), patientID, NULL),
            `if`( ! missing(startTime), startTime, NULL),
            `if`( ! missing(endTime), endTime, NULL),
            `if`( ! missing(status), status, NULL),
            `if`( ! missing(markerVar), markerVar, NULL),
            `if`( ! missing(markerTime), markerTime, NULL),
            `if`( ! missing(arrowFilter), arrowFilter, NULL))

    for (v in status) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in markerVar) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
    for (v in arrowFilter) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])

    options <- swimmerplot2Options$new(
        patientID = patientID,
        startTime = startTime,
        endTime = endTime,
        status = status,
        markerData = markerData,
        markerVar = markerVar,
        markerTime = markerTime,
        showArrows = showArrows,
        arrowFilter = arrowFilter,
        sortSubjects = sortSubjects,
        laneWidth = laneWidth,
        markerSize = markerSize,
        useDarkTheme = useDarkTheme,
        customTitle = customTitle,
        xLabel = xLabel,
        yLabel = yLabel)

    analysis <- swimmerplot2Class$new(
        options = options,
        data = data)

    analysis$run()

    analysis$results
}
sbalci/ClinicoPathJamoviModule documentation built on June 13, 2025, 9:34 a.m.