R Shiny,Leaflet-> SelectInput在下拉菜单中更改选择的问题

用户名

我是R Shiny的新用户,我正在尝试确定从始发机场可以飞往的所有目的地。

当我将国家/地区硬编码到代码中时,我已经成功创建了显示国家/地区所有机场的地图(以意大利为例)。

我想要做的是有一个“ selectinput”,它允许用户选择一个国家,所有相应的机场都将显示在地图上。

这是我的代码:

#----------Loading my data----------#
#Dataset 1: Routes
routes=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/routes.dat"))


#Dataset #2: Airports
airports=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports-extended.dat"))


#Give Better Names to Columns

colnames(routes)=c("Airline","AirlineID","IATA","SourceAP_ID","DestinationAirport","DestAP_ID","Codeshare","Stops","Equipment")

colnames(airports)=c("AirportID","Name","City","Country","IATA","ICAO","Latitude","Longitude","Altitude","Timezone","DST","TzDatabaseTz","Type","Source")

#Join datasets on Source Airport

fullair=merge(x=routes,y=airports,by="IATA",all.x=TRUE)


#----------Preprocessing Data---------#
fullair2=subset(fullair,fullair$Type=="airport")

fullair2$UniqueID=paste0(fullair2$IATA,"_",fullair2$DestinationAirport)

library(dplyr)
  group_by(IATA) %>%
  mutate(Count=n_distinct(UniqueID)) %>%
  ungroup()
fullair3=as.data.frame(fullair3)


fullair3=fullair3[!duplicated(fullair3[c("UniqueID")]),]

library(rowr)
library(sqldf)
library(RSQLite)



library(stringi)
fullair3$Region=stri_extract(fullair3$TzDatabaseTz, regex='[^/]*')

SpitOutNum=sqldf("select IATA,count(*)
                      from fullair3
                      group by IATA")
SpitOutNum=as.data.frame(SpitOutNum3)
colnames(SpitOutNum)=c("IATA","DestinationCount")
fullair3=merge(x=fullair3,y=SpitOutNum,by="IATA",all.x=TRUE)

#Create the full name
fullair3$NamePart1=paste("(",fullair3$IATA,")",sep ="")
fullair3$FullName=paste(fullair3$Name, fullair3$NamePart1)
fullair3$NamePart1=NULL


#Make destination specific columns like long and lat
SpitOutNum2=sqldf("select IATA, City, Country, Region, Name, DestinationCount, Longitude, 
Latitude
               from fullair3
               group by IATA,City, Country, Region, Name")
colnames(SpitOutNum2)=c("DestinationAirport","DestCity","DestCountry","DestRegion","DestAirportName","DestCount","DestLong","DestLat")
fullair3=merge(x=fullair3,y=SpitOutNum2,by="DestinationAirport",all.x=TRUE)


 #--------------------R Shiny App-------------------#


library(shinydashboard)
library(shiny)
library(leaflet)
library(leaflet.extras)
library(rgdal)
library(sp)
library(raster)

airportchoices=unique(fullair3$FullName)
countrychoices=unique(fullair3$Country)
regionchoices=unique(fullair3$Region)
Italy=subset(fullair3,fullair3$Country=="Italy")


# Define UI for application
ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title="Airport Data"),
dashboardSidebar(
  sidebarMenu(
    menuItem(
      "Maps",
      tabName = "maps",
      icon=icon("globe")
    )
  )
),
dashboardBody(
  tabItems(
    tabItem(
      tabName = "maps",
      tags$style(type="text/css","#all_airports {height:calc(100vh - 80px) !important;}"),
      leafletOutput("all_airports"),
      selectInput(inputId = "countryselect",label="Select a country:",choices=countrychoices)

    )
  )
)
  )
)

 # Define server logic 
