diff --git a/R/jjhistostats.b.R b/R/jjhistostats.b.R index a48d86d6..f495ee8b 100644 --- a/R/jjhistostats.b.R +++ b/R/jjhistostats.b.R @@ -1,5 +1,4 @@ #' @title Histogram -#' #' @importFrom R6 R6Class #' @import jmvcore #' @import ggplot2 @@ -15,7 +14,8 @@ jjhistostatsClass <- if (requireNamespace('jmvcore')) .init = function() { deplen <- length(self$options$dep) - self$results$plot$setSize(400, deplen * 300) + self$results$plot$setSize(deplen * 800, + 600) self$results$plot2$setSize(800, deplen * 300) @@ -398,24 +398,26 @@ jjhistostatsClass <- if (requireNamespace('jmvcore')) plot2 <- ggstatsplot::grouped_gghistostats( data = mydata, x = !!dep, - grouping.var = !!grvar, - binwidth = binwidth, - title.prefix = NULL, - output = "plot", - plotgrid.args = list(), - title.text = NULL, - title.args = list(size = 16, fontface = "bold"), - caption.text = NULL, - caption.args = list(size = 10), - sub.text = NULL, - sub.args = list(size = 12) - - , type = typestatistics - , bar.measure = barmeasure - , centrality.parameter = centralityparameter - , results.subtitle = self$options$resultssubtitle - , normal.curve = self$options$normalcurve - , centrality.plotting = self$options$centralityline + grouping.var = !!grvar + # , + # binwidth = binwidth, + # title.prefix = NULL, + # output = "plot", + # plotgrid.args = list(), + # title.text = NULL, + # title.args = list(size = 16, + # fontface = "bold"), + # caption.text = NULL, + # caption.args = list(size = 10), + # sub.text = NULL, + # sub.args = list(size = 12) + # + # , type = typestatistics + # , bar.measure = barmeasure + # , centrality.parameter = centralityparameter + # , results.subtitle = self$options$resultssubtitle + # , normal.curve = self$options$normalcurve + # , centrality.plotting = self$options$centralityline ) @@ -437,24 +439,26 @@ jjhistostatsClass <- if (requireNamespace('jmvcore')) messages = FALSE), .f = ggstatsplot::grouped_gghistostats, data = mydata, - grouping.var = !!grvar, - binwidth = binwidth, - title.prefix = NULL, - output = "plot", - plotgrid.args = list(), - title.text = NULL, - title.args = list(size = 16, fontface = "bold"), - caption.text = NULL, - caption.args = list(size = 10), - sub.text = NULL, - sub.args = list(size = 12) - - , type = typestatistics - , bar.measure = barmeasure - , centrality.parameter = centralityparameter - , results.subtitle = self$options$resultssubtitle - , normal.curve = self$options$normalcurve - , centrality.plotting = self$options$centralityline + grouping.var = !!grvar + # , + # binwidth = binwidth, + # title.prefix = NULL, + # output = "plot", + # plotgrid.args = list(), + # title.text = NULL, + # title.args = list(size = 16, + # fontface = "bold"), + # caption.text = NULL, + # caption.args = list(size = 10), + # sub.text = NULL, + # sub.args = list(size = 12) + # + # , type = typestatistics + # , bar.measure = barmeasure + # , centrality.parameter = centralityparameter + # , results.subtitle = self$options$resultssubtitle + # , normal.curve = self$options$normalcurve + # , centrality.plotting = self$options$centralityline ) diff --git a/R/survival.b.R b/R/survival.b.R index 2597ac86..988f9eed 100644 --- a/R/survival.b.R +++ b/R/survival.b.R @@ -10,18 +10,19 @@ survivalClass <- if (requireNamespace('jmvcore')) inherit = survivalBase, private = list( - - - .init = function() { - - - if(self$options$ph_cox) { + if (self$options$ph_cox) { # Disable tables self$results$cox_ph$setVisible(TRUE) } + if (!(self$options$ph_cox)) { + # Disable tables + self$results$cox_ph$setVisible(FALSE) + } + + # if (self$options$sas) { # # Disable tables # self$results$medianSummary$setVisible(FALSE) @@ -34,18 +35,10 @@ survivalClass <- if (requireNamespace('jmvcore')) # self$results$pairwiseSummary$setVisible(FALSE) # self$results$pairwiseTable$setVisible(FALSE) # } - } - , - - - - - - .getData = function() { mydata <- self$data @@ -98,60 +91,60 @@ survivalClass <- if (requireNamespace('jmvcore')) - # , - # .todo = function() { - # if ( - # (is.null(self$options$outcome) && !(self$options$multievent)) || - - # (self$options$multievent && - # ( - # is.null(self$options$dod) && - # is.null(self$options$dooc) && - # is.null(self$options$awd) && is.null(self$options$awod) - - # ) - # ) || - - # (self$options$tint && - # ( - # is.null(self$options$dxdate) || is.null(self$options$fudate) - # )) || - - # (is.null(self$options$explanatory) - - # # - # # || (is.null(self$explanatory$sas)) - # # - - # ) - # ) { - - # todo <- glue::glue( - # " - #
Welcome to ClinicoPath - #

