Shiny app for exploring posterior distributions given surprising data

app.R

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(
   
   # Application title
   titlePanel("Bayesian Surprise"),
   
   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
         sliderInput("obs",
                     "Observed value",
                     min = 0,
                     max = 20,
                     value = 15),
         selectInput(inputId = "prior", label = strong("Prior"),
                     choices = c("Cauchy","Normal","Laplace","t_5","t_30","logistic"),
                     selected = "Cauchy"),
         selectInput(inputId = "likelihood", label = strong("Likelihood"),
                     choices = c("Cauchy","Normal","Laplace","t_5","t_30","logistic"),
                     selected = "Normal")
      ),

      # Show a plot of the generated distribution
      mainPanel(
         plotOutput("distPlot")
      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  XLIM<-20
   output$distPlot <- renderPlot({
     prior<-(switch(input$prior,
                            Cauchy=quote(dcauchy(x)),
                            Normal=quote(dnorm(x)),
                            Laplace=quote(dexp(abs(x),1)),
                            t_5=quote(dt(x,5)),
                            t_30=quote(dt(x,30)),
                            logistic=quote(dlogis(x))))
     likelihood<-(switch(input$likelihood,
                                 Cauchy=quote(dcauchy(input$obs-x)),
                                 Normal=quote(dnorm(input$obs-x)),
                                 Laplace=quote(dexp(abs(input$obs-x),1)),
                                 t_5=quote(dt(input$obs-x,5)),
                                 t_30=quote(dt(input$obs-x,30)),
                                 logistic=quote(dlogis(input$obs-x))))
     # generate bins based on input$bins from ui.R
     eval(bquote(curve(.(likelihood)*.(prior),from=-2, to=XLIM+2,ylab="Posterior",xlab="x")))
     abline(v=0,col="purple",lty=2)
     abline(v=input$obs,col="green")
   })
}

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