创建一个闪亮的模块，在闪亮的应用程序中创建传单地图

Question

我有下面这个简单闪亮的应用程序，我在其中创建了传单地图。我想创建一个闪亮的模块，虽然它会专门创建传单地图。

    ## app.R ##
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)

# 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"
                                                                                                                                                    ))
# Define the side panel UI and server
sideUI <- function(id) {
  ns <- NS(id)
  pickerInput(
    inputId = ns("sci"),
    label = "Scientific name", 
    choices = unique(data$scientificName),
    selected = unique(data$scientificName)[1] 
    
  )
  actionButton("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))
      })
      return(react)
      
    })
}
# 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)
  leafletOutput(ns("map"))
}

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

# Build ui & server and then run
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sideUI("side")),
  dashboardBody(mapUI("mapUK"))
)
server <- function(input, output, session) {
  
  # use the reactive in another module
  city_input <- sideServer("side")
  mapServer("mapUK", city_input)
  
}
shinyApp(ui, server)

Answer 1

你犯了一些错误。

下面是没有这些错误的代码：

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(leaflet)
library(dplyr)

# 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"
                                                                                                                                                    ))
# Define the side panel UI and server
sideUI <- function(id) {
  ns <- NS(id)
  tagList(
    pickerInput(
      inputId = ns("sci"),
      label = "Scientific name", 
      choices = unique(data$scientificName),
      selected = unique(data$scientificName)[1] 
      
    ),
    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))
      })
      
      return(react)
      
    })
}
# 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))
      })
    })
}

# Build ui & server and then run
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sideUI("side")),
  dashboardBody(mapUI("mapUK"))
)
server <- function(input, output, session) {
  
  # use the reactive in another module
  city_input <- sideServer("side")
  mapServer("mapUK", city_input)
  
}
shinyApp(ui, server)

始终在模块中的 UI 中使用 tagList()。有时它可以在没有它的情况下工作，但通常不会。
在这一行中：actionButton(ns("action"),"Submit") 你错过了 ns()。
在这一行中：leaflet(data = city()) %>% addTiles() %>% 您使用了 react() 而不是 city()。这是错误的，因为你的函数中没有参数react，而是city，所以你必须引用city。这与普通函数中的相同，即您需要引用函数中的参数才能使用传递给该函数的参数。

创建一个闪亮的模块，在闪亮的应用程序中创建传单地图

Create a shiny module that creates a leaflet map in shiny app

module

r

leaflet

shiny