diff --git a/ClinicoPathDescriptives b/ClinicoPathDescriptives index acb9ced5..db8c8d0c 160000 --- a/ClinicoPathDescriptives +++ b/ClinicoPathDescriptives @@ -1 +1 @@ -Subproject commit acb9ced54614cf4944a00dcb9bb7c932ad1794fb +Subproject commit db8c8d0c85da37c53a77e0a70f54256e8be4d10b diff --git a/ClinicoPathLinuxDescriptives b/ClinicoPathLinuxDescriptives index 3ade1ada..97a17c5e 160000 --- a/ClinicoPathLinuxDescriptives +++ b/ClinicoPathLinuxDescriptives @@ -1 +1 @@ -Subproject commit 3ade1ada7272ce475ca3aa4f772bf20c0ba1baa2 +Subproject commit 97a17c5ec6f030b186a7c271c7dcb7585649e9d6 diff --git a/DESCRIPTION b/DESCRIPTION index 4a77b247..f9acb6e7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -70,8 +70,6 @@ Imports: gtExtras, labelled, PMCMRplus -Remotes: - nbarrowman/vtree@ffa53d4ea5050fa9b26918f4bb30595e91a0f489 VignetteBuilder: knitr Encoding: UTF-8 diff --git a/R/multisurvival.b.R b/R/multisurvival.b.R index d602f418..bdb1c63a 100644 --- a/R/multisurvival.b.R +++ b/R/multisurvival.b.R @@ -9,205 +9,155 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) inherit = multisurvivalBase, private = list( - # .todo = function() { - # # If no variable selected Initial Message ---- - # - # 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))) || - # - # (is.null(self$options$elapsedtime) && !(self$options$tint)) || - # - # (self$options$tint && (is.null(self$options$dxdate) || is.null(self$options$fudate))) || - # - # is.null(self$options$explanatory) - # - # # || - # - # # (!is.null(self$options$explanatory) && is.null(self$options$contexpl)) - # - # - # ) - # { - # # TODO ---- - # - # todo <- glue::glue( - # " - #
Welcome to ClinicoPath - #

- # This tool will help you perform a multivariable survival analysis. - #

- # Explanatory variables can be categorical (ordinal or nominal) or continuous. - #

- # 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, continuous, and in months. You may also use dates to calculate survival time in advanced elapsed time options. - #

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

- # " - # ) - # # https://finalfit.org/articles/all_tables_examples.html#cox-proportional-hazards-model-survival-time-to-event - # - # - # html <- self$results$todo - # html$setContent(todo) - # # return() - # - # } else { - # if (nrow(self$data) == 0) - # stop('Data contains no (complete) rows') - # } - # - # } - # , - - - .cleandata = function() { - # Common Definitions ---- - contin <- c("integer", "numeric", "double") + # init ---- + .init = function() { - # Read Data ---- + } + # getData ---- + , + .getData = function() { mydata <- self$data - # Read Arguments ---- + mydata$row_names <- rownames(mydata) - elapsedtime <- self$options$elapsedtime - outcome <- self$options$outcome - explanatory <- self$options$explanatory - contexpl <- self$options$contexpl - outcomeLevel <- self$options$outcomeLevel - tint <- self$options$tint + original_names <- names(mydata) - # Define Outcome ---- + labels <- setNames(original_names, original_names) - multievent <- self$options$multievent + mydata <- mydata %>% janitor::clean_names() - outcome1 <- self$options$outcome - outcome1 <- self$data[[outcome1]] + corrected_labels <- + setNames(original_names, names(mydata)) + mydata <- labelled::set_variable_labels( + .data = mydata, + .labels = corrected_labels + ) - if (!multievent) { - if (inherits(outcome1, contin)) { - if (!((length(unique( - outcome1[!is.na(outcome1)] - )) == 2) && (sum(unique( - outcome1[!is.na(outcome1)] - )) == 1))) { - stop( - 'When using continuous variable as an outcome, it must only contain 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[["myoutcome"]] <- - mydata[[self$options$outcome]] - + all_labels <- labelled::var_label(mydata) - } else if (inherits(outcome1, "factor")) { - # mydata[[self$options$outcome]] <- - # ifelse(test = outcome1 == outcomeLevel, - # yes = 1, - # no = 0) + mytime <- + names(all_labels)[all_labels == self$options$elapsedtime] + myoutcome <- + names(all_labels)[all_labels == self$options$outcome] - mydata[["myoutcome"]] <- - ifelse( - test = outcome1 == outcomeLevel, - yes = 1, - no = 0 - ) + mydxdate <- + names(all_labels)[all_labels == self$options$dxdate] + myfudate <- + names(all_labels)[all_labels == self$options$fudate] - } else { - stop( - 'When using continuous variable as an outcome, it must only contain 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. If you are using a factor as an outcome, please check the levels and content.' - ) + labels_explanatory <- self$options$explanatory - } - - } else if (multievent) { - analysistype <- self$options$analysistype + myexplanatory <- + names(all_labels)[match(labels_explanatory, + all_labels)] - dod <- self$options$dod - dooc <- self$options$dooc - awd <- self$options$awd - awod <- self$options$awod - - - - if (analysistype == 'overall') { - # (Alive) <=> (Dead of Disease & Dead of Other Causes) - - - mydata[["myoutcome"]] <- NA_integer_ - - mydata[["myoutcome"]][outcome1 == awd] <- 0 - mydata[["myoutcome"]][outcome1 == awod] <- 0 - mydata[["myoutcome"]][outcome1 == dod] <- 1 - mydata[["myoutcome"]][outcome1 == dooc] <- 1 + labels_contexpl <- self$options$contexpl + mycontexpl <- + names(all_labels)[match(labels_contexpl, + all_labels)] + return(list( + "mydata_labelled" = mydata, + "mytime_labelled" = mytime, + "myoutcome_labelled" = myoutcome, + "mydxdate_labelled" = mydxdate, + "myfudate_labelled" = myfudate, + "mycontexpl_labelled" = mycontexpl, + "myexplanatory_labelled" = myexplanatory + )) + } - } else if (analysistype == 'cause') { - # (Alive & Dead of Other Causes) <=> (Dead of Disease) + # todo ---- + , + .todo = function() { + # todo ---- + + todo <- glue::glue( + " +
Welcome to ClinicoPath +

+ This tool will help you perform a multivariable survival analysis. +

+ Explanatory variables can be categorical (ordinal or nominal) or continuous. +

+ 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, continuous, and in months. You may also use dates to calculate survival time in advanced elapsed time options. +

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

+ " + ) + # https://finalfit.org/articles/all_tables_examples.html#cox-proportional-hazards-model-survival-time-to-event - mydata[["myoutcome"]] <- NA_integer_ + html <- self$results$todo + html$setContent(todo) + return() - mydata[["myoutcome"]][outcome1 == awd] <- 0 - mydata[["myoutcome"]][outcome1 == awod] <- 0 - mydata[["myoutcome"]][outcome1 == dod] <- 1 - mydata[["myoutcome"]][outcome1 == dooc] <- 0 + } - } else if (analysistype == 'compete') { - # Alive <=> Dead of Disease accounting for Dead of Other Causes - mydata[["myoutcome"]] <- NA_integer_ - mydata[["myoutcome"]][outcome1 == awd] <- 0 - mydata[["myoutcome"]][outcome1 == awod] <- 0 - mydata[["myoutcome"]][outcome1 == dod] <- 1 - mydata[["myoutcome"]][outcome1 == dooc] <- 2 + # Define Survival Time ---- + , + .definemytime = function() { - } + ## Read Labelled Data ---- - } + labelled_data <- private$.getData() + mydata <- labelled_data$mydata_labelled + mytime_labelled <- labelled_data$mytime_labelled + mydxdate_labelled <- labelled_data$mydxdate_labelled + myfudate_labelled <- labelled_data$myfudate_labelled - # Define Survival Time ---- + tint <- self$options$tint if (!tint) { - ## Use precalculated time ---- - - mydata[[self$options$elapsedtime]] <- - jmvcore::toNumeric(mydata[[self$options$elapsedtime]]) + ### Precalculated Time ---- mydata[["mytime"]] <- - jmvcore::toNumeric(mydata[[self$options$elapsedtime]]) + jmvcore::toNumeric(mydata[[mytime_labelled]]) } else if (tint) { - ## Calculate Time Interval ---- + ### Time Interval ---- - dxdate <- self$options$dxdate - fudate <- self$options$fudate + dxdate <- mydxdate_labelled + fudate <- myfudate_labelled timetypedata <- self$options$timetypedata - # stopifnot(inherits(mydata[[dxdate]], c("POSIXct", "POSIXt", "POSIXlt"))) - # stopifnot(inherits(mydata[[fudate]], c("POSIXct", "POSIXt", "POSIXlt"))) + # # 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") { @@ -247,6 +197,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) } + timetypeoutput <- jmvcore::constructFormula(terms = self$options$timetypeoutput) @@ -257,240 +208,479 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) stopifnot(lubridate::is.interval(mydata[["interval"]])) mydata <- mydata %>% - dplyr::mutate(mytime = lubridate::time_length(interval, timetypeoutput)) + dplyr::mutate(mytime = lubridate::time_length(interval, + timetypeoutput)) + } + df_time <- mydata %>% jmvcore::select(c("row_names", "mytime")) + return(df_time) - # Define Explanatory ---- - myexplanatory <- NULL + } - if(!is.null(self$options$explanatory)) { + # Define Outcome ---- + , + .definemyoutcome = function() { - myexplanatory <- as.vector(self$options$explanatory) - } + labelled_data <- private$.getData() + mydata <- labelled_data$mydata_labelled + myoutcome_labelled <- labelled_data$myoutcome_labelled - mycontexpl <- NULL - if(!is.null(self$options$contexpl)) { + contin <- c("integer", "numeric", "double") - mycontexpl <- as.vector(self$options$contexpl) + outcomeLevel <- self$options$outcomeLevel + multievent <- self$options$multievent - } + outcome1 <- mydata[[myoutcome_labelled]] + if (!multievent) { + if (inherits(outcome1, contin)) { + if (!((length(unique( + outcome1[!is.na(outcome1)] + )) == 2) && (sum(unique( + outcome1[!is.na(outcome1)] + )) == 1))) { + stop( + 'When using continuous variable as an outcome, it must only contain 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.' + ) - myfactors <- c(myexplanatory, mycontexpl) + } + mydata[["myoutcome"]] <- mydata[[myoutcome_labelled]] + # mydata[[self$options$outcome]] - self$results$mydataview$setContent( - list( - head(mydata, n = 10), - myexplanatory = myexplanatory, - mycontexpl = mycontexpl, - myfactors = myfactors - ) - ) + } else if (inherits(outcome1, "factor")) { + mydata[["myoutcome"]] <- + ifelse( + test = outcome1 == outcomeLevel, + yes = 1, + no = 0 + ) + } else { + stop( + 'When using continuous variable as an outcome, it must only contain 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. If you are using a factor as an outcome, please check the levels and content.' + ) - # Add Redefined Outcome to Data ---- + } - # if (self$options$multievent) { - # - # if (self$options$outcomeredifened && - # self$results$outcomeredifened$isNotFilled()) { - # self$results$outcomeredifened$setValues(mydata[["myoutcome"]]) - # } - # } + } else if (multievent) { + analysistype <- self$options$analysistype - # Add Calculated Time to Data ---- + dod <- self$options$dod + dooc <- self$options$dooc + awd <- self$options$awd + awod <- self$options$awod - # if (self$options$tint) { - # - # if (self$options$calculatedtime && - # self$results$calculatedtime$isNotFilled()) { - # self$results$calculatedtime$setValues(mydata[["mytime"]]) - # } - # } + if (analysistype == 'overall') { + # Overall ---- + # (Alive) <=> (Dead of Disease & Dead of Other Causes) + + + mydata[["myoutcome"]] <- NA_integer_ + + mydata[["myoutcome"]][outcome1 == awd] <- 0 + mydata[["myoutcome"]][outcome1 == awod] <- 0 + mydata[["myoutcome"]][outcome1 == dod] <- 1 + mydata[["myoutcome"]][outcome1 == dooc] <- 1 + } else if (analysistype == 'cause') { + # Cause Specific ---- + # (Alive & Dead of Other Causes) <=> (Dead of Disease) - # Landmark ---- - # https://www.emilyzabor.com/tutorials/survival_analysis_in_r_tutorial.html#landmark_method - if (self$options$uselandmark) { - landmark <- jmvcore::toNumeric(self$options$landmark) + mydata[["myoutcome"]] <- NA_integer_ + + mydata[["myoutcome"]][outcome1 == awd] <- 0 + mydata[["myoutcome"]][outcome1 == awod] <- 0 + mydata[["myoutcome"]][outcome1 == dod] <- 1 + mydata[["myoutcome"]][outcome1 == dooc] <- 0 + + } else if (analysistype == 'compete') { + # Competing Risks ---- + # Alive <=> Dead of Disease accounting for Dead of Other Causes + + # https://www.emilyzabor.com/tutorials/survival_analysis_in_r_tutorial.html#part_3:_competing_risks + + + mydata[["myoutcome"]] <- NA_integer_ + + mydata[["myoutcome"]][outcome1 == awd] <- 0 + mydata[["myoutcome"]][outcome1 == awod] <- 0 + mydata[["myoutcome"]][outcome1 == dod] <- 1 + mydata[["myoutcome"]][outcome1 == dooc] <- 2 + + } - mydata <- mydata %>% - dplyr::filter(mytime >= landmark) %>% - dplyr::mutate(mytime = mytime - landmark) } + df_outcome <- mydata %>% jmvcore::select(c("row_names", "myoutcome")) + return(df_outcome) + + } + # Define Factor ---- + , + .definemyfactor = function() { + labelled_data <- private$.getData() + mydata_labelled <- labelled_data$mydata_labelled + myexplanatory_labelled <- labelled_data$myexplanatory_labelled + mycontexpl_labelled <- labelled_data$mycontexpl_labelled - # Define Data For Analysis ---- + mydata <- mydata_labelled - mydata <- jmvcore::select(df = mydata, columnNames = c("mytime", "myoutcome", myfactors)) + df_factor <- mydata %>% + jmvcore::select(c("row_names", + myexplanatory_labelled, + mycontexpl_labelled + ) + ) # self$results$mydataview$setContent( # list( - # head(mydata, n = 30) + # df_factor = head(df_factor), + # myexplanatory_labelled = myexplanatory_labelled, + # mycontexpl_labelled = mycontexpl_labelled, + # mydata = head(mydata) # ) # ) + return(df_factor) - # naOmit ---- + } - mydata <- jmvcore::naOmit(mydata) + # Clean Data ---- + , + .cleandata = function() { + ## Common Definitions ---- + + contin <- c("integer", "numeric", "double") + ## Read Data ---- - # Send cleaned mydata to other functions ---- + 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 + mycontexpl_labelled <- labelled_data$mycontexpl_labelled - return(list("mydata" = mydata)) + time <- private$.definemytime() + outcome <- private$.definemyoutcome() + factor <- private$.definemyfactor() + ## Clean Data ---- + cleanData <- dplyr::left_join(time, outcome, by = "row_names") %>% + dplyr::left_join(factor, by = "row_names") + + ## Landmark ---- + + # https://www.emilyzabor.com/tutorials/survival_analysis_in_r_tutorial.html#landmark_method + + if (self$options$uselandmark) { + + landmark <- jmvcore::toNumeric(self$options$landmark) + + cleanData <- cleanData %>% + dplyr::filter(mytime >= landmark) %>% + dplyr::mutate(mytime = mytime - landmark) + } + + ## Names cleanData ---- + + if (self$options$tint) { + name1time <- "CalculatedTime" + } + + if (!self$options$tint && + !is.null(self$options$elapsedtime)) { + name1time <- mytime_labelled + } + + name2outcome <- myoutcome_labelled + + if (self$options$tint) { + name2outcome <- "CalculatedOutcome" + } + + if (!is.null(self$options$explanatory) + ) { + name3expl <- myexplanatory_labelled + } + + + if (!is.null(self$options$contexpl) + ) { + name3contexpl <- mycontexpl_labelled + } + + + # cleanData <- cleanData %>% + # dplyr::rename( + # !!name1time := mytime, + # !!name2outcome := myoutcome, + # !!name3contexpl := myfactor + # ) + + # naOmit ---- + + cleanData <- jmvcore::naOmit(cleanData) + + # Return Data ---- + + return( + list( + "name1time" = name1time, + "name2outcome" = name2outcome, + "name3contexpl" = name3contexpl, + "name3expl" = name3expl, + "cleanData" = cleanData, + "mytime_labelled" = mytime_labelled, + "myoutcome_labelled" = myoutcome_labelled, + "mydxdate_labelled" = mydxdate_labelled, + "myfudate_labelled" = myfudate_labelled, + "myexplanatory_labelled" = myexplanatory_labelled, + "mycontexpl_labelled" = mycontexpl_labelled + ) + ) + + + # self$results$mydataview$setContent( + # list( + # # labelled_data = head(labelled_data), + # # time = head(time), + # # outcome = head(outcome), + # # factor = head(factor), + # 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, + # mycontexpl_labelled = mycontexpl_labelled, + # # cleanData = head(cleanData), + # name1time = name1time, + # name2outcome = name2outcome, + # name3expl = name3expl, + # name3contexpl = name3contexpl + # ) + # ) } + + # run ---- , .run = function() { + # Errors, Warnings ---- + ## No variable todo ---- - # Errors ---- - # 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$options$explanatory) && is.null(self$options$contexpl)) - # - # ) { - # private$.todo() - # # return() - # } + ## Define 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) + condition3a <- !is.null(self$options$contexpl) + condition3b <- !is.null(self$options$explanatory) + + condition1 <- subcondition1a || (subcondition1b1 && (subcondition1b2 || subcondition1b3 || subcondition1b4 || subcondition1b5)) + + condition2 <- subcondition2a || (subcondition2b1 && subcondition2b2 && subcondition2b3) + + condition3 <- condition3a || condition3b + + not_continue_analysis <- !(condition1 && condition2 && condition3) + + + if (not_continue_analysis) { + private$.todo() + self$results$text$setVisible(FALSE) + self$results$text2$setVisible(FALSE) + self$results$plot$setVisible(FALSE) + self$results$plot3$setVisible(FALSE) + self$results$todo$setVisible(TRUE) + return() + } else { + self$results$todo$setVisible(FALSE) + } + + + ## Stop if Empty Data ---- if (nrow(self$data) == 0) stop('Data contains no (complete) rows') - # Calculate mydata ---- + ## mydata ---- cleaneddata <- private$.cleandata() - mydata <- cleaneddata$mydata + name1time <- cleaneddata$name1time + name2outcome <- cleaneddata$name2outcome + name3contexpl <- cleaneddata$name3contexpl + name3expl <- cleaneddata$name3expl + mydata <- cleanData <- cleaneddata$cleanData + mytime_labelled <- cleaneddata$mytime_labelled + myoutcome_labelled <- cleaneddata$myoutcome_labelled + mydxdate_labelled <- cleaneddata$mydxdate_labelled + myfudate_labelled <- cleaneddata$myfudate_labelled + myexplanatory_labelled <- cleaneddata$myexplanatory_labelled + mycontexpl_labelled <- cleaneddata$mycontexpl_labelled + # Cox ---- + private$.cox() - # Cox ---- - private$.cox(mydata) + # Prepare Data For Plots ---- + + image <- self$results$plot + image$setState(cleaneddata) + + image3 <- self$results$plot3 + image3$setState(cleaneddata) + + + # image4 <- self$results$plot4 + # image4$setState(mydata) + + # imageKM <- self$results$plotKM + # imageKM$setState(mydata) + + # image7 <- self$results$plot7 + # image7$setState(mydata) # View mydata ---- # self$results$mydataview$setContent( - # list(head(mydata, n = 30)) + # list( + # head(cleanData) + # ) # ) + # Add Calculated Time to Data ---- + + if (self$options$tint && self$options$calculatedtime && self$results$calculatedtime$isNotFilled()) { + self$results$calculatedtime$setRowNums(cleanData$row_names) + self$results$calculatedtime$setValues(cleanData$mytime) + } - # Prepare Data For Plots ---- - image <- self$results$plot - image$setState(mydata) - image3 <- self$results$plot3 - image3$setState(mydata) + # Add Redefined Outcome to Data ---- + + if (self$options$multievent && self$options$outcomeredifened && self$results$outcomeredifened$isNotFilled()) { + self$results$outcomeredifened$setRowNums(cleanData$row_names) + self$results$outcomeredifened$setValues(cleanData$myoutcome) + } - # image4 <- self$results$plot4 - # image4$setState(mydata) - # imageKM <- self$results$plotKM - # imageKM$setState(mydata) - # image7 <- self$results$plot7 - # image7$setState(mydata) + } + # cox ---- + , + .cox = function() { - }, + cleaneddata <- private$.cleandata() + name1time <- cleaneddata$name1time + name2outcome <- cleaneddata$name2outcome - .cox = function(mydata) { + name3contexpl <- cleaneddata$name3contexpl + name3expl <- cleaneddata$name3expl + mydata <- cleanData <- cleaneddata$cleanData - # prepare formula ---- + mytime_labelled <- cleaneddata$mytime_labelled + myoutcome_labelled <- cleaneddata$myoutcome_labelled + mydxdate_labelled <- cleaneddata$mydxdate_labelled + myfudate_labelled <- cleaneddata$myfudate_labelled + myexplanatory_labelled <- cleaneddata$myexplanatory_labelled + mycontexpl_labelled <- cleaneddata$mycontexpl_labelled - myexplanatory <- NULL + ### prepare formula ---- - if(!is.null(self$options$explanatory)) { - myexplanatory <- as.vector(self$options$explanatory) + myexplanatory <- NULL + if(!is.null(self$options$explanatory)) { + myexplanatory <- as.vector(myexplanatory_labelled) } mycontexpl <- NULL - if(!is.null(self$options$contexpl)) { - mycontexpl <- as.vector(self$options$contexpl) + mycontexpl <- as.vector(mycontexpl_labelled) } formula2 <- c(myexplanatory, mycontexpl) - # formula2 <-c(as.vector(self$options$explanatory), - # as.vector(self$options$contexpl) - # ) - # formulaL <- - # jmvcore::constructFormula(terms = self$options$elapsedtime) - # - # formulaL <- jmvcore::toNumeric(formulaL) - # - # formulaL <- - # jmvcore::constructFormula(terms = self$options$elapsedtime) + myformula <- + paste("Surv( mytime, myoutcome ) ~ ", + paste(formula2, collapse = " + ") + ) - # formulaR <- jmvcore::constructFormula(terms = self$options$outcome) + myformula <- as.formula(myformula) - # formulaR <- jmvcore::toNumeric(formulaR) + # self$results$mydataview$setContent( + # list( + # mydata = head(mydata, n = 30), + # myformula = myformula, + # myexplanatory = myexplanatory, + # mycontexpl = mycontexpl, + # formula2 = formula2 + # ) + # ) - myformula <- - paste("Surv(mytime, myoutcome)") - # finalfit Multivariable table ---- + ## finalfit Multivariable table ---- finalfit::finalfit( .data = mydata, - dependent = myformula, - explanatory = formula2, + formula = myformula, + # dependent = myformula, + # explanatory = formula2, metrics = TRUE ) -> tMultivariable @@ -533,7 +723,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) self$results$text$setContent(results1) - # Cox2 ---- + ## coxph ---- LHT <- "survival::Surv(mytime, myoutcome)" @@ -693,19 +883,53 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) , .plot = function(image, ggtheme, theme, ...) { + if (!self$options$hr) { + return() + } + + if (!(self$options$sty == "t1")) { + return() + } plotData <- image$state - # prepare formula ---- + if (is.null(plotData)) { + return() + } + + name1time <- plotData$name1time + name2outcome <- plotData$name2outcome + name3contexpl <- plotData$name3contexpl + name3expl <- plotData$name3expl - formula2 <- - jmvcore::constructFormula(terms = c(self$options$explanatory, self$options$contexpl)) + mydata <- cleanData <- plotData$cleanData - # formula2 <- as.vector(self$options$explanatory) + mytime_labelled <- plotData$mytime_labelled + myoutcome_labelled <- plotData$myoutcome_labelled + mydxdate_labelled <- plotData$mydxdate_labelled + myfudate_labelled <- plotData$myfudate_labelled + myexplanatory_labelled <- plotData$myexplanatory_labelled + mycontexpl_labelled <- plotData$mycontexpl_labelled + ### prepare formula ---- + + myexplanatory <- NULL + if(!is.null(self$options$explanatory)) { + myexplanatory <- as.vector(myexplanatory_labelled) + } + + mycontexpl <- NULL + if(!is.null(self$options$contexpl)) { + mycontexpl <- as.vector(mycontexpl_labelled) + } + + formula2 <- c(myexplanatory, mycontexpl) + myformula <- - paste("survival::Surv(mytime, myoutcome)") + paste0('Surv( mytime, myoutcome )') + + # myformula <- as.formula(myformula) # hr_plot ---- @@ -713,7 +937,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) plot <- finalfit::hr_plot( - .data = plotData, + .data = mydata, dependent = myformula, explanatory = formula2, dependent_label = "Survival", @@ -721,8 +945,9 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) title_text_size = 14, plot_opts = list( ggplot2::xlab("HR, 95% CI"), - ggplot2::theme(axis.title = - ggplot2::element_text(size = 12)) + ggplot2::theme( + axis.title = + ggplot2::element_text(size = 12)) ) ) @@ -802,20 +1027,72 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) , .plot3 = function(image3, ggtheme, theme, ...) { + if (!self$options$hr) { + return() + } + + if (!(self$options$sty == "t3")) { + return() + } + plotData <- image3$state + if (is.null(plotData)) { + return() + } + + name1time <- plotData$name1time + name2outcome <- plotData$name2outcome + name3contexpl <- plotData$name3contexpl + name3expl <- plotData$name3expl + + mydata <- cleanData <- plotData$cleanData - formula2 <- - jmvcore::constructFormula(terms = c(self$options$explanatory, self$options$contexpl)) + mytime_labelled <- plotData$mytime_labelled + myoutcome_labelled <- plotData$myoutcome_labelled + mydxdate_labelled <- plotData$mydxdate_labelled + myfudate_labelled <- plotData$myfudate_labelled + myexplanatory_labelled <- plotData$myexplanatory_labelled + mycontexpl_labelled <- plotData$mycontexpl_labelled - formula3 <- - paste("survival::Surv(mytime, myoutcome) ~ ", formula2) - formula3 <- as.formula(formula3) + ### prepare formula ---- + + myexplanatory <- NULL + if(!is.null(self$options$explanatory)) { + myexplanatory <- as.vector(myexplanatory_labelled) + } + + mycontexpl <- NULL + if(!is.null(self$options$contexpl)) { + mycontexpl <- as.vector(mycontexpl_labelled) + } + + formula2 <- c(myexplanatory, mycontexpl) + + myformula <- + paste("survival::Surv(mytime, myoutcome) ~ ", + paste(formula2, collapse = " + ") + ) + + + # self$results$mydataview$setContent( + # list( + # "myformula" = myformula, + # "mydata" = head(mydata), + # myexplanatory = myexplanatory, + # mycontexpl = mycontexpl, + # formula2 = formula2 + # ) + # ) + + + + myformula <- as.formula(myformula) mod <- - survival::coxph(formula = formula3, - data = plotData) + survival::coxph(formula = myformula, + data = mydata) # plot @@ -830,8 +1107,9 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) # ggforest ---- + plot3 <- survminer::ggforest(model = mod, - data = plotData) + data = mydata) # print plot ---- @@ -1026,7 +1304,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) # # # https://stackoverflow.com/questions/55404550/computing-se-or-ci-for-ggadjustedcurves # - # # print plot ----- + # ## print plot ----- # # print(plot7) # TRUE @@ -1038,904 +1316,3 @@ multisurvivalClass <- if (requireNamespace('jmvcore')) ) ) - - - - - -# # Define Survival Time ---- -# -# .definemytime = function() { -# -# mydata <- self$data -# -# tint <- self$options$tint -# -# -# if (!tint) { -# -# # Precalculated Time ---- -# -# # mydata[[self$options$elapsedtime]] <- jmvcore::toNumeric(mydata[[self$options$elapsedtime]]) -# -# mydata[["mytime"]] <- jmvcore::toNumeric(mydata[[self$options$elapsedtime]]) -# -# -# } else if (tint) { -# -# # Time Interval ---- -# -# dxdate <- self$options$dxdate -# fudate <- self$options$fudate -# timetypedata <- self$options$timetypedata -# -# -# if (timetypedata == "ymdhms") { -# mydata[["start"]] <- lubridate::ymd_hms(mydata[[dxdate]]) -# mydata[["end"]] <- lubridate::ymd_hms(mydata[[fudate]]) -# } -# if (timetypedata == "ymd") { -# mydata[["start"]] <- lubridate::ymd(mydata[[dxdate]]) -# mydata[["end"]] <- lubridate::ymd(mydata[[fudate]]) -# } -# if (timetypedata == "ydm") { -# mydata[["start"]] <- lubridate::ydm(mydata[[dxdate]]) -# mydata[["end"]] <- lubridate::ydm(mydata[[fudate]]) -# } -# if (timetypedata == "mdy") { -# mydata[["start"]] <- lubridate::mdy(mydata[[dxdate]]) -# mydata[["end"]] <- lubridate::mdy(mydata[[fudate]]) -# } -# if (timetypedata == "myd") { -# mydata[["start"]] <- lubridate::myd(mydata[[dxdate]]) -# mydata[["end"]] <- lubridate::myd(mydata[[fudate]]) -# } -# if (timetypedata == "dmy") { -# mydata[["start"]] <- lubridate::dmy(mydata[[dxdate]]) -# mydata[["end"]] <- lubridate::dmy(mydata[[fudate]]) -# } -# if (timetypedata == "dym") { -# mydata[["start"]] <- lubridate::dym(mydata[[dxdate]]) -# mydata[["end"]] <- lubridate::dym(mydata[[fudate]]) -# } -# -# -# -# timetypeoutput <- jmvcore::constructFormula(terms = self$options$timetypeoutput) -# -# -# mydata <- mydata %>% -# dplyr::mutate( -# interval = lubridate::interval(start, end) -# ) -# -# stopifnot(lubridate::is.interval(mydata[["interval"]])) -# -# mydata <- mydata %>% -# dplyr::mutate( -# mytime = lubridate::time_length(interval, timetypeoutput) -# ) -# -# -# } -# -# -# return(mydata[["mytime"]]) -# -# -# } -# -# # Define Outcome ---- -# , -# .definemyoutcome = function() { -# -# mydata <- self$data -# -# contin <- c("integer", "numeric", "double") -# -# multievent <- self$options$multievent -# outcome1 <- self$options$outcome -# outcome1 <- self$data[[outcome1]] -# -# if (!multievent) { -# -# if (inherits(outcome1, contin)) { -# -# if ( -# !((length(unique(outcome1[!is.na(outcome1)])) == 2) && (sum(unique(outcome1[!is.na(outcome1)])) == 1) ) -# ) { -# stop('When using continuous variable as an outcome, it must only contain 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[["myoutcome"]] <- mydata[[self$options$outcome]] -# -# } else if (inherits(outcome1, "factor")) { -# -# mydata[["myoutcome"]] <- -# ifelse(test = outcome1 == outcomeLevel, -# yes = 1, -# no = 0) -# -# } else { -# -# stop('When using continuous variable as an outcome, it must only contain 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. If you are using a factor as an outcome, please check the levels and content.') -# -# } -# -# } else if (multievent) { -# -# -# analysistype <- self$options$analysistype -# -# dod <- self$options$dod -# dooc <- self$options$dooc -# awd <- self$options$awd -# awod <- self$options$awod -# -# if (analysistype == 'overall') { -# -# # (Alive) <=> (Dead of Disease & Dead of Other Causes) -# -# -# mydata[["myoutcome"]] <- NA_integer_ -# -# mydata[["myoutcome"]][outcome1 == awd] <- 0 -# mydata[["myoutcome"]][outcome1 == awod] <- 0 -# mydata[["myoutcome"]][outcome1 == dod] <- 1 -# mydata[["myoutcome"]][outcome1 == dooc] <- 1 -# -# -# -# } else if (analysistype == 'cause') { -# -# # (Alive & Dead of Other Causes) <=> (Dead of Disease) -# -# -# mydata[["myoutcome"]] <- NA_integer_ -# -# mydata[["myoutcome"]][outcome1 == awd] <- 0 -# mydata[["myoutcome"]][outcome1 == awod] <- 0 -# mydata[["myoutcome"]][outcome1 == dod] <- 1 -# mydata[["myoutcome"]][outcome1 == dooc] <- 0 -# -# } else if (analysistype == 'compete') { -# -# # Alive <=> Dead of Disease accounting for Dead of Other Causes -# -# -# -# mydata[["myoutcome"]] <- NA_integer_ -# -# mydata[["myoutcome"]][outcome1 == awd] <- 0 -# mydata[["myoutcome"]][outcome1 == awod] <- 0 -# mydata[["myoutcome"]][outcome1 == dod] <- 1 -# mydata[["myoutcome"]][outcome1 == dooc] <- 2 -# -# } -# -# } -# -# -# return(mydata[["myoutcome"]]) -# -# } -# -# # Define Factor ---- -# , -# .definemyfactor = function() { -# -# mydata <- self$data -# -# # 1 Explanatory Factor ---- -# -# if ( length(self$options$explanatory) == 1 ) { -# -# expl <- self$options$explanatory -# -# mydata[["myfactor"]] <- mydata[[expl]] -# -# return(mydata[["myfactor"]]) -# -# } -# -# # > 1 Explanatory Factor ---- -# -# if ( length(self$options$explanatory) > 1 ) { -# -# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# return(thefactor) -# -# } -# -# # single arm ---- -# -# sas <- self$options$sas -# -# if (sas) { -# thefactor <- 1 -# return(thefactor) -# } -# -# -# } -# -# -# # Clean Data For Analysis ---- -# , -# .cleandata = function() { -# -# -# time <- private$.definemytime() -# outcome <- private$.definemyoutcome() -# -# -# if ( length(self$options$explanatory) == 1 ) { -# factor <- private$.definemyfactor() -# -# cleanData <- data.frame( -# "mytime" = time, -# "myoutcome" = outcome, -# "factor" = factor -# ) -# } -# -# -# if ( length(self$options$explanatory) > 1 || self$options$sas ) { -# factor <- private$.definemyfactor() -# factor <- jmvcore::select(df = self$data, columnNames = factor) -# -# cleanData <- data.frame( -# "mytime" = time, -# "myoutcome" = outcome, -# factor -# ) -# -# } -# -# -# -# # naOmit ---- -# -# cleanData <- jmvcore::naOmit(cleanData) -# -# -# # View mydata ---- -# -# self$results$mydataview$setContent( -# list(time, -# outcome, -# factor, -# head(cleanData, n = 30) -# ) -# ) -# -# -# # Prepare Data For Plots ---- -# -# plotData <- cleanData -# -# image <- self$results$plot -# image$setState(plotData) -# -# image2 <- self$results$plot2 -# image2$setState(plotData) -# -# image3 <- self$results$plot3 -# image3$setState(plotData) -# -# image6 <- self$results$plot6 -# image6$setState(plotData) -# -# } -# -# -# -# -# -# , -# .run = function() { -# -# -# # Common Errors, Warnings ---- -# -# # No variable ---- -# if ( is.null(self$options$outcome) || -# -# (is.null(self$options$elapsedtime) && !(self$options$tint)) -# -# || is.null(self$options$explanatory) -# -# ) { -# -# 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) -# return() -# } -# -# # More than one explanatory ---- -# if (length(self$options$explanatory) > 1 && !( -# is.null(self$options$outcome) || -# (is.null(self$options$elapsedtime) && !(self$options$tint)) -# ) -# -# ) { -# -# -# todo <- glue::glue(" -#
More than one explanatory variable. -#
-#
") -# html <- self$results$todo -# html$setContent(todo) -# -# } -# -# # One explanatory ---- -# -# if ( -# length(self$options$explanatory) == 1 && !( -# is.null(self$options$outcome) || -# (is.null(self$options$elapsedtime) && !(self$options$tint)) -# ) -# -# ) { -# -# todo <- glue::glue(" -#
Analysis with one variable -#
-#
") -# html <- self$results$todo -# html$setContent(todo) -# -# } -# -# -# # Empty data ---- -# -# if (nrow(self$data) == 0) -# stop('Data contains no (complete) rows') -# -# # Prepare Clean Data ---- -# -# private$.cleandata() -# -# -# -# -# -# -# -# # Median Survival Table ---- -# -# -# -# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# sas <- self$options$sas -# -# if (sas) { -# thefactor <- 1 -# } -# -# formula <- paste('survival::Surv(mytime, myoutcome) ~ ', thefactor) -# formula <- as.formula(formula) -# -# km_fit <- survival::survfit(formula, data = mydata) -# -# -# km_fit_median_df <- summary(km_fit) -# results1html <- as.data.frame(km_fit_median_df$table) %>% -# janitor::clean_names(dat = ., case = "snake") %>% -# tibble::rownames_to_column(.data = .) -# -# -# results1html[,1] <- gsub(pattern = ", ", -# replacement = " and ", -# x = results1html[,1]) -# -# results1table <- results1html -# -# names(results1table)[1] <- "factor" -# -# medianTable <- self$results$medianTable -# data_frame <- results1table -# for (i in seq_along(data_frame[,1,drop = T])) { -# medianTable$addRow(rowKey = i, values = c(data_frame[i,])) -# } -# -# -# # Median Survival Summary ---- -# -# results1table %>% -# dplyr::mutate( -# description = -# glue::glue( -# "When {factor}, median survival is {round(median, digits = 1)} [{round(x0_95lcl, digits = 1)} - {round(x0_95ucl, digits = 1)}, 95% CI] ", self$options$timetypeoutput, "." -# ) -# ) %>% -# dplyr::mutate( -# description = gsub(pattern = "=", replacement = " is ", x = description) -# ) %>% -# dplyr::select(description) %>% -# dplyr::pull(.) -> km_fit_median_definition -# -# medianSummary <- km_fit_median_definition -# -# -# self$results$medianSummary$setContent(medianSummary) -# -# -# -# -# -# # Cox Regression ---- -# -# -# formula2 <- as.vector(self$options$explanatory) -# -# sas <- self$options$sas -# -# if (sas) { -# formula2 <- 1 -# } -# -# myformula <- paste("Surv(", "mytime", "," , "myoutcome", ")") -# -# finalfit::finalfit(.data = mydata, -# dependent = myformula, -# explanatory = formula2, -# -# metrics = TRUE -# ) -> tCox -# -# -# -# tCoxtext2 <- glue::glue(" -#
-# Model Metrics: -# ", -# unlist( -# tCox[[2]] -# ), -# " -#
-# ") -# -# -# self$results$tCoxtext2$setContent(tCoxtext2) -# -# -# -# -# tCox_df <- tibble::as_tibble(tCox[[1]], .name_repair = "minimal") %>% -# janitor::clean_names(dat = ., case = "snake") -# -# -# # Cox-Regression Table ---- -# -# # tCox_df <- tCox_df[,-(dim(tCox_df)[2])] -# -# coxTable <- self$results$coxTable -# -# data_frame <- tCox_df -# -# names(data_frame) <- c( -# "Explanatory", -# "Levels", -# "all", -# "HR_univariable", -# "HR_multivariable" -# ) -# -# for (i in seq_along(data_frame[,1,drop = T])) { -# coxTable$addRow(rowKey = i, values = c(data_frame[i,])) -# } -# -# -# # coxTable explanation ---- -# -# -# tCox_df <- tibble::as_tibble(tCox[[1]], .name_repair = "minimal") %>% -# janitor::clean_names(dat = ., case = "snake") -# -# names(tCox_df) <- names(data_frame) <- c( -# "Explanatory", -# "Levels", -# "all", -# "HR_univariable", -# "HR_multivariable" -# ) -# -# -# # https://stackoverflow.com/questions/38470355/r-fill-empty-cell-with-value-of-last-non-empty-cell -# -# while(length(ind <- which(tCox_df$Explanatory == "")) > 0){ -# tCox_df$Explanatory[ind] <- tCox_df$Explanatory[ind - 1] -# } -# -# # https://stackoverflow.com/questions/51180290/mutate-by-group-in-r -# -# tCox_df %>% -# dplyr::group_by(Explanatory) %>% -# dplyr::mutate(firstlevel = first(Levels)) %>% -# dplyr::mutate( -# coxdescription = glue::glue( -# "When {Explanatory} is {Levels}, there is {HR_multivariable} times risk than when {Explanatory} is {firstlevel}." -# ) -# ) %>% -# dplyr::filter(HR_univariable != '-') %>% -# dplyr::pull(coxdescription) -> coxSummary -# -# -# -# coxSummary <- unlist(coxSummary) -# self$results$coxSummary$setContent(coxSummary) -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# -# # survival table 1,3,5-yr survival ---- -# -# utimes <- self$options$cutp -# -# utimes <- strsplit(utimes, ",") -# utimes <- purrr::reduce(utimes, as.vector) -# utimes <- as.numeric(utimes) -# -# if (length(utimes) == 0) { -# utimes <- c(12,36,60) -# } -# -# km_fit_summary <- summary(km_fit, times = utimes) -# -# km_fit_df <- as.data.frame(km_fit_summary[c("strata", "time", "n.risk", "n.event", "surv", "std.err", "lower", "upper")]) -# -# km_fit_df[,1] <- gsub(pattern = "thefactor=", -# replacement = paste0(self$options$explanatory, " "), -# x = km_fit_df[,1]) -# -# -# survTable <- self$results$survTable -# -# data_frame <- km_fit_df -# for(i in seq_along(data_frame[,1,drop=T])) { -# survTable$addRow(rowKey = i, values = c(data_frame[i,])) -# } -# -# -# -# -# # survTableSummary 1,3,5-yr survival summary ---- -# -# km_fit_df %>% -# dplyr::mutate( -# description = -# glue::glue( -# "When {strata}, {time} month survival is {scales::percent(surv)} [{scales::percent(lower)}-{scales::percent(upper)}, 95% CI]." -# ) -# ) %>% -# dplyr::select(description) %>% -# dplyr::pull(.) -> survTableSummary -# -# -# -# self$results$survTableSummary$setContent(survTableSummary) -# -# -# -# -# -# if (self$options$pw) { -# -# # pairwise comparison ---- -# -# -# formula2 <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# -# formula_p <- paste0('survival::Surv(', "mytime", ',', "myoutcome", ') ~ ', formula2) -# formula_p <- as.formula(formula_p) -# -# results_pairwise <- -# survminer::pairwise_survdiff( -# formula = formula_p, -# data = mydata, -# p.adjust.method = "BH") -# -# -# mypairwise2 <- as.data.frame(results_pairwise[["p.value"]]) %>% -# tibble::rownames_to_column(.data = .) %>% -# tidyr::pivot_longer(data = ., cols = -rowname) %>% -# dplyr::filter(complete.cases(.)) -# -# -# -# # Pairwise Table ---- -# -# pairwiseTable <- self$results$pairwiseTable -# -# data_frame <- mypairwise2 -# for (i in seq_along(data_frame[,1,drop = T])) { -# pairwiseTable$addRow(rowKey = i, values = c(data_frame[i,])) -# } -# -# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# title2 <- as.character(thefactor) -# -# -# sas <- self$options$sas -# -# if (sas) { -# thefactor <- 1 -# title2 <- "Overall" -# } -# -# pairwiseTable$setTitle(paste0('Pairwise Comparisons ', title2)) -# -# -# mypairwise2 %>% -# dplyr::mutate(description = -# glue::glue( -# "The difference between ", -# " {rowname} and {name}", -# " has a p-value of {format.pval(value, digits = 3, eps = 0.001)}." -# ) -# ) %>% -# dplyr::pull(description) -> pairwiseSummary -# -# pairwiseSummary <- unlist(pairwiseSummary) -# -# -# self$results$pairwiseSummary$setContent(pairwiseSummary) -# -# -# if ( length(self$options$explanatory) == 1 && dim(mypairwise2)[1] == 1 ) { -# -# self$results$pairwiseTable$setVisible(FALSE) -# -# pairwiseSummary <- "No pairwise comparison when explanatory variable has < 3 levels." -# self$results$pairwiseSummary$setContent(pairwiseSummary) -# -# } -# -# } -# -# -# } -# -# -# , -# .plot = function(image, ggtheme, theme, ...) { # <-- the plot function ---- -# -# -# sc <- self$options$sc -# -# if (!sc) -# return() -# -# -# plotData <- image$state -# -# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# title2 <- as.character(thefactor) -# -# sas <- self$options$sas -# -# if (sas) { -# thefactor <- 1 -# title2 <- "Overall" -# } -# -# -# plot <- plotData %>% -# finalfit::surv_plot(.data = ., -# dependent = 'survival::Surv(mytime, myoutcome)', -# explanatory = as.vector(self$options$explanatory), -# xlab = paste0('Time (', self$options$timetypeoutput, ')'), -# pval = TRUE, -# legend = 'none', -# break.time.by = self$options$byplot, -# xlim = c(0,self$options$endplot), -# title = paste0("Survival curves for ", title2), -# subtitle = "Based on Kaplan-Meier estimates", -# risk.table = self$options$risktable, -# conf.int = self$options$ci95 -# ) -# -# # plot <- plot + ggtheme -# -# print(plot) -# TRUE -# -# -# -# } -# -# -# -# # https://rpkgs.datanovia.com/survminer/survminer_cheatsheet.pdf -# , -# .plot2 = function(image2, ggtheme, theme, ...) { # <-- the plot2 function ---- -# -# -# ce <- self$options$ce -# -# if (!ce) -# return() -# -# -# plotData <- image2$state -# -# -# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# title2 <- as.character(thefactor) -# -# sas <- self$options$sas -# -# if (sas) { -# thefactor <- 1 -# title2 <- "Overall" -# } -# -# plot2 <- plotData %>% -# finalfit::surv_plot(.data = ., -# dependent = 'survival::Surv(mytime, myoutcome)', -# explanatory = as.vector(self$options$explanatory), -# xlab = paste0('Time (', self$options$timetypeoutput, ')'), -# # pval = TRUE, -# legend = 'none', -# break.time.by = self$options$byplot, -# xlim = c(0,self$options$endplot), -# title = paste0("Cumulative Events ", title2), -# fun = "event", -# risk.table = self$options$risktable, -# conf.int = self$options$ci95 -# ) -# -# -# print(plot2) -# TRUE -# -# -# -# } -# -# -# -# , -# .plot3 = function(image3, ggtheme, theme, ...) { # <-- the plot3 function ---- -# -# -# ch <- self$options$ch -# -# if (!ch) -# return() -# -# plotData <- image3$state -# -# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# title2 <- as.character(thefactor) -# -# sas <- self$options$sas -# -# if (sas) { -# thefactor <- 1 -# title2 <- "Overall" -# } -# -# -# plot3 <- plotData %>% -# finalfit::surv_plot(.data = ., -# dependent = 'survival::Surv(mytime, myoutcome)', -# explanatory = as.vector(self$options$explanatory), -# xlab = paste0('Time (', self$options$timetypeoutput, ')'), -# # pval = TRUE, -# legend = 'none', -# break.time.by = self$options$byplot, -# xlim = c(0,self$options$endplot), -# title = paste0("Cumulative Hazard ", title2), -# fun = "cumhaz", -# risk.table = self$options$risktable, -# conf.int = self$options$ci95 -# ) -# -# -# print(plot3) -# TRUE -# } -# -# -# , -# .plot6 = function(image6, ggtheme, theme, ...) { # <-- the plot6 function ---- -# -# -# kmunicate <- self$options$kmunicate -# -# if (!kmunicate) -# return() -# -# plotData <- image6$state -# -# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory) -# -# -# sas <- self$options$sas -# -# if (sas) { -# thefactor <- 1 -# } -# -# formula <- paste('survival::Surv(mytime, myoutcome) ~ ', thefactor) -# -# formula <- as.formula(formula) -# -# km_fit <- survival::survfit(formula, data = plotData) -# -# time_scale <- seq(0, self$options$endplot, by = self$options$byplot) -# -# -# plot6 <- -# KMunicate::KMunicate(fit = km_fit, -# time_scale = time_scale, -# .xlab = paste0('Time in ', self$options$timetypeoutput) -# ) -# -# -# print(plot6) -# TRUE -# -# } -# -# -# -# -# -# -# ) -# ) - diff --git a/R/singlearm.b.R b/R/singlearm.b.R index 36cc9250..81c4b730 100644 --- a/R/singlearm.b.R +++ b/R/singlearm.b.R @@ -9,24 +9,60 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( inherit = singlearmBase, private = list( + + .getData = function() { + + mydata <- self$data + + mydata$row_names <- rownames(mydata) + + original_names <- names(mydata) + + labels <- setNames(original_names, original_names) + + mydata <- mydata %>% janitor::clean_names() + + corrected_labels <- + setNames(original_names, names(mydata)) + + mydata <- labelled::set_variable_labels(.data = mydata, + .labels = corrected_labels) + + all_labels <- labelled::var_label(mydata) + + + mytime <- + names(all_labels)[all_labels == self$options$elapsedtime] + + myoutcome <- + names(all_labels)[all_labels == self$options$outcome] + + mydxdate <- + names(all_labels)[all_labels == self$options$dxdate] + + myfudate <- + names(all_labels)[all_labels == self$options$fudate] + + return(list( + "mydata_labelled" = mydata + , "mytime_labelled" = mytime + , "myoutcome_labelled" = myoutcome + , "mydxdate_labelled" = mydxdate + , "myfudate_labelled" = myfudate + )) + + + } + + + + + + , .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) - )) - ) { - - todo <- glue::glue( - " + + todo <- glue::glue( + "
Welcome to ClinicoPath

