Skip to content

Commit

Permalink
will fix sbalci/jsurvival#3 but the functions need more work
Browse files Browse the repository at this point in the history
  • Loading branch information
@sbalci
sbalci committed Dec 5, 2023
1 parent 5845746 commit 38e0b87
Show file tree
Hide file tree
Showing 9 changed files with 286 additions and 164 deletions.
176 changes: 141 additions & 35 deletions R/multisurvival.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -405,8 +405,13 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
image3 <- self$results$plot3
image3$setState(mydata)

imageKM <- self$results$plotKM
imageKM$setState(mydata)

image4 <- self$results$plot4
image4$setState(mydata)


# imageKM <- self$results$plotKM
# imageKM$setState(mydata)

# image7 <- self$results$plot7
# image7$setState(mydata)
Expand Down Expand Up @@ -531,7 +536,52 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
summarycoxmodel <- summary(coxmodel)


# https://forum.jamovi.org/viewtopic.php?p=9359&hilit=typeof#p9359

# Diagnostics of Cox Model ----

# https://forum.jamovi.org/viewtopic.php?t=2563&sid=1e80bc4f5cc91581b11be1ca1b9cc169


# fit <- coxph(Surv(futime, fustat) ~ age + ecog.ps + rx, data=ovarian)
# cox_zph_fit <- survival::cox.zph(coxmodel)


# plot all variables
# ggcoxzph(cox.zph.fit)

# plot all variables in specified order
# ggcoxzph(cox.zph.fit,
# var = c("ecog.ps", "rx", "age"))

# plot specified variables in specified order
# ggcoxzph(cox.zph.fit,
# var = c("ecog.ps", "rx"),
# font.main = 12,
# caption = "Caption goes here")




# ggcoxzph(): Graphical test of proportional hazards. Displays a graph of the scaled Schoenfeld residuals, along with a smooth curve using ggplot2.
# Wrapper around plot.cox.zph().
# ggcoxdiagnostics(): Displays diagnostics graphs presenting goodness of Cox Proportional Hazards Model fit.
# ggcoxfunctional(): Displays graphs of continuous explanatory variable against martingale residuals of null cox proportional hazards model. It helps to properly choose the functional form of continuous variable in cox model.















# https://forum.jamovi.org/viewtopic.php?p=9359&hilit=typeof#p9359

# # Create a function ----
# type_info <- function(x) {
Expand Down Expand Up @@ -731,8 +781,6 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))
# }




# Forest plot ----
,
.plot3 = function(image3, ggtheme, theme, ...) {
Expand Down Expand Up @@ -776,50 +824,108 @@ multisurvivalClass <- if (requireNamespace('jmvcore'))

}

# Kaplan-Meier ----



# coxzph plot ----
,
.plotKM = function(imageKM, ggtheme, theme, ...) {
.plot4 = function(image4, ggtheme, theme, ...) {

plotData <- imageKM$state
plotData <- image4$state

thefactor <- jmvcore::constructFormula(terms = self$options$explanatory)
formula2 <-
jmvcore::constructFormula(terms = c(self$options$explanatory, self$options$contexpl))

if (length(self$options$explanatory) > 2)
stop("Kaplan-Meier function allows maximum of 2 explanatory variables")
formula3 <-
paste("survival::Surv(mytime, myoutcome) ~ ", formula2)

if (!is.null(self$options$contexpl))
stop("Kaplan-Meier function does not use continuous explanatory variables.")
formula3 <- as.formula(formula3)

title2 <- as.character(thefactor)
cox_model <-
survival::coxph(formula = formula3,
data = plotData)

plotKM <- plotData %>%
finalfit::surv_plot(.data = .,
dependent = 'survival::Surv(mytime, myoutcome)',
explanatory = as.vector(self$options$explanatory),
xlab = paste0('Time (', self$options$timetypeoutput, ')'),
pval = self$options$pplot,
pval.method = self$options$pplot,
# 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,
censored = self$options$censored

)

# plot <- plot + ggtheme
cox_zph_fit <- survival::cox.zph(cox_model)

print(plotKM)
TRUE

# plot all variables
plot4 <- survminer::ggcoxzph(cox_zph_fit)


}
# print plot ----

print(plot4)
TRUE

}






















# Kaplan-Meier ----

