Skip to content

Commit

Permalink
update survival functions
Browse files Browse the repository at this point in the history
  • Loading branch information
@sbalci
sbalci committed Dec 17, 2023
1 parent d36910c commit ece9a8d
Show file tree
Hide file tree
Showing 22 changed files with 587 additions and 601 deletions.
101 changes: 91 additions & 10 deletions R/multisurvival.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,13 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
# init ----
.init = function() {

explanatory_len <- length(self$options$explanatory)

contexpl_len <- length(self$options$contexpl)

self$results$plot8$setSize(explanatory_len * 400,
contexpl_len * 300)

}

# getData ----
Expand Down Expand Up @@ -197,6 +204,10 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
}


if ( sum(!is.na(mydata[["start"]])) == 0 || sum(!is.na(mydata[["end"]])) == 0) {
stop(paste0("Time difference cannot be calculated. Make sure that time type in variables are correct. Currently it is: ", self$options$timetypedata)
)
}

timetypeoutput <-
jmvcore::constructFormula(terms = self$options$timetypeoutput)
Expand All @@ -205,7 +216,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
mydata <- mydata %>%
dplyr::mutate(interval = lubridate::interval(start, end))

stopifnot(lubridate::is.interval(mydata[["interval"]]))


mydata <- mydata %>%
dplyr::mutate(mytime = lubridate::time_length(interval,
Expand Down Expand Up @@ -420,12 +431,16 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
name2outcome <- "CalculatedOutcome"
}

name3expl <- NULL

if (!is.null(self$options$explanatory)
) {
name3expl <- myexplanatory_labelled
}


name3contexpl <- NULL

if (!is.null(self$options$contexpl)
) {
name3contexpl <- mycontexpl_labelled
Expand Down Expand Up @@ -498,21 +513,22 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
## Define subconditions ----

subcondition1a <- !is.null(self$options$outcome)
subcondition1b1 <- !is.null(self$options$multievent)
subcondition1b1 <- 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)
# subcondition1b4 <- !is.null(self$options$awd)
# subcondition1b5 <- !is.null(self$options$awod)
subcondition2a <- !is.null(self$options$elapsedtime)
subcondition2b1 <- !is.null(self$options$tint)
subcondition2b1 <- 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))
condition1 <- subcondition1a && !subcondition1b1 || subcondition1b1 && subcondition1b2 || subcondition1b1 && subcondition1b3

condition2 <- subcondition2b1 && subcondition2b2 && subcondition2b3 || subcondition2a && !subcondition2b1 && !subcondition2b2 && !subcondition2b3

condition2 <- subcondition2a || (subcondition2b1 && subcondition2b2 && subcondition2b3)

condition3 <- condition3a || condition3b

Expand All @@ -525,6 +541,7 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
self$results$text2$setVisible(FALSE)
self$results$plot$setVisible(FALSE)
self$results$plot3$setVisible(FALSE)
self$results$plot8$setVisible(FALSE)
self$results$todo$setVisible(TRUE)
return()
} else {
Expand Down Expand Up @@ -723,7 +740,9 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))

self$results$text$setContent(results1)

## coxph ----
## coxph Proportional Hazards Assumption ----
if (self$options$ph_cox) {


LHT <- "survival::Surv(mytime, myoutcome)"

Expand All @@ -735,13 +754,52 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))

coxformula <- as.formula(coxformula)

coxmodel <- survival::coxph(
cox_model <- survival::coxph(
coxformula,
data = mydata
)

summarycoxmodel <- summary(coxmodel)
zph <- survival::cox.zph(cox_model)

self$results$cox_ph$setContent(print(zph))


# myfactor <- c("Smoker", "LVI", "PNI", "MeasurementB", "Measurement2")

# formula <-
# paste0("survival::Surv(",
# "mytime",
# ",",
# "myoutcome",
# ") ~ ",
# paste0(myfactor, collapse = " + ")
# )

# formula <- as.formula(formula)



# cox_model <- survival::coxph(formula, data = histopathology)

# summary(cox_model)

# plot(survival::survfit(formula, data = histopathology), xlab = "Time (days)", ylab = "Survival probability")

# cox.zph.fit <- survival::cox.zph(cox_model)

# summary(cox.zph.fit)

# plot(cox.zph.fit, var = 4, xlab = "Time (days)", ylab = "Scaled Schoenfeld residuals")

# survminer::ggcoxzph(cox.zph.fit)




image8 <- self$results$plot8
image8$setState(zph)

}


# Diagnostics of Cox Model ----
Expand Down Expand Up @@ -1120,6 +1178,29 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
}


# cox.zph ----
,
.plot8 = function(image8, ggtheme, theme, ...) {

ph_cox <- self$options$ph_cox

if (!ph_cox)
return()

zph <- image8$state

if (is.null(zph)) {
return()
}

# plot8 <- plot(zph)

plot8 <- survminer::ggcoxzph(zph)

print(plot8)
TRUE

}


# # coxzph plot ----
Expand Down
79 changes: 60 additions & 19 deletions R/multisurvival.h.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,8 @@ multisurvivalOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
uselandmark = FALSE,
landmark = 3,
hr = FALSE,
sty = "t1", ...) {
sty = "t1",
ph_cox = FALSE, ...) {

super$initialize(
package="ClinicoPath",
Expand Down Expand Up @@ -155,6 +156,10 @@ multisurvivalOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
"t1",
"t3"),
default="t1")
private$..ph_cox <- jmvcore::OptionBool$new(
"ph_cox",
ph_cox,
default=FALSE)

