Shiny: Using dynamic renderUI's with actionLinks and shinyJS - r

Question

I am building a dashboard where I need to create a number of boxes (based on the dataset) provided and then have each box be able to click and show subset boxes.
I can do this if I knew the data beforehand but I am having trouble with creating link id's and showing and hiding content when creating things dynamically.
Below is the code of how it should function (but using static content)
library(shiny)
library(shinydashboard)
library(shinyjs)
#####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
uiOutput("box1"),
uiOutput("box2"),
uiOutput("box3")
),
fluidRow(
div(id = "ILRow",
uiOutput("box1a"),
uiOutput("box1b"),
uiOutput("box1c")
),
div(id = "NCRow",
uiOutput("box2a"),
uiOutput("box2b")
),
div(id = "INRow",
uiOutput("box3a")
)
)
)
ui <- dashboardPage(header, sidebar, body)
#####/SERVER/####
server <- function(input, output) {
CSRbox <- function(description = NULL, linkName = NULL) {
# the box tags
withTags(
# col
div(
class = "col-md-2",
# Widget: user widget style 1
div(
class = "box",
## Box Header ##
div(
actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x")),
h2(description)
)
)
)
)
}
dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))
output$box1 <- renderUI({
CSRbox("Illinois", "Ill_Link")
})
output$box2 <- renderUI({
CSRbox("North Carolina", "NC_Link")
})
output$box3 <- renderUI({
CSRbox("Indiana", "IN_Link")
})
output$box1a <- renderUI({
CSRbox("Chicago", "CH_Link")
})
output$box1b <- renderUI({
CSRbox("Niles", "NI_Link")
})
output$box1c <- renderUI({
CSRbox("Evanston", "EV_Link")
})
output$box2a <- renderUI({
CSRbox("Charlotte", "CA_Link")
})
output$box2b <- renderUI({
CSRbox("Raleigh", "RL_Link")
})
output$box3a <- renderUI({
CSRbox("West Lafayette", "WL_Link")
})
shinyjs::hide("ILRow")
shinyjs::hide("NCRow")
shinyjs::hide("INRow")
observeEvent(input$Ill_Link, {
shinyjs::toggle("ILRow")
shinyjs::hide("NCRow")
shinyjs::hide("INRow")
})
observeEvent(input$NC_Link, {
shinyjs::toggle("NCRow")
shinyjs::hide("ILRow")
shinyjs::hide("INRow")
})
observeEvent(input$IN_Link, {
shinyjs::toggle("INRow")
shinyjs::hide("ILRow")
shinyjs::hide("NCRow")
})
}
shinyApp(ui, server)
Below is the code of creating the boxes dynamically but the functionality doesn't work (this is where I need help!):
library(shiny)
library(shinydashboard)
library(shinyjs)
#####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
uiOutput("boxLevel1")
),
fluidRow(
div(id = "LevelDetail",
uiOutput("boxLevel2")
)
)
)
ui <- dashboardPage(header, sidebar, body)
#####/SERVER/####
server <- function(input, output) {
CSRbox <- function(description = NULL, linkName = NULL) {
# the box tags
withTags(
# col
div(
class = "col-md-2",
# Widget: user widget style 1
div(
class = "box",
## Box Header ##
div(
actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x")),
h2(description)
)
)
)
)
}
dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))
output$boxLevel1 <- renderUI({
lapply(sort(unique(dat$State)), function(name) {
CSRbox(name, paste0(name,"Link"))
})
})
output$boxLevel2 <- renderUI({
temp <- dat[dat$State == "Illinois",] #Should be based of off the input$Click of the Input Link. Ex: input$Illinois
lapply(sort(unique(temp$City)), function(name) {
CSRbox(name, paste0(name,"Link2"))
})
})
shinyjs::hide("LevelDetail")
observeEvent(input$IllinoisLink, { #Would need to loop through and make an observeEvent for each possible input$click
shinyjs::toggle("LevelDetail")
})
}
shinyApp(ui, server)
UPDATE
I have figured out how to track the input ID's which allows me to create the correct subset of boxes dynamically(woo!). I am still having trouble with the show and hide though. I have figured out how to show the subset of boxes but I can't figure out how to hide since I am using the input ID which doesn't change when pressing on the link twice so the observeEvent doesn't run. I tried to get just the input of the link which would tell me the count of it so I know if it's changed BUT I am getting errors when I use the input[[input$last_btn]] (which should be the same as ex: input$Illinois). Any help is appreciated! I could add another button separately that would do the hide but that is not ideal.
library(shiny)
library(shinydashboard)
library(shinyjs)
#####/UI/####
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
tags$head(tags$script(HTML("$(document).on('click', '.needed', function () {
Shiny.onInputChange('last_btn',this.id);
});"))),
fluidRow(
uiOutput("boxLevel1"),
textOutput("lastButtonCliked")
),
fluidRow(
div(id = "LevelDetail",
uiOutput("boxLevel2")
)
)
)
ui <- dashboardPage(header, sidebar, body)
#####/SERVER/####
server <- function(input, output) {
CSRbox <- function(description = NULL, linkName = NULL) {
# the box tags
withTags(
# col
div(
class = "col-md-2",
# Widget: user widget style 1
div(
class = "box",
## Box Header ##
div(
actionLink(linkName, NULL, icon = icon("plus-square-o", "fa-2x"), class="needed"),
h2(description)
)
)
)
)
}
dat <- data.frame(State = c("Illinois","Illinois","Illinois","North Carolina","North Carolina","Indiana"), City = c("Chicago","Niles","Evanston","Charlotte","Raleigh","West Lafayette"))
output$boxLevel1 <- renderUI({
lapply(sort(unique(dat$State)), function(name) {
CSRbox(name, paste0(name))
})
})
output$boxLevel2 <- renderUI({
temp <- dat[dat$State == input$last_btn,] #Should be based of off the input$Click of the Input Link. Ex: input$Illinois
lapply(sort(unique(temp$City)), function(name) {
CSRbox(name, paste0(name,"Link2"))
})
})
avs <- reactiveValues(
clickN = NA, #new click
clickO = NA, #original click
dataSame = TRUE #data sets are the same
)
observe({
avs$clickN <- input$last_btn
})
shinyjs::hide("LevelDetail")
observeEvent(input$last_btn, {
avs$dataSame <- identical(avs$clickN, avs$clickO)
if(!avs$dataSame) {
shinyjs::show("LevelDetail")
avs$clickO <- avs$clickN
} else {
shinyjs::hide("LevelDetail")
avs$clickO <- NULL
}
})
}
shinyApp(ui, server)