我正在撰寫的一個函式使用ggplot2::geom_text(). 但是，我需要字體大小保持縮放到視窗大小，這意味著：如果視窗大小減小，則字體大小也必須減小，反之亦然，以防增加視窗大小。我沒有在網上找到解決方案。因此，我正在嘗試創建一個與實際GeomTextScaled作業略有不同的 ggplot2 GeomText。受這篇文章的啟發，我在下面撰寫了初步解決方案。對于熟悉grid和 grobs 等的每個人來說，這可能是非常尷尬的。
# awkward temporary solution
# other fns. resizingGrobText, drawDetails.resizingTextGrob,
# preDrawDetails.resizingGrobText, postDrawDetails.resizingGrobText
#' @export
resizingTextGrob <- function(...){
grid::grob(tg = grid::textGrob(...), cl = "resizingTextGrob")
}
# draw --------------------------------------------------------------------
drawDetails <- grid::drawDetails
#' @exportS3Method
drawDetails.resizingTextGrob <- function(x, recording = TRUE){
grid::grid.draw(x$tg)
}
# pre ---------------------------------------------------------------------
preDrawDetails <- grid::preDrawDetails
#' @exportS3Method
preDrawDetails.resizingTextGrob <- function(x){
# awkward...
size.x <-
base::get(
x = "temp_x.size.scale.bar.text.x_temp",
envir = .GlobalEnv
)
h <- grid::convertHeight(unit(size.x, "snpc"), "mm", valueOnly=TRUE)
fs <- scales::rescale(h, to=c(18, 7), from=c(120, 20))
grid::pushViewport(viewport(gp = grid::gpar(fontsize = fs)))
}
# post --------------------------------------------------------------------
postDrawDetails <- grid::postDrawDetails
#' @exportS3Method
postDrawDetails.resizingTextGrob <- function(x){ grid::popViewport()}
# ggplot2 --------------------------------------------------------------------
#' @title GeomTextScaled
#' @format NULL
#' @usage NULL
#' @export
GeomTextScaled <- ggplot2::ggproto(
`_class` = "GeomTextScaled",
`_inherit` = ggplot2::Geom,
required_aes = c("x", "y", "label"),
default_aes = aes(
colour = "black", size = 3.88, angle = 0, hjust = 0.5,
vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2
),
draw_panel = function(data, panel_params, coord, parse = FALSE,
na.rm = FALSE, check_overlap = FALSE) {
lab <- data$label
data <- coord$transform(data, panel_params)
size.x <- data$size
# awkward...
base::assign(
x = "temp_x.size.scale.bar.text.x_temp",
value = size.x,
envir = .GlobalEnv
)
resizingTextGrob(
label = lab,
x = data$x,
y = data$y,
default.units = "native",
rot = data$angle,
gp = grid::gpar(
col = ggplot2::alpha(data$colour, data$alpha),
fontfamily = data$family,
fontface = data$fontface,
lineheight = data$lineheight
),
check.overlap = check_overlap
)
},
draw_key = ggplot2::draw_key_text
)
#' @export
geom_text_scaled <- function(...,
mapping = ggplot2::aes(),
data = NULL,
stat = "identity",
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE){
ggplot2::layer(
geom = GeomTextScaled,
data = data,
stat = stat,
position = position,
params = c(..., list(na.rm = na.rm)),
show.legend = show.legend,
inherit.aes = inherit.aes,
mapping = mapping
)
}
這是一個有效的例子......
# example -----------------------------------------------------------------
?
library(ggplot2)
?
ggplot()
geom_text_fixed(
data = data.frame(x = 25, y = 25, label = "scaled_to_window"),
mapping = aes(x = x, y= y, label = label),
size = 1
)
geom_text(
data = data.frame(x = 75, y = 75, label = "stays the same"),
mapping = aes(x = x, y= y, label = label),
size = 5
)
coord_cartesian(xlim = c(0,100), ylim = c(0,100))
?
但它只適用于我想洗掉的兩種情況：
我無法通過
size引數“交流”preDrawDetails()，每次使用時都必須為全域環境分配一個變數。我不想這樣做，但我不知道如何訪問調整GrobText() 的方法。我實際上正在撰寫一個必須匯出所有內容的包。如果我在全域環境中加載下面的代碼，一切正常。如果我只通過它加載包
devtools::load_all()則不會。
我該如何解決這個問題？
如果有比撰寫一個我在谷歌找不到的全新 Geom 更簡單的解決方案，我很樂意使用它！我只需要此圖中的文本保持縮放到視口大小。
任何幫助表示贊賞。非常感謝！
……
uj5u.com熱心網友回復：
makeContent.my_class我認為在這種情況下，創建一個方法比您之前撰寫的所有三種方法都容易。下面，我們縮放字體大小，使其成為面板寬度的一小部分。
#' @export
resizingTextGrob <- function(...){
grobTree(tg = textGrob(...), cl = "resizingTextGrob")
}
#' @export
#' @method makeContent resizingTextGrob
makeContent.resizingTextGrob <- function(x) {
width <- convertWidth(unit(1, "npc"), "pt", valueOnly = TRUE)
fontsize <- x$children[[1]]$gp$fontsize
fontsize <- if (is.null(fontsize)) 12 else fontsize
x$children[[1]]$gp$fontsize <- fontsize * width / 100
x
}
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/532435.html