snowCluster: Multivariate Analysis

Documented in hcm

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

hcmOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "hcmOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            podatki = NULL,
            imena = NULL,
            stand = TRUE,
            dis = "euclidean",
            method = "ward.D2",
            grp = "number",
            group = 2,
            hght = 15,
            case = FALSE,
            dend = FALSE,
            horiz = FALSE,
            heat = FALSE,
            pair = FALSE,
            width = 500,
            height = 500,
            width1 = 500,
            height1 = 500,
            width2 = 500,
            height2 = 500, ...) {

            super$initialize(
                package="snowCluster",
                name="hcm",
                requiresData=TRUE,
                ...)

            private$..podatki <- jmvcore::OptionVariables$new(
                "podatki",
                podatki,
                rejectInf=TRUE)
            private$..imena <- jmvcore::OptionVariable$new(
                "imena",
                imena,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "id",
                    "factor"))
            private$..stand <- jmvcore::OptionBool$new(
                "stand",
                stand,
                default=TRUE)
            private$..dis <- jmvcore::OptionList$new(
                "dis",
                dis,
                options=list(
                    "euclidean",
                    "manhattan",
                    "maximum",
                    "canberra",
                    "binary",
                    "minkowski"),
                default="euclidean")
            private$..method <- jmvcore::OptionList$new(
                "method",
                method,
                options=list(
                    "ward.D2",
                    "ward.D",
                    "centroid",
                    "complete",
                    "average",
                    "single",
                    "mcquitty",
                    "median"),
                default="ward.D2")
            private$..grp <- jmvcore::OptionList$new(
                "grp",
                grp,
                options=list(
                    "height",
                    "number"),
                default="number")
            private$..group <- jmvcore::OptionInteger$new(
                "group",
                group,
                default=2,
                min=2)
            private$..hght <- jmvcore::OptionNumber$new(
                "hght",
                hght,
                default=15,
                min=0.01)
            private$..case <- jmvcore::OptionBool$new(
                "case",
                case,
                default=FALSE)
            private$..dend <- jmvcore::OptionBool$new(
                "dend",
                dend,
                default=FALSE)
            private$..horiz <- jmvcore::OptionBool$new(
                "horiz",
                horiz,
                default=FALSE)
            private$..heat <- jmvcore::OptionBool$new(
                "heat",
                heat,
                default=FALSE)
            private$..pair <- jmvcore::OptionBool$new(
                "pair",
                pair,
                default=FALSE)
            private$..clust <- jmvcore::OptionOutput$new(
                "clust")
            private$..width <- jmvcore::OptionInteger$new(
                "width",
                width,
                default=500)
            private$..height <- jmvcore::OptionInteger$new(
                "height",
                height,
                default=500)
            private$..width1 <- jmvcore::OptionInteger$new(
                "width1",
                width1,
                default=500)
            private$..height1 <- jmvcore::OptionInteger$new(
                "height1",
                height1,
                default=500)
            private$..width2 <- jmvcore::OptionInteger$new(
                "width2",
                width2,
                default=500)
            private$..height2 <- jmvcore::OptionInteger$new(
                "height2",
                height2,
                default=500)

            self$.addOption(private$..podatki)
            self$.addOption(private$..imena)
            self$.addOption(private$..stand)
            self$.addOption(private$..dis)
            self$.addOption(private$..method)
            self$.addOption(private$..grp)
            self$.addOption(private$..group)
            self$.addOption(private$..hght)
            self$.addOption(private$..case)
            self$.addOption(private$..dend)
            self$.addOption(private$..horiz)
            self$.addOption(private$..heat)
            self$.addOption(private$..pair)
            self$.addOption(private$..clust)
            self$.addOption(private$..width)
            self$.addOption(private$..height)
            self$.addOption(private$..width1)
            self$.addOption(private$..height1)
            self$.addOption(private$..width2)
            self$.addOption(private$..height2)
        }),
    active = list(
        podatki = function() private$..podatki$value,
        imena = function() private$..imena$value,
        stand = function() private$..stand$value,
        dis = function() private$..dis$value,
        method = function() private$..method$value,
        grp = function() private$..grp$value,
        group = function() private$..group$value,
        hght = function() private$..hght$value,
        case = function() private$..case$value,
        dend = function() private$..dend$value,
        horiz = function() private$..horiz$value,
        heat = function() private$..heat$value,
        pair = function() private$..pair$value,
        clust = function() private$..clust$value,
        width = function() private$..width$value,
        height = function() private$..height$value,
        width1 = function() private$..width1$value,
        height1 = function() private$..height1$value,
        width2 = function() private$..width2$value,
        height2 = function() private$..height2$value),
    private = list(
        ..podatki = NA,
        ..imena = NA,
        ..stand = NA,
        ..dis = NA,
        ..method = NA,
        ..grp = NA,
        ..group = NA,
        ..hght = NA,
        ..case = NA,
        ..dend = NA,
        ..horiz = NA,
        ..heat = NA,
        ..pair = NA,
        ..clust = NA,
        ..width = NA,
        ..height = NA,
        ..width1 = NA,
        ..height1 = NA,
        ..width2 = NA,
        ..height2 = NA)
)

hcmResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "hcmResults",
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        izpis = function() private$.items[["izpis"]],
        groups = function() private$.items[["groups"]],
        plot = function() private$.items[["plot"]],
        heat = function() private$.items[["heat"]],
        pairs = function() private$.items[["pairs"]],
        clust = function() private$.items[["clust"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Hierarchical Clustering",
                refs="snowCluster")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                visible=TRUE))
            self$add(jmvcore::Table$new(
                options=options,
                name="izpis",
                title="Summary",
                rows=1,
                clearWith=list(
                    "dis",
                    "method"),
                columns=list(
                    list(
                        `name`="var", 
                        `title`="Variables", 
                        `type`="integer"),
                    list(
                        `name`="case", 
                        `title`="Cases", 
                        `type`="integer"),
                    list(
                        `name`="dist", 
                        `title`="Distances", 
                        `type`="text"),
                    list(
                        `name`="method", 
                        `title`="Clustering method", 
                        `type`="text"))))
            self$add(jmvcore::Table$new(
                options=options,
                name="groups",
                title="Group membership",
                rows=0,
                columns=list(
                    list(
                        `name`="cluster", 
                        `title`="Cluster", 
                        `type`="integer"),
                    list(
                        `name`="freq", 
                        `title`="Number of elements", 
                        `type`="integer")),
                clearWith=list(
                    "dis",
                    "method",
                    "group",
                    "grp",
                    "hght",
                    "case")))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot",
                title="Dendrogram",
                visible=FALSE,
                renderFun=".plot",
                clearWith=list(
                    "dis",
                    "method",
                    "group",
                    "grp",
                    "hght",
                    "case",
                    "width",
                    "height",
                    "horiz")))
            self$add(jmvcore::Image$new(
                options=options,
                name="heat",
                title="Heatmap",
                visible=FALSE,
                renderFun=".heat",
                clearWith=list(
                    "width1",
                    "height1")))
            self$add(jmvcore::Image$new(
                options=options,
                name="pairs",
                title="Pairs plot",
                visible=FALSE,
                renderFun=".pairs",
                clearWith=list(
                    "width2",
                    "height2")))
            self$add(jmvcore::Output$new(
                options=options,
                name="clust",
                title="Clustering",
                varTitle="Clustering",
                measureType="nominal",
                clearWith=list(
                    "dis",
                    "method",
                    "group",
                    "grp",
                    "hght",
                    "case")))}))

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

#' Hierarchical Clustering
#'
#' 
#' @param data .
#' @param podatki .
#' @param imena .
#' @param stand .
#' @param dis .
#' @param method .
#' @param grp .
#' @param group .
#' @param hght .
#' @param case .
#' @param dend .
#' @param horiz .
#' @param heat .
#' @param pair .
#' @param width .
#' @param height .
#' @param width1 .
#' @param height1 .
#' @param width2 .
#' @param height2 .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$izpis} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$groups} \tab \tab \tab \tab \tab a table \cr
#'   \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$heat} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$pairs} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$clust} \tab \tab \tab \tab \tab an output \cr
#' }
#'
#' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
#'
#' \code{results$izpis$asDF}
#'
#' \code{as.data.frame(results$izpis)}
#'
#' @export
hcm <- function(
    data,
    podatki,
    imena,
    stand = TRUE,
    dis = "euclidean",
    method = "ward.D2",
    grp = "number",
    group = 2,
    hght = 15,
    case = FALSE,
    dend = FALSE,
    horiz = FALSE,
    heat = FALSE,
    pair = FALSE,
    width = 500,
    height = 500,
    width1 = 500,
    height1 = 500,
    width2 = 500,
    height2 = 500) {

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

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


    options <- hcmOptions$new(
        podatki = podatki,
        imena = imena,
        stand = stand,
        dis = dis,
        method = method,
        grp = grp,
        group = group,
        hght = hght,
        case = case,
        dend = dend,
        horiz = horiz,
        heat = heat,
        pair = pair,
        width = width,
        height = height,
        width1 = width1,
        height1 = height1,
        width2 = width2,
        height2 = height2)

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

    analysis$run()

    analysis$results
}