started adding pairwise chi-square test to jmv analysis

sbalci · May 9, 2020 · 92a04bf · 92a04bf
1 parent f61cb79
commit 92a04bf
Show file tree

Hide file tree

Showing 14 changed files with 252 additions and 32 deletions.
diff --git a/.Rprofile b/.Rprofile
@@ -5,7 +5,7 @@ options(repos = c(
                   )
 )
 
-.libPaths(new = "~/histopathRprojects/ClinicoPathLibrary")
+# .libPaths(new = "~/histopathRprojects/ClinicoPathLibrary")
 
 
 # source(
@@ -20,17 +20,19 @@ options(repos = c(
 # https://conjugateprior.org/2015/06/identifying-the-os-from-r/
 
 
-if (.Platform$OS.type == "windows") {
-
-    library("jmvtools")
-
-    jmvtools::check("C://Program Files//jamovi//bin")
-
-    .libPaths(new = "C:\\ClinicoPathLibrary")
-
-    Sys.setenv(TZ = "Europe/Istanbul")
-
-}
+# if (.Platform$OS.type == "windows") {
+#
+#     if (!requireNamespace('jmvtools')) install.packages('jmvtools', repos=c('https://repo.jamovi.org', 'https://cran.r-project.org'))
+#
+#     library("jmvtools")
+#
+#     jmvtools::check("C://Program Files//jamovi//bin")
+#
+#     .libPaths(new = "C:\\ClinicoPathLibrary")
+#
+#     Sys.setenv(TZ = "Europe/Istanbul")
+#
+# }
 
 
 .First <- function(){

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -65,7 +65,8 @@ Suggests:
     randomForest,
     huxtable,
     flextable,
-    Hmisc
+    Hmisc,
+    rmarkdown
 VignetteBuilder:
     knitr
 Encoding: UTF-8

diff --git a/R/00jmv.R b/R/00jmv.R
@@ -262,4 +262,18 @@
         `year`=2020, 
         `title`="gtsummary: Presentation-Ready Data Summary and Analytic Result Tables", 
         `publisher`="[R package]. Retrieved from https://CRAN.R-project.org/package=gtsummary", 
-        `url`="https://CRAN.R-project.org/package=gtsummary"))
+        `url`="https://CRAN.R-project.org/package=gtsummary"), 
+    `rmngb`=list(
+        `type`="software", 
+        `author`="Antoine Filipovic Pierucci", 
+        `year`=2014, 
+        `title`="rmngb: Miscellaneous Collection of Functions for Medical Data Analysis", 
+        `publisher`="[R package]. Retrieved from https://CRAN.R-project.org/package=rmngb", 
+        `url`="https://CRAN.R-project.org/package=rmngb"), 
+    `RVAideMemoire`=list(
+        `type`="software", 
+        `author`="Maxime Herv\u00E9", 
+        `year`=2020, 
+        `title`="RVAideMemoire: Testing and Plotting Procedures for Biostatistics", 
+        `publisher`="[R package]. Retrieved from https://CRAN.R-project.org/package=RVAideMemoire", 
+        `url`="https://CRAN.R-project.org/package=RVAideMemoire"))
diff --git a/R/crosstable.h.R b/R/crosstable.h.R
@@ -60,7 +60,7 @@ crosstableResults <- if (requireNamespace('jmvcore')) R6::R6Class(
             super$initialize(
                 options=options,
                 name="",
-                title="CrossTable",
+                title="Cross Tables",
                 refs=list(
                     "tangram"))
             self$add(jmvcore::Html$new(
@@ -88,7 +88,7 @@ crosstableBase <- if (requireNamespace('jmvcore')) R6::R6Class(
                 requiresMissings = FALSE)
         }))
 
-#' CrossTables
+#' Cross Tables
 #'
 #' Function for making Cross Tables.
 #'

diff --git a/R/pairchi.b.R b/R/pairchi.b.R
@@ -309,6 +309,17 @@ inherit = pairchiBase, private = list(
                         rr <- private$.relativeRisk(mat)
                     }
 
+
+                    # pairwise in code ----
+
+                    if (self$options$pairw)
+                        pw <- private$.pairwise(mat)
+
+                    self$results$pw$setContent(pw)
+
+
+
+
                 }) # suppressWarnings
 
                 total <- sum(mat)
@@ -618,6 +629,69 @@ inherit = pairchiBase, private = list(
             return(list(rr=rr, lower=lower, upper=upper))
 
         },
