Я пытаюсь наметить маршруты между столицами пары торговых партнеров, поэтому я сослался на этот пост и изменил его код R
. Однако, хотя оригинальный код хорошо работает в ситуации, когда все соединительные маршруты на объекте карты происходят из одного и того же местоположения, на моем графическом выводе, похоже, есть некоторые глюки, потому что может показаться, что эти доверительные интервальные вертикальные полосы над Атлантикой c Океан - результат линий большого круга (D C -Осло, Париж-D C), перекрывающих друг друга. На графике это выглядит не очень хорошо.
Мне интересно, есть ли способ исправить это? Я прикрепил свой код ниже.
library(maps)
library(geosphere)
library(plyr)
library(ggplot2)
library(sp)
library(foreign)
capcities <- read.csv(file="https://www.dropbox.com/s/u5jinh1mio9e8jz/capcities.csv?dl=1",as.is=TRUE,header=TRUE)
edges <- read.csv(file="https://www.dropbox.com/s/gq2rgaoix8mj6f8/edges.csv?dl=1",as.is=TRUE,header=TRUE)
names(capcities)[1] <- "Name"
names(edges)[1] <- "From"
edges.ag <- ddply(edges, c("From","To"), function(x) count(x$To))
edges.ll <- merge(edges.ag, capcities, all.x=T, by.x="To", by.y="Name")
edges.ll <- edges.ll[,-3]
DC.ll <- c(capcities$longitude[capcities["Name"]=="DC"],capcities$latitude[capcities["Name"]=="DC"])
Paris.ll <- c(capcities$longitude[capcities["Name"]=="Paris"],capcities$latitude[capcities["Name"]=="Paris"])
## define fortify.SpatialLinesDataFrame
fortify.SpatialLinesDataFrame <- function(model, data, ...) {
plyr::ldply(model@lines, fortify)
}
# wiring edges -- Dateline Break FALSE, otherwise we get a bump in the shifted ggplots
dc <- gcIntermediate(DC.ll, edges.ll[edges.ll$From == "DC",c('longitude', 'latitude')], 150, breakAtDateLine=FALSE, addStartEnd=TRUE, sp=TRUE)
dc.ff <- fortify.SpatialLinesDataFrame(dc) # convert into ggplot plott-able format
paris <- gcIntermediate(Paris.ll, edges.ll[edges.ll$From == "Paris",c('longitude', 'latitude')], 150, breakAtDateLine=FALSE, addStartEnd=TRUE, sp=TRUE)
paris.ff <- fortify.SpatialLinesDataFrame(paris) # convert into ggplot plott-able format
# combine dc- and paris-origined connecting routes
rts.ff <- rbind(dc.ff, paris.ff)
edges.ll$id <-as.character(c(1:nrow(edges.ll))) # that rts15.ff$id is a char
gcircles <- merge(rts.ff, edges.ll, all.x=T, by="id") # join attributes, keep all
# re-center the graph to avoid breaks
center <- 360
gcircles$long.recenter <- ifelse(gcircles$long < center - 180 , gcircles$long + 360, gcircles$long)
# shift coordinates to recenter worldmap
worldmap <- map_data("world")
worldmap$long.recenter <- ifelse(worldmap$long < center - 180 , worldmap$long + 360, worldmap$long)
sub <- subset(worldmap, region %in% c("USA", "Australia", "Belarus", "Belgium", "Canada", "China", "Czech Republic", "Finland",
"France", "Germany", "Israel", "Italy", "Japan", "Netherlands", "Norway", "Russia", "Singapore", "South Africa",
"South Korea", "Spain", "Sweden", "Switzerland", "Turkey", "UK", "Ukraine"))
sub$long.recenter <- ifelse(sub$long < center - 180 , sub$long + 360, sub$long)
### Function to regroup split lines and polygons
# takes dataframe, column with long and unique group variable, returns df with added column named group.regroup
RegroupElements <- function(df, longcol, idcol){
g <- rep(1, length(df[,longcol]))
if (diff(range(df[,longcol])) > 300) { # check if longitude within group differs more than 300 deg (i.e., if element was split)
d <- df[,longcol] > mean(range(df[,longcol])) # use the mean to separate extreme values
g[!d] <- 1 # some marker for parts that stay in place (get rid of concave polygons)
g[d] <- 2 # parts that are moved
}
g <- paste(df[, idcol], g, sep=".") # attach to id to create unique group identifiers
df$group.regroup <- g
df
}
### Function to close regrouped polygons
# takes dataframe, checks if 1st and last longitude value are the same, if not, inserts first as last and reassigns order variable
ClosePolygons <- function(df, longcol, ordercol){
if (df[1,longcol] != df[nrow(df),longcol]) {
tmp <- df[1,]
df <- rbind(df,tmp)
}
o <- c(1: nrow(df)) # rassign the order variable
df[,ordercol] <- o
df
}
# now regroup
gcircles.rg <- ddply(gcircles, .(id), RegroupElements, "long.recenter", "id")
worldmap.rg <- ddply(worldmap, .(group), RegroupElements, "long.recenter", "group")
sub.rg <- ddply(sub, .(group), RegroupElements, "long.recenter", "group")
# close polys
worldmap.cp <- ddply(worldmap.rg, .(group.regroup), ClosePolygons, "long.recenter", "order") # use the new grouping var
sub.cp <- ddply(sub.rg, .(group.regroup), ClosePolygons, "long.recenter", "order")
# plot
g <- ggplot() +
geom_polygon(aes(long.recenter,lat,group=group.regroup), size = 0.2, fill="#f9f9f9", colour = "gray80", data=worldmap.cp) +
ylim(-60, 90) +
theme_bw() +
coord_equal()
g <- g + theme(legend.position = "none")
g <- g + theme(axis.title.x = element_blank(), axis.title.y = element_blank())
g <- g + theme(axis.text.x = element_blank(), axis.text.y = element_blank())
g <- g + geom_polygon(data=sub.cp, aes(long.recenter,lat,group=group.regroup), colour="grey30", fill="grey80")
g <- g + geom_line(aes(long.recenter,lat, group=group.regroup, color=freq, alpha=freq), size=0.4, data= gcircles.rg, col='red')
g <- g + labs(x = "New x label", y = " ")
g
, который создает этот график, как мы можем сказать из графика, CI-подобные перекрытия между двумя соединительными маршрутами через Атлантику c Ocean немного раздражают.