I am trying to have an explanatory image and text box appear after a user presses an action button. Ideally, Id like the box to be centered and directly below the image without too much space in between. Also, I'm curious how to make the box wider for aesthetic purposes.
Here is what my attempt looks like:
Here is my code:
ui <- dashboardPage(
dashboardHeader(title = "Test Test Test"),
dashboardSidebar(disable = T),
dashboardBody(useShinyjs(),
shinyUI(fluidPage(
navbarPage(
"Test",
id = "main_navbar",
tabPanel(
"Test",
fluidRow(align="center",
column(width = 6,
numericInput("age", "Age", 40, min = 18, max = 100, step = 2)
)),
fluidRow(align="center",
actionButton("predict", "Predict")
),
br(),
fluidRow(align="center",
imageOutput("waterfallPlot")
),
shinyjs::hidden(
div(style="text-align: justify",
id = "hiddenbox",
box(
title = "Hidden Box",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
uiOutput(outputId = "waterfallDescription")
)
)
)
)
)
))))
server <- function(input, output, session) {
results <- eventReactive(input$predict, {
output <- as.integer(input$age)
output
})
output$waterfallPlot <- renderImage({
# Return a list containing the filename
temp <- results()
list(src = waterfallPlots[1],
contentType = 'image/png'
,width = 400,
height = 300
)
}, deleteFile = FALSE)
observeEvent(input$predict, {
shinyjs::show(id = "hiddenbox")
})
output$waterfallDescription <- renderText({
temp <- results()
HTML(paste0("<p>","bold","</b>", " The waterfall chart to the left explains why your prediction
differs from the average person’s prediction.The average prediction is shown at the bottom.", "</p>", "<p>",
"Each factor that goes into the model is shown in increasing order of impact going up.
For example, a blue bar pointing left means that your input for that feature decreases the model’s
output from the average output by the listed number.", "</p>"))
})
}
shinyApp(ui, server)
library(shiny);
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = "Test Test Test"),
dashboardSidebar(disable = T),
dashboardBody(useShinyjs(),
shinyUI(fluidPage(
navbarPage(
"Test",
id = "main_navbar",
tabPanel(
"Test",
fluidRow(align="center",
column(width = 12,
numericInput("age", "Age", 40, min = 18, max = 100, step = 2)
)),
fluidRow(align="center",
actionButton("predict", "Predict")
),
br(),
fluidRow(align="center",
imageOutput("waterfallPlot", height = "200px")
),
shinyjs::hidden(
div(style="text-align: justify",
id = "hiddenbox",
box(
width = 12,
title = "Hidden Box",
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
uiOutput(outputId = "waterfallDescription")
)
)
)
)
)
))))
server <- function(input, output, session) {
results <- eventReactive(input$predict, {
output <- as.integer(input$age)
output
})
output$waterfallPlot <- renderImage({
# Return a list containing the filename
temp <- results()
list(src = tempfile(),
contentType = 'image/png'
,width = 400,
height = 300
)
}, deleteFile = FALSE)
observeEvent(input$predict, {
shinyjs::show(id = "hiddenbox")
})
output$waterfallDescription <- renderText({
temp <- results()
HTML(paste0("<p>","bold","</b>", " The waterfall chart to the left explains why your prediction
differs from the average person’s prediction.The average prediction is shown at the bottom.", "</p>", "<p>",
"Each factor that goes into the model is shown in increasing order of impact going up.
For example, a blue bar pointing left means that your input for that feature decreases the model’s
output from the average output by the listed number.", "</p>"))
})
}
shinyApp(ui, server)
width
to change box
width, from 1-12.height
of imageOutput
to adjust the gap between image and box.