在ggmap中的点之间绘制曲线

Dan*_*aja 8 r ggplot2 ggmap

我正在尝试将实体在谷歌地图上的运动绘制为一组使用的有向线ggmap.目前我正在使用从中绘制线段的geom_segment调用ggplot2.但是,如果1->2->1线条重叠,则运动中存在周期.这使得从可视化中找出运动变得更加困难.

有没有办法弯曲线段来处理这个?或者我可以尝试其他方法或库吗?

Cyr*_*ian 3

我认为您正在寻找的是“贝塞尔曲线”(查看维基百科以获取有关该主题的完整解释https://en.wikipedia.org/wiki/B\xc3\xa9zier_curve)。在 R 中,这是使用许多不同的包来实现的,或者您可以创建自己的包,如下所示:

\n\n
 #Load dependencies\nlibrary(ggplot2)\nlibrary(maptools)\nlibrary(geosphere)\n\n#Identify countries of interest and their centroids (see https://www.cia.gov/library/publications/the-world-factbook/fields/2011.html)\ncountries <- data.frame(\n  Country=c("United States", "Iran"),\n  ISO3=c("USA","IRN"),\n  latitude=c(38,32),\n  longitude=c(-97,53),\n  stringsAsFactors=FALSE)\n\n#Get world map\ndata(wrld_simpl)\nmap.data <- fortify(wrld_simpl)\n\n#Set up map\ndraw.map <- function(ylim=c(0,85)) {\n  ggplot(map.data, aes(x=long, y=lat, group=group)) +\n    geom_polygon(fill="grey") +\n    geom_path(size=0.1,color="white") +\n    coord_map("mercator", ylim=c(-60,120), xlim=c(-180,180)) +\n    theme(line = element_blank(),\n          text = element_blank())\n}\n\n#Identify the points of the curve\np1 <- c(countries$longitude[1],\n        countries$latitude[1])\np2 <- c(countries$longitude[2],\n        countries$latitude[2])\n\n#Create function to draw Brezier curve\nbezier.curve <- function(p1, p2, p3) {\n  n <- seq(0,1,length.out=50)\n  bx <- (1-n)^2 * p1[[1]] +\n    (1-n) * n * 2 * p3[[1]] +\n    n^2 * p2[[1]]\n  by <- (1-n)^2 * p1[[2]] +\n    (1-n) * n * 2 * p3[[2]] +\n    n^2 * p2[[2]]\n  data.frame(lon=bx, lat=by)\n}\n\nbezier.arc <- function(p1, p2) {\n  intercept.long <- (p1[[1]] + p2[[1]]) / 2\n  intercept.lat  <- 85\n  p3 <- c(intercept.long, intercept.lat)\n  bezier.curve(p1, p2, p3)\n}\n\narc3 <- bezier.arc(p1,p2)\n\nbezier.uv.arc <- function(p1, p2) {\n  # Get unit vector from P1 to P2\n  u <- p2 - p1\n  u <- u / sqrt(sum(u*u))\n  d <- sqrt(sum((p1-p2)^2))\n  # Calculate third point for spline\n  m <- d / 2\n  h <- floor(d * .2)\n  # Create new points in rotated space \n  pp1 <- c(0,0)\n  pp2 <- c(d,0)\n  pp3 <- c(m, h)\n  mx <- as.matrix(bezier.curve(pp1, pp2, pp3))\n  # Now translate back to original coordinate space\n  theta <- acos(sum(u * c(1,0))) * sign(u[2])\n  ct <- cos(theta)\n  st <- sin(theta)\n  tr <- matrix(c(ct,  -1 * st, st, ct),ncol=2)\n  tt <- matrix(rep(p1,nrow(mx)),ncol=2,byrow=TRUE)\n  points <- tt + (mx %*% tr)\n  tmp.df <- data.frame(points)\n  colnames(tmp.df) <- c("lon","lat")\n  tmp.df\n}\n\narc4 <- bezier.uv.arc(p1,p2)\n\nbezier.uv.merc.arc <- function(p1, p2) {\n  pp1 <- p1\n  pp2 <- p2\n  pp1[2] <- asinh(tan(p1[2]/180 * pi))/pi * 180\n  pp2[2] <- asinh(tan(p2[2]/180 * pi))/pi * 180\n\n  arc <- bezier.uv.arc(pp1,pp2)\n  arc$lat <-  atan(sinh(arc$lat/180 * pi))/pi * 180\n  arc\n}\n\n\narc5 <- bezier.uv.merc.arc(p1, p2)\nd <- data.frame(lat=c(32,38),\n                lon=c(53,-97))\ndraw.map() + \n  geom_path(data=as.data.frame(arc5), \n            aes(x=lon, y=lat, group=NULL)) +\n  geom_line(data=d, aes(x=lon, y=lat, group=NULL), \n            color="black", size=0.5)\n
Run Code Online (Sandbox Code Playgroud)\n\n

在此输入图像描述

\n\n

另请参阅http://dsgeek.com/2013/06/08/DrawingArcsonMaps.html使用 ggplot2 更全面地解释贝塞尔曲线

\n