Show and hide text in modularized shiny app based on actionButton() and shinyJS()

0

Issue

In the modularized shiny app below Im trying to display a message when the app is loaded for first time and then when I click the actionButton() this message is being hidden using shinyJs() and the plots are displayed. But the message is not displayed from the beginning.

library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)
library(plotly)
# Some data
data<-structure(list(scientificName = c("Turdus merula Linnaeus, 1758", 
                                        "Passer domesticus (Linnaeus, 1758)", "Cantharellus cinereus (Pers.) Fr.", 
                                        "Flammulina fennae Bas", "Mycena crocata (Schrad.) P.Kumm.", 
                                        "Lepista luscina (Fr.) Singer", "Mycena permixta (Britzelm.) Sacc.", 
                                        "Rhodophyllus byssisedus (Pers.) Quel.", "Rhodophyllus porphyrophaeus (Fr.) J.E.Lange", 
                                        "Panaeolus rickenii Hora"), decimalLatitude = c(52.204429, 51.387818, 
                                                                                        52.176667, 50.066111, 49.179167, 49.419444, 52.3, 52.3, 49.419444, 
                                                                                        49.179167), decimalLongitude = c(21.189275, 19.62673, 19.088056, 
                                                                                                                         19.502778, 22.434722, 20.380556, 20.566667, 20.566667, 20.380556, 
                                                                                                                         22.434722)), row.names = c(1L, 2L, 32L, 35L, 37L, 38L, 39L, 40L, 
                                                                                                                                                    41L, 42L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
                                                                                                                                                    ))
data$year<-c(1990,1989,2003,1990,1980,1990,1989,2003,1990,1980)
# Define the side panel UI and server
sideUI <- function(id) {
  ns <- NS(id)
  tagList(
    
    uiOutput(ns("ye")),
    uiOutput(ns("scient")),
    actionButton(ns("action"),"Submit")
  )
  
}

sideServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      
      # define a reactive and return it
      react<-eventReactive(input$action,{
        
        omited <-subset(data, data$scientificName %in% isolate(input$sci)&data$year %in% isolate(input$yea))
      })
      
      output$ye<-renderUI({
        pickerInput(
          inputId = session$ns("yea"),
          label = "Year", 
          choices = sort(unique(data$year),decreasing=F),
          selected = unique(data$year),
          multiple = T
          
        )
      })
      
      output$scient<-renderUI({
        data <-subset(data, data$year %in% input$yea)
        
        pickerInput(
          inputId = session$ns("sci"),
          label = "Scientific name", 
          choices = unique(data$scientificName),
          selected = unique(data$scientificName)[1], 
          
        )
      })
      
      counted<-eventReactive(input$action,{isolate(react()) %>% 
          group_by(year) %>% 
          summarise(count=isolate(n())
          )
        
      })
      return(list(react = react, counted = counted, sci = reactive(input$sci),yea=reactive(input$yea)))
    })
}
# In this case this server not needed but using uiOuput/renderUI in real case
# sideServer <- function(id) { moduleServer(id,function(input, output, session) { })}

# Define the UI and server functions for the map
mapUI <- function(id) {
  ns <- NS(id)
  tagList(
    leafletOutput(ns("map"))
  )
}

mapServer <- function(id, city) {
  moduleServer(
    id,
    function(input, output, session) {
      output$map<-renderLeaflet({
        
        leaflet(data = city()) %>% addTiles() %>%
          addMarkers(~decimalLatitude, ~decimalLongitude, popup = ~as.character(scientificName), label = ~as.character(scientificName))
      })
    })
}

plotUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    plotlyOutput(ns("plot"))
  )
}
textUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    verbatimTextOutput(ns("help_text"))
  )
}
plotServer <- function(id, city, sci,yea) {
  moduleServer(
    id,
    function(input, output, session) {
      output$plot<-renderPlotly({
        
        fig <- plot_ly(data=city(), x = ~as.factor(year), y = ~count, type = 'scatter', mode = 'markers+lines')
        
        fig%>% layout(title = paste("Count of", sci(),"through the years"),
                      xaxis = list(title = "Years",tickangle=45),
                      yaxis = list (title = "Count"))
      })
    })
}
textServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      output$help_text <- renderUI({
        HTML("<b>Click 'Show plot' to show the plot.</b>")
      })
      
      
      observeEvent(input$action,{
        hide("help_text")
      })
    })
  
    
}
# Build ui & server and then run
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sideUI("side")),
  dashboardBody(useShinyjs(),mapUI("mapUK"), plotUI("plotPl"))
)
server <- function(input, output, session) {
  
  # use the reactive in another module
  city_input <- sideServer("side")
  textServer("textPL")
  mapServer("mapUK", city_input$react)
  plotServer("plotPl", city_input$counted, sci = city_input$sci,yea=city_input$yea)
  
}
shinyApp(ui, server)    

Solution

Three things are wrong:

  • you use renderUI() but you have verbatimTextOutput in the UI part. You need to use uiOutput() instead
  • you forgot to call textUI("textPL") in the UI part
  • you want to hide the text when input$action is clicked, but this input is defined in another module. Therefore it has a different namespace and clicking it doesn’t trigger hide(). You need to pass the "click" through modules. There’s a similar post about that here.

