抖动 text/labels 与 position_stack
Jitter text/labels with position_stack
考虑以下 data.frame
和图表:
library(ggplot2)
library(scales)
df <- data.frame(L=rep(LETTERS[1:2],each=4),
l=rep(letters[1:4],2),
val=c(96.5,1,2,0.5,48,0.7,0.3,51))
# L l val
# 1 A a 96.5
# 2 A b 1.0
# 3 A c 2.0
# 4 A d 0.5
# 5 B a 48.0
# 6 B b 0.7
# 7 B c 0.3
# 8 B d 51.0
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(label=percent(val/100)),position=position_stack(vjust =0.5))
我找到了 2 个解决方案,涉及预先计算标签的基本位置,一个使用 position_jitter
,一个使用 ggrepel
(由用户@gfgm 在删除的答案中建议)
创建职位:
注意我需要把NAs
放在第一位所以我使用了:How to have NA's displayed first using arrange()
library(dplyr)
df <- df %>%
group_by(L) %>%
arrange(!is.na(l), desc(l)) %>%
mutate(pos = cumsum(val) - val/2)) # the -val/2 is to center the text
position_jitter
解决方案
set.seed(2)
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(y=pos,label=percent(val/100)),position = position_jitter(width = 0,height=4))
library(ggrepel)
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text_repel(aes(y=pos,label=percent(val/100)),direction="y",box.padding=0)
ggrepel
解决方案不需要手动校准,输出不完美但一致,但它也具有很大的灵活性,并且是我问题的大多数变体的首选解决方案。请注意 geom_text_repel
有一个 seed
参数,但在我的例子中它不会影响结果。
position_jitter
没有给出一致的结果,位置是随机的,并且在大多数情况下,它作为文本叠加是一个不太好的解决方案(我认为它像处理点一样抖动)。对于给定的图表,虽然它可以提供比 ggrepel
更好的解决方案,但事先使用 set.seed
,所以对于某些报告来说可能更好,但在其余时间更糟。
如果 geom_text_repel
支持 position_stack
我就不必经历第一步的痛苦,但不幸的是它没有。
这两种解决方案都有一点令人讨厌的抖动孤立标签的效果,而这些标签根本不应该抖动(这个问题由@erocoar 的解决方案处理)。
我们可以创建一个新的 Position
, position_jitter_stack()
.
position_jitter_stack <- function(vjust = 1, reverse = FALSE,
jitter.width = 1, jitter.height = 1,
jitter.seed = NULL, offset = NULL) {
ggproto(NULL, PositionJitterStack, vjust = vjust, reverse = reverse,
jitter.width = jitter.width, jitter.height = jitter.height,
jitter.seed = jitter.seed, offset = offset)
}
PositionJitterStack <- ggproto("PositionJitterStack", PositionStack,
type = NULL,
vjust = 1,
fill = FALSE,
reverse = FALSE,
jitter.height = 1,
jitter.width = 1,
jitter.seed = NULL,
offset = 1,
setup_params = function(self, data) {
list(
var = self$var %||% ggplot2:::stack_var(data),
fill = self$fill,
vjust = self$vjust,
reverse = self$reverse,
jitter.height = self$jitter.height,
jitter.width = self$jitter.width,
jitter.seed = self$jitter.seed,
offset = self$offset
)
},
setup_data = function(self, data, params) {
data <- PositionStack$setup_data(data, params)
if (!is.null(params$offset)) {
data$to_jitter <- sapply(seq(nrow(data)), function(i) {
any(abs(data$y[-i] - data$y[i]) <= params$offset)
})
} else {
data$to_jitter <- TRUE
}
data
},
compute_panel = function(data, params, scales) {
data <- PositionStack$compute_panel(data, params, scales)
jitter_df <- data.frame(width = params$jitter.width,
height = params$jitter.height)
if (!is.null(params$jitter.seed)) jitter_df$seed = params$jitter.seed
jitter_positions <- PositionJitter$compute_layer(
data[data$to_jitter, c("x", "y")],
jitter_df
)
data$x[data$to_jitter] <- jitter_positions$x
data$y[data$to_jitter] <- jitter_positions$y
data
}
)
并绘制它...
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(label=percent(val/100)),
position = position_jitter_stack(vjust =0.5,
jitter.height = 0.1,
jitter.width = 0.3, offset = 1))
或者,我们可以编写一个非常简单的排斥函数。
library(rlang)
position_stack_repel <- function(vjust = 1, reverse = FALSE,
offset = 1) {
ggproto(NULL, PositionStackRepel, vjust = vjust, reverse = reverse,
offset = offset)
}
PositionStackRepel <- ggproto("PositionStackRepel", PositionStack,
type = NULL,
vjust = 1,
fill = FALSE,
reverse = FALSE,
offset = 1,
setup_params = function(self, data) {
list(
var = self$var %||% ggplot2:::stack_var(data),
fill = self$fill,
vjust = self$vjust,
reverse = self$reverse,
offset = self$offset
)
},
setup_data = function(self, data, params) {
data <- PositionStack$setup_data(data, params)
data <- data[order(data$x), ]
data$to_repel <- unlist(by(data, data$x, function(x) {
sapply(seq(nrow(x)), function(i) {
(x$y[i]) / sum(x$y) < 0.1 & (
(if (i != 1) (x$y[i-1] / sum(x$y)) < 0.1 else FALSE) | (
if (i != nrow(x)) (x$y[i+1] / sum(x$y)) < 0.1 else FALSE))
})
}))
data
},
compute_panel = function(data, params, scales) {
data <- PositionStack$compute_panel(data, params, scales)
data[data$to_repel, "x"] <- unlist(
by(data[data$to_repel, ], data[data$to_repel, ]$x,
function(x) seq(x$x[1] - 0.3, x$x[1] + 0.3, length.out = nrow(x))))
data
}
)
绘制它:
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(label=percent(val/100)),
position = position_stack_repel(vjust =0.5))
考虑以下 data.frame
和图表:
library(ggplot2)
library(scales)
df <- data.frame(L=rep(LETTERS[1:2],each=4),
l=rep(letters[1:4],2),
val=c(96.5,1,2,0.5,48,0.7,0.3,51))
# L l val
# 1 A a 96.5
# 2 A b 1.0
# 3 A c 2.0
# 4 A d 0.5
# 5 B a 48.0
# 6 B b 0.7
# 7 B c 0.3
# 8 B d 51.0
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(label=percent(val/100)),position=position_stack(vjust =0.5))
我找到了 2 个解决方案,涉及预先计算标签的基本位置,一个使用 position_jitter
,一个使用 ggrepel
(由用户@gfgm 在删除的答案中建议)
创建职位:
注意我需要把NAs
放在第一位所以我使用了:How to have NA's displayed first using arrange()
library(dplyr)
df <- df %>%
group_by(L) %>%
arrange(!is.na(l), desc(l)) %>%
mutate(pos = cumsum(val) - val/2)) # the -val/2 is to center the text
position_jitter
解决方案
set.seed(2)
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(y=pos,label=percent(val/100)),position = position_jitter(width = 0,height=4))
library(ggrepel)
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text_repel(aes(y=pos,label=percent(val/100)),direction="y",box.padding=0)
ggrepel
解决方案不需要手动校准,输出不完美但一致,但它也具有很大的灵活性,并且是我问题的大多数变体的首选解决方案。请注意 geom_text_repel
有一个 seed
参数,但在我的例子中它不会影响结果。
position_jitter
没有给出一致的结果,位置是随机的,并且在大多数情况下,它作为文本叠加是一个不太好的解决方案(我认为它像处理点一样抖动)。对于给定的图表,虽然它可以提供比 ggrepel
更好的解决方案,但事先使用 set.seed
,所以对于某些报告来说可能更好,但在其余时间更糟。
如果 geom_text_repel
支持 position_stack
我就不必经历第一步的痛苦,但不幸的是它没有。
这两种解决方案都有一点令人讨厌的抖动孤立标签的效果,而这些标签根本不应该抖动(这个问题由@erocoar 的解决方案处理)。
我们可以创建一个新的 Position
, position_jitter_stack()
.
position_jitter_stack <- function(vjust = 1, reverse = FALSE,
jitter.width = 1, jitter.height = 1,
jitter.seed = NULL, offset = NULL) {
ggproto(NULL, PositionJitterStack, vjust = vjust, reverse = reverse,
jitter.width = jitter.width, jitter.height = jitter.height,
jitter.seed = jitter.seed, offset = offset)
}
PositionJitterStack <- ggproto("PositionJitterStack", PositionStack,
type = NULL,
vjust = 1,
fill = FALSE,
reverse = FALSE,
jitter.height = 1,
jitter.width = 1,
jitter.seed = NULL,
offset = 1,
setup_params = function(self, data) {
list(
var = self$var %||% ggplot2:::stack_var(data),
fill = self$fill,
vjust = self$vjust,
reverse = self$reverse,
jitter.height = self$jitter.height,
jitter.width = self$jitter.width,
jitter.seed = self$jitter.seed,
offset = self$offset
)
},
setup_data = function(self, data, params) {
data <- PositionStack$setup_data(data, params)
if (!is.null(params$offset)) {
data$to_jitter <- sapply(seq(nrow(data)), function(i) {
any(abs(data$y[-i] - data$y[i]) <= params$offset)
})
} else {
data$to_jitter <- TRUE
}
data
},
compute_panel = function(data, params, scales) {
data <- PositionStack$compute_panel(data, params, scales)
jitter_df <- data.frame(width = params$jitter.width,
height = params$jitter.height)
if (!is.null(params$jitter.seed)) jitter_df$seed = params$jitter.seed
jitter_positions <- PositionJitter$compute_layer(
data[data$to_jitter, c("x", "y")],
jitter_df
)
data$x[data$to_jitter] <- jitter_positions$x
data$y[data$to_jitter] <- jitter_positions$y
data
}
)
并绘制它...
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(label=percent(val/100)),
position = position_jitter_stack(vjust =0.5,
jitter.height = 0.1,
jitter.width = 0.3, offset = 1))
或者,我们可以编写一个非常简单的排斥函数。
library(rlang)
position_stack_repel <- function(vjust = 1, reverse = FALSE,
offset = 1) {
ggproto(NULL, PositionStackRepel, vjust = vjust, reverse = reverse,
offset = offset)
}
PositionStackRepel <- ggproto("PositionStackRepel", PositionStack,
type = NULL,
vjust = 1,
fill = FALSE,
reverse = FALSE,
offset = 1,
setup_params = function(self, data) {
list(
var = self$var %||% ggplot2:::stack_var(data),
fill = self$fill,
vjust = self$vjust,
reverse = self$reverse,
offset = self$offset
)
},
setup_data = function(self, data, params) {
data <- PositionStack$setup_data(data, params)
data <- data[order(data$x), ]
data$to_repel <- unlist(by(data, data$x, function(x) {
sapply(seq(nrow(x)), function(i) {
(x$y[i]) / sum(x$y) < 0.1 & (
(if (i != 1) (x$y[i-1] / sum(x$y)) < 0.1 else FALSE) | (
if (i != nrow(x)) (x$y[i+1] / sum(x$y)) < 0.1 else FALSE))
})
}))
data
},
compute_panel = function(data, params, scales) {
data <- PositionStack$compute_panel(data, params, scales)
data[data$to_repel, "x"] <- unlist(
by(data[data$to_repel, ], data[data$to_repel, ]$x,
function(x) seq(x$x[1] - 0.3, x$x[1] + 0.3, length.out = nrow(x))))
data
}
)
绘制它:
ggplot(df,aes(x=L,y=val,fill=l)) +
geom_bar(stat="identity") +
geom_text(aes(label=percent(val/100)),
position = position_stack_repel(vjust =0.5))