R/ihcstats.h.R

In sbalci/ClinicoPathJamoviModule: Analysis for Clinicopathological Research

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

ihcstatsOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "ihcstatsOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            markers = NULL,
            computeHScore = FALSE,
            clusterMethod = "hierarchical",
            distanceMetric = "gower",
            nClusters = 3,
            showDendrogram = FALSE,
            showHeatmap = FALSE,
            showScoreDist = FALSE, ...) {

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

            private$..markers <- jmvcore::OptionVariables$new(
                "markers",
                markers,
                suggested=list(
                    "ordinal",
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..computeHScore <- jmvcore::OptionBool$new(
                "computeHScore",
                computeHScore,
                default=FALSE)
            private$..clusterMethod <- jmvcore::OptionList$new(
                "clusterMethod",
                clusterMethod,
                options=list(
                    "hierarchical",
                    "pam"),
                default="hierarchical")
            private$..distanceMetric <- jmvcore::OptionList$new(
                "distanceMetric",
                distanceMetric,
                options=list(
                    "gower",
                    "jaccard"),
                default="gower")
            private$..nClusters <- jmvcore::OptionInteger$new(
                "nClusters",
                nClusters,
                min=2,
                max=10,
                default=3)
            private$..showDendrogram <- jmvcore::OptionBool$new(
                "showDendrogram",
                showDendrogram,
                default=FALSE)
            private$..showHeatmap <- jmvcore::OptionBool$new(
                "showHeatmap",
                showHeatmap,
                default=FALSE)
            private$..showScoreDist <- jmvcore::OptionBool$new(
                "showScoreDist",
                showScoreDist,
                default=FALSE)

            self$.addOption(private$..markers)
            self$.addOption(private$..computeHScore)
            self$.addOption(private$..clusterMethod)
            self$.addOption(private$..distanceMetric)
            self$.addOption(private$..nClusters)
            self$.addOption(private$..showDendrogram)
            self$.addOption(private$..showHeatmap)
            self$.addOption(private$..showScoreDist)
        }),
    active = list(
        markers = function() private$..markers$value,
        computeHScore = function() private$..computeHScore$value,
        clusterMethod = function() private$..clusterMethod$value,
        distanceMetric = function() private$..distanceMetric$value,
        nClusters = function() private$..nClusters$value,
        showDendrogram = function() private$..showDendrogram$value,
        showHeatmap = function() private$..showHeatmap$value,
        showScoreDist = function() private$..showScoreDist$value),
    private = list(
        ..markers = NA,
        ..computeHScore = NA,
        ..clusterMethod = NA,
        ..distanceMetric = NA,
        ..nClusters = NA,
        ..showDendrogram = NA,
        ..showHeatmap = NA,
        ..showScoreDist = NA)
)

ihcstatsResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "ihcstatsResults",
    inherit = jmvcore::Group,
    active = list(
        todo = function() private$.items[["todo"]],
        hscoreTable = function() private$.items[["hscoreTable"]],
        clusterSummary = function() private$.items[["clusterSummary"]],
        clusterPlot = function() private$.items[["clusterPlot"]],
        heatmapPlot = function() private$.items[["heatmapPlot"]],
        scoreDist = function() private$.items[["scoreDist"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="IHC Expression Analysis")
            self$add(jmvcore::Html$new(
                options=options,
                name="todo",
                title="Getting Started"))
            self$add(jmvcore::Table$new(
                options=options,
                name="hscoreTable",
                title="H-Score Analysis",
                visible="(computeHScore)",
                columns=list(
                    list(
                        `name`="marker", 
                        `title`="Marker", 
                        `type`="text"),
                    list(
                        `name`="hscore", 
                        `title`="H-Score", 
                        `type`="number", 
                        `format`="zto"),
                    list(
                        `name`="dist", 
                        `title`="Score Distribution", 
                        `type`="text"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="clusterSummary",
                title="Clustering Results",
                columns=list(
                    list(
                        `name`="cluster", 
                        `title`="Cluster", 
                        `type`="integer"),
                    list(
                        `name`="size", 
                        `title`="Size", 
                        `type`="integer"),
                    list(
                        `name`="pattern", 
                        `title`="Expression Pattern", 
                        `type`="text"))))
            self$add(jmvcore::Image$new(
                options=options,
                name="clusterPlot",
                title="Expression Pattern Clustering",
                renderFun=".clusterPlot",
                width=600,
                height=400))
            self$add(jmvcore::Image$new(
                options=options,
                name="heatmapPlot",
                title="Expression Heatmap",
                renderFun=".heatmapPlot",
                width=600,
                height=400))
            self$add(jmvcore::Image$new(
                options=options,
                name="scoreDist",
                title="Score Distribution",
                visible="(showScoreDist)",
                renderFun=".scoreDistPlot",
                width=600,
                height=400))}))

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

#' IHC Expression Analysis
#'
#' 
#' @param data The data as a data frame.
#' @param markers IHC marker variables with categorical expression scores
#' @param computeHScore .
#' @param clusterMethod .
#' @param distanceMetric .
#' @param nClusters .
#' @param showDendrogram .
#' @param showHeatmap .
#' @param showScoreDist .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$todo} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$hscoreTable} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$clusterSummary} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$clusterPlot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$heatmapPlot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$scoreDist} \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$hscoreTable$asDF}
#'
#' \code{as.data.frame(results$hscoreTable)}
#'
#' @export
ihcstats <- function(
    data,
    markers,
    computeHScore = FALSE,
    clusterMethod = "hierarchical",
    distanceMetric = "gower",
    nClusters = 3,
    showDendrogram = FALSE,
    showHeatmap = FALSE,
    showScoreDist = FALSE) {

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

    if ( ! missing(markers)) markers <- jmvcore::resolveQuo(jmvcore::enquo(markers))
    if (missing(data))
        data <- jmvcore::marshalData(
            parent.frame(),
            `if`( ! missing(markers), markers, NULL))

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

    options <- ihcstatsOptions$new(
        markers = markers,
        computeHScore = computeHScore,
        clusterMethod = clusterMethod,
        distanceMetric = distanceMetric,
        nClusters = nClusters,
        showDendrogram = showDendrogram,
        showHeatmap = showHeatmap,
        showScoreDist = showScoreDist)

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

    analysis$run()

    analysis$results
}