Saya pengguna R Shiny baru dan saya mencoba memetakan semua tujuan yang dapat diterbangi dari bandara asal.

Saya telah berhasil membuat peta yang menampilkan semua bandara suatu negara ketika saya mengkodekan negara tersebut ke dalam kode saya (saya telah menggunakan Italia sebagai contoh).

Yang ingin saya lakukan adalah memiliki "selectinput" yang memungkinkan pengguna memilih negara dan semua bandara terkait akan muncul di peta.

Ini kode saya:

#----------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)

Ini adalah masalah saya:

Saya tidak yakin bagaimana membuat menu tarik-turun selectInput muncul di peta saya dan kemudian menghubungkan pilihannya ke peta.

Bagaimana saya mengubah kode di atas untuk melakukan itu?

Bantuan apa pun akan dihargai!

1
user2813606 19 April 2020, 18:12

1 menjawab

Jawaban Terbaik

Anda telah melakukan semua pekerjaan yang diperlukan. Ganti saja semua kode keras Italia ke data, yang akan memiliki subset data bandara dengan negara yang dipilih pengguna. Saya juga mempertimbangkan untuk memindahkan selectInput ke atas dasbor karena sulit untuk menggulir dari bawah dan pengguna mungkin tidak melihatnya. Saya telah menempatkannya di tengah atas untuk menghindari opsi dropdown yang dicakup oleh kontrol zoom in.

Kode yang diperbarui:

#----------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)

enter image description here

1
Mr.Rlover 19 April 2020, 18:04