Next time, you should also provide a minimal example, there is a lot of code that is irrelevant to the problem here.

Here’s the working code:

library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)
library(plotly)
# Some data
data<-structure(list(scientificName = c("Turdus merula Linnaeus, 1758", 
                                        "Passer domesticus (Linnaeus, 1758)", "Cantharellus cinereus (Pers.) Fr.", 
                                        "Flammulina fennae Bas", "Mycena crocata (Schrad.) P.Kumm.", 
                                        "Lepista luscina (Fr.) Singer", "Mycena permixta (Britzelm.) Sacc.", 
                                        "Rhodophyllus byssisedus (Pers.) Quel.", "Rhodophyllus porphyrophaeus (Fr.) J.E.Lange", 
                                        "Panaeolus rickenii Hora"), decimalLatitude = c(52.204429, 51.387818, 
                                                                                        52.176667, 50.066111, 49.179167, 49.419444, 52.3, 52.3, 49.419444, 
                                                                                        49.179167), decimalLongitude = c(21.189275, 19.62673, 19.088056, 
                                                                                                                         19.502778, 22.434722, 20.380556, 20.566667, 20.566667, 20.380556, 
                                                                                                                         22.434722)), row.names = c(1L, 2L, 32L, 35L, 37L, 38L, 39L, 40L, 
                                                                                                                                                    41L, 42L), class = c("spec_tbl_df", "tbl_df", "tbl", "data.frame"
                                                                                                                                                    ))
data$year<-c(1990,1989,2003,1990,1980,1990,1989,2003,1990,1980)
# Define the side panel UI and server
sideUI <- function(id) {
  ns <- NS(id)
  tagList(
    
    uiOutput(ns("ye")),
    uiOutput(ns("scient")),
    actionButton(ns("action"),"Submit")
  )
  
}

sideServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      
      # define a reactive and return it
      react<-eventReactive(input$action,{
        
        omited <-subset(data, data$scientificName %in% isolate(input$sci)&data$year %in% isolate(input$yea))
      })
      
      output$ye<-renderUI({
        pickerInput(
          inputId = session$ns("yea"),
          label = "Year", 
          choices = sort(unique(data$year),decreasing=F),
          selected = unique(data$year),
          multiple = T
          
        )
      })
      
      output$scient<-renderUI({
        data <-subset(data, data$year %in% input$yea)
        
        pickerInput(
          inputId = session$ns("sci"),
          label = "Scientific name", 
          choices = unique(data$scientificName),
          selected = unique(data$scientificName)[1], 
          
        )
      })
      
      counted<-eventReactive(input$action,{isolate(react()) %>% 
          group_by(year) %>% 
          summarise(count=isolate(n())
          )
        
      })
      return(list(react = react, counted = counted, sci = reactive(input$sci),yea=reactive(input$yea), btn = reactive(input$action)))
    })
}
# In this case this server not needed but using uiOuput/renderUI in real case
# sideServer <- function(id) { moduleServer(id,function(input, output, session) { })}

# Define the UI and server functions for the map
mapUI <- function(id) {
  ns <- NS(id)
  tagList(
    leafletOutput(ns("map"))
  )
}

mapServer <- function(id, city) {
  moduleServer(
    id,
    function(input, output, session) {
      output$map<-renderLeaflet({
        
        leaflet(data = city()) %>% addTiles() %>%
          addMarkers(~decimalLatitude, ~decimalLongitude, popup = ~as.character(scientificName), label = ~as.character(scientificName))
      })
    })
}

plotUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    plotlyOutput(ns("plot"))
  )
}
textUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    uiOutput(ns("help_text"))
  )
}
plotServer <- function(id, city, sci,yea) {
  moduleServer(
    id,
    function(input, output, session) {
      output$plot<-renderPlotly({
        
        fig <- plot_ly(data=city(), x = ~as.factor(year), y = ~count, type = 'scatter', mode = 'markers+lines')
        
        fig%>% layout(title = paste("Count of", sci(),"through the years"),
                      xaxis = list(title = "Years",tickangle=45),
                      yaxis = list (title = "Count"))
      })
    })
}
textServer <- function(id, btn) {
  moduleServer(
    id,
    function(input, output, session) {
      output$help_text <- renderUI({
        HTML("<b>Click 'Show plot' to show the plot.</b>")
      })
      
      
      observeEvent(btn(),{
        hide("help_text")
      })
    })
  
  
}
# Build ui & server and then run
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sideUI("side")),
  dashboardBody(useShinyjs(),textUI("textPL"), mapUI("mapUK"), plotUI("plotPl"))
)
server <- function(input, output, session) {
  
  # use the reactive in another module
  city_input <- sideServer("side")
  textServer("textPL", btn = city_input$btn)
  mapServer("mapUK", city_input$react)
  plotServer("plotPl", city_input$counted, sci = city_input$sci,yea=city_input$yea)
  
}
shinyApp(ui, server)    

Answered By – bretauv

This Answer collected from stackoverflow, is licensed under cc by-sa 2.5 , cc by-sa 3.0 and cc by-sa 4.0

Leave A Reply

Your email address will not be published.

This website uses cookies to improve your experience. We'll assume you're ok with this, but you can opt-out if you wish. Accept Read More