R/hc.h.R

In hyunsooseol/snowCluster: Multivariate Analysis

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

hcOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "hcOptions",
    inherit = jmvcore::Options,
    public = list(
        initialize = function(
            mode = NULL,
            labels = NULL,
            vars = NULL,
            stand = TRUE,
            k = 2,
            metric = "euclidean",
            method = "ward.D2",
            type = "rectangle",
            plot = FALSE,
            horiz = FALSE,
            width = 500,
            height = 500,
            vars1 = NULL,
            method1 = "average",
            nb = 100,
            dm = "correlation",
            plot1 = FALSE,
            width1 = 500,
            height1 = 500, ...) {

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

            private$..mode <- jmvcore::OptionList$new(
                "mode",
                mode,
                options=list(
                    "simple",
                    "complex"))
            private$..labels <- jmvcore::OptionVariable$new(
                "labels",
                labels,
                suggested=list(
                    "nominal"),
                permitted=list(
                    "id",
                    "factor"))
            private$..vars <- jmvcore::OptionVariables$new(
                "vars",
                vars)
            private$..stand <- jmvcore::OptionBool$new(
                "stand",
                stand,
                default=TRUE)
            private$..k <- jmvcore::OptionInteger$new(
                "k",
                k,
                default=2,
                min=1)
            private$..metric <- jmvcore::OptionList$new(
                "metric",
                metric,
                options=list(
                    "euclidean",
                    "manhattan",
                    "maximum",
                    "canberra",
                    "binary",
                    "minkowski"),
                default="euclidean")
            private$..method <- jmvcore::OptionList$new(
                "method",
                method,
                options=list(
                    "ward.D",
                    "ward.D2",
                    "single",
                    "complete",
                    "average"),
                default="ward.D2")
            private$..type <- jmvcore::OptionList$new(
                "type",
                type,
                options=list(
                    "rectangle",
                    "circular",
                    "phylogenic"),
                default="rectangle")
            private$..plot <- jmvcore::OptionBool$new(
                "plot",
                plot,
                default=FALSE)
            private$..clust <- jmvcore::OptionOutput$new(
                "clust")
            private$..horiz <- jmvcore::OptionBool$new(
                "horiz",
                horiz,
                default=FALSE)
            private$..width <- jmvcore::OptionInteger$new(
                "width",
                width,
                default=500)
            private$..height <- jmvcore::OptionInteger$new(
                "height",
                height,
                default=500)
            private$..vars1 <- jmvcore::OptionVariables$new(
                "vars1",
                vars1)
            private$..method1 <- jmvcore::OptionList$new(
                "method1",
                method1,
                options=list(
                    "average",
                    "median",
                    "centroid",
                    "ward.D",
                    "ward.D2",
                    "single",
                    "complete",
                    "mcquitty"),
                default="average")
            private$..nb <- jmvcore::OptionInteger$new(
                "nb",
                nb,
                default=100,
                min=10)
            private$..dm <- jmvcore::OptionList$new(
                "dm",
                dm,
                options=list(
                    "correlation",
                    "uncentered",
                    "abscor"),
                default="correlation")
            private$..plot1 <- jmvcore::OptionBool$new(
                "plot1",
                plot1,
                default=FALSE)
            private$..width1 <- jmvcore::OptionInteger$new(
                "width1",
                width1,
                default=500)
            private$..height1 <- jmvcore::OptionInteger$new(
                "height1",
                height1,
                default=500)

            self$.addOption(private$..mode)
            self$.addOption(private$..labels)
            self$.addOption(private$..vars)
            self$.addOption(private$..stand)
            self$.addOption(private$..k)
            self$.addOption(private$..metric)
            self$.addOption(private$..method)
            self$.addOption(private$..type)
            self$.addOption(private$..plot)
            self$.addOption(private$..clust)
            self$.addOption(private$..horiz)
            self$.addOption(private$..width)
            self$.addOption(private$..height)
            self$.addOption(private$..vars1)
            self$.addOption(private$..method1)
            self$.addOption(private$..nb)
            self$.addOption(private$..dm)
            self$.addOption(private$..plot1)
            self$.addOption(private$..width1)
            self$.addOption(private$..height1)
        }),
    active = list(
        mode = function() private$..mode$value,
        labels = function() private$..labels$value,
        vars = function() private$..vars$value,
        stand = function() private$..stand$value,
        k = function() private$..k$value,
        metric = function() private$..metric$value,
        method = function() private$..method$value,
        type = function() private$..type$value,
        plot = function() private$..plot$value,
        clust = function() private$..clust$value,
        horiz = function() private$..horiz$value,
        width = function() private$..width$value,
        height = function() private$..height$value,
        vars1 = function() private$..vars1$value,
        method1 = function() private$..method1$value,
        nb = function() private$..nb$value,
        dm = function() private$..dm$value,
        plot1 = function() private$..plot1$value,
        width1 = function() private$..width1$value,
        height1 = function() private$..height1$value),
    private = list(
        ..mode = NA,
        ..labels = NA,
        ..vars = NA,
        ..stand = NA,
        ..k = NA,
        ..metric = NA,
        ..method = NA,
        ..type = NA,
        ..plot = NA,
        ..clust = NA,
        ..horiz = NA,
        ..width = NA,
        ..height = NA,
        ..vars1 = NA,
        ..method1 = NA,
        ..nb = NA,
        ..dm = NA,
        ..plot1 = NA,
        ..width1 = NA,
        ..height1 = NA)
)

hcResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
    "hcResults",
    inherit = jmvcore::Group,
    active = list(
        instructions = function() private$.items[["instructions"]],
        clust = function() private$.items[["clust"]],
        plot = function() private$.items[["plot"]],
        plot1 = function() private$.items[["plot1"]],
        text = function() private$.items[["text"]]),
    private = list(),
    public=list(
        initialize=function(options) {
            super$initialize(
                options=options,
                name="",
                title="Clustering Dendrogram",
                refs="snowCluster")
            self$add(jmvcore::Html$new(
                options=options,
                name="instructions",
                title="Instructions",
                visible=TRUE))
            self$add(jmvcore::Output$new(
                options=options,
                name="clust",
                title="Clustering",
                varTitle="Clustering",
                measureType="nominal",
                clearWith=list(
                    "vars",
                    "labels",
                    "k",
                    "stand",
                    "metric",
                    "type",
                    "method")))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot",
                title="Cluster Dendrogram",
                requiresData=TRUE,
                refs="factoextra",
                visible="(plot)",
                renderFun=".plot",
                clearWith=list(
                    "vars",
                    "labels",
                    "k",
                    "stand",
                    "metric",
                    "type",
                    "method",
                    "width",
                    "height",
                    "horiz")))
            self$add(jmvcore::Image$new(
                options=options,
                name="plot1",
                title="Cluster Dendrogram with p-values",
                requiresData=TRUE,
                refs="pvclust",
                visible="(plot1)",
                renderFun=".plot1",
                clearWith=list(
                    "vars1",
                    "nb",
                    "method1",
                    "dm",
                    "width1",
                    "height1")))
            self$add(jmvcore::Preformatted$new(
                options=options,
                name="text",
                title="Cluster Information",
                visible="(plot1)"))}))

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

#' Clustering Dendrogram
#'
#' 
#' @param mode .
#' @param data The data as a data frame.
#' @param labels .
#' @param vars .
#' @param stand .
#' @param k .
#' @param metric .
#' @param method .
#' @param type .
#' @param plot .
#' @param horiz .
#' @param width .
#' @param height .
#' @param vars1 .
#' @param method1 .
#' @param nb .
#' @param dm .
#' @param plot1 .
#' @param width1 .
#' @param height1 .
#' @return A results object containing:
#' \tabular{llllll}{
#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
#'   \code{results$clust} \tab \tab \tab \tab \tab an output \cr
#'   \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$plot1} \tab \tab \tab \tab \tab an image \cr
#'   \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
#' }
#'
#' @export
hc <- function(
    mode,
    data,
    labels,
    vars,
    stand = TRUE,
    k = 2,
    metric = "euclidean",
    method = "ward.D2",
    type = "rectangle",
    plot = FALSE,
    horiz = FALSE,
    width = 500,
    height = 500,
    vars1,
    method1 = "average",
    nb = 100,
    dm = "correlation",
    plot1 = FALSE,
    width1 = 500,
    height1 = 500) {

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

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


    options <- hcOptions$new(
        mode = mode,
        labels = labels,
        vars = vars,
        stand = stand,
        k = k,
        metric = metric,
        method = method,
        type = type,
        plot = plot,
        horiz = horiz,
        width = width,
        height = height,
        vars1 = vars1,
        method1 = method1,
        nb = nb,
        dm = dm,
        plot1 = plot1,
        width1 = width1,
        height1 = height1)

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

    analysis$run()

    analysis$results
}