基本plot()
功能允许人们设置type='b'
并获得组合的线和点图,其中点从线段偏移
plot(pressure, type = 'b', pch = 19)
Run Code Online (Sandbox Code Playgroud)
我可以轻松地创建一个带有线和点的ggplot,如下所示.
ggplot(pressure, aes(temperature, pressure)) +
geom_line() +
geom_point()
Run Code Online (Sandbox Code Playgroud)
然而,这些线直到点.我可以想象一种方法,我可以type='b'
使用其他geom(例如geom_segment()
?)将某些功能组合在一起,但我想知道是否有更直接的方法来实现这一点geom_line()
和geom_point()
.
Wei*_*ong 19
这样做的一个有点hacky的方法是在较大的白点上绘制一个小黑点:
ggplot(pressure, aes(temperature, pressure)) +
geom_line() +
geom_point(size=5, colour="white") +
geom_point(size=2) +
theme_classic() +
theme(panel.background = element_rect(colour = "black"))
Run Code Online (Sandbox Code Playgroud)
另外,在ggplot中控制点边框厚度之后,在版本2.0.0中ggplot2
可以使用stroke
参数geom_point
来控制边框厚度,因此geom_point
可以用(例如)替换两个s geom_point(size=2, shape=21, fill="black", colour="white", stroke=3)
,从而消除了叠加点的需要.
cam*_*lle 14
与手动将笔触颜色与面板背景匹配相比,不那么棘手的一种选择是预先从theme_get
默认主题或要使用的特定主题中获取面板背景。使用如下所示的笔触形状21
,可以使内部圆圈变为黑色,笔触与背景颜色相同。
library(ggplot2)
bgnd <- theme_get()$panel.background$fill
ggplot(pressure, aes(x = temperature, y = pressure)) +
geom_line() +
geom_point(shape = 21, fill = "black", size = 2, stroke = 1, color = bgnd)
Run Code Online (Sandbox Code Playgroud)
几个SO问题(这里是一个)涉及缩短点之间的线段背后的数学问题。它是简单但乏味的几何图形。但是,自从这个问题首次发布以来,该lemon
软件包就已经问世了,它具有一定的魔力。它有关于如何计算缩短时间的参数,这可能只需要一些简单的调整即可。
library(lemon)
ggplot(pressure, aes(x = temperature, y = pressure)) +
geom_pointline()
Run Code Online (Sandbox Code Playgroud)
好的,我有一个geom的实现,它不依赖于硬编码,也不应该有更奇怪的偏移量。本质上geom_point()
,这是一种实现,即在点之间绘制路径*,绘制颜色较大的背景点(将颜色设置为面板背景),然后再设置法线点。
*请注意,路径的行为不是沿x轴连接点,而是沿data.frame
ggplot中指定的行顺序。如果需要,可以事先对数据进行排序geom_line()
。
我的主要问题是获取geom绘图代码的内部构造,以检索当前图的主题,以提取面板的背景色。因此,我不确定这将是多么稳定(并且欢迎任何提示),但是至少它能起作用。
编辑:现在应该更稳定
让我们来看看冗长的ggproto
目标代码:
GeomPointPath <- ggproto(
"GeomPointPath", GeomPoint,
draw_panel = function(self, data, panel_params, coord, na.rm = FALSE)
{
# bgcol <- sys.frame(4)$theme$panel.background$fill
# if (is.null(bgcol)) {
# bgcol <- theme_get()$panel.background$fill
# }
# EDIT: More robust bgcol finding -----------
# Find theme, approach as in https://github.com/tidyverse/ggplot2/issues/3116
theme <- NULL
for(i in 1:20) {
env <- parent.frame(i)
if("theme" %in% names(env)) {
theme <- env$theme
break
}
}
if (is.null(theme)) {
theme <- theme_get()
}
# Lookup likely background fills
bgcol <- theme$panel.background$fill
if (is.null(bgcol)) {
bgcol <- theme$plot.background$fill
}
if (is.null(bgcol)) {
bgcol <- theme$rect$fill
}
if (is.null(bgcol)) {
# Default to white if no fill can be found
bgcol <- "white"
}
# END EDIT ------------------
if (is.character(data$shape)) {
data$shape <- ggplot2:::translate_shape_string(data$shape)
}
coords <- coord$transform(data, panel_params)
# Draw background points
bgpoints <- grid::pointsGrob(
coords$x, coords$y, pch = coords$shape,
gp = grid::gpar(
col = alpha(bgcol, NA),
fill = alpha(bgcol, NA),
fontsize = (coords$size * .pt + coords$stroke * .stroke/2) * coords$mult,
lwd = coords$stroke * .stroke/2
)
)
# Draw actual points
mypoints <- grid::pointsGrob(
coords$x, coords$y, pch = coords$shape,
gp = grid::gpar(
col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$fill, coords$alpha),
fontsize = coords$size * .pt + coords$stroke * .stroke/2,
lwd = coords$stroke * .stroke/2
)
)
# Draw line
myline <- grid::polylineGrob(
coords$x, coords$y,
id = match(coords$group, unique(coords$group)),
default.units = "native",
gp = grid::gpar(
col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$colour, coords$alpha),
lwd = (coords$linesize * .pt),
lty = coords$linetype,
lineend = "butt",
linejoin = "round", linemitre = 10
)
)
# Place graphical objects in a tree
ggplot2:::ggname(
"geom_pointpath",
grid::grobTree(myline, bgpoints, mypoints)
)
},
# Set some defaults, assures that aesthetic mappings can be made
default_aes = aes(
shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5,
linesize = 0.5, linetype = 1, mult = 3,
)
)
Run Code Online (Sandbox Code Playgroud)
细心的人可能已经注意到这条线了bgcol <- sys.frame(4)$theme$panel.background$fill
。我找不到其他方法来访问当前图的主题,而不必调整至少其他几个函数以将该主题作为参数传递。在我的ggplot(3.1.0)版本中,第4个sys.frame()
是ggplot2:::ggplot_gtable.ggplot_built
调用环境,在其中评估了geom绘图代码。很难想象此功能可以在将来进行更新(这可能会更改作用域),因此会发出稳定性警告。作为备份,当找不到当前主题时,它将默认使用全局主题设置。
编辑:现在应该更稳定
继续到不言自明的图层包装器:
geom_pointpath <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", ..., na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE)
{
layer(data = data, mapping = mapping, stat = stat, geom = GeomPointPath,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...))
}
Run Code Online (Sandbox Code Playgroud)
将其添加到ggplot中应该是很熟悉的事情。只需将主题设置为默认值theme_gray()
即可测试它是否确实采用了当前绘图的主题。
theme_set(theme_gray())
g <- ggplot(pressure, aes(temperature, pressure)) +
geom_pointpath() +
theme(panel.background = element_rect(fill = "dodgerblue"))
Run Code Online (Sandbox Code Playgroud)
当然,这种方法会使背景点的网格线模糊,但这是我为防止由于线径缩短而产生的扭曲而做出的权衡。线条大小,线条类型和背景点的相对大小可以使用aes(linesize = ..., linetype = ..., mult = ...)
或根据中的...
参数进行设置geom_pointpath()
。它继承了其他美学GeomPoint
。
我很抱歉回答了两次,但这似乎完全不同,值得一个不同的答案。
我已经对这个问题进行了更多思考,我承认几何方法确实比点对点方法更好。但是,几何方法有其自身的一系列问题,即在绘制时间之前预计算坐标的任何尝试都会以一种或另一种方式给您一些偏斜(请参阅@Tjebo的后续问题)。
几乎不可能事先知道图的纵横比或确切大小,除非手动设置纵横比或使用 的space
参数facet_grid()
。因为这是不可能的,所以如果调整图的大小,任何预先计算的坐标集都将是不够的。
我无耻地从其他人那里窃取了一些好主意,所以感谢 @Tjebo 和 @moody_mudskipper 的数学和功劳,感谢 ggplot 大师thomasp85和 ggforce 包在绘制时进行计算灵感。
继续吧;首先,我们将像以前一样定义我们的 ggproto,现在为我们的路径创建一个自定义的 grob 类。一个重要的细节是我们将 xy 坐标转换为正式单位。
GeomPointPath <- ggproto(
"GeomPointPath", GeomPoint,
draw_panel = function(data, panel_params, coord, na.rm = FALSE){
# Default geom point behaviour
if (is.character(data$shape)) {
data$shape <- translate_shape_string(data$shape)
}
coords <- coord$transform(data, panel_params)
my_points <- pointsGrob(
coords$x,
coords$y,
pch = coords$shape,
gp = gpar(col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$fill, coords$alpha),
fontsize = coords$size * .pt + coords$stroke * .stroke/2,
lwd = coords$stroke * .stroke/2))
# New behaviour
## Convert x and y to units
x <- unit(coords$x, "npc")
y <- unit(coords$y, "npc")
## Make custom grob class
my_path <- grob(
x = x,
y = y,
mult = (coords$size * .pt + coords$stroke * .stroke/2) * coords$mult,
name = "pointpath",
gp = grid::gpar(
col = alpha(coords$colour, coords$alpha),
fill = alpha(coords$colour, coords$alpha),
lwd = (coords$linesize * .pt),
lty = coords$linetype,
lineend = "butt",
linejoin = "round", linemitre = 10
),
vp = NULL,
### Now this is the important bit:
cl = 'pointpath'
)
## Combine grobs
ggplot2:::ggname(
"geom_pointpath",
grid::grobTree(my_path, my_points)
)
},
# Adding some defaults for lines and mult
default_aes = aes(
shape = 19, colour = "black", size = 1.5, fill = NA, alpha = NA, stroke = 0.5,
linesize = 0.5, linetype = 1, mult = 0.5,
)
)
Run Code Online (Sandbox Code Playgroud)
通过面向对象编程的魔力,我们现在可以为我们的新 grob 类编写一个新方法。虽然这本身可能很无趣,但如果我们为 编写这个方法,它会变得特别有趣makeContent
,每次绘制 grob 时都会调用它。因此,让我们编写一个方法,在图形设备将使用的精确坐标上调用数学运算:
# Make hook for drawing
makeContent.pointpath <- function(x){
# Convert npcs to absolute units
x_new <- convertX(x$x, "mm", TRUE)
y_new <- convertY(x$y, "mm", TRUE)
# Do trigonometry stuff
hyp <- sqrt(diff(x_new)^2 + diff(y_new)^2)
sin_plot <- diff(y_new) / hyp
cos_plot <- diff(x_new) / hyp
diff_x0_seg <- head(x$mult, -1) * cos_plot
diff_x1_seg <- (hyp - head(x$mult, -1)) * cos_plot
diff_y0_seg <- head(x$mult, -1) * sin_plot
diff_y1_seg <- (hyp - head(x$mult, -1)) * sin_plot
x0 = head(x_new, -1) + diff_x0_seg
x1 = head(x_new, -1) + diff_x1_seg
y0 = head(y_new, -1) + diff_y0_seg
y1 = head(y_new, -1) + diff_y1_seg
keep <- unclass(x0) < unclass(x1)
# Remove old xy coordinates
x$x <- NULL
x$y <- NULL
# Supply new xy coordinates
x$x0 <- unit(x0, "mm")[keep]
x$x1 <- unit(x1, "mm")[keep]
x$y0 <- unit(y0, "mm")[keep]
x$y1 <- unit(y1, "mm")[keep]
# Set to segments class
class(x)[1] <- 'segments'
x
}
Run Code Online (Sandbox Code Playgroud)
现在我们只需要一个像以前一样的层包装器,它没有什么特别的:
geom_pointpath <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", ..., na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE)
{
layer(data = data, mapping = mapping, stat = stat, geom = GeomPointPath,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...))
}
Run Code Online (Sandbox Code Playgroud)
演示:
g <- ggplot(pressure, aes(temperature, pressure)) +
# Ribbon for showing no point-over-point background artefacts
geom_ribbon(aes(ymin = pressure - 50, ymax = pressure + 50), alpha = 0.2) +
geom_pointpath()
Run Code Online (Sandbox Code Playgroud)
对于任何调整大小的纵横比,这应该是稳定的。您可以提供aes(mult = ...)
或仅mult = ...
控制段之间的间隙大小。默认情况下,它与点大小成正比,因此在保持间隙不变的同时改变点大小是一个挑战。短于间隙两倍的段将被删除。
归档时间: |
|
查看次数: |
715 次 |
最近记录: |