add tableone styles

sbalci · May 13, 2020 · def40f8 · def40f8
1 parent 5f18d9f
commit def40f8
Show file tree

Hide file tree

Showing 27 changed files with 902 additions and 251 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: ClinicoPath
 Title: Analysis for Clinicopathological Research
-Version: 0.0.1.0012
-Date: 2020-05-08
+Version: 0.0.1.0013
+Date: 2020-05-13
 Authors@R: 
     person(given = "Serdar",
            family = "Balci",
@@ -53,20 +53,25 @@ Imports:
     magrittr,
     corrr,
     correlation,
-    RVAideMemoire
+    RVAideMemoire,
+    plotROC,
+    arsenal
 Remotes:
     ddsjoberg/gtsummary,
     ndphillips/FFTrees,
     easystats/report,
     spgarbet/tangram,
-    cran/rmngb
+    cran/rmngb,
+    mixOmicsTeam/mixOmics
 Suggests:
     circlize,
     randomForest,
     huxtable,
     flextable,
     Hmisc,
-    rmarkdown
+    rmarkdown,
+    corpcor,
+    rARPACK
 VignetteBuilder:
     knitr
 Encoding: UTF-8

diff --git a/NAMESPACE b/NAMESPACE
@@ -31,6 +31,7 @@ import(ggplot2)
 import(ggstatsplot)
 import(gtsummary)
 import(jmvcore)
+import(plotROC)
 import(rmngb)
 import(survival)
 import(survminer)

diff --git a/R/competingsurvival.b.R b/R/competingsurvival.b.R
@@ -1,9 +1,6 @@
 #' Competing Survival Analysis
 #'
-
-
 #'
-#' 
 #'
 #' @importFrom R6 R6Class
 #' @import jmvcore

diff --git a/R/competingsurvival.h.R b/R/competingsurvival.h.R
@@ -8,7 +8,11 @@ competingsurvivalOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
         initialize = function(
             explanatory = NULL,
             overalltime = NULL,
-            outcome = NULL, ...) {
+            outcome = NULL,
+            dod = NULL,
+            dooc = NULL,
+            awd = NULL,
+            awod = NULL, ...) {
 
             super$initialize(
                 package='ClinicoPath',
@@ -35,22 +39,51 @@ competingsurvivalOptions <- if (requireNamespace('jmvcore')) R6::R6Class(
                 "outcome",
                 outcome,
                 suggested=list(
-                    "continuous"),
+                    "ordinal",
+                    "nominal"),
                 permitted=list(
-                    "numeric"))
+                    "factor"))
+            private$..dod <- jmvcore::OptionLevel$new(
+                "dod",
+                dod,
+                variable="(outcome)")
+            private$..dooc <- jmvcore::OptionLevel$new(
+                "dooc",
+                dooc,
+                variable="(outcome)")
+            private$..awd <- jmvcore::OptionLevel$new(
+                "awd",
+                awd,
+                variable="(outcome)")
+            private$..awod <- jmvcore::OptionLevel$new(
+                "awod",
+                awod,
+                variable="(outcome)")
 
             self$.addOption(private$..explanatory)
             self$.addOption(private$..overalltime)
             self$.addOption(private$..outcome)
