Skip to content

Commit

Permalink
Apply automatic stylistic changes
Browse files Browse the repository at this point in the history
  • Loading branch information
@github-actions
github-actions[bot] committed Dec 11, 2024
1 parent 9c7c135 commit a1c8a5f
Show file tree
Hide file tree
Showing 3 changed files with 68 additions and 65 deletions.
61 changes: 31 additions & 30 deletions R/coxph.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ coxUI <- function(id) {
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")),
Expand Down Expand Up @@ -158,12 +158,12 @@ 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
)
)
})
Expand All @@ -177,11 +177,13 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct =
)
tagList(
selectInput(session$ns("cmp_event_cox"), "Competing Event",
choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = FALSE,
selected = NULL),
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)
choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = FALSE,
selected = NULL
)
)
})
})
Expand All @@ -190,8 +192,8 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct =
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))
)
})
})
Expand Down Expand Up @@ -290,8 +292,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]
)
)
})
Expand All @@ -314,8 +316,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]
)
)
})
Expand All @@ -331,14 +333,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])
)
}
}
Expand Down Expand Up @@ -377,8 +379,7 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct =
"survival::Surv(fgstart, fgstop, fgstatus) ~ ",
paste(input$indep_cox, collapse = "+")
))
}
else{
} 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 {
Expand Down Expand Up @@ -429,13 +430,13 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct =
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))
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(
Expand All @@ -446,9 +447,9 @@ coxModule <- function(input, output, session, data, data_label, data_varStruct =
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)&!input$cmp_risk_check) {
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 if (!is.null(id.cluster)&!input$cmp_risk_check){
} 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)
Expand Down
28 changes: 15 additions & 13 deletions R/forestcox.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -258,11 +258,13 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor
)
tagList(
selectInput(session$ns("cmp_event_cox"), "Competing Event",
choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = FALSE,
selected = NULL),
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)
choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = FALSE,
selected = NULL
)
)
})
})
Expand Down Expand Up @@ -299,15 +301,15 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor
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("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)
}
Expand Down
44 changes: 22 additions & 22 deletions R/kaplan.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -320,11 +320,13 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc
)
tagList(
selectInput(session$ns("cmp_event_km"), "Competing Event",
choices = mklist(data_varStruct(), vlist()$factor_01vars), multiple = FALSE,
selected = NULL),
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)
choices = mklist(data_varStruct(), vlist()$conti_vars_positive), multiple = FALSE,
selected = NULL
)
)
})
})
Expand Down Expand Up @@ -493,12 +495,12 @@ 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){
if (input$cmp_risk_check) {
req(!is.null(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))
data.km$cmpp_event <- factor(data.km$cmpp_event, 0:2, labels=c("zero", "cmp", "cmprsk"))
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))
data.km$cmpp_event <- factor(data.km$cmpp_event, 0:2, labels = c("zero", "cmp", "cmprsk"))
}
if (input$subcheck == T) {
validate(
Expand Down Expand Up @@ -688,34 +690,32 @@ kaplanModule <- function(input, output, session, data, data_label, data_varStruc
if (is.null(design.survey)) {
status_cmprsk <- NULL
if (input$cmp_risk_check) {
status_cmprsk <- 'cmp'
status_cmprsk <- "cmp"
}
if (is.null(id.cluster)) {
if(input$cmp_risk_check){
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
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(
} 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
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 {
} 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 = "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, status.cmprsk = status_cmprsk
showpercent = input$showpercent, surv.scale = surv.scale, status.cmprsk = status_cmprsk
)
)
}
Expand Down

0 comments on commit a1c8a5f

Please sign in to comment.