Перекрывает пространство в gsIntermediate () и fortify.SpatialLinesDataFrame - PullRequest
0 голосов
/ 27 марта 2020

Я пытаюсь наметить маршруты между столицами пары торговых партнеров, поэтому я сослался на этот пост и изменил его код 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 немного раздражают.

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...