+
+
+# pairwise function ------
+#
+#
+#
+
+.pairwise = function(mat) {
+
+
+    pairwiseRVAideMemoire <- RVAideMemoire::chisq.multcomp(mat)
+
+    pairwisermngb <- rmngb::pairwise.chisq.test(as.table(mat))
+
+
+    pairwise <- list("RVAideMemoire" = pairwiseRVAideMemoire,
+                     "rmngb" = pairwisermngb)
+
+    return(pairwise)
+
+
+    # dims <- dim(mat)
+
+    # if (dims[1] > 2 || dims[2] > 2)
+    #     return(NULL)
+
+    # ciWidth <- self$options$ciWidth
+    # tail <- (100 - ciWidth) / 200
+    # z <- qnorm(tail, lower.tail = FALSE)
+
+    # a <- mat[1,1]
+    # b <- mat[1,2]
+    # c <- mat[2,1]
+    # d <- mat[2,2]
+
+    # p1 <- a / (a + b)
+    # p2 <- c / (c + d)
+
+    # m <- log(p1 / p2)
+    # s <- sqrt((b / (a*(a+b))) + (d / (c*(c+d))))
+    # lower <- exp(m - z*s)
+    # upper <- exp(m + z*s)
+
+    # rr <- p1 / p2
+
+    # return(list(rr=rr, lower=lower, upper=upper))
+
+},
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
         .sourcifyOption = function(option) {
             if (option$name %in% c('rows', 'cols', 'counts'))
                 return('')

diff --git a/R/pairchi.h.R b/R/pairchi.h.R
@@ -27,7 +27,8 @@ pairchiOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
             exp = FALSE,
             pcRow = FALSE,
             pcCol = FALSE,
-            pcTot = FALSE, ...) {
+            pcTot = FALSE,
+            pairw = FALSE, ...) {
 
             super$initialize(
                 package='ClinicoPath',
@@ -139,6 +140,10 @@ pairchiOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
                 "pcTot",
                 pcTot,
                 default=FALSE)
+            private$..pairw <- jmvcore::OptionBool$new(
+                "pairw",
+                pairw,
+                default=FALSE)
 
             self$.addOption(private$..rows)
             self$.addOption(private$..cols)
@@ -162,6 +167,7 @@ pairchiOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
             self$.addOption(private$..pcRow)
             self$.addOption(private$..pcCol)
             self$.addOption(private$..pcTot)
+            self$.addOption(private$..pairw)
         }),
     active = list(
         rows = function() private$..rows$value,
@@ -185,7 +191,8 @@ pairchiOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
         exp = function() private$..exp$value,
         pcRow = function() private$..pcRow$value,
         pcCol = function() private$..pcCol$value,
-        pcTot = function() private$..pcTot$value),
+        pcTot = function() private$..pcTot$value,
+        pairw = function() private$..pairw$value),
     private = list(
         ..rows = NA,
         ..cols = NA,
@@ -208,7 +215,8 @@ pairchiOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
         ..exp = NA,
         ..pcRow = NA,
         ..pcCol = NA,
-        ..pcTot = NA)
+        ..pcTot = NA,
+        ..pairw = NA)
 )
 
 pairchiResults <- if (requireNamespace('jmvcore')) R6::R6Class(
@@ -219,14 +227,18 @@ pairchiResults <- if (requireNamespace('jmvcore')) R6::R6Class(
         odds = function() private$.items[["odds"]],
         nom = function() private$.items[["nom"]],
         gamma = function() private$.items[["gamma"]],
-        taub = function() private$.items[["taub"]]),
+        taub = function() private$.items[["taub"]],
+        pw = function() private$.items[["pw"]]),
     private = list(),
     public=list(
         initialize=function(options) {
             super$initialize(
                 options=options,
                 name="",
-                title="Paired Samples Contingency Tables")
+                title="Pairwise Chi-Square Test",
+                refs=list(
+                    "rmngb",
+                    "RVAideMemoire"))
             self$add(jmvcore::Table$new(
                 options=options,
                 name="freqs",
@@ -492,7 +504,11 @@ pairchiResults <- if (requireNamespace('jmvcore')) R6::R6Class(
                         `name`="p", 
                         `title`="p", 
                         `type`="number", 
-                        `format`="zto,pvalue"))))}))
+                        `format`="zto,pvalue"))))
+            self$add(jmvcore::Preformatted$new(
+                options=options,
+                name="pw",
+                title="Pairwise Chi-Square Comparison"))}))
 
 pairchiBase <- if (requireNamespace('jmvcore')) R6::R6Class(
     "pairchiBase",
@@ -598,6 +614,7 @@ pairchiBase <- if (requireNamespace('jmvcore')) R6::R6Class(
 #'   percentages
 #' @param pcTot \code{TRUE} or \code{FALSE} (default), provide total
 #'   percentages
+#' @param pairw .
 #' @param formula (optional) the formula to use, see the examples
 #' @return A results object containing:
 #' \tabular{llllll}{
@@ -607,6 +624,7 @@ pairchiBase <- if (requireNamespace('jmvcore')) R6::R6Class(
 #'   \code{results$nom} \tab \tab \tab \tab \tab a table of the 'nominal' test results \cr
 #'   \code{results$gamma} \tab \tab \tab \tab \tab a table of the gamma test results \cr
 #'   \code{results$taub} \tab \tab \tab \tab \tab a table of the Kendall's tau-b test results \cr
+#'   \code{results$pw} \tab \tab \tab \tab \tab a preformatted \cr
 #' }
 #'
 #' Tables can be converted to data frames with \code{asDF} or \code{\link{as.data.frame}}. For example:
@@ -640,6 +658,7 @@ pairchi <- function(
     pcRow = FALSE,
     pcCol = FALSE,
     pcTot = FALSE,
+    pairw = FALSE,
     formula) {
 
     if ( ! requireNamespace('jmvcore'))
@@ -714,7 +733,8 @@ pairchi <- function(
         exp = exp,
         pcRow = pcRow,
         pcCol = pcCol,
-        pcTot = pcTot)
+        pcTot = pcTot,
+        pairw = pairw)
 
     analysis <- pairchiClass$new(
         options = options,

diff --git a/codemeta.json b/codemeta.json
@@ -100,6 +100,18 @@
         "url": "https://cran.r-project.org"
       },
       "sameAs": "https://CRAN.R-project.org/package=Hmisc"
+    },
+    {
+      "@type": "SoftwareApplication",
+      "identifier": "rmarkdown",
+      "name": "rmarkdown",
+      "provider": {
+        "@id": "https://cran.r-project.org",
+        "@type": "Organization",
+        "name": "Comprehensive R Archive Network (CRAN)",
+        "url": "https://cran.r-project.org"
+      },
+      "sameAs": "https://CRAN.R-project.org/package=rmarkdown"
     }
   ],
   "softwareRequirements": [
@@ -511,6 +523,6 @@
     "survival-analysis",
     "natural-language-summaries"
   ],
-  "fileSize": "16896.02KB",
+  "fileSize": "16896.298KB",
   "readme": "https://github.com/sbalci/ClinicoPathJamoviModule/blob/master/README.md"
 }
