如何在闪亮的应用程序中将传单地图点击（事件）与绘图创建联系起来

Question

您好，我正在创建一个环境闪亮的应用程序，我想在其中使用传单地图创建一些基于 openair 包的简单图（https://rpubs.com/NateByers/Openair）。

Aq_measurements() 一般形式

AQ<- (aq_measurements(country = “country”, city = “city”, location = “location”, parameter = “pollutant choice”, date_from = “YYYdateY-MM-DD”, date_to = “YYYY-MM-DD”)。

位置数据框中所有可用的参数。

worldmet() 一般形式

met <- importNOAA(code = "12345-12345", year = YYYYY:YYYY)

位置数据帧中可用的 NOAA 代码

下面我创建了一个初始数据框的示例：

location = c("100 ail","16th and Whitmore","40AB01 - ANTWERPEN") 
lastUpdated = c("2018-02-01 09:30:00", "2018-02-01 03:00:00", "2017-03-07 10:00:00") 
firstUpdated = c("2015-09-01 00:00:00","2016-03-06 19:00:00","2016-11-22 15:00:00")
pm25=c("FALSE","FALSE","FALSE")
pm10=c("TRUE","FALSE","FALSE")
no2=c("TRUE","FALSE","FALSE")
latitude=c(47.932907,41.322470,36.809700)
longitude=c(106.92139000,-95.93799000
,-107.65170000)

df = data.frame(location, lastUpdated, firstUpdated,latitude,longitude,pm25,pm10,no2)

一般来说，我希望能够根据此数据框点击地图中的某个位置。然后我有一个selectInput() 和两个dateInput()。 2 dateInput() 应分别将 df$firstUpdated 和 df$lastUpdated 作为输入。然后selectInput() 应根据“TRUE”/“FALSE”值将df 中存在的污染物作为输入。然后应该创建图。所有这些都应该通过点击地图来触发。

到目前为止，我无法做到这一点，因此为了帮助您了解我将selectInput() 和dateInput() 与input$loc 连接起来，selectIpnut() 的位置在第一个选项卡中，我将当我找到解决方案时不需要这个。

library(shiny)
library(leaflet)
library(plotly)
library(shinythemes)
library(htmltools)
library(DT)
library(utilr)
library(openair)
library(plotly)
library(dplyr)
library(ggplot2)
library(gissr)
library(ropenaq)
library(worldmet)

# Define UI for application that draws a histogram
   ui = navbarPage("ROPENAQ",
           tabPanel("CREATE DATAFRAME",
                    sidebarLayout(

                      # Sidebar panel for inputs ----
                      sidebarPanel(
                        wellPanel(
                          uiOutput("loc"),
                          helpText("Choose a Location to create the dataframe.")
                        )
                        ),
                      mainPanel(

                      )
                    )
           ),
           tabPanel("LEAFLET MAP",
                    leafletOutput("map"),
                    wellPanel(
                      uiOutput("dt"),
                      uiOutput("dt2"),
                      helpText("Choose a start and end date for the dataframe creation. Select up to 2 dates")
                    ),
                    "Select your Pollutant",
                    uiOutput("pollutant"),                     

                    helpText("While all pollutants are listed here, not all pollutants are measured at all locations and all times.  
                             Results may not be available; this will be corrected in further revisions of the app.  Please refer to the measurement availability 
                             in the 'popup' on the map."),

                    hr(),
                    fluidRow(column(8, plotOutput("tim")),
                             column(4,plotOutput("polv"))),
                    hr(),

                    fluidRow(column(4, plotOutput("win")),
                             column(8,plotOutput("cal"))),
                    hr(),
                    fluidRow(column(12, plotOutput("ser"))
                             )
           )


)

#server.r

# load data
# veh_data_full <- readRDS("veh_data_full.RDS")
# veh_data_time_var_type <- readRDS("veh_data_time_var_type.RDS")
df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {

    output$pollutant<-renderUI({
      selectInput("pollutant", label = h4("Choose Pollutant"), 
                  choices = colnames(df[,6:8]), 
                  selected = 1)
    })


    #Stores the value of the pollutant selection to pass to openAQ request      

    ###################################
   #output$OALpollutant <- renderUI({OALpollutant})


    ##################################
    # create the map, using dataframe 'locations' which is polled daily (using ropenaq)
    #MOD TO CONSIDER: addd all available measurements to the popup - true/false for each pollutant, and dates of operation.


    output$map <- renderLeaflet({
      leaflet(subset(df,(df[,input$pollutant]=="TRUE")))%>% addTiles() %>%
        addMarkers(lng = subset(df,(df[,input$pollutant]=="TRUE"))$longitude, lat = subset(df,(df[,input$pollutant]=="TRUE"))$latitude,
                   popup = paste("Location:", subset(df,(df[,input$pollutant]=="TRUE"))$location, "<br>",
                                 "Pollutant:", input$pollutant, "<br>",
                                 "First Update:", subset(df,(df[,input$pollutant]=="TRUE"))$firstUpdated, "<br>",
                                 "Last Update:", subset(df,(df[,input$pollutant]=="TRUE"))$lastUpdated
                                 ))
    })
    #Process Tab
   OAL_site <- reactive({
        req(input$map_marker_click)
        location %>%
            filter(latitude == input$map_marker_click$lat,
                   longitude == input$map_marker_click$lng)

###########
        #call Functions for data retrieval and processing.  Might be best to put all data request
        #functions into a seperate single function.  Need to:
        # call importNOAA() to retrieve meteorology data into temporary data frame
        # call aq_measurements() to retrieve air quality into a temporary data frame
        # merge meteorology and air quality datasets into one working dataset for computations; temporary
        # meteorology and air quality datasets to be removed.
        # call openAir() functions to create plots from merged file.  Pass output to a dashboard to assemble 
        # into appealing output.
        # produce output, either as direct download, or as an emailable PDF.
        # delete all temporary files and reset for next run.
    })
   #fun 

   output$loc<-renderUI({
     selectInput("loc", label = h4("Choose location"),
                 choices = df$location ,selected = 1
     )
   })

   output$dt<-renderUI({

                 dateInput('date',
                           label = 'First Available Date',
                           value = subset(df$firstUpdated,(df[,1]==input$loc))
                 )           


   })
   output$dt2<-renderUI({

                 dateInput('date2',
                           label = 'Last available Date',
                           value = subset(df$lastUpdated,(df[,1]==input$loc))
                 )            


   })

   rt<-reactive({


     AQ<- aq_measurements(location = input$loc, date_from = input$dt,date_to = input$dt2,parameter = input$pollutant)
     met <- importNOAA(year = 2014:2018)
     colnames(AQ)[9] <- "date"
     merged<-merge(AQ, met, by="date")
     # date output -- reports user-selected state & stop dates in UI
     merged$location <- gsub( " " , "+" , merged$location)

     merged


   })
   #DT  

     output$tim = renderPlot({
       timeVariation(rt(), pollutant = "value")
     })


}

shinyApp(ui = ui, server = server)

我认为应该应用 input$MAPID_click 的代码部分是：

output$map <- renderLeaflet({
      leaflet(subset(locations,(locations[,input$pollutant]=="TRUE")))%>% addTiles() %>%
        addMarkers(lng = subset(locations,(locations[,input$pollutant]=="TRUE"))$longitude, lat = subset(locations,(locations[,input$pollutant]=="TRUE"))$latitude,
                   popup = paste("Location:", subset(locations,(locations[,input$pollutant]=="TRUE"))$location, "<br>",
                                 "Pollutant:", input$pollutant, "<br>",
                                 "First Update:", subset(locations,(locations[,input$pollutant]=="TRUE"))$firstUpdated, "<br>",
                                 "Last Update:", subset(locations,(locations[,input$pollutant]=="TRUE"))$lastUpdated
                   ))
    })  

  output$dt<-renderUI({

                 dateInput('date',
                           label = 'First Available Date',
                           value = subset(locations$firstUpdated,(locations[,1]==input$loc))
                 )           


   })
   output$dt2<-renderUI({

                 dateInput('date2',
                           label = 'Last available Date',
                           value = subset(locations$lastUpdated,(locations[,1]==input$loc))
                 )            


   })


   rt<-reactive({



     AQ<- aq_measurements(location = input$loc, date_from = input$dt,date_to = input$dt2)
     met <- importNOAA(year = 2014:2018)
     colnames(AQ)[9] <- "date"
     merged<-merge(AQ, met, by="date")
     # date output -- reports user-selected state & stop dates in UI
     merged$location <- gsub( " " , "+" , merged$location)

     merged


   })
   #DT  










     output$tim = renderPlot({
       timeVariation(rt(), pollutant = "value")
     })         

Answer 1

这是一个最小的例子。你点击你的标记，你会得到一个情节。

ui = fluidPage(
  leafletOutput("map"),
  textOutput("temp"),
  plotOutput('tim')
)

#server.r

#df$location <- gsub( " " , "+" , df$location)
server = function(input, output, session) {


  output$map <- renderLeaflet({
    leaflet(df)%>% addTiles() %>% addMarkers(lng = longitude, lat = latitude)
  })

  output$temp <- renderPrint({

    input$map_marker_click$lng
  })

  output$tim <- renderPlot({
    temp <- df %>% filter(longitude == input$map_marker_click$lng)
   # timeVariation(temp, pollutant = "value")
    print(ggplot(data = temp, aes(longitude, latitude)) + geom_point())
  })


}

shinyApp(ui = ui, server = server)