R Shiny --> 忽略 AddCircles 函数中的 FillOpacity 参数
R Shiny --> FillOpacity Argument in AddCircles Function Ignored
我正在进行一个 R Shiny 项目，以可视化世界上所有的机场。下面包含的代码是我的项目示例。在功能上，该应用程序按预期运行 - 当您选择不同的国家/地区时，数据 table 和地图会更新。但是，我对地图上的点有一点疑问。由于我的点的半径取决于来自机场的路线数量，因此在可能有多个大型机场（例如芝加哥）的人口稠密地区，一些较大的点与较小的点重叠。我在 AddCircles 函数中使用了 FillOpacity 参数来提高透明度，这样您就可以看到可能被屏蔽的点。但是，当我在下面的代码中使用它时，似乎忽略了这个参数：
#Dataset 1: Routes
routes=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/routes.dat"))
dim(routes)
#67662 9
str(routes)
#Dataset #2: Airports
airports=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports-extended.dat"))
dim(airports)
#12667 14
#Rename 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
#-------------------------------#
#IATA in airports
#SourceAirport in routes (IATA)
fullair=merge(x=routes,y=airports,by="IATA",all.x=TRUE)
fullair2=subset(fullair,fullair$Type=="airport")
library(dplyr)
#Make a new unique ID by combining IATA and Destination Airport
fullair2$UniqueID=paste0(fullair2$IATA,"_",fullair2$DestinationAirport)
#Create column that assigns number of unique routes to single airport
fullair3=fullair2 %>%
group_by(IATA) %>%
mutate(Count=n_distinct(UniqueID)) %>%
ungroup()
fullair3=as.data.frame(fullair3)
#Get rid of duplicates
fullair3=fullair3[!duplicated(fullair3[c("UniqueID")]),]
library(rowr)
library(sqldf)
library(RSQLite)
#-----------Number of Routes from Destination------------#
SpitOutNum=sqldf("select IATA,count(*)
from fullair3
group by IATA")
SpitOutNum=as.data.frame(SpitOutNum)
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
fullair3$Name2Part1=paste("(",fullair3$DestinationAirport,")",sep ="")
fullair3$DestFullName=paste(fullair3$DestAirportName, fullair3$Name2Part1)
fullair3$Name2Part1=paste("(",fullair3$DestinationAirport,")",sep ="")
fullair3$DestFullName=paste(fullair3$DestAirportName, fullair3$Name2Part1)
table2=sqldf("select Country, FullName as 'Airport Name', City, count(*) as 'Number of Routes'
from fullair3
group by Country, FullName, City
order by count(*) desc")
#Sort by FullName
fullair3= fullair3[order(fullair3$FullName),]
#-----------------------------------------------------
library(shinydashboard)
library(shiny)
library(leaflet)
library(leaflet.extras)
library(rgdal)
library(sp)
library(raster)
library(DT)
library(markdown)
library(geosphere)
library(htmltools)
airportchoices=unique(fullair3$FullName)
countrychoices=unique(fullair3$Country)
countrychoices=as.character(countrychoices)
countrychoices=sort(countrychoices)
# Define UI for application
ui <- fluidPage(
dashboardPage(
dashboardHeader(title="Airport Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Country Maps",
tabName = "CountryMaps",
icon=icon("flag")
))
),
dashboardBody(
tabItems(
tabItem(
tabName = "CountryMaps",
tags$style(type="text/css","#country_airports {height:calc(100vh - 80px) !important;}"),
fluidRow(column(4),
column(8, selectInput(inputId = "countryselect",label="Select a country:",choices=countrychoices)
)),
DTOutput("countrydata"),
leafletOutput("country_airports")
)
)
)
)
)
# Define server logic
server <- function(input, output) {
#----------COUNTRY FILTERING---------#
CountryData=reactive({
filteredData=subset(fullair3,Country == input$countryselect)
return(filteredData)
})
CountryDataTable=reactive({
filteredDataTable=subset(table2,Country==input$countryselect)
filteredDataTable$Country=NULL
return(filteredDataTable)
})
#-------------------COUNTRY PLOTS-------------------#
output$countrydata=renderDT({
data_table = CountryDataTable()
datatable(data_table,options=list(pageLength=5,
lengthMenu=c(5,10,15,20)
),rownames = FALSE)
})
output$country_airports=renderLeaflet({
data=CountryData()
pal=colorNumeric("Yellow",data$DestinationCount)
leaflet(data=data) %>%
addTiles(group="CartoDB.Positron") %>%
addProviderTiles(providers$CartoDB.Positron,
options = tileOptions(minZoom =0, maxZoom = 13),
group = "CartoDB.Positron") %>%
addCircles(radius = ~data$DestinationCount*1000,
weight = 1,
color = "black",
fillColor = ~pal(data$DestinationCount),
fillOpacity = 0.4,
popup = paste0("Airport Name: ", data$Name, "<br>",
"City: ", data$City, "<br>",
"Destination Count: ",data$DestinationCount,"<br>"
),
label = ~as.character(data$IATA),
group = "Points")
})
}
# Run the application
shinyApp(ui = ui, server = server)
有人对如何解决此问题有任何建议吗？任何帮助，将不胜感激！谢谢！
我认为 fillOpacity = 0.4 太高，无法获得例如芝加哥附近点的透明度。我在下面设置 fillOpacity = 0.01 的图像中得到了透明度。使用较低的 alpha 值需要更多的点才能使点完全不透明。我认为，例如，机场 ORD 有 0.4 行和 200 多行，您就达到了这个阈值。
您可以尝试解决此问题，每个机场只绘制一个点（即数据集中只有一行）。
例如 fillOpacity = 0.4 并在 leaflet 函数
之前添加此代码
data <- data %>%
dplyr::distinct(IATA, Latitude, Longitude, DestinationCount, Name, City)
我得到了下图中的地图
在评论中回答您的进一步问题，似乎一种可能的方法是使用 z-index 参数，但我发现 SVG（如 Circles）不支持 z-index 和顺序基于元素添加到地图的顺序。所以我尝试通过以下方式更改上面的代码：
data <- data %>%
dplyr::distinct(IATA, Latitude, Longitude, DestinationCount, Name, City) %>%
dplyr::arrange(desc(DestinationCount))
得到这个结果
您也可以尝试使用 addCircleMarkers 而不是 addCircles，只更改 radius = ~data$DestinationCount*0.3。如果放大足够大，您会看到 ORD 和 MDW 没有重叠。
我正在进行一个 R Shiny 项目，以可视化世界上所有的机场。下面包含的代码是我的项目示例。在功能上，该应用程序按预期运行 - 当您选择不同的国家/地区时，数据 table 和地图会更新。但是，我对地图上的点有一点疑问。由于我的点的半径取决于来自机场的路线数量，因此在可能有多个大型机场（例如芝加哥）的人口稠密地区，一些较大的点与较小的点重叠。我在 AddCircles 函数中使用了 FillOpacity 参数来提高透明度，这样您就可以看到可能被屏蔽的点。但是，当我在下面的代码中使用它时，似乎忽略了这个参数：
#Dataset 1: Routes
routes=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/routes.dat"))
dim(routes)
#67662 9
str(routes)
#Dataset #2: Airports
airports=read.csv(url("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports-extended.dat"))
dim(airports)
#12667 14
#Rename 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
#-------------------------------#
#IATA in airports
#SourceAirport in routes (IATA)
fullair=merge(x=routes,y=airports,by="IATA",all.x=TRUE)
fullair2=subset(fullair,fullair$Type=="airport")
library(dplyr)
#Make a new unique ID by combining IATA and Destination Airport
fullair2$UniqueID=paste0(fullair2$IATA,"_",fullair2$DestinationAirport)
#Create column that assigns number of unique routes to single airport
fullair3=fullair2 %>%
group_by(IATA) %>%
mutate(Count=n_distinct(UniqueID)) %>%
ungroup()
fullair3=as.data.frame(fullair3)
#Get rid of duplicates
fullair3=fullair3[!duplicated(fullair3[c("UniqueID")]),]
library(rowr)
library(sqldf)
library(RSQLite)
#-----------Number of Routes from Destination------------#
SpitOutNum=sqldf("select IATA,count(*)
from fullair3
group by IATA")
SpitOutNum=as.data.frame(SpitOutNum)
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
fullair3$Name2Part1=paste("(",fullair3$DestinationAirport,")",sep ="")
fullair3$DestFullName=paste(fullair3$DestAirportName, fullair3$Name2Part1)
fullair3$Name2Part1=paste("(",fullair3$DestinationAirport,")",sep ="")
fullair3$DestFullName=paste(fullair3$DestAirportName, fullair3$Name2Part1)
table2=sqldf("select Country, FullName as 'Airport Name', City, count(*) as 'Number of Routes'
from fullair3
group by Country, FullName, City
order by count(*) desc")
#Sort by FullName
fullair3= fullair3[order(fullair3$FullName),]
#-----------------------------------------------------
library(shinydashboard)
library(shiny)
library(leaflet)
library(leaflet.extras)
library(rgdal)
library(sp)
library(raster)
library(DT)
library(markdown)
library(geosphere)
library(htmltools)
airportchoices=unique(fullair3$FullName)
countrychoices=unique(fullair3$Country)
countrychoices=as.character(countrychoices)
countrychoices=sort(countrychoices)
# Define UI for application
ui <- fluidPage(
dashboardPage(
dashboardHeader(title="Airport Analysis"),
dashboardSidebar(
sidebarMenu(
menuItem("Country Maps",
tabName = "CountryMaps",
icon=icon("flag")
))
),
dashboardBody(
tabItems(
tabItem(
tabName = "CountryMaps",
tags$style(type="text/css","#country_airports {height:calc(100vh - 80px) !important;}"),
fluidRow(column(4),
column(8, selectInput(inputId = "countryselect",label="Select a country:",choices=countrychoices)
)),
DTOutput("countrydata"),
leafletOutput("country_airports")
)
)
)
)
)
# Define server logic
server <- function(input, output) {
#----------COUNTRY FILTERING---------#
CountryData=reactive({
filteredData=subset(fullair3,Country == input$countryselect)
return(filteredData)
})
CountryDataTable=reactive({
filteredDataTable=subset(table2,Country==input$countryselect)
filteredDataTable$Country=NULL
return(filteredDataTable)
})
#-------------------COUNTRY PLOTS-------------------#
output$countrydata=renderDT({
data_table = CountryDataTable()
datatable(data_table,options=list(pageLength=5,
lengthMenu=c(5,10,15,20)
),rownames = FALSE)
})
output$country_airports=renderLeaflet({
data=CountryData()
pal=colorNumeric("Yellow",data$DestinationCount)
leaflet(data=data) %>%
addTiles(group="CartoDB.Positron") %>%
addProviderTiles(providers$CartoDB.Positron,
options = tileOptions(minZoom =0, maxZoom = 13),
group = "CartoDB.Positron") %>%
addCircles(radius = ~data$DestinationCount*1000,
weight = 1,
color = "black",
fillColor = ~pal(data$DestinationCount),
fillOpacity = 0.4,
popup = paste0("Airport Name: ", data$Name, "<br>",
"City: ", data$City, "<br>",
"Destination Count: ",data$DestinationCount,"<br>"
),
label = ~as.character(data$IATA),
group = "Points")
})
}
# Run the application
shinyApp(ui = ui, server = server)
有人对如何解决此问题有任何建议吗？任何帮助，将不胜感激！谢谢！
我认为 fillOpacity = 0.4 太高，无法获得例如芝加哥附近点的透明度。我在下面设置 fillOpacity = 0.01 的图像中得到了透明度。使用较低的 alpha 值需要更多的点才能使点完全不透明。我认为，例如，机场 ORD 有 0.4 行和 200 多行，您就达到了这个阈值。
您可以尝试解决此问题，每个机场只绘制一个点（即数据集中只有一行）。
例如 fillOpacity = 0.4 并在 leaflet 函数
data <- data %>%
dplyr::distinct(IATA, Latitude, Longitude, DestinationCount, Name, City)
我得到了下图中的地图
在评论中回答您的进一步问题，似乎一种可能的方法是使用 z-index 参数，但我发现 SVG（如 Circles）不支持 z-index 和顺序基于元素添加到地图的顺序。所以我尝试通过以下方式更改上面的代码：
data <- data %>%
dplyr::distinct(IATA, Latitude, Longitude, DestinationCount, Name, City) %>%
dplyr::arrange(desc(DestinationCount))
得到这个结果
您也可以尝试使用 addCircleMarkers 而不是 addCircles，只更改 radius = ~data$DestinationCount*0.3。如果放大足够大，您会看到 ORD 和 MDW 没有重叠。