【发布时间】：2022-01-03 19:58:33
【问题描述】：
在下面的模块化闪亮应用程序中，当我点击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)
【问题讨论】：
标签： r shiny module box shinyjs