- # This tool will help you calculate median survivals and 1,3,5-yr survivals for a given fisk factor. - #

- # Explanatory variable should be categorical (ordinal or nominal). - #

- # Select outcome level from Outcome variable. - #

- # Outcome Level: if patient is dead or event (recurrence) occured. You may also use advanced outcome options depending on your analysis type. - #

- # Survival time should be numeric and continuous. You may also use dates to calculate survival time in advanced elapsed time options. - #

- # This function uses survival, survminer, and finalfit packages. Please cite jamovi and the packages as given below. - #

- #
- # See details for survival here." - # ) - - # html <- self$results$todo - # html$setContent(todo) + , + .todo = function() { + + # # Define your subconditions + # subcondition1a <- !is.null(self$options$outcome) + # subcondition1b1 <- !is.null(self$options$multievent) + # subcondition1b2 <- !is.null(self$options$dod) + # subcondition1b3 <- !is.null(self$options$dooc) + # subcondition1b4 <- !is.null(self$options$awd) + # subcondition1b5 <- !is.null(self$options$awod) + # subcondition2a <- !is.null(self$options$elapsedtime) + # subcondition2b1 <- !is.null(self$options$tint) + # subcondition2b2 <- !is.null(self$options$dxdate) + # subcondition2b3 <- !is.null(self$options$fudate) + # condition3 <- !is.null(self$options$explanatory) + # + # + # + # + # condition1 <- subcondition1a || (subcondition1b1 && (subcondition1b2 || subcondition1b3 || subcondition1b4 || subcondition1b5)) + # + # + # + # condition2 <- subcondition2a || (subcondition2b1 && subcondition2b2 && subcondition2b3) + # + # + # if (!(condition1 && condition2 && condition3)) { + + todo <- glue::glue( + " +
Welcome to ClinicoPath +

+ This tool will help you calculate median survivals and 1,3,5-yr survivals for a given fisk factor. +

+ Explanatory variable should be categorical (ordinal or nominal). +

+ Select outcome level from Outcome variable. +

+ Outcome Level: if patient is dead or event (recurrence) occured. You may also use advanced outcome options depending on your analysis type. +

+ Survival time should be numeric and continuous. You may also use dates to calculate survival time in advanced elapsed time options. +

+ This function uses survival, survminer, and finalfit packages. Please cite jamovi and the packages as given below. +

