ClinicoPathJamoviModule: Analysis for Clinicopathological Research

Documented in classification

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

classificationOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "classificationOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            dep = NULL,
            indep = NULL,
            testSize = 0.33,
            noOfFolds = 10,
            testing = NULL,
            reporting = list(
                "classifMetrices"),
            classifier = NULL,
            minSplit = 20,
            minBucket = 0,
            complecity = 0.01,
            maxCompete = 4,
            maxSurrogate = 5,
            unsurrogate = 2,
            noCrossValidations = 10,
            maxDepth = 30,
            noOfTrees = 10,
            maxDepthRandFor = 30,
            sampleFraction = 1,
            splitRule = NULL,
            plotDecisionTree = FALSE,
            predictedFreq = FALSE,
            printRandForest = FALSE,
            predictedFreqRF = FALSE, ...) {

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

            private$..dep <- jmvcore::OptionVariable$new(
                "dep",
                dep,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "factor"))
            private$..indep <- jmvcore::OptionVariables$new(
                "indep",
                indep,
                suggested=list(
                    "nominal",
                    "continuous"),
                permitted=list(
                    "factor",
                    "numeric"))
            private$..testSize <- jmvcore::OptionNumber$new(
                "testSize",
                testSize,
                default=0.33)
            private$..noOfFolds <- jmvcore::OptionNumber$new(
                "noOfFolds",
                noOfFolds,
                default=10)
            private$..testing <- jmvcore::OptionList$new(
                "testing",
                testing,
                options=list(
                    "trainSet",
                    "split",
                    "crossValidation"))
            private$..reporting <- jmvcore::OptionNMXList$new(
                "reporting",
                reporting,
                options=list(
                    "classifMetrices",
                    "confusionMatrix",
                    "AUC"),
                default=list(
                    "classifMetrices"))
            private$..classifier <- jmvcore::OptionList$new(
                "classifier",
                classifier,
                options=list(
                    "singleDecisionTree",
                    "randomForest"))
            private$..minSplit <- jmvcore::OptionNumber$new(
                "minSplit",
                minSplit,
                default=20)
            private$..minBucket <- jmvcore::OptionNumber$new(
                "minBucket",
                minBucket,
                default=0)
            private$..complecity <- jmvcore::OptionNumber$new(
                "complecity",
                complecity,
                default=0.01)
            private$..maxCompete <- jmvcore::OptionNumber$new(
                "maxCompete",
                maxCompete,
                default=4)
            private$..maxSurrogate <- jmvcore::OptionNumber$new(
                "maxSurrogate",
                maxSurrogate,
                default=5)
            private$..unsurrogate <- jmvcore::OptionNumber$new(
                "unsurrogate",
                unsurrogate,
                default=2)
            private$..noCrossValidations <- jmvcore::OptionNumber$new(
                "noCrossValidations",
                noCrossValidations,
                default=10)
            private$..maxDepth <- jmvcore::OptionNumber$new(
                "maxDepth",
                maxDepth,
                default=30)
            private$..noOfTrees <- jmvcore::OptionNumber$new(
                "noOfTrees",
                noOfTrees,
                default=10)
            private$..maxDepthRandFor <- jmvcore::OptionNumber$new(
                "maxDepthRandFor",
                maxDepthRandFor,
                default=30)
            private$..sampleFraction <- jmvcore::OptionNumber$new(
                "sampleFraction",
                sampleFraction,
                default=1)
            private$..splitRule <- jmvcore::OptionList$new(
                "splitRule",
                splitRule,
                options=list(
                    "gini",
                    "extratrees",
                    "hellinger"))
            private$..plotDecisionTree <- jmvcore::OptionBool$new(
                "plotDecisionTree",
                plotDecisionTree,
                default=FALSE)
            private$..predictedFreq <- jmvcore::OptionBool$new(
                "predictedFreq",
                predictedFreq,
                default=FALSE)
            private$..printRandForest <- jmvcore::OptionBool$new(
                "printRandForest",
                printRandForest,
                default=FALSE)
            private$..predictedFreqRF <- jmvcore::OptionBool$new(
                "predictedFreqRF",
                predictedFreqRF,
                default=FALSE)

            self$.addOption(private$..dep)
            self$.addOption(private$..indep)
            self$.addOption(private$..testSize)
            self$.addOption(private$..noOfFolds)
            self$.addOption(private$..testing)
            self$.addOption(private$..reporting)
            self$.addOption(private$..classifier)
            self$.addOption(private$..minSplit)
            self$.addOption(private$..minBucket)
            self$.addOption(private$..complecity)
            self$.addOption(private$..maxCompete)
            self$.addOption(private$..maxSurrogate)
            self$.addOption(private$..unsurrogate)
            self$.addOption(private$..noCrossValidations)
            self$.addOption(private$..maxDepth)
            self$.addOption(private$..noOfTrees)
            self$.addOption(private$..maxDepthRandFor)
            self$.addOption(private$..sampleFraction)
            self$.addOption(private$..splitRule)
            self$.addOption(private$..plotDecisionTree)
            self$.addOption(private$..predictedFreq)
            self$.addOption(private$..printRandForest)
            self$.addOption(private$..predictedFreqRF)
        }),
    active = list(
        dep = function() private$..dep$value,
        indep = function() private$..indep$value,
        testSize = function() private$..testSize$value,
        noOfFolds = function() private$..noOfFolds$value,
        testing = function() private$..testing$value,
        reporting = function() private$..reporting$value,
        classifier = function() private$..classifier$value,
        minSplit = function() private$..minSplit$value,
        minBucket = function() private$..minBucket$value,
        complecity = function() private$..complecity$value,
        maxCompete = function() private$..maxCompete$value,
        maxSurrogate = function() private$..maxSurrogate$value,
        unsurrogate = function() private$..unsurrogate$value,
        noCrossValidations = function() private$..noCrossValidations$value,
        maxDepth = function() private$..maxDepth$value,
        noOfTrees = function() private$..noOfTrees$value,
        maxDepthRandFor = function() private$..maxDepthRandFor$value,
        sampleFraction = function() private$..sampleFraction$value,
        splitRule = function() private$..splitRule$value,
        plotDecisionTree = function() private$..plotDecisionTree$value,
        predictedFreq = function() private$..predictedFreq$value,
        printRandForest = function() private$..printRandForest$value,
        predictedFreqRF = function() private$..predictedFreqRF$value),
    private = list(
        ..dep = NA,
        ..indep = NA,
        ..testSize = NA,
        ..noOfFolds = NA,
        ..testing = NA,
        ..reporting = NA,
        ..classifier = NA,
        ..minSplit = NA,
        ..minBucket = NA,
        ..complecity = NA,
        ..maxCompete = NA,
        ..maxSurrogate = NA,
        ..unsurrogate = NA,
        ..noCrossValidations = NA,
        ..maxDepth = NA,
        ..noOfTrees = NA,
        ..maxDepthRandFor = NA,
        ..sampleFraction = NA,
        ..splitRule = NA,
        ..plotDecisionTree = NA,
        ..predictedFreq = NA,
        ..printRandForest = NA,
        ..predictedFreqRF = NA)
)

classificationResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "classificationResults",
    inherit = jmvcore::Group,
    active = list(
        modelSettings = function() private$.items[["modelSettings"]],
        confusion = function() private$.items[["confusion"]],
        classificationMetrics = function() private$.items[["classificationMetrics"]],
        rocCurvePlot = function() private$.items[["rocCurvePlot"]],
        decisionTreeModel = function() private$.items[["decisionTreeModel"]],
        predictedFreqPlot = function() private$.items[["predictedFreqPlot"]],
        printRandForest = function() private$.items[["printRandForest"]],
        text = function() private$.items[["text"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Decision tree")
            self$add(jmvcore::Html$new(
                options=options,
                name="modelSettings",
                title="Model parameters"))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    matrix = function() private$.items[["matrix"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="confusion",
                            title="Confusion matric")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="matrix",
                            title="Confusion matrix",
                            visible="(reporting:confusionMatrix)",
                            rows=0,
                            columns=list(
                                list(
                                    `name`="class", 
                                    `title`="response", 
                                    `type`="number"))))}))$new(options=options))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    general = function() private$.items[["general"]],
                    class = function() private$.items[["class"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="classificationMetrics",
                            title="Classification metrics")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="general",
                            visible="(reporting:classifMetrices)",
                            title="General",
                            rows=0,
                            columns=list(
                                list(
                                    `name`="metric", 
                                    `title`="Metric", 
                                    `type`="text"),
                                list(
                                    `name`="value", 
                                    `title`="Value", 
                                    `type`="number"))))
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="class",
                            title="Per class",
                            visible="(reporting:classifMetrices)",
                            rows=0,
                            columns=list(
                                list(
                                    `name`="class", 
                                    `title`="class name", 
                                    `type`="text"),
                                list(
                                    `name`="classif.precision", 
                                    `title`="precision", 
                                    `type`="number", 
                                    `visible`="(reporting:classifMetrices)"),
                                list(
                                    `name`="classif.recall", 
                                    `title`="recall", 
                                    `type`="number", 
                                    `visible`="(reporting:classifMetrices)"),
                                list(
                                    `name`="classif.fbeta", 
                                    `title`="F-score", 
                                    `type`="number", 
                                    `visible`="(reporting:classifMetrices)"),
                                list(
                                    `name`="classif.auc", 
                                    `title`="AUC", 
                                    `type`="number", 
                                    `visible`="(reporting:AUC)"))))}))$new(options=options))
            self$add(jmvcore::Image$new(
                options=options,
                name="rocCurvePlot",
                title="ROC curve",
                visible="(reporting:AUC)",
                width=400,
                height=300,
                renderFun=".plotRocCurve"))
            self$add(jmvcore::Image$new(
                options=options,
                name="decisionTreeModel",
                title="Decision tree model",
                visible="(plotDecisionTree)",
                width=400,
                height=300,
                renderFun=".printDecisionTree"))
            self$add(jmvcore::Image$new(
                options=options,
                name="predictedFreqPlot",
                title="Predicted frequencies",
                visible="(predictedFreq)",
                width=350,
                height=450,
                renderFun=".plotFrequencies"))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    randomForestModel = function() private$.items[["randomForestModel"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="printRandForest",
                            title="Random forest model")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="randomForestModel",
                            title="",
                            visible="(printRandForest)",
                            rows=8,
                            columns=list(
                                list(
                                    `name`="type", 
                                    `title`="Type", 
                                    `type`="Text"),
                                list(
                                    `name`="classif", 
                                    `title`="Classification", 
                                    `type`="Number"))))}))$new(options=options))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="text",
                title=""))}))

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