+            self$.addOption(private$..dod)
+            self$.addOption(private$..dooc)
+            self$.addOption(private$..awd)
+            self$.addOption(private$..awod)
         }),
     active = list(
         explanatory = function() private$..explanatory$value,
         overalltime = function() private$..overalltime$value,
-        outcome = function() private$..outcome$value),
+        outcome = function() private$..outcome$value,
+        dod = function() private$..dod$value,
+        dooc = function() private$..dooc$value,
+        awd = function() private$..awd$value,
+        awod = function() private$..awod$value),
     private = list(
         ..explanatory = NA,
         ..overalltime = NA,
-        ..outcome = NA)
+        ..outcome = NA,
+        ..dod = NA,
+        ..dooc = NA,
+        ..awd = NA,
+        ..awod = NA)
 )
 
 competingsurvivalResults <- if (requireNamespace('jmvcore')) R6::R6Class(
@@ -110,6 +143,10 @@ competingsurvivalBase <- if (requireNamespace('jmvcore')) R6::R6Class(
 #' @param explanatory .
 #' @param overalltime .
 #' @param outcome .
+#' @param dod .
+#' @param dooc .
+#' @param awd .
+#' @param awod .
 #' @return A results object containing:
 #' \tabular{llllll}{
 #'   \code{results$todo} \tab \tab \tab \tab \tab a html \cr
@@ -121,7 +158,11 @@ competingsurvival <- function(
     data,
     explanatory,
     overalltime,
-    outcome) {
+    outcome,
+    dod,
+    dooc,
+    awd,
+    awod) {
 
     if ( ! requireNamespace('jmvcore'))
         stop('competingsurvival requires jmvcore to be installed (restart may be required)')
@@ -137,11 +178,16 @@ competingsurvival <- function(
             `if`( ! missing(outcome), outcome, NULL))
 
     for (v in explanatory) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
+    for (v in outcome) if (v %in% names(data)) data[[v]] <- as.factor(data[[v]])
 
     options <- competingsurvivalOptions$new(
         explanatory = explanatory,
         overalltime = overalltime,
-        outcome = outcome)
+        outcome = outcome,
+        dod = dod,
+        dooc = dooc,
+        awd = awd,
+        awod = awod)
 
     analysis <- competingsurvivalClass$new(
         options = options,

diff --git a/R/roc.b.R b/R/roc.b.R
@@ -1,32 +1,172 @@
 #' ROC Analysis
 #'
-
-
 #'
-#' 
 #'
 #' @importFrom R6 R6Class
 #' @import jmvcore
-#'
+#' @import ggplot2
+#' @import plotROC
 
 
-rocClass <- if (requireNamespace("jmvcore")) R6::R6Class("rocClass", inherit = rocBase, 
+rocClass <- if (requireNamespace("jmvcore")) R6::R6Class("rocClass", inherit = rocBase,
     private = list(.run = function() {
-        
-        
-        
+
+
+
         # TODO
-        
+
         todo <- glue::glue("This Module is still under development
                 -
                 -
                 ")
-        
+
         self$results$todo$setContent(todo)
-
-
-        if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
-
-
-
-    }))
+
+
+        # if (nrow(self$data) == 0) stop("Data contains no (complete) rows")
+
+        # plotROC
+        #
+        # http://sachsmc.github.io/plotROC/
+
+
+        set.seed(2529)
+        D.ex <- rbinom(200, size = 1, prob = .5)
+        M1 <- rnorm(200, mean = D.ex, sd = .65)
+        M2 <- rnorm(200, mean = D.ex, sd = 1.5)
+
+        plotData <- data.frame(D = D.ex,
+                               D.str = c("Healthy", "Ill")[D.ex + 1],
+                               M1 = M1,
+                               M2 = M2,
+                               stringsAsFactors = FALSE)
+
+
+
+        # Prepare plot data
+
+        image <- self$results$plot
+        image$setState(plotData)
+
+
+        plot3 <- private$.plot2()
+
+        self$results$plot3$setContent(plot3)
+
+
+
+
+
+    },
+
+    .plot=function(image, ...) {
+
+        plotData <- image$state
+
+
+        set.seed(2529)
+        D.ex <- rbinom(200, size = 1, prob = .5)
+        M1 <- rnorm(200, mean = D.ex, sd = .65)
+        M2 <- rnorm(200, mean = D.ex, sd = 1.5)
+
+        plotData <- data.frame(D = D.ex,
+                               D.str = c("Healthy", "Ill")[D.ex + 1],
+                               M1 = M1,
+                               M2 = M2,
+                               stringsAsFactors = FALSE)
+
+        plot <- plotData %>%
+            ggplot2::ggplot(.,
+                                ggplot2::aes(d = D, m = M1)
+                                ) +
+            plotROC::geom_roc(
+                labels = TRUE,
+                n.cuts = 5,
+                labelsize = 5,
+                labelround = 2
+            ) +
+            plotROC::style_roc(
+                theme = theme_grey,
+                xlab = "1 - Specificity"
+            ) +
+            plotROC::geom_rocci(
+                sig.level = .01,
+                ci.at = quantile(M1, c(.1, .4, .5, .6, .9))
+            )
+
+
+
+        plotROC::direct_label(
+            ggroc_p = plot,
+            labels = "Biomarker",
+            label.angle = 45,
+            nudge_x = 0,
+            nudge_y = -.1,
+            size = 6
+            ) +
+            plotROC::style_roc()
+
+
+
+        print(plot)
+        TRUE
+    } ,
+
+    .plot2=function() {
+
+        # plotData <- image$state
+
+
+        set.seed(2529)
+        D.ex <- rbinom(200, size = 1, prob = .5)
+        M1 <- rnorm(200, mean = D.ex, sd = .65)
+        M2 <- rnorm(200, mean = D.ex, sd = 1.5)
+
+        plotData <- data.frame(D = D.ex,
+                               D.str = c("Healthy", "Ill")[D.ex + 1],
+                               M1 = M1,
+                               M2 = M2,
+                               stringsAsFactors = FALSE)
+
+        plot2 <- plotData %>%
+            ggplot2::ggplot(.,
+                            ggplot2::aes(d = D, m = M1)
+            ) +
+            plotROC::geom_roc()
+
+
+    # Interactive Plots
+
+        plot2 <- plotROC::plot_interactive_roc(plot2)
+        # opens in new html
+
+
+        # plot2 <- plotROC::export_interactive_roc(plot2)
+        # no output
+
+
+        # plot2 <- cat(plotROC::export_interactive_roc(plot2))
+        # no output
+
+        knitr::asis_output(plot2)
+    }
+
+    # Multiple ROC Curves
+    # http://sachsmc.github.io/plotROC/
+
+    # New Features
+
+    # Advanced Options
+
+
+    )
+    )
+
+
+
+
+# Other ROC Packages on CRAN
+#
+# AROC: Covariate-Adjusted Receiver Operating Characteristic Curve Inference
+# https://cran.r-project.org/web/packages/AROC/index.html
+
diff --git a/R/roc.h.R b/R/roc.h.R
@@ -57,7 +57,9 @@ rocResults <- if (requireNamespace('jmvcore')) R6::R6Class(
     inherit = jmvcore::Group,
     active = list(
         todo = function() private$.items[["todo"]],
-        text = function() private$.items[["text"]]),
+        text = function() private$.items[["text"]],
+        plot = function() private$.items[["plot"]],
+        plot3 = function() private$.items[["plot3"]]),
     private = list(),
     public=list(
         initialize=function(options) {
@@ -72,7 +74,19 @@ rocResults <- if (requireNamespace('jmvcore')) R6::R6Class(
             self$add(jmvcore::Preformatted$new(
                 options=options,
                 name="text",
-                title="ROC"))}))
+                title="ROC"))
+            self$add(jmvcore::Image$new(
+                options=options,
+                title="ROC",
+                name="plot",
+                width=600,
+                height=450,
+                renderFun=".plot",
+                requiresData=TRUE))
+            self$add(jmvcore::Html$new(
+                options=options,
+                title="ROC Interactive",
+                name="plot3"))}))
 
 rocBase <- if (requireNamespace('jmvcore')) R6::R6Class(
     "rocBase",
@@ -111,6 +125,8 @@ rocBase <- if (requireNamespace('jmvcore')) R6::R6Class(
 #' \tabular{llllll}{
 #'   \code{results$todo} \tab \tab \tab \tab \tab a html \cr
 #'   \code{results$text} \tab \tab \tab \tab \tab a preformatted \cr
+#'   \code{results$plot} \tab \tab \tab \tab \tab an image \cr
+#'   \code{results$plot3} \tab \tab \tab \tab \tab a html \cr
 #' }
 #'
 #' @export