Skip to content

Instantly share code, notes, and snippets.

@awwsmm
Created July 12, 2019 15:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save awwsmm/f3050c63b1fa8bfa1f168b1234b7185b to your computer and use it in GitHub Desktop.
Save awwsmm/f3050c63b1fa8bfa1f168b1234b7185b to your computer and use it in GitHub Desktop.
Clickable valueBox in R Shiny which opens a modal with reactive inputs, in a module
# define the UI of the module
clickableValueBoxUI <- function(id) {
# create the namespace
ns <- NS(id)
# define the UI components
fluidRow(
valueBoxOutput(ns("my_valueBox"))
)
}
# define the "business logic" of the module
clickableValueBox <- function(input, output, session) {
# get the namespace
ns <- session$ns
# dynamically render the valueBox
output$my_valueBox <- renderValueBox({
# create a valueBox object to return
box1 <- valueBox("example", subtitle="subtitle", icon=icon("credit-card"))
# must add action-button for functionality, others for appearance
box1$children[[1]]$attribs$class<-"action-button small-box bg-aqua"
# give the box any arbitrary id, we use this for observeEvent()
box1$children[[1]]$attribs$id<-ns("arbitrary_id")
# make sure returning the valueBox object is the last thing you do here
return(box1)
})
# define the function which creates the modal
themodal <- function() {
modalDialog(
title = strong("Example Modal"),
textInput(ns("example-modal-input-1"),
"What is your name?", placeholder = 'Sir Galahad of Camelot'),
textInput(ns("example-modal-input-2"),
"What is your quest?", placeholder = 'I seek the Grail'),
textInput(ns("example-modal-input-3"),
"What is your favourite colour?", placeholder = 'Blue... no, yellllooooooowwwwwww...'),
footer = tagList(
modalButton("Cancel"),
actionButton(ns("modal-ok-btn"), "OK")
),
size = "s",
easyClose = TRUE
)
}
# show the modal when the valueBox is clicked
observeEvent(input$arbitrary_id, showModal(themodal()))
# listen for the "OK" button from the modal
observeEvent(input$"modal-ok-btn", {
print("saw OK button")
print(sprintf("input 1: '%s'", input$"example-modal-input-1"))
print(sprintf("input 2: '%s'", input$"example-modal-input-2"))
print(sprintf("input 2: '%s'", input$"example-modal-input-3"))
removeModal()
})
}
library(shiny)
library(shinydashboard) # for proper valueBox rendering
# source the module definition file...
source("clickableValueBoxModule.R")
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
# import the UI from the module...
clickableValueBoxUI("main")
)
)
# ...and call the module function. That's it!
server <- function(input, output, session) {
callModule(clickableValueBox, "main")
}
shinyApp(ui,server)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment