library(shiny)
library(bayesplot)
library(rstan)
library(shinydashboard)
library(coda)
library(runjags)
shinyApp(
ui <- fluidPage(
includeScript("../../../Matomo-tquant.js"),
dashboardPage(
dashboardHeader(
),
dashboardSidebar(
sidebarMenu(
menuItem("Information", tabName = "info", icon = icon("file")),
menuItem("Data", tabName = "data", icon = icon("dashboard")),
menuItem("Model 1", tabName = "one", icon = icon("cog"),htmlOutput("para1"),
menuSubItem("Model Code",tabName = "model1"),
menuSubItem("Autocorrelation",tabName = "auto_1"),
menuSubItem("Trace",tabName = "trace_1"),
menuSubItem("Posterior",tabName = "post_1")),
menuItem("Model 2", tabName = "two", icon = icon("cog"),htmlOutput("para2"),
menuSubItem("Model Code",tabName = "model2"),
menuSubItem("Autocorrelation",tabName = "auto_2"),
menuSubItem("Trace",tabName = "trace_2"),
menuSubItem("Posterior",tabName = "post_2")
),
menuItem("Model 1 & 2", tabName = "both", icon = icon("cogs"), htmlOutput("para3"),
menuSubItem("Model Code",tabName = "model3"),
menuSubItem("Autocorrelation",tabName = "auto_3"),
menuSubItem("Trace",tabName = "trace_3"),
menuSubItem("Posterior",tabName = "post_3")
)
)
),
dashboardBody(
tabItems(
tabItem(tabName = "info",
fluidPage(
div(style = 'overflow-x:hidden',
fluidRow(
column(12,
HTML('<h3><p align=center>This Shiny App was developed with two main purposes:<br> To visualize sampled Monte-Carlo data and to allow for easy comparison between two different sets of sampled Monte-Carlo data.</p><p align=center>This app can work with both rstan and runjags.<br> You can supplement your own files (in .rds format) or choose some of the implemented demo-datasets.</p>'),
HTML('<p align=center><img src = "tquant.png"></p>'),
HTML('<h5><p align=center>Developed during <a href="https://tquant.eu/tquant/about-tquant/">TquanT 2018 - Glasgow</a> by</p>')
)
),
fluidRow(
column(4,
HTML('<h5>Thomas Verliefde')
),
column(4,
HTML('<h5>Florian Hansen')
),
column(4,
HTML('<h5>Andrea Brancaccio')
)
),
fluidRow(
column(4, img(src = "Leuven.jpg", align = "left", width="90%")),
column(4, img(src = "Glasgow.png", align = "left", width="90%")),
column(4, img(src = "Padova.jpg", align = "left",width="80%"))
)
)
)
),
tabItem(tabName = "data",
fluidPage(
div(style='overflow-x:hidden;font-size:150%;',
fluidRow(
column(12,
radioButtons(
'inputData',
'Data Selection',
c(
'Demo - JAGS & STAN' = 'school1',
'Demo 2 - non-convergence' = 'school2',
'Import files' = 'import'
)
),
conditionalPanel(
condition = "input.inputData == 'school1'",
HTML('<h4>This demo utilizes two sampled datasets based on <br> <a href="http://andrewgelman.com/2014/01/21/everything-need-know-bayesian-statistics-learned-eight-schools/">the Gelman Eight School Problem</a>.<br> The first model is computed with STAN, the second model is computed with JAGS.<br> Note that it is quite difficult to use the exact same models for both.<br> As such, the differences perceived in this demo are a combination of many factors, which include the model and program.')
),
conditionalPanel(
condition = "input.inputData == 'school2'",
HTML('<h4>This demo utilizes two sampled datasets based on <br> <a href="http://andrewgelman.com/2014/01/21/everything-need-know-bayesian-statistics-learned-eight-schools/">the Gelman Eight School Problem</a>.<br> Both models are computed with JAGS, but they have quite different models.')
),
conditionalPanel(
condition = "input.inputData == 'school1' | input.inputData == 'school2'",
dataTableOutput('schooldata')
),
conditionalPanel(
condition = "input.inputData == 'import'",
HTML('You can import .rds files containing an object of class "runjags" or class "stanfit"'),
fileInput('file1',NULL,
accept=c('.rds'),
buttonLabel = 'Select Dataset 1',
placeholder = 'e.g. stanfit.rds'
),
fileInput('file2',NULL,
accept=c('.rds'),
buttonLabel = 'Select Dataset 2',
placeholder = 'e.g. runjags.rds'
)
)
)
)
)
)
),
## Model 1 Tabel#################
tabItem(tabName = "model1",
fluidRow(
HTML('<h3>Model 1:'),
verbatimTextOutput("sumdat1")
)
),
tabItem(tabName = "auto_1",
plotOutput("auto_1", height = "820px")
),
tabItem(tabName = "trace_1",
plotOutput("trace_1", height = "820px")
),
tabItem(tabName = "post_1",
plotOutput("post_1", height = "820px")
),
## Model 2 Tabel#################
tabItem(tabName = "model2",
fluidRow(
HTML('<h3>Model 2:'),
verbatimTextOutput("sumdat2")
)
),
tabItem(tabName = "auto_2",
plotOutput("auto_2", height = "820px")
),
tabItem(tabName = "trace_2",
plotOutput("trace_2", height = "820px")
),
tabItem(tabName = "post_2",
plotOutput("post_2", height = "820px")
),
## Both Model Tabel#################
tabItem(tabName = "model3",
fluidRow(
HTML('<h3>Model 1:'),
verbatimTextOutput('sumdat3a'),
HTML('<h3>Model 2:'),
verbatimTextOutput('sumdat3b')
)
),
tabItem(tabName = "auto_3",
plotOutput("auto_3",height= "820px")
),
tabItem(tabName = "trace_3",
plotOutput('trace_3',height="820px")
),
tabItem(tabName = "post_3",
plotOutput('post_3',height="820px")
)
)
)
)
),
server <- function(input, output, session) {
color_scheme_set("viridis")
output$schooldata = renderDataTable(data.frame(
School = LETTERS[seq_len(8)],
Effect = c(28,8,-3,7,-1,1,18,12),
SE = c(15,10,16,11,9,11,10,18)
),
options=list(dom='t',searching=FALSE,column.width='30%')
)
##data
Path1 = reactive(
switch(
input$inputData,
'school1' = 'stanfit.rds',
'school2' = 'jagsfit.rds',
'import' = input$file1[['datapath']]
)
)
Path2 = reactive(
switch(
input$inputData,
'school1' = 'jagsfit.rds',
'school2' = 'jagsfit2.rds',
'import' = input$file2[['datapath']]
)
)
File1 = reactive(
if(
!is.null(Path1())
) {
return(readRDS(Path1()))
}
)
File2 = reactive(
if(
!is.null(Path2())
) {
return(readRDS(Path2()))
}
)
Mcmc1 = reactive(
if(
!is.null(Path1())
) {
if(
class(File1())=='stanfit'
) {
return(rstan::As.mcmc.list(File1()))
} else if(
class(File1())=='runjags'
) {
return(coda::as.mcmc.list(File1()))
}
}
)
Mcmc2 = reactive(
if(
!is.null(Path2())
) {
if(
class(isolate(File2()))=='stanfit'
) {
return(rstan::As.mcmc.list(File2()))
} else if(
class((File2()))=='runjags'
) {
return(coda::as.mcmc.list(File2()))
}
}
)
if(
!is.null(isolate(Path1())) & !is.null(isolate(Path2()))
) {
Mcmc3 = reactive(
as.mcmc.list(
cbind(
Mcmc1()[,intersect(varnames(Mcmc1()),varnames(Mcmc2()))],
Mcmc2()[,intersect(varnames(Mcmc1()),varnames(Mcmc2()))]
)[1,]
)
)
}
# Parameters
output$para1 = renderUI({
selectInput("parameter1", "Which parameter to display",
choices=c("all",varnames(Mcmc1())))
})
output$para2 = renderUI({
selectInput("parameter2", "Which parameter to display",
choices=c("all",varnames(Mcmc2())))
})
output$para3 = renderUI({
selectInput("parameter3","Which parameter to display",
choices=c("all",varnames(Mcmc3())))
})
plot_parameter1 = reactive(
if(input$parameter1!="all"){
input$parameter1
} else {
varnames(Mcmc1())
}
)
plot_parameter2 = reactive(
if(input$parameter2!="all"){
input$parameter2
} else {
varnames(Mcmc2())
}
)
plot_parameter3 = reactive(
if(input$parameter3!='all'){
input$parameter3
} else {
varnames(Mcmc3())
}
)
##model 1
output$sumdat1<-renderText({
ifelse(
class(File1()) == 'stanfit',
attr(get_stanmodel(File1()),'model_code'),
File1()$model
)
})
output$trace_1<-renderPlot({
mcmc_trace(Mcmc1(), pars = plot_parameter1(), facet_args = list(nrow = 4))
})
output$auto_1<-renderPlot({
mcmc_acf(Mcmc1(), pars = plot_parameter1())
})
output$post_1<-renderPlot({
mcmc_dens_overlay(Mcmc1(), pars = plot_parameter1())
})
##model 2
output$sumdat2<-renderText({
ifelse(
class(File2()) == 'stanfit',
attr(get_stanmodel(File2()),'model_code'),
File2()$model
)
})
output$trace_2<-renderPlot({
mcmc_trace(Mcmc2(), pars = plot_parameter2(), facet_args = list(nrow = 4))
})
output$auto_2<-renderPlot({
mcmc_acf(Mcmc2(), pars = plot_parameter2())
})
output$post_2<-renderPlot({
mcmc_dens_overlay(Mcmc2(), pars = plot_parameter2())
})
# combined models ###
output$sumdat3a<-renderText({
ifelse(
class(File1()) == 'stanfit',
attr(get_stanmodel(File1()),'model_code'),
File1()$model
)
})
output$sumdat3b<-renderText({
ifelse(
class(File2()) == 'stanfit',
attr(get_stanmodel(File2()),'model_code'),
File2()$model
)
})
output$trace_3 = renderPlot({
mcmc_trace(Mcmc3(), pars = plot_parameter3(), facet_args = list(nrow=4)) +
scale_color_manual(name='Models',values=c('green','orange'))
})
output$auto_3 = renderPlot({
mcmc_acf(Mcmc3(), pars = plot_parameter3())+
scale_color_manual(name='Models',values=c('green','orange'))
})
output$post_3 = renderPlot({
mcmc_dens_overlay(Mcmc3(), pars = plot_parameter3()) +
scale_color_manual(name='Models',values=c('green','orange'))
})
},options = list('launch.browser' = TRUE)
)
