R/experimenter.h.R

Defines functions experimenter

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

experimenterOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
    "experimenterOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            dep = NULL,
            indep = NULL,
            testSize = 0.33,
            noOfFolds = 10,
            testing = NULL,
            reporting = list(
                "classifMetrices"),
            classifiersToUse = NULL,
            classifierSettings = NULL, ...) {

            super$initialize(
                package='MachineLearning',
                name='experimenter',
                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",
                    "perClass",
                    "AUC",
                    "plotMetricComparison"),
                default=list(
                    "classifMetrices"))
            private$..classifiersToUse <- jmvcore::OptionTerms$new(
                "classifiersToUse",
                classifiersToUse)
            private$..classifierSettings <- jmvcore::OptionString$new(
                "classifierSettings",
                classifierSettings)

            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$..classifiersToUse)
            self$.addOption(private$..classifierSettings)
        }),
    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,
        classifiersToUse = function() private$..classifiersToUse$value,
        classifierSettings = function() private$..classifierSettings$value),
    private = list(
        ..dep = NA,
        ..indep = NA,
        ..testSize = NA,
        ..noOfFolds = NA,
        ..testing = NA,
        ..reporting = NA,
        ..classifiersToUse = NA,
        ..classifierSettings = NA)
)

experimenterResults <- if (requireNamespace('jmvcore')) R6::R6Class(
    inherit = jmvcore::Group,
    active = list(
        overallMetrics = function() private$.items[["overallMetrics"]],
        perClassMetrics = function() private$.items[["perClassMetrics"]],
        rocCurvePlots = function() private$.items[["rocCurvePlots"]],
        metricComparison = function() private$.items[["metricComparison"]],
        text = function() private$.items[["text"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Experimenter")
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    overallMetricsTable = function() private$.items[["overallMetricsTable"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="overallMetrics",
                            title="Classification metrics")
                        self$add(jmvcore::Table$new(
                            options=options,
                            name="overallMetricsTable",
                            title="Overall metrics",
                            visible="(reporting:classifMetrices)",
                            columns=list(
                                list(
                                    `name`="classifier", 
                                    `title`="classifier", 
                                    `type`="text"),
                                list(
                                    `name`="classif.acc", 
                                    `title`="Accuracy", 
                                    `type`="number"),
                                list(
                                    `name`="classif.bacc", 
                                    `title`="Balanced accuracy", 
                                    `type`="number"),
                                list(
                                    `name`="classif.ce", 
                                    `title`="Error rate", 
                                    `type`="number"),
                                list(
                                    `name`="classif.recall", 
                                    `title`="Macro recall", 
                                    `type`="number"),
                                list(
                                    `name`="classif.precision", 
                                    `title`="Macro precision", 
                                    `type`="number"),
                                list(
                                    `name`="classif.fbeta", 
                                    `title`="Macro F-score", 
                                    `type`="number"),
                                list(
                                    `name`="classif.auc", 
                                    `title`="Macro AUC", 
                                    `type`="number", 
                                    `visible`="(reporting:AUC)"))))}))$new(options=options))
            self$add(jmvcore::Array$new(
                options=options,
                name="perClassMetrics",
                title="Per class metrics",
                items="(classifiersToUse)",
                template=jmvcore::Table$new(
                    options=options,
                    title="($key)",
                    visible="(reporting:perClass)",
                    columns=list(
                        list(
                            `name`="class", 
                            `title`="class name", 
                            `type`="text"),
                        list(
                            `name`="classif.precision", 
                            `title`="precision", 
                            `type`="number"),
                        list(
                            `name`="classif.recall", 
                            `title`="recall", 
                            `type`="number"),
                        list(
                            `name`="classif.fbeta", 
                            `title`="F-score", 
                            `type`="number"),
                        list(
                            `name`="classif.auc", 
                            `title`="AUC", 
                            `type`="number", 
                            `visible`="(reporting:AUC)")))))
            self$add(jmvcore::Array$new(
                options=options,
                name="rocCurvePlots",
                title="Roc curve plots",
                items="(classifiersToUse)",
                template=jmvcore::Image$new(
                    options=options,
                    title="($key)",
                    visible="(reporting:AUC)",
                    width=600,
                    height=300,
                    renderFun=".rocCurve")))
            self$add(R6::R6Class(
                inherit = jmvcore::Group,
                active = list(
                    metricComparisonPlot = function() private$.items[["metricComparisonPlot"]],
                    perClassComparisonPlot = function() private$.items[["perClassComparisonPlot"]]),
                private = list(),
                public=list(
                    initialize=function(options) {
                        super$initialize(
                            options=options,
                            name="metricComparison",
                            title="Metric comparison")
                        self$add(jmvcore::Image$new(
                            options=options,
                            name="metricComparisonPlot",
                            title="Metric comparison",
                            visible="(reporting:plotMetricComparison)",
                            width=700,
                            height=300,
                            renderFun=".plotMetricComparison"))
                        self$add(jmvcore::Image$new(
                            options=options,
                            name="perClassComparisonPlot",
                            title="Per class metric comparison",
                            visible="(reporting:plotMetricComparison)",
                            width=700,
                            height=600,
                            renderFun=".perClassMetricComparison"))}))$new(options=options))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="text"))}))

experimenterBase <- if (requireNamespace('jmvcore')) R6::R6Class(
    "experimenterBase",
    inherit = jmvcore::Analysis,
    public = list(
        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
            super$initialize(
                package = 'MachineLearning',
                name = 'experimenter',
                version = c(1,0,0),
                options = options,
                results = experimenterResults$new(options=options),
                data = data,
                datasetId = datasetId,
                analysisId = analysisId,
                revision = revision,
                pause = NULL,
                completeWhenFilled = FALSE)
        }))

#' Experimenter
#'
#' 
#' @param data .
#' @param dep .
#' @param indep .
#' @param testSize .
#' @param noOfFolds .
#' @param testing .
#' @param reporting .
#' @param classifiersToUse .
#' @param classifierSettings .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$overallMetrics$overallMetricsTable} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$perClassMetrics} \tab \tab \tab \tab \tab an array of metrics for class for chosen algorithms \cr
#'   \code{results$rocCurvePlots} \tab \tab \tab \tab \tab an array of roc curve plots for chosen algorithms \cr
#'   \code{results$metricComparison$metricComparisonPlot} \tab \tab \tab \tab \tab plot for comparison of results of chosen algorithms \cr
#'   \code{results$metricComparison$perClassComparisonPlot} \tab \tab \tab \tab \tab plot for comparison of results of specific class for chosen algorithms \cr
#'   \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
#' }
#'
#' @export
experimenter <- function(
    data,
    dep,
    indep,
    testSize = 0.33,
    noOfFolds = 10,
    testing,
    reporting = list(
                "classifMetrices"),
    classifiersToUse,
    classifierSettings) {

    if ( ! requireNamespace('jmvcore'))
        stop('experimenter 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]])
    if (inherits(classifiersToUse, 'formula')) classifiersToUse <- jmvcore::decomposeFormula(classifiersToUse)

    options <- experimenterOptions$new(
        dep = dep,
        indep = indep,
        testSize = testSize,
        noOfFolds = noOfFolds,
        testing = testing,
        reporting = reporting,
        classifiersToUse = classifiersToUse,
        classifierSettings = classifierSettings)

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

    analysis$run()

    analysis$results
}
marusakonecnik/jamovi-plugin-for-machine-learning documentation built on May 2, 2020, 1:24 p.m.