This tool will help you calculate median survivals and 1,3,5-yr survivals for your whole population. @@ -41,19 +77,26 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class(

See details for survival here." - ) - - html <- self$results$todo - html$setContent(todo) + ) - } + html <- self$results$todo + html$setContent(todo) } + # Define Survival Time ---- , .definemytime = function() { - mydata <- self$data + + # Read Labelled Data ---- + + labelled_data <- private$.getData() + + mydata <- labelled_data$mydata_labelled + mytime_labelled <- labelled_data$mytime_labelled + mydxdate_labelled <- labelled_data$mydxdate_labelled + myfudate_labelled <- labelled_data$myfudate_labelled tint <- self$options$tint @@ -61,20 +104,36 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( if (!tint) { # Precalculated Time ---- - # mydata[[self$options$elapsedtime]] <- jmvcore::toNumeric(mydata[[self$options$elapsedtime]]) - mydata[["mytime"]] <- - jmvcore::toNumeric(mydata[[self$options$elapsedtime]]) + jmvcore::toNumeric(mydata[[mytime_labelled]]) } else if (tint) { # Time Interval ---- - dxdate <- self$options$dxdate - fudate <- self$options$fudate + dxdate <- mydxdate_labelled # self$options$dxdate + fudate <- myfudate_labelled #self$options$fudate 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"]] <- @@ -129,34 +188,32 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( } - return(mydata[["mytime"]]) + df_time <- mydata %>% jmvcore::select(c("row_names", "mytime")) - } - # Add Calculated Time to Data ---- - , - .mytimetodata = function() { - mycalculatedtime <- private$.definemytime() + return(df_time) - if (self$options$calculatedtime && - self$results$calculatedtime$isNotFilled()) { - self$results$calculatedtime$setValues(mycalculatedtime) - } } # Define Outcome ---- , .definemyoutcome = function() { - mydata <- self$data + + + labelled_data <- private$.getData() + + mydata <- labelled_data$mydata_labelled + myoutcome_labelled <- labelled_data$myoutcome_labelled + contin <- c("integer", "numeric", "double") outcomeLevel <- self$options$outcomeLevel multievent <- self$options$multievent - outcome1 <- self$options$outcome - outcome1 <- self$data[[outcome1]] + + outcome1 <- mydata[[myoutcome_labelled]] if (!multievent) { if (inherits(outcome1, contin)) { @@ -171,8 +228,8 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( } - mydata[["myoutcome"]] <- - mydata[[self$options$outcome]] + mydata[["myoutcome"]] <- mydata[[myoutcome_labelled]] + # mydata[[self$options$outcome]] } else if (inherits(outcome1, "factor")) { mydata[["myoutcome"]] <- @@ -241,47 +298,53 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( } + df_outcome <- mydata %>% jmvcore::select(c("row_names", "myoutcome")) - return(mydata[["myoutcome"]]) + return(df_outcome) } - # Add Redefined Outcome to Data ---- + # Define Factor ---- , - .myoutcometodata = function() { - mydefinedoutcome <- private$.definemyoutcome() - if (self$options$outcomeredifened && - self$results$outcomeredifened$isNotFilled()) { - self$results$outcomeredifened$setValues(mydefinedoutcome) - } - - } + .definemyfactor = function() { + labelled_data <- private$.getData() + mydata_labelled <- labelled_data$mydata_labelled + mydata <- mydata_labelled - # Define Factor ---- - , - .definemyfactor = function() { - mydata <- self$data mydata[["myfactor"]] <- "1" - return(mydata[["myfactor"]]) + + + df_factor <- mydata %>% jmvcore::select(c("row_names","myfactor")) + + return(df_factor) + } # Clean Data For Analysis ---- , .cleandata = function() { + + 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 + time <- private$.definemytime() outcome <- private$.definemyoutcome() factor <- private$.definemyfactor() - cleanData <- data.frame("mytime" = time, - "myoutcome" = outcome, - "factor" = factor) + cleanData <- dplyr::left_join(time, outcome, by = "row_names") %>% + dplyr::left_join(factor, by = "row_names") # Landmark ---- # https://www.emilyzabor.com/tutorials/survival_analysis_in_r_tutorial.html#landmark_method @@ -308,38 +371,30 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( if (!self$options$tint && !is.null(self$options$elapsedtime)) { - name1time <- jmvcore::composeTerm(self$options$elapsedtime) + name1time <- mytime_labelled } - name2outcome <- - jmvcore::composeTerm(self$options$outcome) + name2outcome <- myoutcome_labelled + if (self$options$tint) { + name2outcome <- "CalculatedOutcome" + } - name3explanatory <- "SingleArm" + name3explanatory <- "SingleArm" - names(cleanData) <- - c(name1time, name2outcome, name3explanatory) + cleanData <- cleanData %>% + dplyr::rename( + !!name1time := mytime, + !!name2outcome := myoutcome, + !!name3explanatory := myfactor + ) # naOmit ---- cleanData <- jmvcore::naOmit(cleanData) - - - - - # # View mydata ---- - # self$results$mydataview$setContent(list(time, - # outcome, - # factor, - # name1time, - # name2outcome, - # name3explanatory, - # head(cleanData, n = 30))) - - # Prepare Data For Plots ---- plotData <- list( @@ -368,7 +423,11 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( "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 ) ) @@ -378,64 +437,73 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( # Run Analysis ---- , .run = function() { - # Common 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) - )) - ) { - private$.todo() + # Errors, Warnings ---- + + ## No variable todo ---- + + ## Define 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) + + condition1 <- subcondition1a || (subcondition1b1 && (subcondition1b2 || subcondition1b3 || subcondition1b4 || subcondition1b5)) + + condition2 <- subcondition2a || (subcondition2b1 && subcondition2b2 && subcondition2b3) + + if (!(condition1 && condition2)) { + private$.todo() return() + } else { + self$results$todo$setVisible(FALSE) } + # Empty data ---- + if (nrow(self$data) == 0) stop('Data contains no (complete) rows') - # Add Calculated Time to Data ---- - - if (self$options$tint) { - private$.mytimetodata() - } + # Get Clean Data ---- + results <- private$.cleandata() - # mycalculatedtime <- private$.definemytime() - # - # if (self$options$calculatedtime && self$results$calculatedtime$isNotFilled()) { - # self$results$calculatedtime$setValues(mycalculatedtime) - # } + # Run Analysis ---- + ## Median Survival ---- + private$.medianSurv(results) - # Add Redefined Outcome to Data ---- - if (self$options$multievent) { - private$.myoutcometodata() - } + ## Survival Table ---- + private$.survTable(results) + # Add Calculated Time to Data ---- - # Get Clean Data ---- - results <- private$.cleandata() + # self$results$mydataview$setContent( + # list( + # results + # ) + # ) - # Run Analysis ---- - # Median Survival ---- - private$.medianSurv(results) + if (self$options$tint && self$options$calculatedtime && self$results$calculatedtime$isNotFilled()) { + self$results$calculatedtime$setRowNums(results$cleanData$row_names) + self$results$calculatedtime$setValues(results$cleanData$CalculatedTime) + } - # Survival Table ---- - private$.survTable(results) + # Add Redefined Outcome to Data ---- + if (self$options$multievent && self$options$outcomeredifened && self$results$outcomeredifened$isNotFilled()) { + self$results$outcomeredifened$setRowNums(results$cleanData$row_names) + self$results$outcomeredifened$setValues(results$cleanData$CalculatedOutcome) + } } # Median Survival Function ---- @@ -450,7 +518,7 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( mydata[[mytime]] <- jmvcore::toNumeric(mydata[[mytime]]) - # Median Survival Table ---- + ## Median Survival Table ---- formula <- paste('survival::Surv(', @@ -466,14 +534,21 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( km_fit_median_df <- summary(km_fit) + + # medianSummary2 <- + # as.data.frame(km_fit_median_df$table) + # self$results$medianSummary2$setContent(medianSummary2) + + + results1html <- as.data.frame(km_fit_median_df$table) %>% t() %>% as.data.frame() %>% janitor::clean_names(dat = ., case = "snake") - + results1table <- results1html - + medianTable <- self$results$medianTable data_frame <- results1table @@ -482,21 +557,7 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( } - # medianSummary2 <- - # as.data.frame(km_fit_median_df$table) %>% - # # janitor::clean_names(dat = ., case = "snake") %>% - # t() %>% - # as.data.frame() %>% - # janitor::clean_names(dat = ., case = "snake") - # # medianSummary2 <- class(medianSummary2) - # - # - # self$results$medianSummary2$setContent(medianSummary2) - - - - - # Median Survival Summary ---- + ## Median Survival Summary ---- results1table %>% dplyr::mutate( @@ -507,6 +568,23 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( "." ) ) %>% + # dplyr::mutate( + # description = dplyr::case_when( + # is.na(median) ~ paste0( + # glue::glue("{description} \n Note that when {factor}, the survival curve does not drop below 1/2 during \n the observation period, thus the median survival is undefined.")), + # TRUE ~ paste0(description) + # ) + # ) %>% + # dplyr::mutate(description = gsub( + # 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 @@ -531,7 +609,7 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( mydata[[mytime]] <- jmvcore::toNumeric(mydata[[mytime]]) - # Median Survival Table ---- + ## Median Survival Table ---- formula <- paste('survival::Surv(', @@ -568,8 +646,24 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( "lower", "upper")]) + # self$results$tableview$setContent(km_fit_df) + + + # km_fit_df[, 1] <- gsub( + # pattern = "thefactor=", + # replacement = paste0(self$options$explanatory, " "), + # x = km_fit_df[, 1] + # ) + # 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 @@ -578,9 +672,15 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( } + ## survTableSummary 1,3,5-yr survival summary ---- + # km_fit_df2[, 1] <- gsub( + # pattern = paste0(myexplanatory_labelled,"="), + # replacement = paste0(self$options$explanatory, " is "), + # x = km_fit_df2[, 1] + # ) - # survTableSummary 1,3,5-yr survival summary ---- + ## survTableSummary 1,3,5-yr survival summary ---- km_fit_df %>% dplyr::mutate( @@ -620,7 +720,7 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( myfactor <- results$name3explanatory myfactor <- - jmvcore::constructFormula(terms = myfactor) + jmvcore::constructFormula(terms = myfactor) plotData <- results$cleanData @@ -630,8 +730,6 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( myformula <- paste("survival::Surv(", mytime, ",", myoutcome, ")") - title2 <- "Overall" - plot <- plotData %>% @@ -645,7 +743,10 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( legend = 'none', break.time.by = self$options$byplot, xlim = c(0, self$options$endplot), - title = paste0("Survival curves for ", title2), + ylim = c( + self$options$ybegin_plot, + self$options$yend_plot), + title = "Survival of the Whole Group", subtitle = "Based on Kaplan-Meier estimates", risk.table = self$options$risktable, conf.int = self$options$ci95, @@ -657,8 +758,6 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( print(plot) TRUE - - } @@ -684,7 +783,7 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( myfactor <- results$name3explanatory myfactor <- - jmvcore::constructFormula(terms = myfactor) + jmvcore::constructFormula(terms = myfactor) plotData <- results$cleanData @@ -695,31 +794,30 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( paste("survival::Surv(", mytime, ",", myoutcome, ")") - title2 <- "Overall" - plot2 <- plotData %>% finalfit::surv_plot( .data = ., dependent = myformula, explanatory = myfactor, xlab = paste0('Time (', self$options$timetypeoutput, ')'), - # pval = TRUE, + # pval = self$options$pplot, + # pval.method = self$options$pplot, legend = 'none', break.time.by = self$options$byplot, xlim = c(0, self$options$endplot), - title = paste0("Cumulative Events ", title2), + ylim = c( + self$options$ybegin_plot, + self$options$yend_plot), + title = "Cumulative Events of the Whole Group", fun = "event", risk.table = self$options$risktable, conf.int = self$options$ci95, censored = self$options$censored ) - print(plot2) TRUE - - } @@ -744,7 +842,7 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( myfactor <- results$name3explanatory myfactor <- - jmvcore::constructFormula(terms = myfactor) + jmvcore::constructFormula(terms = myfactor) plotData <- results$cleanData @@ -755,20 +853,21 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( paste("survival::Surv(", mytime, ",", myoutcome, ")") - title2 <- "Overall" - - plot3 <- plotData %>% finalfit::surv_plot( .data = ., dependent = myformula, explanatory = myfactor, xlab = paste0('Time (', self$options$timetypeoutput, ')'), - # pval = TRUE, + # pval = self$options$pplot, + # pval.method = self$options$pplot, legend = 'none', break.time.by = self$options$byplot, xlim = c(0, self$options$endplot), - title = paste0("Cumulative Hazard ", title2), + ylim = c( + self$options$ybegin_plot, + self$options$yend_plot), + title = "Cumulative Hazard of the Whole Group", fun = "cumhaz", risk.table = self$options$risktable, conf.int = self$options$ci95, @@ -809,8 +908,8 @@ singlearmClass <- if (requireNamespace('jmvcore', quietly=TRUE)) R6::R6Class( jmvcore::toNumeric(plotData[[mytime]]) + title2 <- "Single Arm Survival" - title2 <- "Overall" myformula <- paste('survival::Surv(', diff --git a/R/survivalcont.b.R b/R/survivalcont.b.R index 27a09cd5..3405ac68 100644 --- a/R/survivalcont.b.R +++ b/R/survivalcont.b.R @@ -66,7 +66,7 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { "myoutcome_labelled" = myoutcome, "mydxdate_labelled" = mydxdate, "myfudate_labelled" = myfudate, - "mymycontexpl_labelled" = mycontexpl + "mycontexpl_labelled" = mycontexpl )) } @@ -330,11 +330,11 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { labelled_data <- private$.getData() mydata_labelled <- labelled_data$mydata_labelled - mymycontexpl_labelled <- labelled_data$mymycontexpl_labelled + mycontexpl_labelled <- labelled_data$mycontexpl_labelled mydata <- mydata_labelled - mydata[["myfactor"]] <- mydata[[mymycontexpl_labelled]] + mydata[["myfactor"]] <- mydata[[mycontexpl_labelled]] df_factor <- mydata %>% jmvcore::select(c("row_names","myfactor")) @@ -355,7 +355,7 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { myoutcome_labelled <- labelled_data$myoutcome_labelled mydxdate_labelled <- labelled_data$mydxdate_labelled myfudate_labelled <- labelled_data$myfudate_labelled - mymycontexpl_labelled <- labelled_data$mymycontexpl_labelled + mycontexpl_labelled <- labelled_data$mycontexpl_labelled time <- private$.definemytime() outcome <- private$.definemyoutcome() @@ -394,7 +394,7 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { if (!is.null(self$options$contexpl) ) { - name3contexpl <- mymycontexpl_labelled + name3contexpl <- mycontexpl_labelled } cleanData <- cleanData %>% @@ -420,7 +420,7 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { "myoutcome_labelled" = myoutcome_labelled, "mydxdate_labelled" = mydxdate_labelled, "myfudate_labelled" = myfudate_labelled, - "mymycontexpl_labelled" = mymycontexpl_labelled + "mycontexpl_labelled" = mycontexpl_labelled ) ) @@ -454,8 +454,25 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { condition2 <- subcondition2a || (subcondition2b1 && subcondition2b2 && subcondition2b3) - if (!(condition1 && condition2 && condition3)) { + not_continue_analysis <- !(condition1 && condition2 && condition3) + + + if (not_continue_analysis) { private$.todo() + self$results$coxSummary$setVisible(FALSE) + self$results$coxTable$setVisible(FALSE) + self$results$tCoxtext2$setVisible(FALSE) + self$results$rescutTable$setVisible(FALSE) + self$results$medianSummary$setVisible(FALSE) + self$results$medianTable$setVisible(FALSE) + self$results$survTableSummary$setVisible(FALSE) + self$results$survTable$setVisible(FALSE) + self$results$plot4$setVisible(FALSE) + self$results$plot5$setVisible(FALSE) + self$results$plot2$setVisible(FALSE) + self$results$plot3$setVisible(FALSE) + self$results$plot6$setVisible(FALSE) + self$results$todo$setVisible(TRUE) return() } else { self$results$todo$setVisible(FALSE) @@ -482,86 +499,96 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { ## Run Cut-off calculation ---- - # res.cut <- private$.cutoff(results) + res.cut <- private$.cutoff(results) ## Run Cut-off Table ---- - # private$.cutoffTable(res.cut) + private$.cutoffTable(res.cut) ## Run Categorise Data ---- - # cutoffdata <- private$.cutoff2(res.cut) - + cutoffdata <- private$.cutoff2(res.cut) - ## Add Calculated Time to Data ---- - # if (self$options$findcut && self$results$calculatedcutoff$isNotFilled()) { - # # Set rownames ---- - # rowNums <- rownames(mydata) - # self$results$calculatedcutoff$setRowNums(rowNums) - # # Add calculatedcutoff to Data ---- + # self$results$mydataview$setContent( + # list( + # res.cut = res.cut, + # cutoffdata = cutoffdata, + # not_continue_analysis = not_continue_analysis + # ) + # ) - # cutoffgr <- cutoffdata[[self$options$contexpl]] - - # if (self$options$calculatedcutoff && - # self$results$calculatedcutoff$isNotFilled()) { - # self$results$calculatedcutoff$setValues(cutoffgr) - # } - # } ## Run median cutoff ---- - # private$.mediancutoff(cutoffdata) + private$.mediancutoff(cutoffdata) ## Run life table cutoff ---- - # private$.lifetablecutoff(cutoffdata) + private$.lifetablecutoff(cutoffdata) # Prepare Data For Plots ---- - # plotData1 <- res.cut - # image4 <- self$results$plot4 - # image4$setState(plotData1) + plotData1 <- list(res.cut = res.cut, + name3contexpl = results$name3contexpl + # , + # not_continue_analysis = not_continue_analysis + ) - # plotData2 <- cutoffdata + # self$results$mydataview2$setContent(plotData1) - # image5 <- self$results$plot5 - # image5$setState(plotData2) - # image2 <- self$results$plot2 - # image2$setState(plotData2) + image4 <- self$results$plot4 + image4$setState(plotData1) - # image3 <- self$results$plot3 - # image3$setState(plotData2) + plotData2 <- list( + cutoffdata = cutoffdata, + results = results + # , + # not_continue_analysis = not_continue_analysis + ) - # image6 <- self$results$plot6 - # image6$setState(plotData2) + image5 <- self$results$plot5 + image5$setState(plotData2) + image2 <- self$results$plot2 + image2$setState(plotData2) + image3 <- self$results$plot3 + image3$setState(plotData2) + image6 <- self$results$plot6 + image6$setState(plotData2) - # # Add Calculated Time to Data ---- - # # self$results$mydataview$setContent( - # # list( - # # results - # # ) - # # ) + # Add Calculated Time to Data ---- - # if (self$options$tint && self$options$calculatedtime && self$results$calculatedtime$isNotFilled()) { - # self$results$calculatedtime$setRowNums(results$cleanData$row_names) - # self$results$calculatedtime$setValues(results$cleanData$CalculatedTime) - # } + + if (self$options$tint && self$options$calculatedtime && self$results$calculatedtime$isNotFilled()) { + self$results$calculatedtime$setRowNums(results$cleanData$row_names) + self$results$calculatedtime$setValues(results$cleanData$CalculatedTime) + } - # # Add Redefined Outcome to Data ---- + # Add Redefined Outcome to Data ---- + + if (self$options$multievent && self$options$outcomeredifened && self$results$outcomeredifened$isNotFilled()) { + self$results$outcomeredifened$setRowNums(results$cleanData$row_names) + self$results$outcomeredifened$setValues(results$cleanData$CalculatedOutcome) + } + + + # Add calculatedcutoff to Data ---- + + cutoffgr <- cutoffdata[[results$name3contexpl]] + + if (self$options$calculatedcutoff && + self$results$calculatedcutoff$isNotFilled()) { + self$results$calculatedcutoff$setValues(cutoffgr) + } - # if (self$options$multievent && self$options$outcomeredifened && self$results$outcomeredifened$isNotFilled()) { - # self$results$outcomeredifened$setRowNums(results$cleanData$row_names) - # self$results$outcomeredifened$setValues(results$cleanData$CalculatedOutcome) - # } } @@ -702,18 +729,37 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { .cutoff = function(results) { + mytime <- results$name1time + mytime <- jmvcore::constructFormula(terms = mytime) + + myoutcome <- results$name2outcome + myoutcome <- + jmvcore::constructFormula(terms = myoutcome) + + + myfactor <- results$name3contexpl + myfactor <- + jmvcore::constructFormula(terms = myfactor) + + mydata <- results$cleanData + + mydata[[mytime]] <- + jmvcore::toNumeric(mydata[[mytime]]) + # https://rpkgs.datanovia.com/survminer/reference/surv_cutpoint.html res.cut <- survminer::surv_cutpoint( mydata, - time = "mytime", - event = "myoutcome", - self$options$contexpl, + time = mytime, + event = myoutcome, + variables = myfactor, minprop = 0.1 # , # progressbar = TRUE ) + return(res.cut) + } # Cut-off Table ---- @@ -742,22 +788,47 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { # Median ---- , .mediancutoff = function(cutoffdata) { + + results <- private$.cleandata() + mydata <- cutoffdata # Median Survival Table ---- - thefactor <- - jmvcore::constructFormula(terms = self$options$contexpl) + mytime <- results$name1time + myoutcome <- results$name2outcome + mycontexpl <- results$name3contexpl + + + mytime <- + jmvcore::constructFormula(terms = mytime) + + myoutcome <- + jmvcore::constructFormula(terms = myoutcome) + + mycontexpl <- + jmvcore::constructFormula(terms = mycontexpl) + + + mydata[[mytime]] <- + jmvcore::toNumeric(mydata[[mytime]]) formula <- - paste("survival::Surv(mytime, myoutcome) ~ ", thefactor) + paste('survival::Surv(', + mytime, + ',', + myoutcome, + ') ~ ', + mycontexpl) + formula <- as.formula(formula) km_fit <- survival::survfit(formula, data = mydata) km_fit_median_df <- summary(km_fit) + results1html <- as.data.frame(km_fit_median_df$table) %>% janitor::clean_names(dat = ., case = "snake") %>% @@ -772,16 +843,28 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { results1table <- results1html + results1table <- results1html + names(results1table)[1] <- "factor" + + results2table <- results1table + + results2table$factor <- gsub(pattern = paste0(mycontexpl,"="), + replacement = "", + x = results1table$factor) + + + + 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, ])) + medianTable$addRow(rowKey = i, values = c(data_frame[i,])) } - # Median Survival Summary ---- + ## Median Survival Summary ---- results1table %>% dplyr::mutate( @@ -792,25 +875,36 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { "." ) ) %>% + dplyr::mutate( + description = dplyr::case_when( + is.na(median) ~ paste0( + glue::glue("{description} \n Note that when {factor}, the survival curve does not drop below 1/2 during \n the observation period, thus the median survival is undefined.")), + TRUE ~ paste0(description) + ) + ) %>% dplyr::mutate(description = gsub( pattern = "=", replacement = " is ", x = description )) %>% + dplyr::mutate(description = gsub( + pattern = mycontexpl, + replacement = self$options$contexpl, + x = description + )) %>% dplyr::select(description) %>% dplyr::pull(.) -> km_fit_median_definition medianSummary <- km_fit_median_definition - self$results$medianSummary$setContent(medianSummary) + } # Life Table ---- , .lifetablecutoff = function(cutoffdata) { - mydata <- cutoffdata # survival table 1,3,5-yr survival ---- @@ -825,19 +919,41 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { utimes <- c(12, 36, 60) } + results <- private$.cleandata() - thefactor <- - jmvcore::constructFormula(terms = self$options$contexpl) + mydata <- cutoffdata + + mytime <- results$name1time + myoutcome <- results$name2outcome + mycontexpl <- results$name3contexpl + + + mytime <- + jmvcore::constructFormula(terms = mytime) + + myoutcome <- + jmvcore::constructFormula(terms = myoutcome) + + mycontexpl <- + jmvcore::constructFormula(terms = mycontexpl) + + + mydata[[mytime]] <- + jmvcore::toNumeric(mydata[[mytime]]) formula <- - paste("survival::Surv(mytime, myoutcome) ~ ", thefactor) + paste('survival::Surv(', + mytime, + ',', + myoutcome, + ') ~ ', + mycontexpl) + formula <- as.formula(formula) km_fit <- survival::survfit(formula, data = mydata) - - km_fit_summary <- summary(km_fit, times = utimes) km_fit_df <- @@ -859,9 +975,17 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { ) + km_fit_df2 <- km_fit_df + + km_fit_df2$strata <- gsub(pattern = paste0(mycontexpl,"="), + replacement = "", + x =km_fit_df2$strata) + + data_frame <- km_fit_df2 + survTable <- self$results$survTable - data_frame <- km_fit_df + for (i in seq_along(data_frame[, 1, drop = T])) { survTable$addRow(rowKey = i, values = c(data_frame[i, ])) } @@ -871,6 +995,13 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { # survTableSummary 1,3,5-yr survival summary ---- + km_fit_df[, 1] <- gsub( + pattern = paste0(mycontexpl,"="), + replacement = paste0(self$options$contexpl, " is "), + x = km_fit_df[, 1] + ) + + km_fit_df %>% dplyr::mutate( description = @@ -887,12 +1018,27 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { # Cut-off Plot ---- , .plot4 = function(image4, ggtheme, theme, ...) { + + if (!self$options$findcut) { + return() + } + plotData <- image4$state - res.cut <- plotData + if (is.null(plotData)) { + return() + } + + # if (plotData$not_continue_analysis) { + # return() + # } + + res.cut <- plotData$res.cut + + name3contexpl <- plotData$name3contexpl plot4 <- - plot(res.cut, self$options$contexpl, palette = "npg") + plot(res.cut, name3contexpl, palette = "npg") print(plot4) TRUE @@ -902,17 +1048,54 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { # Survival Curve with new cut-off ---- , .plot5 = function(image5, ggtheme, theme, ...) { + + + + if (!self$options$findcut) { + return() + } + plotData <- image5$state - res.cat <- plotData + if (is.null(plotData)) { + return() + } - contfactor <- - jmvcore::constructFormula(terms = self$options$contexpl) + # if (plotData$not_continue_analysis) { + # return() + # } - myformula <- - paste0("survival::Surv(mytime, myoutcome) ~ ", contfactor) - myformula <- as.formula(myformula) + + res.cat <- plotData$cutoffdata + + results <- plotData$results + + mytime <- results$name1time + myoutcome <- results$name2outcome + mycontexpl <- results$name3contexpl + + + mytime <- + jmvcore::constructFormula(terms = mytime) + + myoutcome <- + jmvcore::constructFormula(terms = myoutcome) + + mycontexpl <- + jmvcore::constructFormula(terms = mycontexpl) + + + formula <- + paste('survival::Surv(', + mytime, + ',', + myoutcome, + ') ~ ', + mycontexpl) + + myformula <- as.formula(formula) + fit <- survminer::surv_fit( formula = myformula, @@ -924,6 +1107,7 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { data = res.cat, risk.table = self$options$risktable, conf.int = self$options$ci95 + ) print(plot5) TRUE @@ -934,27 +1118,66 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { # https://rpkgs.datanovia.com/survminer/survminer_cheatsheet.pdf , .plot2 = function(image2, ggtheme, theme, ...) { + + if (!self$options$findcut) { + return() + } + + if (!self$options$ce) { + return() + } + plotData <- image2$state - contfactor <- - jmvcore::constructFormula(terms = self$options$contexpl) - myformula <- paste0("survival::Surv(mytime, myoutcome)") + if (is.null(plotData)) { + return() + } + + # if (plotData$not_continue_analysis) { + # return() + # } + + res.cat <- plotData$cutoffdata + + results <- plotData$results + + mytime <- results$name1time + myoutcome <- results$name2outcome + mycontexpl <- results$name3contexpl + + mytime <- + jmvcore::constructFormula(terms = mytime) + + myoutcome <- + jmvcore::constructFormula(terms = myoutcome) + + mycontexpl <- + jmvcore::constructFormula(terms = mycontexpl) + - # myformula <- as.formula(myformula) + myformula <- + paste0('survival::Surv(', + mytime, + ',', + myoutcome, + ')') - title2 <- as.character(contfactor) + title2 <- as.character(mycontexpl) - plot2 <- plotData %>% + plot2 <- res.cat %>% finalfit::surv_plot( .data = ., dependent = myformula, - explanatory = contfactor, + explanatory = mycontexpl, xlab = paste0("Time (", self$options$timetypeoutput, ")"), # pval = TRUE, legend = "none", break.time.by = self$options$byplot, xlim = c(0, self$options$endplot), + ylim = c( + self$options$ybegin_plot, + self$options$yend_plot), title = paste0("Cumulative Events ", title2), fun = "event", risk.table = self$options$risktable, @@ -971,34 +1194,66 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { # Cumulative Hazard with new cut-off ---- , .plot3 = function(image3, ggtheme, theme, ...) { - ch <- self$options$ch - if (!ch) { + if (!self$options$findcut) { + return() + } + + if (!self$options$ch) { return() } plotData <- image3$state - contfactor <- - jmvcore::constructFormula(terms = self$options$contexpl) + if (is.null(plotData)) { + return() + } + + # if (plotData$not_continue_analysis) { + # return() + # } + + res.cat <- plotData$cutoffdata + + results <- plotData$results + + mytime <- results$name1time + myoutcome <- results$name2outcome + mycontexpl <- results$name3contexpl - myformula <- - paste0("survival::Surv(mytime, myoutcome)") - # myformula <- as.formula(myformula) + mytime <- + jmvcore::constructFormula(terms = mytime) - title2 <- as.character(contfactor) + myoutcome <- + jmvcore::constructFormula(terms = myoutcome) + + mycontexpl <- + jmvcore::constructFormula(terms = mycontexpl) - plot3 <- plotData %>% + + myformula <- + paste('survival::Surv(', + mytime, + ',', + myoutcome, + ')') + + title2 <- as.character(mycontexpl) + + plot3 <- res.cat %>% finalfit::surv_plot( .data = ., dependent = myformula, - explanatory = contfactor, + explanatory = mycontexpl, xlab = paste0("Time (", self$options$timetypeoutput, ")"), # pval = TRUE, legend = "none", break.time.by = self$options$byplot, xlim = c(0, self$options$endplot), + ylim = c( + self$options$ybegin_plot, + self$options$yend_plot), title = paste0("Cumulative Hazard ", title2), fun = "cumhaz", risk.table = self$options$risktable, @@ -1014,23 +1269,58 @@ survivalcontClass <- if (requireNamespace("jmvcore")) { # KMunicate Style with new cut-off ---- , .plot6 = function(image6, ggtheme, theme, ...) { - kmunicate <- self$options$kmunicate - if (!kmunicate) { + if (!self$options$findcut) { + return() + } + + if (!self$options$kmunicate) { return() } plotData <- image6$state - contfactor <- - jmvcore::constructFormula(terms = self$options$contexpl) + if (is.null(plotData)) { + return() + } + + # if (plotData$not_continue_analysis) { + # return() + # } + + res.cat <- plotData$cutoffdata + + results <- plotData$results + + mytime <- results$name1time + myoutcome <- results$name2outcome + mycontexpl <- results$name3contexpl + + + mytime <- + jmvcore::constructFormula(terms = mytime) + + myoutcome <- + jmvcore::constructFormula(terms = myoutcome) + + mycontexpl <- + jmvcore::constructFormula(terms = mycontexpl) + myformula <- - paste0("survival::Surv(mytime, myoutcome) ~ ", contfactor) + paste('survival::Surv(', + mytime, + ',', + myoutcome, + ') ~ ', + mycontexpl) myformula <- as.formula(myformula) - km_fit <- survival::survfit(myformula, data = plotData) + # myformula <- + # paste0("survival::Surv(mytime, myoutcome) ~ ", contfactor) + + km_fit <- survival::survfit(myformula, data = res.cat) time_scale <- seq(0, self$options$endplot, by = self$options$byplot) diff --git a/R/survivalcont.h.R b/R/survivalcont.h.R index 4497383f..9cfb2591 100644 --- a/R/survivalcont.h.R +++ b/R/survivalcont.h.R @@ -339,8 +339,21 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas "survminer", "dichotomizing", "survivaltutorial", - "ClinicoPathJamoviModule"), + "ClinicoPathJamoviModule")) + self$add(jmvcore::Html$new( + options=options, + name="todo", + title="To Do")) + self$add(jmvcore::Preformatted$new( + options=options, + name="coxSummary", + title="`Cox Regression Summary and Table - ${contexpl}`", clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", "outcome", "outcomeLevel", "overalltime", @@ -349,15 +362,7 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas "fudate", "dxdate", "tint", - "multievent")) - self$add(jmvcore::Html$new( - options=options, - name="todo", - title="To Do")) - self$add(jmvcore::Preformatted$new( - options=options, - name="coxSummary", - title="`Cox Regression Summary and Table - ${contexpl}`")) + "multievent"))) self$add(jmvcore::Table$new( options=options, name="coxTable", @@ -383,12 +388,42 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas list( `name`="HR_multivariable", `title`="HR (Multivariable)", - `type`="text")))) + `type`="text")), + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Html$new( options=options, name="tCoxtext2", title="", - refs="finalfit")) + refs="finalfit", + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Table$new( options=options, name="rescutTable", @@ -403,7 +438,22 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas `name`="statistic", `title`="Statistic", `type`="number")), - visible="(findcut)")) + visible="(findcut)", + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Image$new( options=options, name="plot4", @@ -412,11 +462,26 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas height=450, renderFun=".plot4", visible="(findcut)", - requiresData=TRUE)) + requiresData=TRUE, + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Image$new( options=options, name="plot5", - title="Survival Plot with new Cut-off", + title="`Survival Plot - ${contexpl} Grouped with New Cut-Off`", width=600, height=450, renderFun=".plot5", @@ -427,12 +492,36 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas "endplot", "byplot", "ci95", - "risktable"))) + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Preformatted$new( options=options, name="medianSummary", title="`Median Survival Summary and Table - ${contexpl}`", - visible="(findcut)")) + visible="(findcut)", + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Table$new( options=options, name="medianTable", @@ -473,12 +562,42 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas `title`="Upper", `superTitle`="95% Confidence Interval", `type`="number")), - visible="(findcut)")) + visible="(findcut)", + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Preformatted$new( options=options, name="survTableSummary", title="`1, 3, 5-yr Survival Summary and Table - ${contexpl}`", - visible="(findcut)")) + visible="(findcut)", + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Table$new( options=options, name="survTable", @@ -518,11 +637,26 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas `superTitle`="95% Confidence Interval", `type`="number", `format`="pc")), - visible="(findcut)")) + visible="(findcut)", + clearWith=list( + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Image$new( options=options, name="plot2", - title="`Cumulative Events - ${contexpl}`", + title="`Cumulative Events - ${contexpl} Grouped with New Cut-Off`", width=600, height=450, renderFun=".plot2", @@ -533,11 +667,20 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas "endplot", "byplot", "ci95", - "risktable"))) + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Image$new( options=options, name="plot3", - title="`Cumulative Hazard - ${contexpl}`", + title="`Cumulative Hazard - ${contexpl} Grouped with New Cut-Off`", width=600, height=450, renderFun=".plot3", @@ -548,11 +691,20 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas "endplot", "byplot", "ci95", - "risktable"))) + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Image$new( options=options, name="plot6", - title="`KMunicate-Style Plot - ${contexpl}`", + title="`KMunicate-Style Plot - ${contexpl} Grouped with New Cut-Off`", width=600, height=450, renderFun=".plot6", @@ -561,7 +713,18 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas clearWith=list( "kmunicate", "endplot", - "byplot"), + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"), refs=list( "KMunicate", "KMunicate2"))) @@ -574,7 +737,21 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas clearWith=list( "tint", "dxdate", - "fudate"))) + "fudate", + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent"))) self$add(jmvcore::Output$new( options=options, name="outcomeredifened", @@ -584,6 +761,20 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas clearWith=list( "outcome", "analysistype", + "multievent", + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", "multievent"))) self$add(jmvcore::Output$new( options=options, @@ -596,7 +787,21 @@ survivalcontResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Clas "analysistype", "multievent", "contexpl", - "findcut")))})) + "findcut", + "sc", + "endplot", + "byplot", + "ci95", + "risktable", + "outcome", + "outcomeLevel", + "overalltime", + "findcut", + "contexpl", + "fudate", + "dxdate", + "tint", + "multievent")))})) survivalcontBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class( "survivalcontBase", diff --git a/jamovi/multisurvival.r.yaml b/jamovi/multisurvival.r.yaml index 923eedf5..330c6b1e 100644 --- a/jamovi/multisurvival.r.yaml +++ b/jamovi/multisurvival.r.yaml @@ -37,9 +37,9 @@ items: - - name: mydataview - title: mydataview - type: Preformatted + # - name: mydataview + # title: mydataview + # type: Preformatted # - name: text3 diff --git a/jamovi/multisurvival.u.yaml b/jamovi/multisurvival.u.yaml index 26c24398..615a6f7d 100644 --- a/jamovi/multisurvival.u.yaml +++ b/jamovi/multisurvival.u.yaml @@ -123,6 +123,14 @@ children: children: - type: ComboBox name: analysistype + + - type: LayoutBox + margin: large + children: + - type: Output + name: outcomeredifened + + - type: CollapseBox label: Plots collapsed: false @@ -143,11 +151,7 @@ children: - type: ComboBox name: sty enable: (hr) - - type: LayoutBox - margin: large - children: - - type: Output - name: outcomeredifened + - type: CollapseBox label: Adjusted Survival Curve (Being Updated) collapsed: true diff --git a/jamovi/singlearm.u.yaml b/jamovi/singlearm.u.yaml index ee49a514..a02cfc23 100644 --- a/jamovi/singlearm.u.yaml +++ b/jamovi/singlearm.u.yaml @@ -68,11 +68,7 @@ children: isTarget: true fitToGrid: true stretchFactor: 1 - - type: LayoutBox - margin: large - children: - - type: Output - name: calculatedtime + - type: Label label: Time Type fitToGrid: true @@ -100,6 +96,15 @@ children: name: landmark format: number enable: (uselandmark) + - type: Label + label: Calculated Time to Data + fitToGrid: true + children: + - type: LayoutBox + margin: large + children: + - type: Output + name: calculatedtime - type: CollapseBox label: Analysis with Multiple Outcomes collapsed: true @@ -131,6 +136,11 @@ children: - type: ComboBox name: analysistype enable: (outcome && multievent) + - type: LayoutBox + margin: large + children: + - type: Output + name: outcomeredifened - type: CollapseBox label: Plots collapsed: true @@ -162,23 +172,18 @@ children: - type: TextBox name: byplot format: number + - type: TextBox + name: ybegin_plot + format: number + - type: TextBox + name: yend_plot + format: number - type: CheckBox name: ci95 - type: CheckBox name: risktable - type: CheckBox name: censored - - type: LayoutBox - margin: large - children: - - type: Output - name: outcomeredifened - - type: LayoutBox - margin: large - children: - - type: TextBox - name: ybegin_plot - format: number - type: CollapseBox label: Survival Tables collapsed: true @@ -190,9 +195,4 @@ children: name: cutp format: string width: large - - type: LayoutBox - margin: large - children: - - type: TextBox - name: yend_plot - format: number + diff --git a/jamovi/survivalcont.r.yaml b/jamovi/survivalcont.r.yaml index 0d1c65bc..d8582138 100644 --- a/jamovi/survivalcont.r.yaml +++ b/jamovi/survivalcont.r.yaml @@ -4,42 +4,44 @@ title: Survival Analysis for Continuous Explanatory Variable jrs: '1.1' - -clearWith: - - outcome - - outcomeLevel - - overalltime - - findcut - - contexpl - - fudate - - dxdate - - tint - - multievent - - items: - name: todo title: To Do type: Html + # - name: mydataview2 + # title: mydataview2 + # type: Preformatted + # - name: mydataview # title: mydataview # type: Preformatted - name: coxSummary - # title: Cox Regression Summary and Table title: '`Cox Regression Summary and Table - ${contexpl}`' type: Preformatted - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: coxTable - # title: Cox Table title: '`Cox Table- ${contexpl}`' type: Table rows: 0 columns: - # columns: &idcols - name: Explanatory title: "Explanatory" type: text @@ -55,12 +57,41 @@ items: - name: 'HR_multivariable' title: "HR (Multivariable)" type: text + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: tCoxtext2 title: '' type: Html refs: finalfit - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: rescutTable title: Cut Point @@ -74,7 +105,21 @@ items: title: 'Statistic' type: number visible: (findcut) - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: plot4 title: 'Cutpoint Plot' @@ -84,10 +129,24 @@ items: renderFun: .plot4 visible: (findcut) requiresData: true - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: plot5 - title: 'Survival Plot with new Cut-off' + title: '`Survival Plot - ${contexpl} Grouped with New Cut-Off`' type: Image width: 600 height: 450 @@ -100,18 +159,39 @@ items: - byplot - ci95 - risktable - + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: medianSummary # title: Median Survival Summary and Table title: '`Median Survival Summary and Table - ${contexpl}`' type: Preformatted visible: (findcut) - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: medianTable - # title: Median Survival Table title: '`Median Survival Table: Levels for ${contexpl}`' type: Table rows: 0 @@ -119,7 +199,7 @@ items: # columns: &idcols - name: factor title: "Levels" - # title: '`Factor - ${explanatory}`' + # title: '`Factor - ${contexpl}`' type: text - name: records title: "Records" @@ -151,21 +231,47 @@ items: superTitle: '95% Confidence Interval' type: number visible: (findcut) - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: survTableSummary - # title: '1, 3, 5-yr Survival Summary and Table' title: '`1, 3, 5-yr Survival Summary and Table - ${contexpl}`' type: Preformatted visible: (findcut) - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: survTable title: '`1, 3, 5 year Survival - ${contexpl}`' - # title: '1, 3, 5 year Survival' type: Table rows: 0 columns: @@ -197,11 +303,24 @@ items: type: number format: pc visible: (findcut) - + clearWith: + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: plot2 - # title: Cumulative Events - title: '`Cumulative Events - ${contexpl}`' + title: '`Cumulative Events - ${contexpl} Grouped with New Cut-Off`' type: Image width: 600 height: 450 @@ -214,11 +333,18 @@ items: - byplot - ci95 - risktable - + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: plot3 - # title: Cumulative Hazard - title: '`Cumulative Hazard - ${contexpl}`' + title: '`Cumulative Hazard - ${contexpl} Grouped with New Cut-Off`' type: Image width: 600 height: 450 @@ -231,10 +357,18 @@ items: - byplot - ci95 - risktable - + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: plot6 - title: '`KMunicate-Style Plot - ${contexpl}`' + title: '`KMunicate-Style Plot - ${contexpl} Grouped with New Cut-Off`' type: Image width: 600 height: 450 @@ -245,6 +379,17 @@ items: - kmunicate - endplot - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent refs: - KMunicate - KMunicate2 @@ -259,7 +404,20 @@ items: - tint - dxdate - fudate - + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: outcomeredifened title: Add Redefined Outcome to Data @@ -270,7 +428,20 @@ items: - outcome - analysistype - multievent - + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent - name: calculatedcutoff title: Add Calculated Cut-off Group to Data @@ -283,7 +454,20 @@ items: - multievent - contexpl - findcut - + - sc + - endplot + - byplot + - ci95 + - risktable + - outcome + - outcomeLevel + - overalltime + - findcut + - contexpl + - fudate + - dxdate + - tint + - multievent diff --git a/jamovi/survivalcont.u.yaml b/jamovi/survivalcont.u.yaml index f0595394..d425cdd3 100644 --- a/jamovi/survivalcont.u.yaml +++ b/jamovi/survivalcont.u.yaml @@ -43,6 +43,7 @@ children: children: - type: CheckBox name: findcut + enable: (contexpl) - type: Output name: calculatedcutoff - type: CollapseBox diff --git a/jjstatsplot b/jjstatsplot index c3d9c52c..5a8238d5 160000 --- a/jjstatsplot +++ b/jjstatsplot @@ -1 +1 @@ -Subproject commit c3d9c52c7ef130ae7e453b30769eba250f62de1c +Subproject commit 5a8238d5ec085ff5874fda0172d2bb46adda0014 diff --git a/jsurvival b/jsurvival index e68226b8..5dc9989c 160000 --- a/jsurvival +++ b/jsurvival @@ -1 +1 @@ -Subproject commit e68226b8d84066eff3b1015547f97ed8c063e66c +Subproject commit 5dc9989cb4ff4b1475e1fd9116bcfa5b59348438 diff --git a/meddecide b/meddecide index bcbffbad..039a4d3d 160000 --- a/meddecide +++ b/meddecide @@ -1 +1 @@ -Subproject commit bcbffbad02620b0bb42315dc3bb848b7e34a6c8d +Subproject commit 039a4d3d8cc70f0576240e342cbe997552cb713e