+
+ See details for survival here." + ) - # } + html <- self$results$todo + html$setContent(todo) - # } + # } + + } @@ -173,7 +166,7 @@ survivalClass <- if (requireNamespace('jmvcore')) myfudate_labelled <- labelled_data$myfudate_labelled # myexplanatory_labelled <- labelled_data$myexplanatory_labelled - tint <- self$options$tint + tint <- self$options$tint if (!tint) { @@ -194,6 +187,24 @@ survivalClass <- if (requireNamespace('jmvcore')) timetypedata <- self$options$timetypedata + # # Define a mapping from timetypedata to lubridate functions + # lubridate_functions <- list( + # ymdhms = lubridate::ymd_hms, + # ymd = lubridate::ymd, + # ydm = lubridate::ydm, + # mdy = lubridate::mdy, + # myd = lubridate::myd, + # dmy = lubridate::dmy, + # dym = lubridate::dym + # ) + # # Apply the appropriate lubridate function based on timetypedata + # if (timetypedata %in% names(lubridate_functions)) { + # func <- lubridate_functions[[timetypedata]] + # mydata[["start"]] <- func(mydata[[dxdate]]) + # mydata[["end"]] <- func(mydata[[fudate]]) + # } + + if (timetypedata == "ymdhms") { mydata[["start"]] <- lubridate::ymd_hms(mydata[[dxdate]]) mydata[["end"]] <- @@ -427,13 +438,13 @@ survivalClass <- if (requireNamespace('jmvcore')) # expl <- self$options$explanatory - labelled_data <- private$.getData() + labelled_data <- private$.getData() mydata_labelled <- labelled_data$mydata_labelled - mytime_labelled <- labelled_data$mytime_labelled - myoutcome_labelled <- labelled_data$myoutcome_labelled - mydxdate_labelled <- labelled_data$mydxdate_labelled - myfudate_labelled <- labelled_data$myfudate_labelled + # mytime_labelled <- labelled_data$mytime_labelled + # myoutcome_labelled <- labelled_data$myoutcome_labelled + # mydxdate_labelled <- labelled_data$mydxdate_labelled + # myfudate_labelled <- labelled_data$myfudate_labelled myexplanatory_labelled <- labelled_data$myexplanatory_labelled @@ -467,13 +478,13 @@ survivalClass <- if (requireNamespace('jmvcore')) , .cleandata = function() { - labelled_data <- private$.getData() + labelled_data <- private$.getData() - mydata_labelled <- labelled_data$mydata_labelled - mytime_labelled <- labelled_data$mytime_labelled - myoutcome_labelled <- labelled_data$myoutcome_labelled - mydxdate_labelled <- labelled_data$mydxdate_labelled - myfudate_labelled <- labelled_data$myfudate_labelled + mydata_labelled <- labelled_data$mydata_labelled + mytime_labelled <- labelled_data$mytime_labelled + myoutcome_labelled <- labelled_data$myoutcome_labelled + mydxdate_labelled <- labelled_data$mydxdate_labelled + myfudate_labelled <- labelled_data$myfudate_labelled myexplanatory_labelled <- labelled_data$myexplanatory_labelled @@ -609,7 +620,12 @@ survivalClass <- if (requireNamespace('jmvcore')) "name1time" = name1time, "name2outcome" = name2outcome, "name3explanatory" = name3explanatory, - "cleanData" = cleanData + "cleanData" = cleanData, + "mytime_labelled" = mytime_labelled, + "myoutcome_labelled" = myoutcome_labelled, + "mydxdate_labelled" = mydxdate_labelled, + "myfudate_labelled" = myfudate_labelled, + "myexplanatory_labelled" = myexplanatory_labelled ) ) @@ -619,45 +635,56 @@ survivalClass <- if (requireNamespace('jmvcore')) # Run Analysis ---- , .run = function() { - # Common Errors, Warnings ---- + + # Errors, Warnings ---- # No variable TODO ---- - if ((is.null(self$options$outcome) && - !(self$options$multievent)) || - - (self$options$multievent && - ( - is.null(self$options$dod) && - is.null(self$options$dooc) && - is.null(self$options$awd) && is.null(self$options$awod) - )) || - - (self$options$tint && - ( - is.null(self$options$dxdate) || is.null(self$options$fudate) - )) || - - is.null(self$options$explanatory)) { - private$.todo() + # Define your subconditions + subcondition1a <- !is.null(self$options$outcome) + subcondition1b1 <- !is.null(self$options$multievent) + subcondition1b2 <- !is.null(self$options$dod) + subcondition1b3 <- !is.null(self$options$dooc) + subcondition1b4 <- !is.null(self$options$awd) + subcondition1b5 <- !is.null(self$options$awod) + subcondition2a <- !is.null(self$options$elapsedtime) + subcondition2b1 <- !is.null(self$options$tint) + subcondition2b2 <- !is.null(self$options$dxdate) + subcondition2b3 <- !is.null(self$options$fudate) + condition3 <- !is.null(self$options$explanatory) + + + + + condition1 <- subcondition1a || (subcondition1b1 && (subcondition1b2 || subcondition1b3 || subcondition1b4 || subcondition1b5)) + + + + condition2 <- subcondition2a || (subcondition2b1 && subcondition2b2 && subcondition2b3) + + + if (!(condition1 && condition2 && condition3)) { + private$.todo() return() } else { self$results$todo$setVisible(FALSE) } + + # Empty data ---- + if (nrow(self$data) == 0) stop('Data contains no (complete) rows') - labelled_data <- private$.getData() - - mydata_labelled <- labelled_data$mydata_labelled - mytime_labelled <- labelled_data$mytime_labelled - myoutcome_labelled <- labelled_data$myoutcome_labelled - mydxdate_labelled <- labelled_data$mydxdate_labelled - myfudate_labelled <- labelled_data$myfudate_labelled - myexplanatory_labelled <- labelled_data$myexplanatory_labelled + # labelled_data <- private$.getData() + # mydata_labelled <- labelled_data$mydata_labelled + # mytime_labelled <- labelled_data$mytime_labelled + # myoutcome_labelled <- labelled_data$myoutcome_labelled + # mydxdate_labelled <- labelled_data$mydxdate_labelled + # myfudate_labelled <- labelled_data$myfudate_labelled + # myexplanatory_labelled <- labelled_data$myexplanatory_labelled @@ -687,26 +714,20 @@ survivalClass <- if (requireNamespace('jmvcore')) - self$results$mydataview$setContent( - list( - mydata_labelled = head(mydata_labelled), - mytime_labelled = mytime_labelled, - myoutcome_labelled = myoutcome_labelled, - mydxdate_labelled = mydxdate_labelled, - myfudate_labelled = myfudate_labelled, - myexplanatory_labelled = myexplanatory_labelled, - # time = head(time), - # outcome = head(outcome), - # factor = head(factor), - results = head(results) - ) - ) - - - - - - + # self$results$mydataview$setContent( + # list( + # mydata_labelled = head(mydata_labelled), + # mytime_labelled = mytime_labelled, + # myoutcome_labelled = myoutcome_labelled, + # mydxdate_labelled = mydxdate_labelled, + # myfudate_labelled = myfudate_labelled, + # myexplanatory_labelled = myexplanatory_labelled, + # # time = head(time), + # # outcome = head(outcome), + # # factor = head(factor), + # results = head(results) + # ) + # ) # Run Analysis ---- @@ -726,36 +747,20 @@ survivalClass <- if (requireNamespace('jmvcore')) private$.pairwise(results) } - - - - - - - - - - - - - - - - - - - - - - } # Median Survival Function ---- , .medianSurv = function(results) { + mytime <- results$name1time myoutcome <- results$name2outcome myfactor <- results$name3explanatory + # mytime_labelled <- results$mytime_labelled + # myoutcome_labelled <- results$myoutcome_labelled + # mydxdate_labelled <- results$mydxdate_labelled + # myfudate_labelled <- results$myfudate_labelled + myexplanatory_labelled <- results$myexplanatory_labelled mydata <- results$cleanData @@ -800,8 +805,21 @@ survivalClass <- if (requireNamespace('jmvcore')) names(results1table)[1] <- "factor" + + results2table <- results1table + + results2table$factor <- gsub(pattern = paste0(myexplanatory_labelled,"="), + replacement = "", + x = results1table$factor) + + + # self$results$medianSummary2$setContent(results2table) + + + + medianTable <- self$results$medianTable - data_frame <- results1table + data_frame <- results2table for (i in seq_along(data_frame[, 1, drop = T])) { medianTable$addRow(rowKey = i, values = c(data_frame[i,])) } @@ -829,6 +847,11 @@ survivalClass <- if (requireNamespace('jmvcore')) pattern = "=", replacement = " is ", x = description + )) %>% + dplyr::mutate(description = gsub( + pattern = myexplanatory_labelled, + replacement = self$options$explanatory, + x = description )) %>% dplyr::select(description) %>% dplyr::pull(.) -> km_fit_median_definition @@ -989,10 +1012,6 @@ survivalClass <- if (requireNamespace('jmvcore')) # ) - - - - mydata[[mytime]] <- jmvcore::toNumeric(mydata[[mytime]]) @@ -1006,8 +1025,6 @@ survivalClass <- if (requireNamespace('jmvcore')) formula <- as.formula(formula) - - cox_model <- survival::coxph(formula, data = mydata) zph <- survival::cox.zph(cox_model) @@ -1022,14 +1039,13 @@ survivalClass <- if (requireNamespace('jmvcore')) } - - # Survival Table Function ---- , .survTable = function(results) { mytime <- results$name1time myoutcome <- results$name2outcome myfactor <- results$name3explanatory + myexplanatory_labelled <- results$myexplanatory_labelled mydata <- results$cleanData @@ -1072,6 +1088,9 @@ survivalClass <- if (requireNamespace('jmvcore')) "lower", "upper")]) + # self$results$tableview$setContent(km_fit_df) + + km_fit_df[, 1] <- gsub( pattern = "thefactor=", replacement = paste0(self$options$explanatory, " "), @@ -1079,6 +1098,14 @@ survivalClass <- if (requireNamespace('jmvcore')) ) + km_fit_df2 <- km_fit_df + + km_fit_df[, 1] <- gsub( + pattern = paste0(myexplanatory_labelled,"="), + replacement = paste0(self$options$explanatory, " "), + x = km_fit_df[, 1] + ) + survTable <- self$results$survTable data_frame <- km_fit_df @@ -1087,11 +1114,15 @@ survivalClass <- if (requireNamespace('jmvcore')) } - - # survTableSummary 1,3,5-yr survival summary ---- - km_fit_df %>% + km_fit_df2[, 1] <- gsub( + pattern = paste0(myexplanatory_labelled,"="), + replacement = paste0(self$options$explanatory, " is "), + x = km_fit_df2[, 1] + ) + + km_fit_df2 %>% dplyr::mutate( description = glue::glue( @@ -1187,9 +1218,9 @@ survivalClass <- if (requireNamespace('jmvcore')) dplyr::mutate( description = glue::glue( - "The difference", + "The difference of ", title2, - "between {rowname} and {name}", + " between {rowname} and {name}", " has a p-value of {format.pval(value, digits = 3, eps = 0.001)}." ) ) %>% diff --git a/R/survival.h.R b/R/survival.h.R index e362ff26..351bdd20 100644 --- a/R/survival.h.R +++ b/R/survival.h.R @@ -329,7 +329,6 @@ survivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( active = list( subtitle = function() private$.items[["subtitle"]], todo = function() private$.items[["todo"]], - mydataview = function() private$.items[["mydataview"]], medianSummary = function() private$.items[["medianSummary"]], medianTable = function() private$.items[["medianTable"]], coxSummary = function() private$.items[["coxSummary"]], @@ -338,6 +337,7 @@ survivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( cox_ph = function() private$.items[["cox_ph"]], plot7 = function() private$.items[["plot7"]], survTableSummary = function() private$.items[["survTableSummary"]], + tableview = function() private$.items[["tableview"]], survTable = function() private$.items[["survTable"]], pairwiseSummary = function() private$.items[["pairwiseSummary"]], pairwiseTable = function() private$.items[["pairwiseTable"]], @@ -377,10 +377,6 @@ survivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( "dxdate", "tint", "multievent"))) - self$add(jmvcore::Preformatted$new( - options=options, - name="mydataview", - title="mydataview")) self$add(jmvcore::Preformatted$new( options=options, name="medianSummary", @@ -506,6 +502,7 @@ survivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( options=options, name="cox_ph", title="Proportional Hazards Assumption", + visible="(ph_cox)", clearWith=list( "explanatory", "outcome", @@ -550,6 +547,10 @@ survivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( "dxdate", "tint", "multievent"))) + self$add(jmvcore::Preformatted$new( + options=options, + name="tableview", + title="tableview")) self$add(jmvcore::Table$new( options=options, name="survTable", @@ -817,7 +818,6 @@ survivalBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( #' \tabular{llllll}{ #' \code{results$subtitle} \tab \tab \tab \tab \tab a preformatted \cr #' \code{results$todo} \tab \tab \tab \tab \tab a html \cr -#' \code{results$mydataview} \tab \tab \tab \tab \tab a preformatted \cr #' \code{results$medianSummary} \tab \tab \tab \tab \tab a preformatted \cr #' \code{results$medianTable} \tab \tab \tab \tab \tab a table \cr #' \code{results$coxSummary} \tab \tab \tab \tab \tab a preformatted \cr @@ -826,6 +826,7 @@ survivalBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( #' \code{results$cox_ph} \tab \tab \tab \tab \tab a preformatted \cr #' \code{results$plot7} \tab \tab \tab \tab \tab an image \cr #' \code{results$survTableSummary} \tab \tab \tab \tab \tab a preformatted \cr +#' \code{results$tableview} \tab \tab \tab \tab \tab a preformatted \cr #' \code{results$survTable} \tab \tab \tab \tab \tab a table \cr #' \code{results$pairwiseSummary} \tab \tab \tab \tab \tab a preformatted \cr #' \code{results$pairwiseTable} \tab \tab \tab \tab \tab a table \cr diff --git a/jamovi/survival.r.yaml b/jamovi/survival.r.yaml index 0c18d843..7865d693 100644 --- a/jamovi/survival.r.yaml +++ b/jamovi/survival.r.yaml @@ -26,9 +26,9 @@ items: - multievent - - name: mydataview - title: mydataview - type: Preformatted + # - name: mydataview + # title: mydataview + # type: Preformatted # - name: medianSummary2 @@ -177,6 +177,7 @@ items: - name: cox_ph title: 'Proportional Hazards Assumption' type: Preformatted + visible: (ph_cox) clearWith: - explanatory - outcome @@ -228,7 +229,10 @@ items: - multievent - + - name: tableview + title: tableview + type: Preformatted + - name: survTable title: '`1, 3, 5 year Survival - ${explanatory}`' @@ -294,6 +298,7 @@ items: + - name: pairwiseTable title: '`Pairwise Comparison Table - ${explanatory}`' type: Table diff --git a/man/survival.Rd b/man/survival.Rd index b52272e7..f5480dcd 100644 --- a/man/survival.Rd +++ b/man/survival.Rd @@ -115,7 +115,6 @@ A results object containing: \tabular{llllll}{ \code{results$subtitle} \tab \tab \tab \tab \tab a preformatted \cr \code{results$todo} \tab \tab \tab \tab \tab a html \cr -\code{results$mydataview} \tab \tab \tab \tab \tab a preformatted \cr \code{results$medianSummary} \tab \tab \tab \tab \tab a preformatted \cr \code{results$medianTable} \tab \tab \tab \tab \tab a table \cr \code{results$coxSummary} \tab \tab \tab \tab \tab a preformatted \cr