change module name

hyunsooseol · Jun 18, 2020 · 733145a · 733145a
1 parent 314b2da
commit 733145a
Show file tree

Hide file tree

Showing 20 changed files with 1,318 additions and 0 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -0,0 +1,7 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+#Github stuffs
+.gitignore
+.Rhistory
+^build\/js$
+^build\/R.*$
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -0,0 +1,25 @@
+Package: seolmatrix
+Type: Package
+Title: Correlations suite for jamovi
+Version: 0.0.3
+Date: 2020-06-17
+Author: Hyunsoo Seol
+Maintainer: Hyunsoo Seol <[email protected]>
+Description:This module is a tool for calculating correlations, such as Pearson, Partial, Point-Biserial,Tetrachoric and allows users to produce 
+  Gaussian Graphical Model.
+License: GPL (>= 2)
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 7.1.0
+Imports: 
+    janitor,
+    jmvcore (>= 1.0.8),
+    knitr,
+    R6,
+    magrittr,
+    tidyverse,
+    stats,
+    qgraph,
+    psych
+
+
diff --git a/NAMESPACE b/NAMESPACE
@@ -0,0 +1,11 @@
+# Generated by roxygen2: do not edit by hand
+
+export(dichotomous)
+export(dichotomousClass)
+export(partial)
+export(partialClass)
+import(jmvcore)
+import(psych)
+import(qgraph)
+importFrom(R6,R6Class)
+importFrom(magrittr,"%>%")
diff --git a/R/00jmv.R b/R/00jmv.R
@@ -0,0 +1,18 @@
+
+# This file is automatically generated, you probably don't want to edit this
+
+.jmvrefs <- list(
+    `cormatrix`=list(
+        `type`="software", 
+        `author`="Seol, H.", 
+        `year`=2020, 
+        `title`="cormatrix", 
+        `publisher`="[jamovi module]. Retrieved from https://github.com/hyunsooseol/cormatrix/", 
+        `url`="https://github.com/hyunsooseol/cormatrix/"), 
+    `psych`=list(
+        `type`="software", 
+        `author`="William Revelle", 
+        `year`=2019, 
+        `title`="psych: Procedures for Personality and Psychological Research", 
+        `publisher`="[R package]. Retrieved from https://CRAN.R-project.org/package=psych", 
+        `url`="https://CRAN.R-project.org/package=psych"))
diff --git a/R/dichotomous.b.R b/R/dichotomous.b.R
@@ -0,0 +1,142 @@
+# This file is a generated template, your changes will not be overwritten
+
+
+#' Tetrachoric Analysis
+#'
+#' @importFrom R6 R6Class
+#' @import jmvcore
+#' @importFrom magrittr "%>%"
+#' @import psych
+#' @import qgraph
+#' @export
+
+# This file is a generated template, your changes will not be overwritten
+
+dichotomousClass <- if (requireNamespace('jmvcore')) R6::R6Class(
+    "dichotomousClass",
+    inherit = dichotomousBase,
+    private = list(
+
+ #==========================================================
+      .init = function() {
+        # get variables
+
+        matrix <- self$results$get('matrix')
+        vars <- self$options$get('vars')
+        nVars <- length(vars)
+
+
+        # add columns--------
+
+        for (i in seq_along(vars)) {
+          var <- vars[[i]]
+
+          matrix$addColumn(
+            name = paste0(var, '[r]'),
+            title = var,
+            type = 'number',
+            format = 'zto'
+          )
+
+        }
+
+        # empty cells above and put "-" in the main diagonal
+
+        for (i in seq_along(vars)) {
+          var <- vars[[i]]
+
+          values <- list()
+
+          for (j in seq(i, nVars)) {
+            v <- vars[[j]]
+
+            values[[paste0(v, '[r]')]]  <- ''
+
+          }
+
+         matrix$setRow(rowKey = var, values)
+
+        }
+
+        if (length(self$options$vars) <= 1)
+          self$setStatus('complete')
+      },
+
+
+
+#==========================================================
+      .run = function() {
+        # `self$data` contains the data
+        # `self$options` contains the options
+        # `self$results` contains the results object (to populate)
+
+
+        self$results$instructions$setContent(
+          "<html>
+            <head>
+            </head>
+            <body>
+            <div class='instructions'>
+            <p>Welcome to Tetrachoric Correlation for doing factor analysis as an input data.</p>
+            
+            <p>To get started:</p>
+            
+            <p>- The input dataset require dichotomous data with the type of numeric-continuous in jamovi.</p>
+            <p>- Just highlight the variables and click the arrow to move it across into the 'Variables' box.</p>
+            
+            <p>If you encounter any errors, or have questions, please e-mail me: [email protected]</a></p>
+            </div>
+            </body>
+            </html>"
+        )
+
+
+        # get variables---------------------------------
+
+        matrix <- self$results$get('matrix')
+        vars <- self$options$get('vars')
+        nVars <- length(vars)
+
+        mydata <- self$data
+
+        # compute tetrachoric correlation with psych package--------
+
+        tetrarho <- psych::tetrachoric(mydata)$rho
+
+
+        # populate result----------------------------------------
+
+        for (i in 2:nVars) {
+          for (j in seq_len(i - 1)) {
+            values <- list()
+
+            values[[paste0(vars[[j]], '[r]')]] <- tetrarho[i, j]
+
+            matrix$setRow(rowNo = i, values)
+          }
+        }
+
+        # Prepare Data For Plot -------
+        image <- self$results$plot
+        image$setState(tetrarho)
+
+      },
+
+#================================================================
+
+      .plot = function(image, ...) {
+        ggm <- self$options$ggm
+
+        if (!ggm)
+          return()
+
+
+        tetrarho <- image$state
+
+        plot <- qgraph(tetrarho, layout = "spring", details = TRUE)
+
+        print(plot)
+        TRUE
+
+      }
+    ))
diff --git a/R/dichotomous.h.R b/R/dichotomous.h.R
@@ -0,0 +1,152 @@
+
+# This file is automatically generated, you probably don't want to edit this
+
+dichotomousOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
+    "dichotomousOptions",
+    inherit = jmvcore::Options,
+    public = list(
+        initialize = function(
+            vars = NULL,
+            ggm = FALSE, ...) {
+
+            super$initialize(
+                package='seolmatrix',
+                name='dichotomous',
+                requiresData=TRUE,
+                ...)
+
+            private$..vars <- jmvcore::OptionVariables$new(
+                "vars",
+                vars,
+                suggested=list(
+                    "continuous"),
+                permitted=list(
+                    "numeric"))
+            private$..ggm <- jmvcore::OptionBool$new(
+                "ggm",
+                ggm,
+                default=FALSE)
+
+            self$.addOption(private$..vars)
+            self$.addOption(private$..ggm)
+        }),
+    active = list(
+        vars = function() private$..vars$value,
+        ggm = function() private$..ggm$value),
+    private = list(
+        ..vars = NA,
+        ..ggm = NA)
+)
+
+dichotomousResults <- if (requireNamespace('jmvcore')) R6::R6Class(
+    inherit = jmvcore::Group,
+    active = list(
+        instructions = function() private$.items[["instructions"]],
+        matrix = function() private$.items[["matrix"]],
+        plot = function() private$.items[["plot"]]),
+    private = list(),
+    public=list(
+        initialize=function(options) {
+            super$initialize(
+                options=options,
+                name="",
+                title="Tetrachoric Correlation")
+            self$add(jmvcore::Html$new(
+                options=options,
+                name="instructions",
+                title="Instructions",
+                visible=TRUE))
+            self$add(jmvcore::Table$new(
+                options=options,
+                name="matrix",
+                title="Tetrachoric Correlation",
+                rows="(vars)",
+                refs="psych",
+                columns=list(
+                    list(
+                        `name`=".name[r]", 
+                        `title`="", 
+                        `type`="text", 
+                        `content`="($key)", 
+                        `combineBelow`=TRUE),
+                    list(
+                        `name`=".stat[r]", 
+                        `title`="", 
+                        `type`="text", 
+                        `content`="r"))))
+            self$add(jmvcore::Image$new(
+                options=options,
+                name="plot",
+                title="Show Gaussian Graphical Model",
+                width=500,
+                height=500,
+                renderFun=".plot",
+                visible=TRUE))}))
+
+dichotomousBase <- if (requireNamespace('jmvcore')) R6::R6Class(
+    "dichotomousBase",
+    inherit = jmvcore::Analysis,
+    public = list(
+        initialize = function(options, data=NULL, datasetId="", analysisId="", revision=0) {
+            super$initialize(
+                package = 'seolmatrix',
+                name = 'dichotomous',
+                version = c(1,0,0),
+                options = options,
+                results = dichotomousResults$new(options=options),
+                data = data,
+                datasetId = datasetId,
+                analysisId = analysisId,
+                revision = revision,
+                pause = NULL,
+                completeWhenFilled = FALSE,
+                requiresMissings = FALSE)
+        }))
+
+#' Tetrachoric Correlation
+#'
+#' 
+#' @param data The data as a data frame.
+#' @param vars .
+#' @param ggm .
+#' @return A results object containing:
+#' \tabular{llllll}{
+#'   \code{results$instructions} \tab \tab \tab \tab \tab a html \cr
+#'   \code{results$matrix} \tab \tab \tab \tab \tab correlation matrix table \cr
+#'   \code{results$plot} \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$matrix$asDF}
+#'
+#' \code{as.data.frame(results$matrix)}
+#'
+#' @export
+dichotomous <- function(
+    data,
+    vars,
+    ggm = FALSE) {
+
+    if ( ! requireNamespace('jmvcore'))
+        stop('dichotomous requires jmvcore to be installed (restart may be required)')
+
+    if ( ! missing(vars)) vars <- jmvcore::resolveQuo(jmvcore::enquo(vars))
+    if (missing(data))
+        data <- jmvcore::marshalData(
+            parent.frame(),
+            `if`( ! missing(vars), vars, NULL))
+
+
+    options <- dichotomousOptions$new(
+        vars = vars,
+        ggm = ggm)
+
+    analysis <- dichotomousClass$new(
+        options = options,
+        data = data)
+
+    analysis$run()
+
+    analysis$results
+}