I am trying to build a simple app in shiny to create from a database a table with survival % at a timepoint, comparing 2 groups (female vs male, drug a vs drug b, etc).
The app has a sidebar with inputs (time var. and status var.) to calculate the survival. For a descriptive table without group comparison (just survival at 24 months in %) , it works fine (code below with dataframe example).
library(shiny)
library(gtsummary)
library(survival)
library(dplyr)
library(DT)
library(cards)
library(cardx)
library(gt)
# Create a made-up dataframe
set.seed(123)
data <- data.frame(
gender = sample(c("male", "female"), 100, replace = TRUE),
age = sample(18:70, 100, replace = TRUE),
stage = sample(1:4, 100, replace = TRUE),
OS = runif(100, 2, 70),
status = sample(0:1, 100, replace = TRUE),
ECOG24 = sample(0:1, 100, replace = TRUE)
)
# Define UI
ui <- fluidPage(
navbarPage("Clinical Data App",
tabPanel("Survival Analysis",
sidebarLayout(
sidebarPanel(
selectInput("time_var", "Select Time Variable:",
choices = names(data), selected = "OS"),
selectInput("status_var", "Select Status Variable:",
choices = names(data), selected = "status"),
numericInput("timepoint", "Enter Timepoint:", 24, min = 1, max = 70)
),
mainPanel(
tabsetPanel(
tabPanel("Survival Table", gt_output("surv_table"))
)
)
)
)
)
)
# Define server logic
server <- function(input, output, session) {
output$surv_table <- render_gt({
# Validate inputs
req(input$time_var, input$status_var, input$timepoint)
# Create survival object
surv_obj <- Surv(time = data[[input$time_var]], event = data[[input$status_var]])
# Build tbl_survival using the input values
tbl_survival <-
survfit(surv_obj ~ 1, data) |>
cardx::ard_survival_survfit(times = c(input$timepoint)) |>
cards::update_ard_fmt_fn(
stat_names = c("estimate", "conf.low", "conf.high"),
fmt_fn = label_style_sigfig(digits = 2, scale = 100)
) |>
tbl_ard_summary(
label = list(time = paste0(input$timepoint, " months Survival Probability")),
statistic = time ~ "{estimate}%"
)
# Convert to gt table before rendering
gt_table <- as_gt(tbl_survival)
# Render the table
gt_table
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am expecting a table created with this code:
survfit(Surv(OS, status) ~ gender, data) |>
cardx::ard_survival_survfit(times = c(24)) |>
cards::update_ard_fmt_fn(
stat_names = c("estimate", "conf.low", "conf.high"),
fmt_fn = label_style_sigfig(digits = 2, scale = 100)
) |>
tbl_ard_summary(
by = gender,
label = list(time = paste0("24 ", " months Survival Probability")),
statistic = time ~ "{estimate}%"
)
The problem is in shiny when I add a variable to compare groups (for example gender).
with this code:
ui <- fluidPage(
navbarPage("Clinical Data App",
tabPanel("Survival Analysis",
sidebarLayout(
sidebarPanel(
selectInput("time_var", "Select Time Variable:",
choices = names(data)),
selectInput("status_var", "Select Status Variable:",
choices = names(data)),
selectInput("group_var", "Select Grouping Variable:",
choices = c("None", names(data))),
numericInput("timepoint", "Enter Timepoint:", 12, min = 1, max = 70)
),
mainPanel(
tabsetPanel(
tabPanel("Survival Table", gt_output("surv_table"))
)
)
)
)
)
)
# Define server logic
server <- function(input, output, session) {
output$surv_table <- render_gt({
# Validate inputs
req(input$time_var, input$status_var, input$timepoint)
# Create the survival object
surv_obj <- Surv(time = data[[input$time_var]], event = data[[input$status_var]])
print("Survival Object Created:")
print(surv_obj)
# Determine grouping formula
if (input$group_var == "None") {
formula <- surv_obj ~ 1
} else {
formula <- as.formula(paste("surv_obj ~", input$group_var))
}
# Print the formula for debugging
print("Survival Formula:")
print(formula)
# Fit the survival model with the correct data
fit <- survfit(formula, data = data)
print("Survival Model Fitted:")
print(summary(fit))
# Build tbl_survival using the input value
tbl_survival <-
fit |>
cardx::ard_survival_survfit(times = input$timepoint) |>
cards::update_ard_fmt_fn(
stat_names = c("estimate", "conf.low", "conf.high"),
fmt_fn = label_style_sigfig(digits = 2, scale = 100)
) |>
dplyr::mutate(context = "categorical") |> # forcing the summary to a "category-like" format
tbl_ard_summary(
by = if (input$group_var == "None") NULL else input$group_var,
label = list(time = paste0(input$timepoint, " months Survival Probability")),
statistic = time ~ "{estimate}% (95% CI {conf.low}%, {conf.high}%)"
)
print("Summary Table:")
print(tbl_survival)
# Convert to gt table before rendering
gt_table <- as_gt(tbl_survival)
# Render the table
gt_table
})
}
# Run the application
shinyApp(ui = ui, server = server)
I get the error "object of type 'symbol' is not subsettable" (i tried many different alternatives and always the same error).
When debugging, the formula works fine (summary(fit) is ok).
Also, same coding in simple r (no shiny) using a fixed grouping variable (for example gender), it works fine. (see code above)
So, the problem should be in the construction of the table with gt_summary, I assume...
Do you have any ideas? Thanks!
You can track the error down to this part:
fit |>
cardx::ard_survival_survfit(times = c(24))
You can use Shiny inputs to create the formula object passed to the survfit function to create the fit object. This object is created without errors, but then it includes a "call" element containing the formula, written like this:
str(fit$call)
# language survfit(formula = formula, data = data)
And this "call" element is then used by the cardx/cards functions to calculate further estimates, but it cannot find the real formula.
If you look at the "call" element from the following fit, directly created without variables/inputs (like in your second code block), the whole formula is there:
fit2 <- survfit(Surv(OS, status) ~ gender, data)
str(fit2$call)
# language survfit(formula = Surv(OS, status) ~ gender, data = data)
So we need a way to both create the fit object with the formula generated dynamically from input variables, and then pass the whole formula in the fit$call element. I was able to do this by using the quote(), deparse() and deparse1() functions to recreate the formula and replace it in the fit$call element, as a call object:
# don't create the surv_obj object yet
surv_obj <- quote(Surv(time = data[[input$time_var]], event = data[[input$status_var]]))
# Determine grouping formula
if (input$group_var == "None") {
formula <- as.formula(paste0(deparse(surv_obj), "~ gender"))
} else {
formula <- as.formula(paste0(deparse(surv_obj), "~", input$group_var))
}
# Print the formula for debugging
print("Survival Formula:")
print(formula)
# Fit the survival model with the correct data
fit <- survfit(formula = formula, data = data)
formula2 = deparse1(formula)
fit$call <- as.call(str2lang(paste("survfit(formula = ", formula2, ", data = data)")))
print("Survival Model Fitted:")
print(summary(fit))
This is kinf of hacky, but then the cardx::ard_survival_survfit() functions does not show any error, and your app works well!
EDIT Here's the full working code:
ui <- fluidPage(
navbarPage("Clinical Data App",
tabPanel("Survival Analysis",
sidebarLayout(
sidebarPanel(
selectInput("time_var", "Select Time Variable:",
choices = names(data), selected = "OS"),
selectInput("status_var", "Select Status Variable:",
choices = names(data), selected = "status"),
selectInput("group_var", "Select Grouping Variable:",
choices = c("None", names(data)), selected = "gender"),
numericInput("timepoint", "Enter Timepoint:", 24, min = 1, max = 70)
),
mainPanel(
tabsetPanel(
tabPanel("Survival Table", gt_output("surv_table"))
)
)
)
)
)
)
# Define server logic
server <- function(input, output, session) {
output$surv_table <- render_gt({
# Validate inputs
req(input$time_var, input$status_var, input$timepoint)
# Create the survival object
surv_obj <- quote(Surv(time = data[[input$time_var]], event = data[[input$status_var]]))
# Determine grouping formula
if (input$group_var == "None") {
formula <- as.formula(paste0(deparse(surv_obj), "~ gender"))
} else {
formula <- as.formula(paste0(deparse(surv_obj), "~", input$group_var))
}
# Print the formula for debugging
print("Survival Formula:")
print(formula)
# Fit the survival model with the correct data
fit <- survfit(formula = formula, data = data)
formula2 = deparse1(formula)
fit$call <- as.call(str2lang(paste("survfit(formula = ", formula2, ", data = data)")))
print("Survival Model Fitted:")
print(summary(fit))
# Build tbl_survival using the input value
tbl_survival <-
fit |>
cardx::ard_survival_survfit(times = input$timepoint) |>
cards::update_ard_fmt_fn(
stat_names = c("estimate", "conf.low", "conf.high"),
fmt_fn = label_style_sigfig(digits = 2, scale = 100)
) |>
dplyr::mutate(context = "categorical") |> # forcing the summary to a "category-like" format
tbl_ard_summary(
by = if (input$group_var == "None") NULL else input$group_var,
label = list(time = paste0(input$timepoint, " months Survival Probability")),
statistic = time ~ "{estimate}% (95% CI {conf.low}%, {conf.high}%)"
)
print("Summary Table:")
print(tbl_survival)
# Convert to gt table before rendering
gt_table <- as_gt(tbl_survival)
# Render the table
gt_table
})
}
# Run the application
shinyApp(ui = ui, server = server)