Skip to content

Commit

Permalink
working app with pre-fitting plots
Browse files Browse the repository at this point in the history
  • Loading branch information
@hillalex
hillalex committed Nov 1, 2024
1 parent 14b1ad0 commit a95a5a9
Show file tree
Hide file tree
Showing 5 changed files with 177 additions and 37 deletions.
3 changes: 2 additions & 1 deletion R/biokinetics.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -281,11 +281,12 @@ biokinetics <- R6::R6Class(
#' @description Plot model input data with a smoothing function. Note that
#' this plot is on a log scale, regardless of whether data was provided on a
#' log or a natural scale.
#' @vparam ncol Optional number of cols to display facets in.
#' @param ncol Optional number of cols to display facets in.
#' @return A ggplot2 object.
plot_model_inputs = function(ncol = NULL) {
plot_sero_data(private$data, private$all_formula_vars, ncol)
},
#' @description Opens an RShiny app to help with model diagnostics.
inspect = function() {
inspect_model(self, private)
},
Expand Down
107 changes: 89 additions & 18 deletions R/inspect-model.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,8 @@ inspect_model <- function(mod, private) {
sigma <- paste("sigma", name, sep = "_")
shiny::div(shiny::fluidRow(
shiny::column(4,
paste(name, description, sep = ": ")),
description
),
shiny::column(4,
shiny::fluidRow(class = "form-group",
shiny::tags$label(paste0("mean (", mu, ")"), class = "col-sm-6 col-form-label text-right"),
Expand All @@ -21,9 +22,11 @@ inspect_model <- function(mod, private) {
)
}

all_covariates <- c("None", detect_covariates(private$data))

ui <- shiny::fluidPage(style = "margin: 0.5em",
shiny::fluidRow(
shiny::column(6,
shiny::column(5,
shiny::h3("Prior predictive check"),
plotly::plotlyOutput("prior_predicted"),
shiny::tags$pre(style = "overflow: hidden; text-wrap: auto; word-break: keep-all; white-space: pre-line; margin-top: 20px;",
Expand All @@ -36,13 +39,38 @@ inspect_model <- function(mod, private) {
prior_inputs("m2", "Plateau rate"),
prior_inputs("m3", "Waning rate")
),
shiny::column(6,
shiny::column(7,
shiny::h3("Model input data"),
plotly::plotlyOutput("data"),
shiny::uiOutput(
"data_plot"
),
shiny::div(style = "margin-top: 20px;",
shiny::fluidRow(class = "form-group",
shiny::tags$label("Number of columns", class = "col-sm-3 col-form-label"),
shiny::column(3, raw_numeric_input("ncol", value = NULL))
shiny::column(2,
shiny::numericInput("ncol", label = "Number of columns", value = 3)
),
shiny::column(3,
shiny::selectInput("covariate", "Facet by",
choices = all_covariates,
selected = "None",
selectize = FALSE)
),
shiny::column(7,
shiny::div(class = "form-group",
shiny:::shinyInputLabel("filter", "Filter by"),
shiny::fluidRow(
shiny::column(5,
raw_select_input("filter",
choices = all_covariates,
selected = "None")
),
shiny::column(1, style = "padding-top: 5px;", "~="),
shiny::column(5,
raw_text_input("filter_value", placeholder = "regex")
)
)
)
)
)
)
)
Expand All @@ -55,6 +83,7 @@ inspect_model <- function(mod, private) {
)

server <- function(input, output, session) {
# priors
prior <- shiny::reactive(
biokinetics_priors(mu_t0 = input$mu_t0, mu_tp = input$mu_tp,
mu_ts = input$mu_ts, mu_m1 = input$mu_m1,
Expand All @@ -69,25 +98,67 @@ inspect_model <- function(mod, private) {
output$prior_predicted <- plotly::renderPlotly({
plotly::ggplotly(plot(prior()))
})
output$prior_mu <- shiny::renderTable(
as.data.frame(private$priors)[
c("mu_t0", "mu_tp", "mu_ts", "mu_m1", "mu_m2", "mu_m3")])
output$prior_sigma <- shiny::renderTable(
as.data.frame(private$priors)[
c("sigma_t0", "sigma_tp", "sigma_ts", "sigma_m1", "sigma_m2", "sigma_m3")])
cols <- shiny::reactive({ switch(is.na(input$ncol), NULL, input$ncol) })

# model inputs
cols <- shiny::reactive({
if (is.na(input$ncol)) {
return(NULL)
} else {
return(input$ncol)
}
})

selected_covariate <- shiny::reactive({
input$covariate
})

filter <- shiny::reactive({
input$filter
})

filter_value <- shiny::reactive({
input$filter_value
})

data <- shiny::reactive({
if (filter_value() != "" &&
!is.null(filter()) &&
filter() != "None") {
return(private$data[grepl(filter_value(), get(filter()), ignore.case = TRUE)])
} else {
return(private$data)
}
})

plot_inputs <- shiny::reactive({
mod$plot_model_inputs(ncol = cols()) +
selected <- selected_covariate()
if (is.null(selected) || selected == "None") {
selected <- character(0)
}
plot_data(data(), ncol = cols(), covariates = selected) +
theme(plot.margin = unit(c(1, 0, 0, 0), "cm"))
})

output$data <- plotly::renderPlotly({
gp <- plotly::ggplotly(plot_inputs())
if (length(private$all_formula_vars) > 0) {
facet_strip_bigger(gp, 30)
if (nrow(data()) > 0) {
gp <- plotly::ggplotly(plot_inputs())
if (selected_covariate() != "None") {
return(facet_strip_bigger(gp, 30))
} else {
return(gp)
}
}
})

output$data_plot <- renderUI({
if (nrow(data()) > 0) {
plotly::plotlyOutput("data")
} else {
gp
shiny::h3("No rows selected. Please change your filter.")
}
})

# model outputs
output$fitted <- shiny::renderText({
if (is.null(private$fitted)) {
"Model has not been fitted yet. Once fitted, inspect the model again to see posterior predictions."
Expand Down
43 changes: 32 additions & 11 deletions R/shiny-utils.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,17 +7,38 @@ raw_numeric_input <- function(inputId, value, min = NA, max = NA, step = NA) {
inputTag
}

raw_text_input <- function(inputId, value = "", placeholder = NULL) {
value <- shiny::restoreInput(id = inputId, default = value)
tags$input(id = inputId, type = "text", class = "shiny-input-text form-control", value = value, placeholder = placeholder)
}

raw_select_input <- function(inputId, choices, selected = NULL, multiple = FALSE) {
selected <- shiny::restoreInput(id = inputId, default = selected)
choices <- shiny:::choicesWithNames(choices)
if (is.null(selected)) {
if (!multiple) selected <- shiny:::firstChoice(choices)
} else selected <- as.character(selected)
tags$select(id = inputId, class = "shiny-input-select", class = "form-control", shiny:::selectOptions(choices, selected, inputId))
}


prior_code <- function(input) {
deparse(substitute(biokinetics_priors(mu_t0 = a, mu_tp = b,
mu_ts = c, mu_m1 = d,
mu_m2 = e, mu_m3 = f,
sigma_t0 = g, sigma_tp = h,
sigma_ts = i, sigma_m1 = j,
sigma_m2 = k, sigma_m3 = l),
list(a = input$mu_t0, b = input$mu_tp,
c = input$mu_ts, d = input$mu_m1,
e = input$mu_m2, f = input$mu_m3,
g = input$sigma_t0, h = input$sigma_tp,
i = input$sigma_ts, j = input$sigma_m1,
k = input$sigma_m2, l = input$sigma_m3)), width.cutoff = 500L)
mu_ts = c, mu_m1 = d,
mu_m2 = e, mu_m3 = f,
sigma_t0 = g, sigma_tp = h,
sigma_ts = i, sigma_m1 = j,
sigma_m2 = k, sigma_m3 = l),
list(a = input$mu_t0, b = input$mu_tp,
c = input$mu_ts, d = input$mu_m1,
e = input$mu_m2, f = input$mu_m3,
g = input$sigma_t0, h = input$sigma_tp,
i = input$sigma_ts, j = input$sigma_m1,
k = input$sigma_m2, l = input$sigma_m3)), width.cutoff = 500L)
}

detect_covariates <- function(data) {
setdiff(colnames(data), c("pid", "day", "last_exp_day",
"titre_type", "value", "censored",
"obs_id", "time_since_last_exp"))
}
20 changes: 19 additions & 1 deletion man/biokinetics.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

41 changes: 35 additions & 6 deletions man/biokinetics_priors.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit a95a5a9

Please sign in to comment.