library(tidymodules)
library(bs4Dash)
library(dplyr)
library(subpat)
tteMappingModule <- TTEMapping$new()
tteModule <- TTE$new()
# From PLG
subpopulationModule <- SubpopulationManager$new()
subgroupManagerModule <- SubgroupManager$new()
store <- Store$new()
ui <- tagList(
shinyjs::useShinyjs(),
bs4DashPage(
sidebar_collapsed = TRUE,
controlbar_collapsed = FALSE,
navbar = bs4DashNavbar(
),
controlbar = bs4DashControlbar(
skin = "light",
title = "KM Configuration",
width = 450,
conditionalPanel("output.dataloaded",
bs4TabSetPanel(
id = "controlbarTabset",
side = "left",
# This NEEDS to be first since the mapping module won't be displayed otherwise
# The variable values come from the select inputs
bs4TabPanel(
tabName = "Variable Mapping",
active = TRUE,
tteMappingModule$ui(),
checkboxInput('useParam', 'Use parameter filtering?', value = T)
),
bs4TabPanel(
tabName = "Other",
h3("Model options"),
# One-sided test support.
# radioButtons('logrankSided', label = 'Hypothesis Tails',choices = c("one-sided", "two-sided"), inline = TRUE),
selectInput('conftype', 'Confidence Interval Type', choices = list("log-log (SAS default)" = "log-log", "log" = "log", "plain" = "plain"), selected = "log-log"),
h3("Plot options"),
checkboxInput('makePlotly', 'Enable interactivity through Plotly?', value = F)
)
)
),
conditionalPanel("! output.dataloaded", p("Please load data first."))
),
sidebar = bs4DashSidebar(
skin = "light",
bs4SidebarMenu(
id = "sidebar",
bs4SidebarHeader("TTE Analysis"),
bs4SidebarMenuItem(
"Load data",
tabName = "loaddata",
icon = "table"
),
bs4SidebarMenuItem(
"Subpopulations",
tabName = "subpop",
icon = "users"
),
bs4SidebarMenuItem(
"Subgroups",
tabName = "subgroups",
icon = "table"
),
bs4SidebarMenuItem(
"KM Summary",
tabName = "km",
icon = "chart-bar"
),
bs4SidebarMenuItem(
"Cox PH Model",
tabName = "coxph",
icon = "chart-area"
),
bs4SidebarMenuItem(
"ModStore",
tabName = "modStore",
icon = "project-diagram"
)
)
),
body = bs4DashBody(
bs4TabItems(
bs4TabItem(
tabName = "loaddata",
fluidRow(
column(
width = 6,
conditionalPanel("! output.fileuploaded",
p("Using example data from: https://github.com/phuse-org/phuse-scripts/blob/master/data/adam/cdisc/adtte.xpt")
),
fileInput("fileupload", "Choose .xpt file",
accept = c(".xpt")
))
),
fluidRow(
textOutput('fileloaded')
),
fluidRow(
p("subpat is a collection of package to help with common tasks for people in pharma doing exploratory data analysis using ADaM datasets. The main features include"),
tags$ul(
tags$li("Creating and editing subpopulations"),
tags$li("Creating subgroups"),
tags$li("Basic time-to-event analysis with flexible variable mapping"),
tags$li("Includes Kaplan-Meier plots and Cox Ph models")
),
p("Users such as medical writers can use the subpopulation features (via the PLG app in subpat) to create ad-hoc reports. Developers can easily plug-and-play the modules into their own applications."),
p("One of the novel features of subpat is the use of tidymodules to manage complex nested modules in shiny. Tidymodules provides a new object-oriented programming (OOP) approach for module development, new module interface using input/output ports and a set of tidy operators for handling cross-module communication."),
p("The bulk of this work was developed over the summer during my internship at Novartis in the SCC (Scientific computing and consulting) group.")
)
),
bs4TabItem(
tabName = "subpop",
subpopulationModule$ui()
),
bs4TabItem(
tabName = "subgroups",
subgroupManagerModule$ui()
),
bs4TabItem(
tabName = "km",
# Load the TTE mapping module after data is loaded
conditionalPanel("output.dataloaded",
uiOutput('selectPopulationUI'),
tteModule$ui()),
conditionalPanel("! output.dataloaded", p("Please load data first."))
),
bs4TabItem(
tabName = "coxph",
conditionalPanel("output.dataloaded",
tteModule$coxUi()),
conditionalPanel("! output.dataloaded", p("Please load data first."))
),
bs4TabItem(
tabName = "modStore",
store$ui()
)
)
)
)
)
server <- function(input, output, session) {
options <- reactive(list(
makePlotly = input$makePlotly,
conftype = input$conftype,
parameter = input$useParam,
parameter_value = input$useParam
))
optionsPlg <- reactive(list(
subjectDs = NULL,
idvar = "USUBJID"
))
callModules()
data_basename <- reactive({
# Only the filename without path and extension
# toupper(tools::file_path_sans_ext(basename(input$datapath)))
"ADTTE"
})
data_reactive <- reactive({
if(is.null(input$fileupload)) {
adtte_path <- system.file("sample_data/cdisc_tte/adtte.xpt", package = "subpat")
haven::read_xpt(adtte_path)
} else {
haven::read_xpt(input$fileupload$datapath)
}
})
data_reactive_pop <- reactive({
d <- data_reactive()
if(is.null(input$selectPopulation) || input$selectPopulation == "Full Population") {
d
} else {
plgDataList <- list(x = d)
# Name the data set with the basename of the file
names(plgDataList) <- data_basename()
# Query for the sub-population
subpat::query(populations()[[input$selectPopulation]], plgDataList)[[1]]
}
})
observe({
print(summary(mod(4)$execOutput("subgroups")))
})
plgDataList <- reactive({
# PLG subpopulation expects a list
l <- list(x = data_reactive())
# Name the data set with the basename of the file
names(l) <- data_basename()
l
})
defineEdges({
data_reactive %>1% tteMappingModule
options %>2% tteMappingModule
data_reactive %>1% subgroupManagerModule
# Pass the mapping into the Subgroup Module
tteMappingModule %1>2% subgroupManagerModule
data_reactive_pop %>1% tteModule
tteMappingModule %1>2% tteModule
subgroupManagerModule %1>3% tteModule
options %>4% tteModule
plgDataList %>1% subpopulationModule
optionsPlg %>2% subpopulationModule
})
populations <- reactive({
mod(3)$execOutput("populations")
})
output$selectPopulationUI <- renderUI({
pop <- populations()
req(pop, length(pop) > 0)
# Get the name from each population
pop_names <- lapply(pop, function(x) x$name)
choices <- c("Full Population", names(pop_names))
names(choices) <- c("Full Population", pop_names)
selectInput('selectPopulation', label = "Select population", choices =choices)
})
output$fileloaded <- renderText({
req(input$datapath, input$load)
paste0("Loaded file: ", basename(input$datapath))
})
output$fileuploaded <- reactive({
!is.null(input$fileupload)
})
output$dataloaded <- reactive({
dataloaded <- !is.null(data_reactive_pop())
#if(dataloaded) {
# Go to the KM Plot tab
# shinyjs::runjs("$('#tab-km').click()")
#}
return(dataloaded)
})
outputOptions(output, 'dataloaded', suspendWhenHidden=FALSE)
}
# Run the application
shinyApp(ui = ui, server = server)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.