在模块化闪亮应用程序中点击 actionButton() 后显示带有绘图的框

Question

在下面的模块化闪亮应用程序中，当我点击 actionButton() 时，我试图同时显示绘图及其框。虽然当我尝试对框执行相同的逻辑时它正在为情节工作，但两者都没有显示。

library(shiny)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
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) { })}




plotUI <- function(id) {
  ns <- NS(id)
  
  tagList(
    shinyjs::hidden(
      div(
        id = "hiddenbox", 
        
        box(
          title = h3("Incidents Map", style = 'font-size:20px;color:black;
                     font-family: "Georgia", Times, "Times New Roman", serif;'), 
          status = "primary", 
          solidHeader = TRUE,
          collapsible = TRUE,
    plotlyOutput(ns("plot"))
        )))
  )
}

plotServer <- function(id, city, sci,yea,btn) {
  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", isolate(sci()),"through the years"),
                      xaxis = list(title = "Years",tickangle=45),
                      yaxis = list (title = "Count"))
      })
      # ----show hiddenbox----
      observeEvent(btn(), {
        shinyjs::show(id = "hiddenbox")
      })
    })
}

# Build ui & server and then run
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sideUI("side")),
  dashboardBody(useShinyjs(), plotUI("plotPl"))
)
server <- function(input, output, session) {
  
  # use the reactive in another module
  city_input <- sideServer("side")
  plotServer("plotPl", city_input$counted, sci = city_input$sci,yea=city_input$yea,btn = city_input$btn)
  
}
shinyApp(ui, server)

Answer 1

id = ns("hiddenbox")

就是答案

在模块化闪亮应用程序中点击 actionButton() 后显示带有绘图的框

Display box with plot after hitting actionButton() in modularized shiny app

module

r

shiny

box

shinyjs