From 015f84515dddd2db47656b13004f87bce459cc3a Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Tue, 10 Dec 2024 06:45:10 +0000 Subject: [PATCH 1/6] add finegray to cox --- R/coxph.R | 89 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 64 insertions(+), 25 deletions(-) diff --git a/R/coxph.R b/R/coxph.R index 41dcec99..96c87c03 100644 --- a/R/coxph.R +++ b/R/coxph.R @@ -15,10 +15,12 @@ coxUI <- function(id) { tagList( uiOutput(ns("eventtime")), checkboxInput(ns("check_rangetime"), "Choose time ranges"), + checkboxInput(ns("cmp_risk_check"), "Competing Risk Analysis(Fine-Gray)"), + uiOutput(ns("cmp_eventtime")), uiOutput(ns("rangetime")), uiOutput(ns("indep")), sliderInput(ns("decimal"), "Digits", - min = 1, max = 4, value = 2 + min = 1, max = 4, value = 2 ), checkboxInput(ns("subcheck"), "Sub-group analysis"), uiOutput(ns("subvar")), @@ -83,7 +85,7 @@ coxUI <- function(id) { #' @importFrom labelled var_label<- #' @importFrom stats glm as.formula model.frame step #' @importFrom purrr map_lgl -#' @importFrom survival cluster coxph Surv +#' @importFrom survival cluster coxph Surv finegray coxModule <- function(input, output, session, data, data_label, data_varStruct = NULL, nfactor.limit = 10, design.survey = NULL, default.unires = T, limit.unires = 20, id.cluster = NULL, ties.coxph = "efron") { ## To remove NOTE. @@ -156,23 +158,40 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = tagList( selectInput(session$ns("event_cox"), "Event", - choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = F, - selected = NULL + choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = F, + selected = NULL ), selectInput(session$ns("time_cox"), "Time", - choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = F, - selected = NULL + choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = F, + selected = NULL ) ) }) + observeEvent(input$cmp_risk_check, { + output$cmp_eventtime <- renderUI({ + req(input$cmp_risk_check == TRUE) + validate( + need(length(vlist()$factor_01vars) >= 1, "No candidate event variables coded as 0, 1"), + need(length(vlist()$conti_vars_positive) >= 1, "No candidate time variables") + ) + tagList( + selectInput(session$ns("cmp_event_cox"), "Competing Event", + choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = FALSE, + selected = NULL), + selectInput(session$ns("cmp_time_cox"), "Competing Time", + choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = FALSE, + selected = NULL) + ) + }) + }) observeEvent(input$check_rangetime, { output$rangetime <- renderUI({ req(input$check_rangetime == T) sliderInput(session$ns("range_time"), "Time ranges", - min = min(data()[[input$time_cox]], na.rm = T), max = max(data()[[input$time_cox]], na.rm = T), - value = c(min(data()[[input$time_cox]], na.rm = T), median(data()[[input$time_cox]], na.rm = T)) + min = min(data()[[input$time_cox]], na.rm = T), max = max(data()[[input$time_cox]], na.rm = T), + value = c(min(data()[[input$time_cox]], na.rm = T), median(data()[[input$time_cox]], na.rm = T)) ) }) }) @@ -271,8 +290,8 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = tagList( selectInput(session$ns("indep_cox"), "Independent variables", - choices = mklist(data_varStruct(), indep.cox), multiple = T, - selected = indep.cox[varsIni] + choices = mklist(data_varStruct(), indep.cox), multiple = T, + selected = indep.cox[varsIni] ) ) }) @@ -295,8 +314,8 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = tagList( selectInput(session$ns("subvar_cox"), "Sub-group variables", - choices = var_subgroup_list, multiple = T, - selected = var_subgroup[1] + choices = var_subgroup_list, multiple = T, + selected = var_subgroup[1] ) ) }) @@ -312,14 +331,14 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = for (v in seq_along(input$subvar_cox)) { if (input$subvar_cox[[v]] %in% vlist()$factor_vars) { outUI[[v]] <- selectInput(session$ns(paste0("subval_cox", v)), paste0("Sub-group value: ", input$subvar_cox[[v]]), - choices = data_label()[variable == input$subvar_cox[[v]], level], multiple = T, - selected = data_label()[variable == input$subvar_cox[[v]], level][1] + choices = data_label()[variable == input$subvar_cox[[v]], level], multiple = T, + selected = data_label()[variable == input$subvar_cox[[v]], level][1] ) } else { val <- stats::quantile(data()[[input$subvar_cox[[v]]]], na.rm = T) outUI[[v]] <- sliderInput(session$ns(paste0("subval_cox", v)), paste0("Sub-group range: ", input$subvar_cox[[v]]), - min = val[1], max = val[5], - value = c(val[2], val[4]) + min = val[1], max = val[5], + value = c(val[2], val[4]) ) } } @@ -351,10 +370,20 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = validate( need(!is.null(input$indep_cox), "Please select at least 1 independent variable.") ) - if (is.null(id.cluster)) { - return(as.formula(paste("survival::Surv(", input$time_cox, ",", input$event_cox, ") ~ ", paste(input$indep_cox, collapse = "+"), sep = ""))) - } else { - return(as.formula(paste("survival::Surv(", input$time_cox, ",", input$event_cox, ") ~ ", paste(input$indep_cox, collapse = "+"), " + cluster(", id.cluster(), ")", sep = ""))) + if (input$cmp_risk_check) { + req(input$cmp_event_cox) + req(input$cmp_time_cox) + as.formula(paste( + "survival::Surv(fgstart, fgstop, fgstatus) ~ ", + paste(input$indep_cox, collapse = "+") + )) + } + else{ + if (is.null(id.cluster)) { + return(as.formula(paste("survival::Surv(", input$time_cox, ",", input$event_cox, ") ~ ", paste(input$indep_cox, collapse = "+"), sep = ""))) + } else { + return(as.formula(paste("survival::Surv(", input$time_cox, ",", input$event_cox, ") ~ ", paste(input$indep_cox, collapse = "+"), " + cluster(", id.cluster(), ")", sep = ""))) + } } }) @@ -363,7 +392,6 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = req(!is.null(input$event_cox)) req(!is.null(input$time_cox)) data.cox <- data() - if (input$check_rangetime == T) { req(input$time_cox) data.cox <- data.cox[!(get(input$time_cox) < input$range_time[1])] @@ -396,6 +424,19 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = label.regress <- data_label()[label.regress2] data.cox[[input$event_cox]] <- as.numeric(as.vector(data.cox[[input$event_cox]])) } + if (input$cmp_risk_check == T) { + req(input$cmp_event_cox) + req(input$cmp_time_cox) + req(input$event_cox) + req(input$time_cox) + data.cox[[input$cmp_event_cox]]<- as.numeric(as.vector(data.cox[[input$cmp_event_cox]])) + data.cox$cmpp_time <- with(data.cox, ifelse(data.cox[[input$event_cox]]==0, data.cox[[input$cmp_time_cox]], data.cox[[input$time_cox]])) + data.cox$cmpp_event <- with(data.cox, ifelse(data.cox[[input$event_cox]]==0, 2*data.cox[[input$cmp_event_cox]], 1)) + data.cox$cmpp_event<- factor(data.cox$cmpp_event) + fg_data <- survival::finegray(formula = survival::Surv(cmpp_time,cmpp_event) ~ ., data = data.cox) + data.cox<-data.table::data.table(fg_data) + cc <- substitute(survival::coxph(.form, data = data.cox, weight = fgwt, model = T, ties = .ties), list(.form = form.cox(), .ties = ties.coxph)) + } mf <- model.frame(form.cox(), data.cox) validate( need(nrow(mf) > 0, paste("No complete data due to missingness. Please remove some variables from independent variables")) @@ -404,11 +445,10 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = validate( need(sum(lgl.1level) == 0, paste(paste(names(lgl.1level)[lgl.1level], collapse = " ,"), "has(have) a unique value. Please remove that from independent variables")) ) - if (is.null(design.survey)) { - if (is.null(id.cluster)) { + if (is.null(id.cluster)&!input$cmp_risk_check) { cc <- substitute(survival::coxph(.form, data = data.cox, model = T, ties = .ties), list(.form = form.cox(), .ties = ties.coxph)) - } else { + } else if (!is.null(id.cluster)&!input$cmp_risk_check){ cc <- substitute(survival::coxph(.form, data = data.cox, model = T, robust = T, ties = .ties), list(.form = form.cox(), .ties = ties.coxph)) } res.cox <- eval(cc) @@ -420,7 +460,6 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct = scope <- lapply(list(input$step_upper, input$step_lower), function(x) { as.formula(ifelse(is.null(x), "~1", paste0("~", paste(x, collapse = "+")))) }) - data.cox.step <<- data.cox[complete.cases(data.cox[, .SD, .SDcols = c(input$time_cox, input$event_cox, input$indep_cox)])] if (is.null(id.cluster)) { From eeaf61f52f49cdc011f581d620c6d5c8fef2b0dc Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Tue, 10 Dec 2024 09:10:37 +0000 Subject: [PATCH 2/6] add competing risk analysis to kaplan meier plot --- NAMESPACE | 1 + R/kaplan.R | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 61 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 784f4227..d5b44614 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -184,6 +184,7 @@ importFrom(survival,Surv) importFrom(survival,cluster) importFrom(survival,concordance) importFrom(survival,coxph) +importFrom(survival,finegray) importFrom(survival,survfit) importFrom(timeROC,SeSpPPVNPV) importFrom(timeROC,timeROC) diff --git a/R/kaplan.R b/R/kaplan.R index dea30e3e..20aecb9c 100644 --- a/R/kaplan.R +++ b/R/kaplan.R @@ -45,6 +45,8 @@ kaplanUI <- function(id) { uiOutput(ns("eventtime")), uiOutput(ns("indep")), uiOutput(ns("cutconti")), + checkboxInput(ns("cmp_risk_check"), "Competing risk analysis", F), + uiOutput(ns("cmp_var")), checkboxInput(ns("scale"), "% y scale", F), checkboxInput(ns("cumhaz"), "Show cumulative incidence", F), checkboxInput(ns("pval"), "Show p-value(log-rank test)", T), @@ -161,7 +163,6 @@ ggplotdownUI <- function(id) { optionUI <- function(id) { # Create a namespace function using the provided id ns <- NS(id) - shinyWidgets::dropdownButton( uiOutput(ns("option_kaplan")), circle = TRUE, status = "danger", icon = icon("gear"), width = "300px", @@ -310,6 +311,30 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc ) }) + observeEvent(input$cmp_risk_check, { + output$cmp_var <- renderUI({ + req(input$cmp_risk_check == TRUE) + validate( + need(length(vlist()$factor_01vars) >= 1, "No candidate event variables coded as 0, 1"), + need(length(vlist()$conti_vars_positive) >= 1, "No candidate time variables") + ) + tagList( + selectInput(session$ns("cmp_event_km"), "Competing Event", + choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = FALSE, + selected = NULL), + selectInput(session$ns("cmp_time_km"), "Competing Time", + choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = FALSE, + selected = NULL) + ) + }) + }) + + observeEvent(input$cmp_risk_check, { + if (input$cmp_risk_check) { + updateCheckboxInput(session, "pval", value = FALSE) + updateCheckboxInput(session, "cumhaz", value = TRUE) + } + }) output$indep <- renderUI({ @@ -434,8 +459,22 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc form.km <- reactive({ validate( need(!is.null(input$indep_km), "Please select at least 1 independent variable."), - need(!is.null(input$time_km), "Please select at least 1 time variable.") + need(!is.null(input$time_km), "Please select at least 1 time variable."), + need(!is.null(input$event_km), "Please select at least 1 event variable.") ) + if (input$cmp_risk_check) { + validate( + need(!is.null(input$cmp_event_km), "Please select a competing event variable."), + need(!is.null(input$cmp_time_km), "Please select a competing time variable.") + ) + if (input$indep_km == "None") { + return(as.formula(paste("survival::Surv(cmpp_time, cmpp_event) ~ ", "1", sep = ""))) + } else if (input$indep_km %in% vlist()$factor_vars) { + return(as.formula(paste("survival::Surv(cmpp_time, cmpp_event) ~ ", input$indep_km, sep = ""))) + } else { + return(as.formula(paste("survival::Surv(cmpp_time, cmpp_event) ~ ", "xcat", sep = ""))) + } + } if (input$indep_km == "None") { return(as.formula(paste("survival::Surv(", input$time_km, ",", input$event_km, ") ~ ", "1", sep = ""))) @@ -454,6 +493,17 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc data.km <- data() label.regress <- data_label() data.km[[input$event_km]] <- as.numeric(as.vector(data.km[[input$event_km]])) + if(input$cmp_risk_check){ + req(!is.null(input$cmp_event_km)) + print(data.km %>% head()) + print(input$event_km) + print('passing') + data.km[[input$cmp_event_km]]<- as.numeric(as.vector(data.km[[input$cmp_event_km]])) + data.km$cmpp_time <- with(data.km, ifelse(data.km[[input$event_km]]==0, data.km[[input$cmp_time_km]], data.km[[input$time_km]])) + data.km$cmpp_event <- with(data.km, ifelse(data.km[[input$event_km]]==0, 2*data.km[[input$cmp_event_km]], 1)) + print('passed') + print(data.km %>% head()) + } if (input$subcheck == T) { validate( need(length(input$subvar_km) > 0, "No variables for subsetting"), @@ -640,12 +690,18 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc } if (is.null(design.survey)) { + status_cmprsk <- NULL + print(res.km) + print(data.km %>% head(., n= 50)) + if (input$cmp_risk_check) { + status_cmprsk <- '1' + } if (is.null(id.cluster)) { return( jskm::jskm(res.km, pval = input$pval, marks = input$marks, table = input$table, ylab = ylab, ystrataname = yst.name, ystratalabs = yst.lab, ci = input$ci, timeby = input$timeby, xlims = input$xlims, ylims = input$ylims, cumhaz = input$cumhaz, cluster.option = "None", cluster.var = NULL, data = data.km, pval.coord = pval.coord, legendposition = legend.p, linecols = pal, xlabs = text.x, dashed = dashed, cut.landmark = cut.landmark, - showpercent = input$showpercent, surv.scale = surv.scale + showpercent = input$showpercent, surv.scale = surv.scale, status.cmprsk = status_cmprsk ) ) } else { @@ -653,7 +709,7 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc jskm::jskm(res.km, pval = input$pval, marks = input$marks, table = input$table, ylab = ylab, ystrataname = yst.name, ystratalabs = yst.lab, ci = input$ci, timeby = input$timeby, xlims = input$xlims, ylims = input$ylims, cumhaz = input$cumhaz, cluster.option = "cluster", cluster.var = id.cluster(), data = data.km, pval.coord = pval.coord, legendposition = legend.p, linecols = pal, xlabs = text.x, dashed = dashed, cut.landmark = cut.landmark, - showpercent = input$showpercent, surv.scale = surv.scale + showpercent = input$showpercent, surv.scale = surv.scale, status.cmprsk = status_cmprsk ) ) } From d1576bf77ca4c35568a46e732b59141d9bef4a1a Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Tue, 10 Dec 2024 14:58:06 +0000 Subject: [PATCH 3/6] edit data <- data[!(var.day < var.time[1])] as datatable and dataframe compatible form --- R/forestcox.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/forestcox.R b/R/forestcox.R index fa266690..5b83bd43 100644 --- a/R/forestcox.R +++ b/R/forestcox.R @@ -268,7 +268,7 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor isgroup <- ifelse(group.tbsub %in% vlist()$group_vars, 1, 0) # data[[var.event]] <- as.numeric(as.vector(data[[var.event]])) - data <- data[!(var.day < var.time[1])] + data <- data[data[[var.day]] >= var.time[1]] data[[var.event]] <- ifelse(data[[var.day]] >= var.time[2] & data[[var.event]] == "1", 0, as.numeric(as.vector(data[[var.event]]))) data[[var.day]] <- ifelse(data[[var.day]] >= var.time[2], var.time[2], data[[var.day]]) From 18b38437b5141ade3e0231144ed09f1e26abd319 Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Wed, 11 Dec 2024 07:11:11 +0000 Subject: [PATCH 4/6] add cmprsk anal in subgroup --- R/forestcox.R | 38 +++++++++++++++++++++++++++++++++++--- 1 file changed, 35 insertions(+), 3 deletions(-) diff --git a/R/forestcox.R b/R/forestcox.R index 5b83bd43..18739d4a 100644 --- a/R/forestcox.R +++ b/R/forestcox.R @@ -68,6 +68,8 @@ forestcoxUI <- function(id, label = "forestplot") { uiOutput(ns("subvar_tbsub")), uiOutput(ns("cov_tbsub")), uiOutput(ns("time_tbsub")), + checkboxInput(ns("cmp_risk_check"), "Competing Risk Analysis(Fine-Gray)"), + uiOutput(ns("cmp_eventtime")) ) } @@ -247,7 +249,23 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor numericInput(session$ns("xMax"), "max HR for forestplot", value = round(max(as.numeric(data[data != "Inf"]), na.rm = TRUE), 2)) }) - + observeEvent(input$cmp_risk_check, { + output$cmp_eventtime <- renderUI({ + req(input$cmp_risk_check == TRUE) + validate( + need(length(vlist()$factor_01vars) >= 1, "No candidate event variables coded as 0, 1"), + need(length(vlist()$conti_vars_positive) >= 1, "No candidate time variables") + ) + tagList( + selectInput(session$ns("cmp_event_cox"), "Competing Event", + choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = FALSE, + selected = NULL), + selectInput(session$ns("cmp_time_cox"), "Competing Time", + choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = FALSE, + selected = NULL) + ) + }) + }) tbsub <- reactive({ label <- data_label() @@ -278,10 +296,24 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor coxdata <- design.survey() coxdata$variables <- data } + if (input$cmp_risk_check) { + req(input$cmp_event_cox) + req(input$cmp_time_cox) + form<- as.formula(paste("survival::Surv(fgstart, fgstop, fgstatus) ~ ", group.tbsub, sep = "")) + cox_data<- data + cox_data[[input$cmp_event_cox]]<- as.numeric(as.vector(cox_data[[input$cmp_event_cox]])) + cox_data$cmpp_time <- with(cox_data, ifelse(cox_data[[input$dep]]==0, cox_data[[input$cmp_time_cox]], cox_data[[input$day]])) + cox_data$cmpp_event <- with(cox_data, ifelse(cox_data[[input$dep]]==0, 2*cox_data[[input$cmp_event_cox]], 1)) + cox_data$cmpp_event<- factor(cox_data$cmpp_event) + fg_data <- survival::finegray(formula = survival::Surv(cmpp_time,cmpp_event) ~ ., data = cox_data) + tbsub <- TableSubgroupMultiCox(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = fg_data, time_eventrate = var.time[2], line = F, decimal.hr = 3, decimal.percent = 1, weights = 'fgwt') + }else{ + form <- as.formula(paste("Surv(", var.day, ",", var.event, ") ~ ", group.tbsub, sep = "")) + tbsub <- TableSubgroupMultiCox(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = coxdata, time_eventrate = var.time[2], line = F, decimal.hr = 3, decimal.percent = 1) + } + - form <- as.formula(paste("Surv(", var.day, ",", var.event, ") ~ ", group.tbsub, sep = "")) - tbsub <- TableSubgroupMultiCox(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = coxdata, time_eventrate = var.time[2], line = F, decimal.hr = 3, decimal.percent = 1) # data[[var.event]] <- ifelse(data[[var.day]] > 365 * 5 & data[[var.event]] == 1, 0, as.numeric(as.vector(data[[var.event]]))) # tbsub<-TableSubgroupMultiCox(as.formula('Surv(mpg,vs)~am'), var_subgroups = 'kk', data=out, time_eventrate = 365 , line = F, decimal.hr = 3, decimal.percent = 1) len <- nrow(label[variable == group.tbsub]) From 47299dee85fdee70325af8d93d24327958f1f1c7 Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Wed, 11 Dec 2024 08:01:50 +0000 Subject: [PATCH 5/6] fix kaplan meier p val in cmp anal --- DESCRIPTION | 7 ++++--- NEWS.md | 4 ++++ R/kaplan.R | 18 +++++++----------- 3 files changed, 15 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 55e63062..97fd9831 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jsmodule Title: 'RStudio' Addins and 'Shiny' Modules for Medical Research -Version: 1.5.9 -Date: 2024-09-29 +Version: 1.5.10 +Date: 2024-12-11 Authors@R: c( person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")), person("Zarathu", role = c("cph", "fnd")), @@ -10,7 +10,8 @@ Authors@R: c( person("Jinhwan", "Kim", email = "jinhwan@zarathu.com", role = c("aut"), comment = c(ORCID = "0009-0009-3217-2417")), person("Yoonkyoung", "Jeon", email = "rachel200357@gmail.com", role = c("aut")), person("Jaewoong", "Heo", email = "koolerjaebee@gmail.com", role = c("aut")), - person("Youngsun", "Park", email = "ddspys@gmail.com", role = c("aut"), comment = c(ORCID = "0009-0009-9336-2281"))) + person("Youngsun", "Park", email = "ddspys@gmail.com", role = c("aut"), comment = c(ORCID = "0009-0009-9336-2281")), + person("Hyungwoo", "Jo", email = "street_4@naver.com", role = c("aut"))) Description: 'RStudio' addins and 'Shiny' modules for descriptive statistics, regression and survival analysis. Depends: R (>= 3.4.0) License: Apache License 2.0 diff --git a/NEWS.md b/NEWS.md index 6020c99c..b491aed4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# jsmodule 1.5.10 +## Update +- Add competing risk analysis in subgroup, Kaplan-meier, regression tab. + # jsmodule 1.5.9 ## Bugfix: - `sav` file load in `FilePSInput.R`, `FileRepeatedInput.R`, `FileSurveyInput.R` diff --git a/R/kaplan.R b/R/kaplan.R index 20aecb9c..8f63f7e6 100644 --- a/R/kaplan.R +++ b/R/kaplan.R @@ -495,14 +495,10 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc data.km[[input$event_km]] <- as.numeric(as.vector(data.km[[input$event_km]])) if(input$cmp_risk_check){ req(!is.null(input$cmp_event_km)) - print(data.km %>% head()) - print(input$event_km) - print('passing') - data.km[[input$cmp_event_km]]<- as.numeric(as.vector(data.km[[input$cmp_event_km]])) + data.km[[input$cmp_event_km]] <- as.numeric(as.vector(data.km[[input$cmp_event_km]])) data.km$cmpp_time <- with(data.km, ifelse(data.km[[input$event_km]]==0, data.km[[input$cmp_time_km]], data.km[[input$time_km]])) data.km$cmpp_event <- with(data.km, ifelse(data.km[[input$event_km]]==0, 2*data.km[[input$cmp_event_km]], 1)) - print('passed') - print(data.km %>% head()) + data.km$cmpp_event <- factor(data.km$cmpp_event, 0:2, labels=c("zero", "cmp", "cmprsk")) } if (input$subcheck == T) { validate( @@ -691,19 +687,19 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc if (is.null(design.survey)) { status_cmprsk <- NULL - print(res.km) - print(data.km %>% head(., n= 50)) if (input$cmp_risk_check) { - status_cmprsk <- '1' + status_cmprsk <- 'cmp' } if (is.null(id.cluster)) { + + if(input$cmp_risk_check){ return( jskm::jskm(res.km, pval = input$pval, marks = input$marks, table = input$table, ylab = ylab, ystrataname = yst.name, ystratalabs = yst.lab, ci = input$ci, timeby = input$timeby, xlims = input$xlims, ylims = input$ylims, cumhaz = input$cumhaz, cluster.option = "None", cluster.var = NULL, data = data.km, pval.coord = pval.coord, legendposition = legend.p, linecols = pal, xlabs = text.x, dashed = dashed, cut.landmark = cut.landmark, showpercent = input$showpercent, surv.scale = surv.scale, status.cmprsk = status_cmprsk - ) - ) + )) + } else { return( jskm::jskm(res.km, From 3a7281a3bce8050d17d4d8b9fb4496d7e6bcbf41 Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Wed, 11 Dec 2024 08:17:42 +0000 Subject: [PATCH 6/6] fix parenthesis err --- R/kaplan.R | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/R/kaplan.R b/R/kaplan.R index 8f63f7e6..cb63b1f8 100644 --- a/R/kaplan.R +++ b/R/kaplan.R @@ -691,16 +691,26 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc status_cmprsk <- 'cmp' } if (is.null(id.cluster)) { - if(input$cmp_risk_check){ + return( + jskm::jskm(res.km, + pval = input$pval, marks = input$marks, table = input$table, ylab = ylab, ystrataname = yst.name, ystratalabs = yst.lab, ci = input$ci, timeby = input$timeby, xlims = input$xlims, ylims = input$ylims, + cumhaz = input$cumhaz, cluster.option = "None", cluster.var = NULL, data = data.km, pval.coord = pval.coord, legendposition = legend.p, linecols = pal, xlabs = text.x, dashed = dashed, cut.landmark = cut.landmark, + showpercent = input$showpercent, surv.scale = surv.scale, status.cmprsk = status_cmprsk + ) + ) + } + else{ return( - jskm::jskm(res.km, - pval = input$pval, marks = input$marks, table = input$table, ylab = ylab, ystrataname = yst.name, ystratalabs = yst.lab, ci = input$ci, timeby = input$timeby, xlims = input$xlims, ylims = input$ylims, - cumhaz = input$cumhaz, cluster.option = "None", cluster.var = NULL, data = data.km, pval.coord = pval.coord, legendposition = legend.p, linecols = pal, xlabs = text.x, dashed = dashed, cut.landmark = cut.landmark, - showpercent = input$showpercent, surv.scale = surv.scale, status.cmprsk = status_cmprsk - )) - - } else { + jskm::jskm(res.km, + pval = input$pval, marks = input$marks, table = input$table, ylab = ylab, ystrataname = yst.name, ystratalabs = yst.lab, ci = input$ci, timeby = input$timeby, xlims = input$xlims, ylims = input$ylims, + cumhaz = input$cumhaz, cluster.option = "None", cluster.var = NULL, data = data.km, pval.coord = pval.coord, legendposition = legend.p, linecols = pal, xlabs = text.x, dashed = dashed, cut.landmark = cut.landmark, + showpercent = input$showpercent, surv.scale = surv.scale, status.cmprsk = status_cmprsk + ) + ) + } + } + else { return( jskm::jskm(res.km, pval = input$pval, marks = input$marks, table = input$table, ylab = ylab, ystrataname = yst.name, ystratalabs = yst.lab, ci = input$ci, timeby = input$timeby, xlims = input$xlims, ylims = input$ylims,