#' Decision tree
#'
#' 
#' @param data .
#' @param dep .
#' @param indep .
#' @param testSize .
#' @param noOfFolds .
#' @param testing .
#' @param reporting .
#' @param classifier .
#' @param minSplit .
#' @param minBucket .
#' @param complecity .
#' @param maxCompete .
#' @param maxSurrogate .
#' @param unsurrogate .
#' @param noCrossValidations .
#' @param maxDepth .
#' @param noOfTrees .
#' @param maxDepthRandFor .
#' @param sampleFraction .
#' @param splitRule .
#' @param plotDecisionTree .
#' @param predictedFreq .
#' @param printRandForest .
#' @param predictedFreqRF .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$modelSettings} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$confusion$matrix} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$classificationMetrics$general} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$classificationMetrics$class} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$rocCurvePlot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$decisionTreeModel} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$predictedFreqPlot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$printRandForest$randomForestModel} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
#' }
#'
#' @export
classification <- function(
    data,
    dep,
    indep,
    testSize = 0.33,
    noOfFolds = 10,
    testing,
    reporting = list(
                "classifMetrices"),
    classifier,
    minSplit = 20,
    minBucket = 0,
    complecity = 0.01,
    maxCompete = 4,
    maxSurrogate = 5,
    unsurrogate = 2,
    noCrossValidations = 10,
    maxDepth = 30,
    noOfTrees = 10,
    maxDepthRandFor = 30,
    sampleFraction = 1,
    splitRule,
    plotDecisionTree = FALSE,
    predictedFreq = FALSE,
    printRandForest = FALSE,
    predictedFreqRF = FALSE) {

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

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

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

    options <- classificationOptions$new(
        dep = dep,
        indep = indep,
        testSize = testSize,
        noOfFolds = noOfFolds,
        testing = testing,
        reporting = reporting,
        classifier = classifier,
        minSplit = minSplit,
        minBucket = minBucket,
        complecity = complecity,
        maxCompete = maxCompete,
        maxSurrogate = maxSurrogate,
        unsurrogate = unsurrogate,
        noCrossValidations = noCrossValidations,
        maxDepth = maxDepth,
        noOfTrees = noOfTrees,
        maxDepthRandFor = maxDepthRandFor,
        sampleFraction = sampleFraction,
        splitRule = splitRule,
        plotDecisionTree = plotDecisionTree,
        predictedFreq = predictedFreq,
        printRandForest = printRandForest,
        predictedFreqRF = predictedFreqRF)

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

    analysis$run()

    analysis$results
}