self$.addOption(private$..elapsedtime)
self$.addOption(private$..tint)
Expand All @@ -178,6 +183,7 @@ multisurvivalOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
self$.addOption(private$..calculatedtime)
self$.addOption(private$..hr)
self$.addOption(private$..sty)
self$.addOption(private$..ph_cox)
}),
active = list(
elapsedtime = function() private$..elapsedtime$value,
Expand All @@ -201,7 +207,8 @@ multisurvivalOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
landmark = function() private$..landmark$value,
calculatedtime = function() private$..calculatedtime$value,
hr = function() private$..hr$value,
sty = function() private$..sty$value),
sty = function() private$..sty$value,
ph_cox = function() private$..ph_cox$value),
private = list(
..elapsedtime = NA,
..tint = NA,
Expand All @@ -224,7 +231,8 @@ multisurvivalOptions <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
..landmark = NA,
..calculatedtime = NA,
..hr = NA,
..sty = NA)
..sty = NA,
..ph_cox = NA)
)

multisurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
Expand All @@ -236,6 +244,8 @@ multisurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
text2 = function() private$.items[["text2"]],
plot = function() private$.items[["plot"]],
plot3 = function() private$.items[["plot3"]],
cox_ph = function() private$.items[["cox_ph"]],
plot8 = function() private$.items[["plot8"]],
calculatedtime = function() private$.items[["calculatedtime"]],
outcomeredifened = function() private$.items[["outcomeredifened"]]),
private = list(),
Expand All @@ -248,18 +258,7 @@ multisurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
refs=list(
"multivariable",
"survivaltutorial",
"ClinicoPathJamoviModule"),
clearWith=list(
"outcome",
"outcomeLevel",
"overalltime",
"explanatory",
"contexpl",
"fudate",
"dxdate",
"tint",
"multievent",
"adjexplanatory"))
"ClinicoPathJamoviModule"))
self$add(jmvcore::Html$new(
options=options,
name="todo",
Expand Down Expand Up @@ -348,12 +347,49 @@ multisurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
"dxdate",
"tint",
"multievent")))
self$add(jmvcore::Preformatted$new(
options=options,
name="cox_ph",
title="Proportional Hazards Assumption",
visible="(ph_cox)",
clearWith=list(
"explanatory",
"outcome",
"outcomeLevel",
"overalltime",
"fudate",
"dxdate",
"tint",
"multievent",
"contexpl")))
self$add(jmvcore::Image$new(
options=options,
name="plot8",
title="Proportional Hazards Assumption",
width=600,
height=450,
renderFun=".plot8",
visible="(ph_cox)",
requiresData=TRUE,
clearWith=list(
"ph_cox",
"endplot",
"byplot",
"explanatory",
"outcome",
"outcomeLevel",
"overalltime",
"fudate",
"dxdate",
"tint",
"multievent",
"contexpl")))
self$add(jmvcore::Output$new(
options=options,
name="calculatedtime",
title="Add Calculated Time to Data",
varTitle="`Calculated Time in Multivariable Survival Function - from ${ dxdate } to { fudate }`",
varDescription="Calculated Time from given Dates",
varDescription="Calculated Time from given Dates in Multivariable Survival Analysis",
clearWith=list(
"tint",
"dxdate",
Expand All @@ -363,7 +399,7 @@ multisurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
name="outcomeredifened",
title="Add Redefined Outcome to Data",
varTitle="`Redefined Outcome in Multivariable Survival Function - from ${ outcome } for analysis { analysistype }`",
varDescription="Redefined Outcome from Outcome based on Analysis Type",
varDescription="Redefined Outcome from Outcome based on Analysis Type in Multivariable Survival Analysis",
clearWith=list(
"outcome",
"analysistype",
Expand Down Expand Up @@ -419,13 +455,16 @@ multisurvivalBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
#' @param landmark .
#' @param hr .
#' @param sty .
#' @param ph_cox .
#' @return A results object containing:
#' \tabular{llllll}{
#' \code{results$todo} \tab \tab \tab \tab \tab a html \cr
#' \code{results$text} \tab \tab \tab \tab \tab a html \cr
#' \code{results$text2} \tab \tab \tab \tab \tab a html \cr
#' \code{results$plot} \tab \tab \tab \tab \tab an image \cr
#' \code{results$plot3} \tab \tab \tab \tab \tab an image \cr
#' \code{results$cox_ph} \tab \tab \tab \tab \tab a preformatted \cr
#' \code{results$plot8} \tab \tab \tab \tab \tab an image \cr
#' \code{results$calculatedtime} \tab \tab \tab \tab \tab an output \cr
#' \code{results$outcomeredifened} \tab \tab \tab \tab \tab an output \cr
#' }
Expand All @@ -452,7 +491,8 @@ multisurvival <- function(
uselandmark = FALSE,
landmark = 3,
hr = FALSE,
sty = "t1") {
sty = "t1",
ph_cox = FALSE) {

if ( ! requireNamespace("jmvcore", quietly=TRUE))
stop("multisurvival requires jmvcore to be installed (restart may be required)")
Expand Down Expand Up @@ -495,7 +535,8 @@ multisurvival <- function(
uselandmark = uselandmark,
landmark = landmark,
hr = hr,
sty = sty)
sty = sty,
ph_cox = ph_cox)

analysis <- multisurvivalClass$new(
options = options,
Expand Down
3 changes: 3 additions & 0 deletions R/oddsratio.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,9 @@ oddsratioClass <- if (requireNamespace('jmvcore')) R6::R6Class(

html <- self$results$todo
html$setContent(todo)
self$results$text$setVisible(FALSE)
self$results$text2$setVisible(FALSE)
self$results$plot$setVisible(FALSE)
return()

} else {
Expand Down
Loading

0 comments on commit ece9a8d

Please sign in to comment.