# ,
# .plotKM = function(imageKM, ggtheme, theme, ...) {
#
# plotData <- imageKM$state
#
# thefactor <- jmvcore::constructFormula(terms = self$options$explanatory)
#
# if (length(self$options$explanatory) > 2)
# stop("Kaplan-Meier function allows maximum of 2 explanatory variables")
#
# if (!is.null(self$options$contexpl))
# stop("Kaplan-Meier function does not use continuous explanatory variables.")
#
# title2 <- as.character(thefactor)
#
# plotKM <- plotData %>%
# finalfit::surv_plot(.data = .,
# dependent = 'survival::Surv(mytime, myoutcome)',
# explanatory = as.vector(self$options$explanatory),
# xlab = paste0('Time (', self$options$timetypeoutput, ')'),
# pval = self$options$pplot,
# pval.method = self$options$pplot,
# # 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,
# censored = self$options$censored
#
# )
#
# # plot <- plot + ggtheme
#
# print(plotKM)
# TRUE
#
#
#
# }



Expand Down
59 changes: 7 additions & 52 deletions R/multisurvival.h.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -225,9 +225,7 @@ multisurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
text2 = function() private$.items[["text2"]],
plot = function() private$.items[["plot"]],
plot3 = function() private$.items[["plot3"]],
plotKM = function() private$.items[["plotKM"]],
calculatedtime = function() private$.items[["calculatedtime"]],
outcomeredifened = function() private$.items[["outcomeredifened"]]),
plot4 = function() private$.items[["plot4"]]),
private = list(),
public=list(
initialize=function(options) {
Expand Down Expand Up @@ -345,52 +343,11 @@ multisurvivalResults <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Cla
"adjexplanatory")))
self$add(jmvcore::Image$new(
options=options,
name="plotKM",
title="Kaplan-Meier",
width=600,
height=450,
renderFun=".plotKM",
requiresData=TRUE,
visible="(km)",
refs="finalfit",
clearWith=list(
"km",
"endplot",
"byplot",
"ci95",
"risktable",
"outcome",
"outcomeLevel",
"overalltime",
"explanatory",
"contexpl",
"fudate",
"dxdate",
"tint",
"multievent",
"adjexplanatory",
"pplot",
"censored")))
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",
clearWith=list(
"tint",
"dxdate",
"fudate")))
self$add(jmvcore::Output$new(
options=options,
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",
clearWith=list(
"outcome",
"analysistype",
"multievent")))}))
name="plot4",
title="coxzph Plot",
width=800,
height=600,
renderFun=".plot4"))}))

multisurvivalBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
"multisurvivalBase",
Expand Down Expand Up @@ -449,9 +406,7 @@ multisurvivalBase <- if (requireNamespace("jmvcore", quietly=TRUE)) R6::R6Class(
#' \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$plotKM} \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
#' \code{results$plot4} \tab \tab \tab \tab \tab an image \cr
#' }
#'
#' @export
Expand Down
72 changes: 72 additions & 0 deletions R/vartree.b.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -338,10 +338,40 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class(
)


# export as svg ----
# results1 <- DiagrammeRsvg::export_svg(gv = results)
# self$results$text1$setContent(print(results1))




# export as svg ----
results1 <- DiagrammeRsvg::export_svg(gv = results)
self$results$text1$setContent(print(results1))

results1 <- base::sub('width=\"[[:digit:]pt\"]+',
ifelse(horizontal==TRUE, 'width=400pt ', 'width=1000pt '),
results1)
# results1 <- base::sub('scale[([:digit:] [:digit:])]+',
# 'scale(1, 1)',
# results1)

results1 <- paste0('<html><head><style>
#myDIV {width: 610px; height: 850px; overflow: auto;}
</style></head><body><div id="myDIV">',
results1,
'</div></script></body></html>')



self$results$text1$setContent(results1)








# ptable ----
if (self$options$ptable) {
Expand All @@ -360,3 +390,45 @@ vartreeClass <- if (requireNamespace('jmvcore')) R6::R6Class(

)
)




WebPage <- R6::R6Class("WebPage",
public = list(
name = character(0),
head = c("<!DOCTYPE html>","<html>","<head>"),
body = "<body>",
style = '<style type="text/css">',
add_style = function(identifier, content){
content <- purrr::imap_chr(content, ~ glue::glue("{.y} : {.x};")) %>%
unname() %>%
paste(collapse = " ")
glued <- glue::glue("%identifier% { %content% }",
.open = "%", .close = "%")
self$style <- c(self$style, glued)
},
initialize = function(name){
self$name <- name
},
add_tag = function(tag, content){
glued <- glue::glue("<{tag}>{content}</{tag}>")
self$body <- c(self$body, glued)
},
save = function(path){
write(private$concat(self$head, self$style, self$body),
glue::glue("{file.path(path, self$name)}.html"))
},
view = function(){
htmltools::html_print(private$concat(self$head, self$style, self$body))
},
print = function(){
cat(private$concat(self$head, self$style, self$body), sep = "\n")
}
),
private = list(
concat = function(head, style, body){
c(head, style, "</style>", body,"</body>","</html>")
}
)
)
Loading

0 comments on commit 38e0b87

Please sign in to comment.