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)
CodePudding user response:
Three things are wrong:
- you use
renderUI()but you haveverbatimTextOutputin the UI part. You need to useuiOutput()instead - you forgot to call
textUI("textPL")in the UI part - you want to hide the text when
input$actionis clicked, but this input is defined in another module. Therefore it has a different namespace and clicking it doesn't triggerhide(). 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)
