Interactive visualization to show the effect of covariate estimates on the response distribution in quantile regression

quantile_coefficients.R

library(shiny)
library(shinythemes)
library(shinysense)
library(tidyverse) 

ui <- fluidPage(
  theme = shinytheme("flatly"),
  fluidRow(
    column(width = 5,
           h4("Drawn coefficients"), shinydrawrUI("outbreak_stats")),
    column(width = 5, offset = 1,
           h4("Smoothed drawn coefficients"), plotOutput(outputId = "effect"))
  ),
  fluidRow(
    column(width = 5,
           h4("Baseline distribution"), plotOutput(outputId = "hist")),
    column(width = 5, offset = 1,
           h4("baseline + effect distribution"), plotOutput(outputId = "hist_effect"))
  )
)


server <- function(input, output) {
  random_data <- data_frame(time = 1:99 / 100,
                            metric = NA)

  #server side call of the drawr module
  drawChart <- callModule(
    shinydrawr,
    "outbreak_stats",
    data = random_data,
    draw_start = 1 / 100,
    x_key = "time",
    y_key = "metric",
    y_max = 1,
    y_min = -1
  )

  observeEvent(drawChart(), {
    drawnValues = drawChart()
    
    baseline <- qnorm(p = 1:99 / 100)

    smoothed_effect <- loess(y ~ x, data.frame(y = drawnValues, x = 1:98)) %>%
      predict() %>% c(2 * .[1] - .[2], .)
    baseline_effect <- sort(baseline + smoothed_effect)
    
    dd <- 1 / ((lead(baseline) - baseline) * 100)
    
    output$hist <- renderPlot({
      plot(baseline, dd, type = "l", xlim = c(-3, 3), ylim = c(0, 1))
    })
    
    dde <- 1 / ((lead(baseline_effect) - baseline_effect) * 100)
    
    output$hist_effect <- renderPlot({
      plot(baseline_effect, dde, type = "l", xlim = c(-3, 3), ylim = c(0, 1))
    })
    drawnValues
    output$effect <- renderPlot({
      smoothed_effect %>% plot(ylim = c(-1, 1), x = 1:99 / 100)
    })
  })

}

# Run the application
shinyApp(ui = ui, server = server)