如何在一个闪亮的应用程序

时间:2018-02-23 02:57:45

标签: events shiny leaflet r-leaflet

您好我正在创建一个环保闪亮的应用程序,我想在其中使用传单地图基于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()和2 dateInput()。 2 dateInput()应分别作为df$firstUpdateddf$lastUpdated的输入。然后selectInput()应该将df中存在的污染物作为输入,基于&#34; TRUE&#34; /&#34; FALSE&#34;值。然后应该创建图表。所有这些都应该通过点击地图来触发。

到目前为止,我无法实现此目的,以便帮助您了解我已将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) 第一个标签中的位置,因为当我找到解决方案时,我不需要这样做。

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")
     })         

我认为应该应用输入$ MAPID_click的代码部分是:

select substring(vlv3, 1, charindex('"', vlv3)-1) as vlv4
from (
    select substring(vlv2, charindex('"', vlv2)+1, len(vlv2)) as vlv3
    from (
        select substring(vlv, charindex('"primary_identity_file"', vlv)+23, len(vlv)) as vlv2
        from test
    ) as test2
) as test3

1 个答案:

答案 0 :(得分:4)

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

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)