multivariate survival control 1

sbalci · Mar 18, 2020 · 2b844e0 · 2b844e0
1 parent c57b17c
commit 2b844e0
Show file tree

Hide file tree

Showing 72 changed files with 475 additions and 338 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: ClinicoPath
 Type: Package
 Title: Analysis for Clinicopathological Research
-Version: 0.0.1.0001
-Date: 2020-03-11
+Version: 0.0.1.0002
+Date: 2020-03-17
 Authors@R: 
     person(given = "Serdar",
            family = "Balci",
@@ -36,14 +36,15 @@ Imports:
     tableone,
     tangram,
     rlang,
-    tidyselect,
     knitr,
     remotes,
     kableExtra,
     ggstatsplot,
     ggalluvial,
-    networkD3
+    caret,
+    irr
 Remotes:
+    r-lib/tidyselect,
     easystats/modelbased,
     easystats/insight,
     easystats/bayestestR,
@@ -54,7 +55,11 @@ Suggests:
     effectsize,
     emmeans,
     rmarkdown,
-    igraph
+    igraph,
+    iterators,
+    rms,
+    commonmark,
+    sass
 RoxygenNote: 7.0.2
 VignetteBuilder: knitr
 URL: https://github.com/sbalci/ClinicoPathJamoviModule/, https://sbalci.github.io/ClinicoPathJamoviModule/ 

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,23 +1,33 @@
 # Generated by roxygen2: do not edit by hand
 
+export(agreement)
+export(correlation)
 export(crosstable)
+export(decision)
+export(decisioncalculator)
 export(multisurvival)
 export(reportcat)
 export(statsplot2)
 export(summarydata)
 export(survival)
 export(tableone)
+export(tree)
+import(dplyr)
 import(finalfit)
 import(ggalluvial)
 import(ggplot2)
 import(ggstatsplot)
+import(gt)
+import(gtsummary)
 import(jmvcore)
 import(networkD3)
 import(survival)
 import(survminer)
+import(tidyselect)
 importFrom(R6,R6Class)
 importFrom(ggalluvial,StatStratum)
 importFrom(jmvcore,toNumeric)
 importFrom(purrr,map)
 importFrom(rlang,.data)
 importFrom(tableone,CreateTableOne)
+importFrom(utils,data)
diff --git a/tododata/agreement.b.R → R/agreement.b.R b/tododata/agreement.b.R → R/agreement.b.R
@@ -19,6 +19,8 @@ agreementClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             todo <- glue::glue(
                 "This Module is still under development
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
                 -
                 -
                 "

diff --git a/tododata/agreement.h.R → R/agreement.h.R b/tododata/agreement.h.R → R/agreement.h.R
diff --git a/tododata/correlation.b.R → R/correlation.b.R b/tododata/correlation.b.R → R/correlation.b.R
@@ -13,6 +13,7 @@ correlationClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             todo <- glue::glue(
                 "This Module is still under development
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
                 - Correlation matrix via ggplot
                 -
                 "
@@ -47,7 +48,17 @@ correlationClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             # self$results$text3$setContent(cor3)
 
-
+            # library("correlation")
+            # mydata %$%
+            #     cor.test(PeritumoralTomurcukSayi, Yas, method = "spearman", exact = FALSE)
+            # mydata %$%
+            #     cor.test(PeritumoralTomurcukSayi, Yas, method = "spearman", exact = FALSE) %>%
+            #     report::report()
+            # ggplot(mydata, aes(x = PeritumoralTomurcukSayi, y = Yas)) +
+            #     geom_point() +
+            #     geom_smooth(method = lm, size = 1)
+            # mydata %>%
+            #     ggstatsplot::ggscatterstats(x = PeritumoralTomurcukSayi, y = Yas, type = "np")
 
 #
 #             iris %>%

diff --git a/tododata/correlation.h.R → R/correlation.h.R b/tododata/correlation.h.R → R/correlation.h.R
diff --git a/tododata/decision.b.R → R/decision.b.R b/tododata/decision.b.R → R/decision.b.R
@@ -13,6 +13,7 @@ decisionClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             todo <- glue::glue(
                 "This Module is still under development
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
                 -
                 -  "
             )

diff --git a/tododata/decision.h.R → R/decision.h.R b/tododata/decision.h.R → R/decision.h.R
diff --git a/tododata/decisioncalculator.b.R → R/decisioncalculator.b.R b/tododata/decisioncalculator.b.R → R/decisioncalculator.b.R
@@ -14,6 +14,7 @@ decisioncalculatorClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             todo <- glue::glue(
                 "This Module is still under development
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
                 -
                 -  "
             )

diff --git a/tododata/decisioncalculator.h.R → R/decisioncalculator.h.R b/tododata/decisioncalculator.h.R → R/decisioncalculator.h.R
diff --git a/R/multisurvival.b.R b/R/multisurvival.b.R
@@ -16,19 +16,41 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
             if (nrow(self$data) == 0)
                 stop('Data contains no (complete) rows')
 
-            if (length(self$options$explanatory) < 1 |  (length(self$options$outcome) + length(self$options$overalltime) < 2))
+            if (is.null(self$options$explanatory) || (length(self$options$outcome) + length(self$options$overalltime) < 2))
+            {
+
+
+                # TODO ----
+
+                todo <- glue::glue(
+                    "This Module is still under development
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
+                - "
+                )
+
+                self$results$todo$setContent(todo)
+
+
                 return()
 
+            } else {
+
 
             # TODO ----
 
             todo <- glue::glue(
                 "This Module is still under development
+                Analysis below
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
+
                 - "
             )
 
             self$results$todo$setContent(todo)
 
+
+
             # Check if outcome variable is suitable or stop ----
             myoutcome2 <- self$options$outcome
             myoutcome2 <- self$data[[myoutcome2]]
@@ -37,6 +59,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
                 stop('Outcome variable must only contains 1s and 0s. If patient is dead or event (recurrence) occured it is 1. If censored (patient is alive or free of disease) at the last visit it is 0.')
 
 
+
             mydata <- self$data
 
             formula2 <- as.vector(self$options$explanatory)
@@ -49,12 +72,18 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             formulaR <- jmvcore::constructFormula(terms = self$options$outcome)
 
+            formulaR <- jmvcore::toNumeric(formulaR)
+
+
             myformula <- paste("Surv(", formulaL, ",", formulaR, ")")
 
 
             finalfit::finalfit(.data = mydata,
                                dependent = myformula,
-                               explanatory = formula2) -> tMultivariate
+                               explanatory = formula2
+                               # ,
+                               # metrics = TRUE
+                               ) -> tMultivariate
 
             results1 <- knitr::kable(tMultivariate,
                                      row.names = FALSE,
@@ -64,20 +93,31 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             self$results$text$setContent(results1)
 
-        },
 
 
+            }
+
+        },
+
         .plot=function(image, ...) {  # <-- the plot function ----
 
             # plotData <- image$state
 
             if (nrow(self$data) == 0)
                 stop('Data contains no (complete) rows')
 
+            if (is.null(self$options$explanatory) || (length(self$options$outcome) + length(self$options$overalltime) < 2))
+                return()
+
             # Check if outcome variable is suitable or stop ----
             myoutcome2 <- self$options$outcome
             myoutcome2 <- self$data[[myoutcome2]]
             myoutcome2 <- na.omit(myoutcome2)
+
+            if(class(myoutcome2) == "factor")
+                stop("Please use a continuous variable for outcome.")
+
+
             if (any(myoutcome2 != 0 & myoutcome2 != 1))
                 stop('Outcome variable must only contains 1s and 0s. If patient is dead or event (recurrence) occured it is 1. If censored (patient is alive or free of disease) at the last visit it is 0.')
 
@@ -91,6 +131,9 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             formulaR <- jmvcore::constructFormula(terms = self$options$outcome)
 
+            formulaR <- jmvcore::toNumeric(formulaR)
+
+
             myformula <- paste("Surv(", formulaL, ",", formulaR, ")")
 
 
@@ -116,11 +159,17 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
             if (nrow(self$data) == 0)
                 stop('Data contains no (complete) rows')
 
+                if (is.null(self$options$explanatory) || (length(self$options$outcome) + length(self$options$overalltime) < 2))
+                    return()
 
             # Check if outcome variable is suitable or stop ----
             myoutcome2 <- self$options$outcome
             myoutcome2 <- self$data[[myoutcome2]]
             myoutcome2 <- na.omit(myoutcome2)
+
+            if(class(myoutcome2) == "factor")
+                stop("Please use a continuous variable for outcome.")
+
             if (any(myoutcome2 != 0 & myoutcome2 != 1))
                 stop('Outcome variable must only contains 1s and 0s. If patient is dead or event (recurrence) occured it is 1. If censored (patient is alive or free of disease) at the last visit it is 0.')
 
@@ -135,6 +184,9 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             formulaR <- jmvcore::constructFormula(terms = self$options$outcome)
 
+            formulaR <- jmvcore::toNumeric(formulaR)
+
+
             formula2 <- jmvcore::constructFormula(terms = self$options$explanatory)
 
             formula3 <- paste("Surv(", formulaL, ",", formulaR, ") ~ ", formula2)

diff --git a/R/multisurvival.h.R b/R/multisurvival.h.R
@@ -72,7 +72,11 @@ multisurvivalResults <- if (requireNamespace('jmvcore')) R6::R6Class(
             self$add(jmvcore::Html$new(
                 options=options,
                 name="text",
-                title="FinalFit Multivariate Survival"))
+                title="FinalFit Multivariate Survival",
+                clearWith=list(
+                    "explanatory",
+                    "outcome",
+                    "overalltime")))
             self$add(jmvcore::Image$new(
                 options=options,
                 name="plot",
@@ -82,20 +86,18 @@ multisurvivalResults <- if (requireNamespace('jmvcore')) R6::R6Class(
                 renderFun=".plot",
                 requiresData=TRUE,
                 clearWith=list(
-                    "sc",
                     "explanatory",
                     "outcome",
                     "overalltime")))
             self$add(jmvcore::Image$new(
                 options=options,
                 name="plot2",
                 title="Hazards Regression Plot",
-                width=600,
-                height=450,
+                width=800,
+                height=600,
                 renderFun=".plot2",
                 requiresData=TRUE,
                 clearWith=list(
-                    "sc",
                     "explanatory",
                     "outcome",
                     "overalltime")))}))

