ggplot2/gis 在多边形区域内绘图

2023-12-12

出于复制目的,请考虑以下数据:

library(rgdal)
library(ggplot2)
library(rgeos)

download.file("http://spatialanalysis.co.uk/wp-content/uploads/2010/09/London_Sport.zip", 

destfile = "London_Sport.zip")
unzip("London_Sport.zip")

projection="+proj=merc"

london_shape = readOGR("./", layer="london_sport")

# Create random points
set.seed(1)
points = data.frame(long=rnorm(10000, mean=-0.1, sd=0.1), lat=rnorm(10000, mean=51.5, sd=0.1))
points = SpatialPoints(points, proj4string=CRS("+proj=latlon"))

# Transform data to our projection
london = spTransform(london_shape, CRS(projection))
points = spTransform(points, CRS(projection))

# Keeps only points inside London
intersection = gIntersects(points, london, byid = T)
outside = apply(intersection == FALSE, MARGIN = 2, all)
points = points[which(!outside), ]

# Blank theme
new_theme_empty <- theme_bw()
new_theme_empty$line <- element_blank()
new_theme_empty$rect <- element_blank()
new_theme_empty$strip.text <- element_blank()
new_theme_empty$axis.text <- element_blank()
new_theme_empty$plot.title <- element_blank()
new_theme_empty$axis.title <- element_blank()
new_theme_empty$plot.margin <- structure(c(0, 0, -1, -1), unit = "lines", valid.unit = 3L, class = "unit")

# Prepare data to ggplot
london = fortify(london)
points = as.data.frame(points)

我想绘制点的密度图。我可以通过使用来做到这一点stat_bin2d:

ggplot() + 
  geom_polygon(data=london, aes(x=long,y=lat,group=group), fill="black") +
  stat_bin2d(data=points, aes(x=long,y=lat), bins=40) +
  geom_path(data=london, aes(x=long,y=lat,group=id), colour='white') +
  coord_equal() +
  new_theme_empty

但这会导致密度方块的某些部分被绘制在伦敦以外的地方:

Density

如何仅绘制伦敦内部的密度图?


我通过获取伦敦边界框与伦敦本身之间的差异的多边形找到了答案(使用gDifference)并将其绘制在所有内容之上的白色。我认为这种方法的缺点是:1)如果某些正方形仍然出现在多边形后面,则必须手动增加多边形的大小。 2)不能使用背景复杂的绘图主题。因此,如果有人有更好的答案,我将暂时保留这个问题。

这是代码:

library(rgdal)
library(ggplot2)
library(rgeos)

projection="+proj=merc"

#London boroughs polygons
download.file("http://spatialanalysis.co.uk/wp-content/uploads/2010/09/London_Sport.zip", destfile = "London_Sport.zip")
unzip("London_Sport.zip")
london = readOGR("./", layer="london_sport")
london = spTransform(london, CRS(projection))

# Generate random points
set.seed(1)
points = data.frame(long=rnorm(10000, mean=-0.1, sd=0.1), lat=rnorm(10000, mean=51.5, sd=0.1))
points = SpatialPoints(points, proj4string=CRS("+proj=latlon"))
points = spTransform(points, CRS(projection))

# Keep only points inside London
intersection = gIntersects(points, london, byid = TRUE)
inside = apply(intersection == TRUE, MARGIN = 2, any)
points = points[which(inside), ]

# Create a bounding box 10% bigger than the bounding box of London
x_excess = (london@bbox['x','max'] - london@bbox['x','min'])*0.1
y_excess = (london@bbox['y','max'] - london@bbox['y','min'])*0.1
x_min = london@bbox['x','min'] - x_excess
x_max = london@bbox['x','max'] + x_excess
y_min = london@bbox['y','min'] - y_excess
y_max = london@bbox['y','max'] + y_excess
bbox = matrix(c(x_min,x_max,x_max,x_min,x_min,
                y_min,y_min,y_max,y_max,y_min),
              nrow = 5, ncol =2)
bbox = Polygon(bbox, hole=FALSE)
bbox = Polygons(list(bbox), "bbox")
bbox = SpatialPolygons(Srl=list(bbox), pO=1:1, proj4string=london@proj4string)

# Get the Polygon that is the difference between the bounding box and London
outside = gDifference(bbox,london)

# Blank theme
new_theme_empty <- theme_bw()
new_theme_empty$line <- element_blank()
new_theme_empty$rect <- element_blank()
new_theme_empty$strip.text <- element_blank()
new_theme_empty$axis.text <- element_blank()
new_theme_empty$plot.title <- element_blank()
new_theme_empty$axis.title <- element_blank()
new_theme_empty$plot.margin <- structure(c(0, 0, -1, -1), unit = "lines", valid.unit = 3L, class = "unit")

# Prepare data for ggplot
london = fortify(london)
points = as.data.frame(points)
outside = fortify(outside)

# Plot!
ggplot() + 
  geom_polygon(data=london, aes(x=long,y=lat,group=group), fill="black") +
  stat_bin2d(data=points, aes(x=long,y=lat), bins=40) +
  geom_path(data=london, aes(x=long,y=lat,group=id), colour='white') +
  geom_polygon(data=outside, aes(x=long,y=lat), fill='white') +
  coord_equal() +
  new_theme_empty

Plot

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