diff --git a/jamovi/0000.yaml b/jamovi/0000.yaml
@@ -34,12 +34,12 @@ analyses:
     menuSubgroup: Descriptives
     menuTitle: Summary of Categorical Variables
     description: Function for Generating Summaries for Categorical Variables.
-  - title: CrossTables
+  - title: Cross Tables
     name: crosstable
     ns: ClinicoPath
     menuGroup: ClinicoPath
     menuSubgroup: Comparisons
-    menuTitle: CrossTables
+    menuTitle: Cross Tables
     description: Function for making Cross Tables.
   - title: Graphs and Plots
     name: statsplot2

diff --git a/jamovi/pairchi.a.yaml b/jamovi/pairchi.a.yaml
@@ -277,4 +277,10 @@ options:
       description:
           R: >
             `TRUE` or `FALSE` (default), provide total percentages
+
+    - name: pairw
+      title: Pairwise
+      type: Bool
+      default: false
+
 ...
diff --git a/jamovi/pairchi.r.yaml b/jamovi/pairchi.r.yaml
@@ -1,6 +1,6 @@
 ---
-name:  contTablesPaired
-title: Paired Samples Contingency Tables
+name:  pairchi
+title: Pairwise Chi-Square Test
 jrs: '1.0'
 
 items:
@@ -280,6 +280,9 @@ items:
           type: number
           format: zto,pvalue
 
+    - name: pw
+      title: Pairwise Chi-Square Comparison
+      type: Preformatted
 
 refs:
     - rmngb

diff --git a/jamovi/pairchi.u.yaml b/jamovi/pairchi.u.yaml
@@ -1,5 +1,5 @@
-name: contTablesPaired
-title: Paired Samples Contingency Tables
+name: pairchi
+title: Pairwise Chi-Square Test
 jus: '2.0'
 compilerMode: tame
 children:
@@ -168,3 +168,23 @@ children:
                         name: pcCol
                       - type: CheckBox
                         name: pcTot
+      - type: CollapseBox
+        label: Pairwise
+        stretchFactor: 1
+        collapsed: true
+        children:
+          - type: LayoutBox
+            cell:
+              column: 1
+              row: 0
+            stretchFactor: 1
+            children:
+              - type: Label
+                label: Pairwise
+                fitToGrid: true
+                cell:
+                  column: 1
+                  row: 0
+                children:
+                  - type: CheckBox
+                    name: pairw