diff --git a/R/statsplot2.b.R b/R/statsplot2.b.R
@@ -25,6 +25,7 @@ statsplot2Class <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             todo <- glue::glue(
                 "This Module is still under development
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
                 -
                 -  "
             )

diff --git a/R/tableone.b.R b/R/tableone.b.R
@@ -1,6 +1,10 @@
 #' @importFrom R6 R6Class
 #' @importFrom jmvcore toNumeric
 #' @importFrom tableone CreateTableOne
+#' @import dplyr
+#' @import tidyselect
+#' @import gt
+#' @import gtsummary
 
 tableoneClass <- if (requireNamespace('jmvcore')) R6::R6Class(
     "tableoneClass",
@@ -37,6 +41,16 @@ tableoneClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             self$results$text1$setContent(mytableone)
 
+            # gtsummary
+
+            # myvars <- jmvcore::constructFormula(terms = self$options$vars)
+            # myvars <- jmvcore::decomposeFormula(formula = myvars)
+            # myvars <- unlist(myvars)
+            # mytableone2 <- self$data %>%
+            #     dplyr::select(myvars)
+            # mytableone2 <- gtsummary::tbl_summary(mytableone2)
+            # self$results$text2$setContent(mytableone2)
+
 
             }
         })

diff --git a/tododata/tree.b.R → R/tree.b.R b/tododata/tree.b.R → R/tree.b.R
@@ -14,6 +14,7 @@ treeClass <- if (requireNamespace('jmvcore')) R6::R6Class(
 
             todo <- glue::glue(
                 "This Module is still under development
+                🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
                 -
                 -
                 "
@@ -77,7 +78,7 @@ treeClass <- if (requireNamespace('jmvcore')) R6::R6Class(
             tree3 <- iris %>%
                 explore::explain_tree(target = Sepal.Length)
 
-            plot <- tree1
+            plot <- tree2
 
             print(plot)
             TRUE

diff --git a/tododata/tree.h.R → R/tree.h.R b/tododata/tree.h.R → R/tree.h.R
-Original file line number
+Diff line change
@@ Expand Up @@
                 todo <- glue::glue(
                     "This Module is still under development
+                    🔬🔬🔬🔬 UNDER CONSTRUCTION 🛠⛔️⚠️🔩
                     -
                     -
                     "
@@ Expand Down @@