在下面的模塊化閃亮應用程式中，我試圖在第一次加載應用程式時顯示一條訊息，然后當我單擊actionButton()該訊息時，該訊息正在被隱藏shinyJs()并顯示圖。但該訊息并未從一開始就顯示出來。
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)
uj5u.com熱心網友回復：
錯了三點：
- 你使用，
renderUI()但你verbatimTextOutput在 UI 部分。你需要uiOutput()改用 - 你忘了
textUI("textPL")在 UI 部分呼叫 - 您想在
input$action單擊時隱藏文本，但此輸入是在另一個模塊中定義的。因此它有一個不同的命名空間，點擊它不會觸發hide(). 您需要通過模塊傳遞“點擊”。有一個類似的帖子關于這里。
下一次，你也應該提供一個最小的例子，這里有很多與問題無關的代碼。
這是作業代碼：
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)
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/403226.html
標籤：
上一篇：每個變數有多個列的分組頻率表