library(shiny)
library(survival)
library(shinyjs)
##
## Attaching package: 'shinyjs'
## The following object is masked from 'package:shiny':
##
## runExample
## The following objects are masked from 'package:methods':
##
## removeClass, show
# Function to generate sample survival data
generate_sample_data <- function() {
set.seed(123)
# Number of observations
n <- 100000
# Generating covariates
age <- rnorm(n, mean = 50, sd = 10)
sex <- factor(sample(c("Male", "Female"), n, replace = TRUE))
treatment <- factor(sample(c("A", "B"), n, replace = TRUE))
# Generating survival time
baseline_hazard <- 0.01
true_lambda <- exp(0.1 * (age - 50)) * ifelse(sex == "Male", 1.5, 1) *
ifelse(treatment == "B", 0.8, 1)
true_survival <- exp(-baseline_hazard * (age - 50)) * exp(-true_lambda)
surv_time <- -log(runif(n)) / true_survival
# Generating censoring indicator
censoring_time <- rexp(n, rate = 0.1)
status <- ifelse(surv_time <= censoring_time, 1, 0)
# Creating data frame
data <- data.frame(time = pmin(surv_time, censoring_time), status = status,
age = age, sex = sex, treatment = treatment)
data
}
# Define UI
ui <- fluidPage(
shinyjs::useShinyjs(), # Enable shinyjs
# Loading text with spinner
tags$div(
id = "loading-text",
style = "text-align: center; font-size: 20px; margin-top: 20px; display: none;",
"Loading... ", tags$i(class = "fa fa-spinner fa-spin")
),
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.15.4/css/all.min.css"),
tags$style(
HTML("
/* Custom CSS styles */
.title {
text-align: center;
font-size: 24px;
font-weight: bold;
margin-bottom: 20px;
color: #333;
}
.description {
text-align: center;
margin-bottom: 10px; /* Adjusted bottom margin */
color: white; /* Updated color to white */
font-size: 18px;
}
.description-box {
background-color: black; /* Changed box color to black */
padding: 10px 20px; /* Adjusted vertical padding */
border: 1px solid #ccc;
border-radius: 5px;
margin-top: 10px; /* Adjusted top margin */
margin-bottom: 10px; /* Adjusted bottom margin */
}
.footer {
text-align: center;
font-style: italic;
color: white; /* Changed text color to white */
}
.footer-box {
background-color: black; /* Changed box color to black */
padding: 10px 20px; /* Adjusted vertical padding */
margin-top: 10px; /* Adjusted top margin */
border-radius: 5px;
}
.sidebarPanel {
background-color: #E8F5E9; /* Light green */
border: 1px solid #81C784; /* Green */
padding: 10px;
margin-bottom: 10px; /* Adjusted margin */
max-height: calc(100vh - 220px); /* Adjusted max height */
}
.mainPanel {
background-color: #E3F2FD; /* Light blue */
border: 1px solid #64B5F6; /* Blue */
padding: 20px;
margin-bottom: 20px; /* Added margin to separate from footer */
}
.actionButton {
background-color: #1976D2; /* Dark blue */
color: #ffffff;
border-color: #1565C0; /* Darker blue */
}
.plotOutput {
background-color: #ffffff;
}
.myPlot {
border: 2px solid #FF5252; /* Red */
border-radius: 5px;
padding: 10px;
}
")
)
),
titlePanel("My First Survival Analysis App"),
sidebarLayout(
sidebarPanel(
class = "sidebarPanel",
fileInput("file", "Choose CSV File",
accept = c(".csv", ".pdf",".rmd")),
br(),
checkboxInput("header", "Header", value = TRUE),
radioButtons("method", "Method:",
choices = c("Kaplan-Meier" = "km", "Cox Proportional Hazard"
= "cox", "Nelson-Aalen Estimate of Integrated
Hazard" = "na")), # Added Nelson-Aalen option
br(),
actionButton("goButton", "Perform Analysis", class = "actionButton"),
downloadButton("downloadData", "Download Sample Data")
),
mainPanel(
class = "mainPanel",
div(class = "title", "Survival Analysis Results"),
plotOutput("survPlot", height = "400px")
)
),
# User text box below the panel
div(class = "description-box",
div(class = "description", HTML("<span style='font-size: larger;
'>USER:</span> I have provided you with
a sample of randomly generated data. Feel
free to upload your own CSV-formatted
Survival Dataset. This app will show you
the plots indicated on the panel.
The attached data will be a good example
of how your data should look like."))),
# Footer outside sidebarLayout
div(class = "footer-box",
div(class = "footer", "Created by Holisizwe Mkhize")
)
)
# Define server logic
server <- function(input, output) {
# Reactive expression to read file
data <- reactiveVal(NULL)
# Read file and update reactive value
observeEvent(input$file, {
req(input$file)
shinyjs::show("loading-text") # Show loading text
data_val <- read.csv(input$file$datapath, header = input$header)
data(data_val)
shinyjs::hide("loading-text") # Hide loading text after data is loaded
})
# Perform survival analysis and plot survival curve
output$survPlot <- renderPlot({
req(input$goButton, data())
shinyjs::show("loading-text") # Show loading text
data_val <- data()
time_col <- "time"
status_col <- "status"
# Detect time and status column names if not provided
if (input$header && !is.null(data_val)) {
time_col <- grep("time", names(data_val), value = TRUE, ignore.case = TRUE)
status_col <- grep("status", names(data_val), value = TRUE, ignore.case = TRUE)
}
# Plot the Curves
if (!is.null(data_val)) {
if (input$method == "km") {
fit <- survfit(Surv(data_val[[time_col]], data_val[[status_col]]) ~ 1)
plot(fit, main = "Kaplan-Meier Survival Curve", col = "blue", ylab = "S(t)", xlab = "t")
} else if (input$method == "cox") {
# Extract variables if available and construct Cox model formula
formula_vars <- c("age", "sex", "treatment")
formula_vars <- formula_vars[formula_vars %in% names(data_val)]
if (length(formula_vars) > 0) {
formula_str <- paste("Surv(", time_col, ", ", status_col, ") ~", paste(formula_vars, collapse = " + "))
} else {
formula_str <- paste("Surv(", time_col, ", ", status_col, ") ~ sex + treatment + sex")
}
formula <- as.formula(formula_str)
fit1 <- coxph(formula, data = data_val)
plot(survfit(fit1), main = "Cox Proportional Hazards Model", col = "red", ylab = "S(t)", xlab = "t")
fit <- survfit(Surv(data_val[[time_col]], data_val[[status_col]]) ~ 1)
lines(fit, col = "blue")
legend("topright", legend = c("Kaplan-Meier Estimate", "The effect of covariates"), col = c("blue", "red"), lwd = 2)
} else if (input$method == "na") {
fit_na <- survfit(Surv(data_val[[time_col]], data_val[[status_col]]) ~ 1)
plot(fit_na, fun = "cumhaz", main = "Nelson-Aalen Estimate of Integrated Hazard", col = "green", ylab = "H(t)", xlab = "t")
}
}
shinyjs::hide("loading-text") # Hide loading text after plot is rendered
})
# Print log-rank test result
output$logRankTest <- renderText({
req(input$goButton, data())
shinyjs::show("loading-text") # Show loading text
data_val <- data()
time_col <- "time"
status_col <- "status"
# Detect time and status column names if not provided
if (input$header && !is.null(data_val)) {
time_col <- grep("time", names(data_val), value = TRUE, ignore.case = TRUE)
status_col <- grep("status", names(data_val), value = TRUE, ignore.case = TRUE)
}
# Calculate log-rank test result
if (input$method %in% c("km", "cox")) {
test_result <- survdiff(Surv(data_val[[time_col]], data_val[[status_col]]) ~ 1, data = data_val)
p_value <- round(pchisq(test_result$chisq, length(test_result$n) - 1, lower.tail = FALSE), 4)
result <- paste("Log-Rank Test p-value:", p_value)
}
shinyjs::hide("loading-text") # Hide loading text after text is rendered
result
})
# Provide sample dataset download
output$downloadData <- downloadHandler(
filename = function() {
"Randomly generated survival data.csv"
},
content = function(file) {
shinyjs::show("loading-text") # Show loading text
write.csv(generate_sample_data(), file, row.names = FALSE)
shinyjs::hide("loading-text") # Hide loading text after file is generated
}
)
}
shinyApp(ui = ui, server = server)
Shiny applications not supported in static R Markdown documents