如何在ggplot中偏移箭头长度
我有一个这样的ggplot：
数据集和代码以最终生成图形。
我想缩短箭头，以免它们触碰到这些点，与这个问题非常相似： Arranging arrows between points nicely in ggplot2
下面的代码从这里稍作修改，以尝试处理ggplot2中的更新： https://pastebin.com/0BRwUzpu
但是，当我运行ggplot代码时，出现以下错误：
Error in geom_segment_plus(aes(x=...
attempt to apply non-function
我不是幕后的R代码专家，也许这可以证明，但是如果有人可以让该代码正常工作，那真是太好了。
（顺便说一句，我认为该功能是ggplot的绝佳补充）
修改后的代码
library(ggplot2)
geom_segment_plus <- function (mapping = NULL, data = NULL, stat = "identity",
position = "identity", arrow = NULL, lineend = "butt", na.rm = FALSE, ...) {
GeomSegmentPlus$new(mapping = mapping, data = data, stat = stat,
position = position, arrow = arrow, lineend = lineend, na.rm = na.rm, ...)
}
GeomSegmentPlus <- ggproto(ggplot2:::GeomRaster, expr={
objname <- "segmentplus"
draw <- function(., data, scales, coordinates, arrow = NULL,
lineend = "butt", na.rm = FALSE, ...) {
data <- remove_missing(data, na.rm = na.rm,
c("x", "y", "xend", "yend", "linetype", "size", "shape","shorten.start","shorten.end","offset"),
name = "geom_segment_plus")
if (empty(data)) return(zeroGrob())
if (is.linear(coordinates)) {
data = coord_transform(coordinates, data, scales)
for(i in 1:dim(data)[1] )
{
match = data$xend == data$x[i] & data$x == data$xend[i] & data$yend == data$y[i] & data$y == data$yend[i]
#print("Match:")
#print(sum(match))
if( sum( match ) == 0 ) data$offset[i] <- 0
}
data$dx = data$xend - data$x
data$dy = data$yend - data$y
data$dist = sqrt( data$dx^2 + data$dy^2 )
data$px = data$dx/data$dist
data$py = data$dy/data$dist
data$x = data$x + data$px * data$shorten.start
data$y = data$y + data$py * data$shorten.start
data$xend = data$xend - data$px * data$shorten.end
data$yend = data$yend - data$py * data$shorten.end
data$x = data$x - data$py * data$offset
data$xend = data$xend - data$py * data$offset
data$y = data$y + data$px * data$offset
data$yend = data$yend + data$px * data$offset
return(with(data,
segmentsGrob(x, y, xend, yend, default.units="native",
gp = gpar(col=alpha(colour, alpha), fill = alpha(colour, alpha),
lwd=size * .pt, lty=linetype, lineend = lineend),
arrow = arrow)
))
}
print("carrying on")
data$group <- 1:nrow(data)
starts <- subset(data, select = c(-xend, -yend))
ends <- rename(subset(data, select = c(-x, -y)), c("xend" = "x", "yend" = "y"),
warn_missing = FALSE)
pieces <- rbind(starts, ends)
pieces <- pieces[order(pieces$group),]
GeomPath$draw_groups(pieces, scales, coordinates, arrow = arrow, ...)
}
default_stat <- function(.) StatIdentity
required_aes <- c("x", "y", "xend", "yend")
default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = NA,shorten.start=0,shorten.end=0,offset=0)
guide_geom <- function(.) "path"
})
数据集：
structure(list(Treatment = c("Control", "Control", "Control",
"Control", "Control", "Control", "Control", "Control", "Treatment",
"Treatment", "Treatment", "Treatment", "Treatment", "Treatment",
"Treatment", "Treatment"), Time = c("Post", "Post", "Post", "Post",
"Pre", "Pre", "Pre", "Pre", "Post", "Post", "Post", "Pre", "Pre",
"Pre", "Pre", "Pre"), Site = c("B", "A", "H", "P", "A", "G",
"H", "P", "B", "G", "H", "B", "A", "G", "H", "P"), Type = c("PostControl",
"PostControl", "PostControl", "PostControl", "PreControl", "PreControl",
"PreControl", "PreControl", "PostTreatment", "PostTreatment",
"PostTreatment", "PreTreatment", "PreTreatment", "PreTreatment",
"PreTreatment", "PreTreatment"), MD1 = c(-1.232682838, 1.313007519,
-0.165953812, -0.123767165, 0.940689029, 0.293944614, 0.940689029,
0.940689029, -0.401351793, 0.867036009, 0.003610098, -1.214486723,
0.940689029, -0.694974611, -1.192650691, -1.214486723), MD2 = c(-0.50627891,
-0.3392641, 0.53072355, 0.53982618, 0.57810777, -1.23757431,
0.57810777, 0.57810777, -1.60422721, -0.83598169, 0.02060607,
0.92139307, 0.57810777, -0.76083124, 0.03778445, 0.92139307)), row.names = c(NA,
-16L), class = c("tbl_df", "tbl", "data.frame"), spec = structure(list(
cols = list(Treatment = structure(list(), class = c("collector_character",
"collector")), Time = structure(list(), class = c("collector_character",
"collector")), Site = structure(list(), class = c("collector_character",
"collector")), Type = structure(list(), class = c("collector_character",
"collector")), MD1 = structure(list(), class = c("collector_double",
"collector")), MD2 = structure(list(), class = c("collector_double",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector"))), class = "col_spec"))
主要图形代码：
xmin <- signif(min(df$MD1))
xmax <- signif(max(df$MD1))
ymin <- signif(min(df$MD2))
ymax <- signif(max(df$MD2))
ggplot(df) +
ggtitle("Soil")+
theme(plot.title = element_text(size=25, face="bold"))+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black", size = 1))+
theme(axis.text.x = element_blank(), axis.title=element_blank(),
axis.text.y = element_blank(), axis.ticks=element_blank())+
theme(legend.text=element_text(size=18), legend.justification = "top", legend.title=element_text(size=19))+
geom_point(data=df,inherit.aes=FALSE, aes(x=MD1, y=MD2, shape=Type),size=9, stroke=3)+
scale_shape_manual(values=c(16, 15, 1, 0), name="Treatment")+
annotate(geom = 'segment', y = Inf, yend = Inf, color = 'black', x = -Inf, xend = Inf, size = 3) +
annotate(geom = 'segment', y = -Inf, yend = Inf, color = 'black', x = Inf, xend = Inf, size = 3)+
annotate(geom = 'segment', y = -Inf, yend = Inf, color = 'black', x = -Inf, xend = -Inf, size = 3)+
annotate(geom = 'segment', y = Inf, yend = Inf, color = 'black', x = -Inf, xend = -Inf, size = 3)+
geom_segment(aes(x=MD1[df$Treatment=="Control"& df$Site=="A"&df$Time=="Pre"],
y=MD2[df$Treatment=="Control"& df$Site=="A"&df$Time=="Pre"],
xend=MD1[df$Treatment=="Control"& df$Site=="A"&df$Time=="Post"],
yend=MD2[df$Treatment=="Control"& df$Site=="A"&df$Time=="Post"]),
arrow=arrow(), size=2, color="black")+
geom_segment(aes(x=MD1[df$Treatment=="Treatment"& df$Site=="G"&df$Time=="Pre"], y=MD2[df$Treatment=="Treatment"& df$Site=="G"&df$Time=="Pre"],
xend=MD1[df$Treatment=="Treatment"& df$Site=="G"&df$Time=="Post"], yend=MD2[df$Treatment=="Treatment"& df$Site=="G"&df$Time=="Post"]),
arrow=arrow(), size=2, color="blue")+
geom_segment(aes(x=MD1[df$Treatment=="Treatment"& df$Site=="H"&df$Time=="Pre"], y=MD2[df$Treatment=="Treatment"& df$Site=="H"&df$Time=="Pre"],
xend=MD1[df$Treatment=="Treatment"& df$Site=="H"&df$Time=="Post"], yend=MD2[df$Treatment=="Treatment"& df$Site=="H"&df$Time=="Post"]),
arrow=arrow(), size=2, color="blue")+
geom_segment(aes(x=MD1[df$Treatment=="Control"& df$Site=="H"&df$Time=="Pre"], y=MD2[df$Treatment=="Control"& df$Site=="H"&df$Time=="Pre"],
xend=MD1[df$Treatment=="Control"& df$Site=="H"&df$Time=="Post"], yend=MD2[df$Treatment=="Control"& df$Site=="H"&df$Time=="Post"]),
arrow=arrow(), size=2, color="black")+
coord_cartesian(ylim=c(ymin, ymax),xlim=c(xmin, xmax))
图形代码。要重现该错误，请在运行上面的自定义函数后，替换
geom_segment(aes(x=MD1[df$Treatment=="Control"& df$Site=="A"&df$Time=="Pre"],
y=MD2[df$Treatment=="Control"& df$Site=="A"&df$Time=="Pre"],
xend=MD1[df$Treatment=="Control"& df$Site=="A"&df$Time=="Post"],
yend=MD2[df$Treatment=="Control"& df$Site=="A"&df$Time=="Post"]),
arrow=arrow(), size=2, color="black")+
使用
geom_segment_plus(aes(x=MD1[CBSoil.sum$Treatment=="Control"& CBSoil.sum$Site=="Flynns"&CBSoil.sum$Time=="Pre"],
y=MD2[CBSoil.sum$Treatment=="Control"& CBSoil.sum$Site=="Flynns"&CBSoil.sum$Time=="Pre"],
xend=MD1[CBSoil.sum$Treatment=="Control"& CBSoil.sum$Site=="Flynns"&CBSoil.sum$Time=="Post"],
yend=MD2[CBSoil.sum$Treatment=="Control"& CBSoil.sum$Site=="Flynns"&CBSoil.sum$Time=="Post"]),
offset=0.01, shorten.start=0.03, shorten.end=0.03,
arrow=arrow(), size=2, color="black")+
1 个答案:
答案 0 :(得分：0)
我想，我已经进行了一些编辑并取得了进展。
geom_segment_plus <- function (mapping = NULL, data = NULL, stat = "identity",
position = "identity",..., arrow = NULL, arrow.fill = NULL,
lineend = "butt", linejoin = "round", na.rm = FALSE, show.legend = NA, # Added in geom_segment arguments
inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = stat, geom = GeomSegmentPlus, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(arrow = arrow, arrow.fill = arrow.fill,
lineend = lineend, linejoin = linejoin, na.rm = na.rm, show.legend = show.legend, ...))} # Added in geom_segment arguments
GeomSegmentPlus <- ggproto(ggplot2:::Geom, expr={
draw = function(., data, scales, coordinates, arrow = NULL, # removed objname <- "segmentplus", changed draw <- to draw =
lineend = "butt", na.rm = FALSE, ...) {
data <- remove_missing(data, na.rm = na.rm,
c("x", "y", "xend", "yend", "linetype", "size", "shape","shorten.start","shorten.end","offset"),
name = "geom_segment_plus")
if (empty(data)) return(zeroGrob())
if (is.linear(coordinates)) {
data = coord_transform(coordinates, data, scales)
for(i in 1:dim(data)[1] )
{
match = data$xend == data$x[i] & data$x == data$xend[i] & data$yend == data$y[i] & data$y == data$yend[i]
#print("Match:")
#print(sum(match))
if( sum( match ) == 0 ) data$offset[i] <- 0
}
data$dx = data$xend - data$x
data$dy = data$yend - data$y
data$dist = sqrt( data$dx^2 + data$dy^2 )
data$px = data$dx/data$dist
data$py = data$dy/data$dist
data$x = data$x + data$px * data$shorten.start
data$y = data$y + data$py * data$shorten.start
data$xend = data$xend - data$px * data$shorten.end
data$yend = data$yend - data$py * data$shorten.end
data$x = data$x - data$py * data$offset
data$xend = data$xend - data$py * data$offset
data$y = data$y + data$px * data$offset
data$yend = data$yend + data$px * data$offset
return(with(data,
segmentsGrob(x, y, xend, yend, default.units="native",
gp = gpar(col=alpha(colour, alpha), fill = alpha(colour, alpha),
lwd=size * .pt, lty=linetype, lineend = lineend),
arrow = arrow)
))
}
print("carrying on")
data$group <- 1:nrow(data)
starts <- subset(data, select = c(-xend, -yend))
ends <- rename(subset(data, select = c(-x, -y)), c("xend" = "x", "yend" = "y"),
warn_missing = FALSE)
pieces <- rbind(starts, ends)
pieces <- pieces[order(pieces$group),]
GeomPath$draw_groups(pieces, scales, coordinates, arrow = arrow, ...)
}
default_stat = function(.) StatIdentity # changed default stat <- to = etc
required_aes <- c("x", "y", "xend", "yend")
default_aes = function(.) aes(colour="black", size=0.5, linetype=1, alpha = NA,shorten.start=0,shorten.end=0,offset=0)
guide_geom = function(.) "path"
})
但是现在我收到此错误：
Error: `geom` must be either a string or a Geom object, not an S3 object with class <environment>/ggproto/gg
我在这里想念什么？
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？