ggplot2/gis 在多边形区域内绘图 的相关文章

  • tidyverse 干扰 ggplot2 吗?无法访问map_data

    在控制台中运行这些命令 输出为 gt cty0 ggplot2 map data county gt library tidyverse Loading tidyverse ggplot2 Loading tidyverse tibble
  • 如何上下移动字符串并从中删除相似的字符串?

    我问了一个可能不太清楚的问题 所以我尝试用一 种可以理解的方式来解释它 这是我的数据 我的数据看起来像这样 看起来像这样 V1 V2 V3 1 Q9UNZ5 Q9Y2W1 2 Q9ULV4 Q6QEF8 3 Q9UNZ5 4 Q9H6F5
  • R 带有列和行的分面 qqplots

    我需要使用按行和列的构面创建 qqplot 我了解如何用列和行绘制分面图 但我不确定如何设置我的数据 最终 我想按列和行对数据集进行分组 然后按升序对 建模 结果和 观察到 结果进行排序 同时添加带有 行 组的列和带有 列 组的列 我一直在
  • 如何更改 r 中的树状图标签

    我在 R 中有一个树形图 它基于使用 hclust 的分层聚类 我正在对不同颜色的标签进行着色 但是当我尝试使用以下命令更改树图的标签 集群所基于的数据帧的行 时dendrogram dendrogram gt set labels dat
  • 在 R 中使用深度网络和 MNIST 数据读取手写数字第 3 部分

    我尝试编写一个基于深度网络的程序来读取手写数字 我在 Youtube 上找到了一个代码 https www youtube com watch v 5bso 5X7Zu4 https www youtube com watch v 5bso
  • 使用 2 个向量参数翻转函数

    我想对需要 2 个向量参数的函数应用滚动 这是使用 data table 的示例 不起作用 library data table df lt as data table cbind data frame x 1 100 y 101 200
  • 更新两组单选按钮 - 闪亮

    我问了这个问题 反应式更新两组单选按钮 闪亮 https stackoverflow com questions 35040579 update two sets of radiobuttons reactively shiny 昨天 但也
  • R:(中缀)运算符的两个定义之间的冲突:如何指定包?

    在 R 中 每当两个包定义相同的函数时 很容易指定要使用哪个包pkg foo 但是 当冲突的功能是一个时 你该怎么办 infix运算符 即使用定义 举个例子 两者ggplot2 and crayon define 有没有一种方法可以让我默认
  • 使用神经网络包进行多项分类

    这个问题应该很简单 但文档没有帮助 我正在使用 R 我必须使用neuralnet多项式分类问题的包 所有示例均针对二项式或线性输出 我可以使用二项式输出进行一些一对一的实现 但我相信我应该能够通过使用 3 个单元作为输出层来做到这一点 其中
  • 跨类别和列自动化卡方

    我有一个调查数据框 其中包含几个问题 列 编码为 1 同意 0 不同意 受访者 行 根据 年龄 年轻 中年 老年 地区 东 中 西 等指标进行分类 大约有30个类别总共 3个年龄 3个地区 2个性别 11个职业等 在每个指标中 类别不重叠且
  • 将模式的所有元素与向量以相同的顺序匹配

    我创建了一个函数yes seq需要两个参数 一个模式pat和数据dat 该函数以相同的顺序查找数据中是否存在模式 例如 dat lt letters 1 10 dat 1 a b c d e f g h i j pat lt c a c g
  • R,igraph,是否可以用图案填充顶点

    使用 R 和 igraph 绘制图形 我使用颜色来标记顶点类型 请参阅下面的代码 是否可以用图案而不是颜色填充顶点 以便在以彩色和黑白查看时可以区分节点类型 我需要 4 种独特的颜色 图案 colorbrewer 中唯一适合的调色板是这个
  • 使用 R Markdown 文档作为函数源

    我正在研究 R Markdown 来记录我经常使用的功能 我会将它们放入 R Markdown 文件中以记录它们 然后如果我几个月后回来查看它 就能够阅读我在函数背后的想法 我的问题是 如果我开始一个新的 R 项目 是否可以获取 r mar
  • 在zooreg时间序列中查找非唯一索引条目时遇到问题

    我有几年的数据正在尝试将其转化为动物园对象 Dropbox 上的 csv https www dropbox com sh vg8w8pt16e0v3xs AABKtWqDkPu9JVKpwBXO36VOa dl 0 一旦数据被强制转换为动
  • 构造奎因(自我复制功能)

    有没有人构建过 quine 生成自己源文本的副本作为其完整输出的程序 http www nyx net gthompso quine htm http www nyx net gthompso quine htm 在 R 中 quine 标
  • 基本 dyplr 函数给出错误:“check_dots_used”

    试图找出为什么我会收到此错误 以前从未见过 谷歌没有帮助 check dots used action warn 中的错误 未使用参数 action warn 我在下面的非常基本的试验中收到错误 而且在 group by count 中也收
  • ggplot2 + 使用比例 X 的日期结构

    我真的需要帮助 因为我已经迷路了 我正在尝试创建一个折线图 显示几个团队一年来的表现 我将一年分为几个季度 2012 年 1 月 1 日 2012 年 4 月 1 日 2012 年 8 月 1 日 12 1 12 并将 csv 数据帧加载到
  • Matlab 中是否有相当于 R 的 dput() 的函数?

    Matlab 中是否有相当于 R 的 dput 的函数 dput 将 R 对象的 ASCII 文本表示形式写入文件或连接 UPDATE 1 添加了递归和对单元格的支持 UPDATE 2 添加了对结构的支持 UPDATE 3 增加了对逻辑 整
  • 如何在闪亮的observeEvent中监听多个事件表达式

    我想要两个不同的事件触发观察者 有人建议here https stackoverflow com questions 34731975 how to listen for more than one event expression wit
  • 从 leafletProxy() 返回渲染的传单地图

    是否可以在渲染后在 Shiny 中检索传单地图 下面是一个代码示例 展示了如何生成地图leaflet 与返回的不同leafletProxy 即使它们在渲染时看起来完全相同 是否有一个功能可能不同于leafletProxy 获取实际的 htm

随机推荐