我想缩短箭头,这样它们就不会接触到点,非常类似于这个问题:
Arranging arrows between points nicely in ggplot2
下面的代码在此基础上稍作修改,试图处理ggplot2中的更新:
https://pastebin.com/0BRwUzpu
Error in geom_segment_plus(aes(x=...
attempt to apply non-function
我不是幕后R代码的专家,也许这说明了这一点,但如果有人能让这段代码正常工作,那就太好了。
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")+
