facet_trelliscope с переносом текста [дубликат]
4 ответа
Благодаря руководству от @baptiste и @thunk, я создал функцию ниже, которая, похоже, довольно хорошо выполняет автоматическую упаковку меток фасет. Предложения по улучшению всегда приветствуются.
strwrap_strip_text = function(p, pad=0.05) {
# get facet font attributes
th = theme_get()
if (length(p$theme) > 0L)
th = th + p$theme
require("grid")
grobs <- ggplotGrob(p)
# wrap strip x text
if ((class(p$facet)[1] == "grid" && !is.null(names(p$facet$cols))) ||
class(p$facet)[1] == "wrap")
{
ps = calc_element("strip.text.x", th)[["size"]]
family = calc_element("strip.text.x", th)[["family"]]
face = calc_element("strip.text.x", th)[["face"]]
if (class(p$facet)[1] == "wrap") {
nm = names(p$facet$facets)
} else {
nm = names(p$facet$cols)
}
# get number of facet columns
levs = levels(factor(p$data[[nm]]))
npanels = length(levs)
if (class(p$facet)[1] == "wrap") {
cols = n2mfrow(npanels)[1]
} else {
cols = npanels
}
# get plot width
sum = sum(sapply(grobs$width, function(x) convertWidth(x, "in")))
panels_width = par("din")[1] - sum # inches
# determine strwrap width
panel_width = panels_width / cols
mx_ind = which.max(nchar(levs))
char_width = strwidth(levs[mx_ind], units="inches", cex=ps / par("ps"),
family=family, font=gpar(fontface=face)$font) /
nchar(levs[mx_ind])
width = floor((panel_width - pad)/ char_width) # characters
# wrap facet text
p$data[[nm]] = unlist(lapply(strwrap(p$data[[nm]], width=width,
simplify=FALSE), paste, collapse="\n"))
}
if (class(p$facet)[1] == "grid" && !is.null(names(p$facet$rows))) {
ps = calc_element("strip.text.y", th)[["size"]]
family = calc_element("strip.text.y", th)[["family"]]
face = calc_element("strip.text.y", th)[["face"]]
nm = names(p$facet$rows)
# get number of facet columns
levs = levels(factor(p$data[[nm]]))
rows = length(levs)
# get plot height
sum = sum(sapply(grobs$height, function(x) convertWidth(x, "in")))
panels_height = par("din")[2] - sum # inches
# determine strwrap width
panels_height = panels_height / rows
mx_ind = which.max(nchar(levs))
char_height = strwidth(levs[mx_ind], units="inches", cex=ps / par("ps"),
family=family, font=gpar(fontface=face)$font) /
nchar(levs[mx_ind])
width = floor((panels_height - pad)/ char_height) # characters
# wrap facet text
p$data[[nm]] = unlist(lapply(strwrap(p$data[[nm]], width=width,
simplify=FALSE), paste, collapse="\n"))
}
invisible(p)
}
Чтобы использовать эту функцию, вызовите ее вместо print.
library(ggplot2)
df = expand.grid(group=paste(c("Very Very Very Long Group Name "), 1:4),
group1=paste(c("Very Very Very Long Group Name "), 5:8),
x=rnorm(5), y=rnorm(5), stringsAsFactors=FALSE)
p = ggplot(df) +
geom_point(aes(x=x, y=y)) +
facet_grid(group1~group)
strwrap_strip_text(p)
-
1– baptiste 24 May 2013 в 15:22
(слишком длинный как комментарий, но не реальный ответ)
Я не думаю, что общее решение будет существовать непосредственно в ggplot2; это классическая проблема самореференции для grid-единиц: ggplot2 хочет рассчитать размеры видовых экранов «на лету», а strwrap должен знать твердую ширину, чтобы решить, как разделить текст. (был очень похожий вопрос, но я забыл, когда и где).
Однако вы могли бы написать вспомогательную функцию, чтобы оценить, сколько обертываний вам понадобится до построения графика. В псевдокоде
# takes the facetting variable and device size
estimate_wrap = function(f, size=8, fudge=1){
n = nlevels(f)
for (loop over the labels of strwidth wider than (full.size * fudge) / n){
new_factor_level[ii] = strwrap(label[ii], available width)
}
return(new_factor)
}
(с некоторыми стандартными преобразованиями единиц)
Конечно, все будет усложняться, если вы хотите использовать space="free".
-
1– user338714 22 May 2013 в 14:56
-
2– thunk 22 May 2013 в 20:12
Поскольку этот вопрос был отправлен, новая функция label_wrap_gen() с ggplot2 (> = 1.0.0, я думаю) прекрасно справляется с этим:
facet_wrap(~groupwrap, labeller = labeller(groupwrap = label_wrap_gen(10)))
Обратите внимание, что вам нужно указать ширину для работы.
Для более старых версий ggplot2:
facet_wrap(~groupwrap, labeller = label_wrap_gen())
-
1– slhck 19 January 2017 в 15:28
-
2– dca 8 July 2017 в 22:34
-
3– David M 15 November 2017 в 17:32
Также слишком длинный для комментария, но не полный ответ. Он идет по строкам ответа баптиста, но с еще несколькими указателями:
p <- ggplot(df) + geom_point(aes(x=x, y=y)) + facet_wrap(~groupwrap)
# get the grobs of the plot and get the widths of the columns
grobs <- ggplotGrob(p)
grobs$width
# here you would have to use convertWidth from gridDebug package
# to convert all the units in the widths to the same unit (say 'pt'),
# including exctraction from the strings they are in -- also, I
# couldn't make it work neither for the unit 'null' nor for 'grobwidth',
# so you'll have to add up all the other ones, neglect grobwidth, and
# subtract all the widths that are not null (which is the width of each
# panel) from the device width
library('grid')
convertWidth(DO FOR EACH ELEMENT OF grobs$width)
sum <- SUM_UP_ALL_THE_NON-PANEL_WIDTHS
# get the width of the graphics device
device <- par('din')[1]
# get width of all panels in a row
panels_width <- device - sum
# get total number of panels in your case
df$group <- as.factor(df$group)
npanels <- nlevels(df$group)
# get number of panels per row (i.e. number of columns in graph) with
# the function that ggplot2 uses internally
cols <- n2mfrow(npanels)
# get estimate of width of single panel
panel_width <- panels_width / cols
Извините, что это по-прежнему неоднородно по частям. Но это до тех пор, пока я получил, поэтому я надеюсь, что эти идеи могут помочь на этом пути ...
-
1– baptiste 21 May 2013 в 13:21
-
2– thunk 21 May 2013 в 13:50
-
3– baptiste 21 May 2013 в 14:04
-
4– thunk 21 May 2013 в 14:38
-
5– baptiste 21 May 2013 в 14:41