server <- function(input, output) {


  AirportData=reactive({
    filteredData=subset(fullair3,Country == input$countryselect)
    return(filteredData)
  })


  output$all_airports=renderLeaflet({

    data=AirportData()

    pal=colorNumeric("Reds",Italy$DestinationCount)


    leaflet(data=Italy) %>% 
      addTiles(group="OpenStreetMap")  %>%


         addCircles(radius = ~Italy$DestinationCount*250, 
             weight = 1, 
             color = "black", 
             fillColor = ~pal(Italy$DestinationCount),
             fillOpacity = 0.7,
             popup = paste0("Airport Name: ", Italy$Name, "<br>",
                            "City: ", Italy$City, "<br>",
                            "Destination Count: ",Italy$DestinationCount,"<br>"
                            ),
             label = ~as.character(Italy$IATA),
             group = "Points") #%>%



      #addMarkers(lng = ~Longitude,lat = ~Latitude, 
       #           popup=~as.character(DestinationCount), 
       #          label=~as.character(DestinationCount), 
       #          group = "Markers")
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

这是我的问题:

我不确定如何获取selectInput下拉菜单以显示在我的地图上,然后将其选择连接到地图。

我将如何更改上面的代码来做到这一点?

任何帮助,将不胜感激!

罗弗先生

您已经完成了所有必要的工作。只需将所有硬编码的意大利替换为数据,即可将机场数据的子集替换为用户选择的国家/地区。我也考虑将其移动selectInput到仪表板的顶部,因为很难从底部滚动它,并且用户可能看不到它。我将其放在顶部居中,以避免下拉选项被放大控件覆盖。

更新的代码:

#----------Loading my data----------#
#Dataset 1: Routes
routes=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/routes.dat"))


#Dataset #2: Airports
airports=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports-extended.dat"))


#Give Better Names to Columns

colnames(routes)=c("Airline","AirlineID","IATA","SourceAP_ID","DestinationAirport","DestAP_ID","Codeshare","Stops","Equipment")

colnames(airports)=c("AirportID","Name","City","Country","IATA","ICAO","Latitude","Longitude","Altitude","Timezone","DST","TzDatabaseTz","Type","Source")

#Join datasets on Source Airport

fullair=merge(x=routes,y=airports,by="IATA",all.x=TRUE)


#----------Preprocessing Data---------#
fullair2=subset(fullair,fullair$Type=="airport")

fullair2$UniqueID=paste0(fullair2$IATA,"_",fullair2$DestinationAirport)

library(dplyr)

fullair3 = fullair2 %>%
  group_by(IATA) %>%
  mutate(Count=n_distinct(UniqueID)) %>%
  ungroup()

fullair3=as.data.frame(fullair3)


fullair3=fullair3[!duplicated(fullair3[c("UniqueID")]),]

library(rowr)
library(sqldf)
library(RSQLite)



library(stringi)
fullair3$Region=stri_extract(fullair3$TzDatabaseTz, regex='[^/]*')

SpitOutNum=sqldf("select IATA,count(*)
                      from fullair3
                      group by IATA")

# SpitOutNum=as.data.frame(SpitOutNum3)

colnames(SpitOutNum)=c("IATA","DestinationCount")
fullair3=merge(x=fullair3,y=SpitOutNum,by="IATA",all.x=TRUE)

#Create the full name
fullair3$NamePart1=paste("(",fullair3$IATA,")",sep ="")
fullair3$FullName=paste(fullair3$Name, fullair3$NamePart1)
fullair3$NamePart1=NULL


#Make destination specific columns like long and lat
SpitOutNum2=sqldf("select IATA, City, Country, Region, Name, DestinationCount, Longitude, 
Latitude
               from fullair3
               group by IATA,City, Country, Region, Name")
colnames(SpitOutNum2)=c("DestinationAirport","DestCity","DestCountry","DestRegion","DestAirportName","DestCount","DestLong","DestLat")
fullair3=merge(x=fullair3,y=SpitOutNum2,by="DestinationAirport",all.x=TRUE)


#--------------------R Shiny App-------------------#


library(shinydashboard)
library(shiny)
library(leaflet)
library(leaflet.extras)
library(rgdal)
library(sp)
library(raster)

airportchoices=unique(fullair3$FullName)
countrychoices=unique(fullair3$Country)
regionchoices=unique(fullair3$Region)
Italy=subset(fullair3,fullair3$Country=="Italy")

countrychoices <- as.character(countrychoices)
countrychoices <- sort(countrychoices)

# Define UI for application
ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title="Airport Data"),
    dashboardSidebar(
      sidebarMenu(
        menuItem(
          "Maps",
          tabName = "maps",
          icon=icon("globe")
        )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "maps",
          tags$style(type="text/css","#all_airports {height:calc(100vh - 80px) !important;}"),

          fluidRow(column(4),
                   column(8,
                          selectInput(inputId = "countryselect",label="Select a country:",choices=countrychoices, selected = "France")
                          )),

          leafletOutput("all_airports")

        )
      )
    )
  )
)

# Define server logic 
server <- function(input, output) {


  AirportData=reactive({
    filteredData=subset(fullair3,Country == input$countryselect)
    return(filteredData)
  })


  output$all_airports=renderLeaflet({

    data=AirportData()

    pal=colorNumeric("Reds",data$DestinationCount)


    leaflet(data=data) %>% 
      addTiles(group="OpenStreetMap")  %>%


      addCircles(radius = ~data$DestinationCount*250, 
                 weight = 1, 
                 color = "black", 
                 fillColor = ~pal(data$DestinationCount),
                 fillOpacity = 0.7,
                 popup = paste0("Airport Name: ", data$Name, "<br>",
                                "City: ", data$City, "<br>",
                                "Destination Count: ",data$DestinationCount,"<br>"
                 ),
                 label = ~as.character(data$IATA),
                 group = "Points") #%>%



    #addMarkers(lng = ~Longitude,lat = ~Latitude, 
    #           popup=~as.character(DestinationCount), 
    #          label=~as.character(DestinationCount), 
    #          group = "Markers")
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

在此处输入图片说明

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章

如何在浏览器中的 R Shiny 中更改 Leaflet 中的光标

通过Shiny / Leaflet / R中的缩放级别更改标记聚类

在R Shiny中的Leaflet中创建具有自定义绝对位置的图例

在R Shiny应用程序中检测Leaflet中的左键或右键单击

带有 Shiny 的 R Leaflet 中的图标未加载(空图像)

如何基于R Shiny中的Leaflet映射的输入来过滤数据表?

Leaflet Marketr Cluster 在 Shiny 中无法与 Echarts4r 一起使用

R Shiny Leaflet javascript插件-热图

R Shiny Leaflet弹出窗口中的includeHTML

R Shiny Leaflet Selector 用于显示 shapefile

在R Shiny中更改selectInput的背景颜色

R Shiny:同一下拉菜单中的右对齐和左对齐

在使用 Shiny/R 中的下拉菜单过滤的数据集上执行代码

更改选择输入选项的字体颜色 R Shiny

如何在下拉菜单中更改选择列表项目的字体

如何让 Shiny selectInput 下拉菜单在多个数据帧之间进行选择

R Shiny openxlsx:上传的 xlsx 文件 - 从下拉菜单中选择一个工作表

R Shiny中的动态selectInput

R Shiny with leaflet:单击图标创建模式窗口

R Leaflet Shiny:shape_click $ id为NULL

R Shiny Leaflet Server 不会改变地图输出

更新R Shiny中动态创建的selectInput框的选择

R Shiny-如何在selectInput中显示选择标签

R,Shiny:内联selectInput

R Shiny:计算“selectInput”选择的新变量

在 Shiny/Leaflet 中选择和取消选择多段线

R Shiny:使用传单地图单击更新多个相关下拉菜单

使用R和Shiny的带有子类别的下拉菜单

R Shiny 中的 selectInput 未正确更新