gla*_*con 13 r ggplot2 ggproto
有没有办法让geom_curve上的箭头关闭?相同的代码适用于geom_segment.也许这是一个错误?
library(tidyverse)
set.seed(123)
data <- data_frame(x = rnorm(10), y = rnorm(10))
# NO ARROWHEAD FILL
ggplot(data, aes(x, y)) +
geom_point() +
geom_curve(aes(x = 0, y = 0, xend = 1, yend = 1),
color = "black",
arrow = arrow(type = "closed"))
# ARROWHEAD FILL WORKS
ggplot(data, aes(x, y)) +
geom_point() +
geom_segment(aes(x = 0, y = 0, xend = 1, yend = 1),
color = "black",
arrow = arrow(type = "closed"))
Run Code Online (Sandbox Code Playgroud)
hrb*_*str 12
我称之为bug,你应该提出问题.直到那时:
geom_curve2 <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
curvature = 0.5,
angle = 90,
ncp = 5,
arrow = NULL,
lineend = "butt",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomCurve2,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
arrow = arrow,
curvature = curvature,
angle = angle,
ncp = ncp,
lineend = lineend,
na.rm = na.rm,
...
)
)
}
GeomCurve2 <- ggproto("GeomCurve2", GeomSegment,
draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90,
ncp = 5, arrow = NULL, lineend = "butt", na.rm = FALSE) {
if (!coord$is_linear()) {
warning("geom_curve is not implemented for non-linear coordinates",
call. = FALSE)
}
trans <- coord$transform(data, panel_params)
curveGrob(
trans$x, trans$y, trans$xend, trans$yend,
default.units = "native",
curvature = curvature, angle = angle, ncp = ncp,
square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE,
gp = gpar(
col = alpha(trans$colour, trans$alpha),
fill = alpha(trans$colour, trans$alpha),
lwd = trans$size * .pt,
lty = trans$linetype,
lineend = lineend),
arrow = arrow
)
}
)
Run Code Online (Sandbox Code Playgroud)
这导致:
ggplot(data, aes(x, y)) +
geom_point() +
geom_curve2(aes(x = 0, y = 0, xend = 1, yend = 1),
color = "black",
arrow = arrow(type = "closed"))
Run Code Online (Sandbox Code Playgroud)
和
要添加一些有用的东西给@hrbrmstr给出了答案,我认为无论是geom_segment()和geom_curve()是不必要的限制,因为他们不会让你从箭头的轮廓分别指定箭头填充颜色.在这里,我提供了一个geom_curve2()允许你这样做的.更改的行(相对于ggplot2代码)突出显示.
# copied from ggplot2 `geom_curve`
geom_curve2 <- function(mapping = NULL, data = NULL,
stat = "identity", position = "identity",
...,
curvature = 0.5,
angle = 90,
ncp = 5,
arrow = NULL,
lineend = "butt",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomCurve2, # call `GeomCurve2` instead of `GeomCurve`
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
arrow = arrow,
curvature = curvature,
angle = angle,
ncp = ncp,
lineend = lineend,
na.rm = na.rm,
...
)
)
}
# copied from ggplot2 `GeomCurve`
GeomCurve2 <- ggproto("GeomCurve2", GeomSegment,
# the following `default_aes =` statement is missing in ggplot2 `GeomCurve`
default_aes = aes(colour = "black", fill = "black", size = 0.5, linetype = 1, alpha = NA),
draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90,
ncp = 5, arrow = NULL, lineend = "butt", na.rm = FALSE) {
if (!coord$is_linear()) {
warning("geom_curve is not implemented for non-linear coordinates",
call. = FALSE)
}
trans <- coord$transform(data, panel_params)
curveGrob(
trans$x, trans$y, trans$xend, trans$yend,
default.units = "native",
curvature = curvature, angle = angle, ncp = ncp,
square = FALSE, squareShape = 1, inflect = FALSE, open = TRUE,
gp = gpar(
col = alpha(trans$colour, trans$alpha),
# the following `fill = ` statement is missing in ggplot2 `GeomCurve`
fill = alpha(trans$fill, trans$alpha),
lwd = trans$size * .pt,
lty = trans$linetype,
lineend = lineend),
arrow = arrow
)
}
)
Run Code Online (Sandbox Code Playgroud)
现在我们可以从轮廓中单独指定箭头填充:
ggplot(data, aes(x, y)) +
geom_point() +
geom_curve2(aes(x = 0, y = 0, xend = 1, yend = 1),
color = "black", fill = "red",
arrow = arrow(type = "closed"))
Run Code Online (Sandbox Code Playgroud)
如何进行等效更改geom_segment()留给读者练习.