我有一个数据集，其中包含一个存储数百个写作样本的列。我的目标是将每个写作样本导出到单独的图像中。下面，我当前的代码：

Question

max_text <- df |> 
  rowwise() |> 
  mutate(n = nchar(Sample)) |> 
  ungroup() |> 
  top_n(1, n)

p_longest_text <- ggplot(max_text, aes(label = Sample)) +
  ggtext::geom_textbox(x = 0, y = 1, width = 0.9, hjust = 0, vjust = 1, size = 3, box.colour = "white") +
  theme_void()

ggsave("longest_text.png", p_longest_text, width = 1000, height = 1200, units = "px", bg = "white")

建立足够的文本大小后，我可以在前面的循环中使用该值（在当前的玩具数据集中）为每个写作样本生成一个图像。在所有图像中，文本大小将相同：

size = 3

不幸的是，仍然存在两个问题：

我无法裁剪空空间。不幸的是，

for(i in 1:nrow(df)) {
    tec <- paste0(df[i,]$ID, ".png")
    p <- ggplot(df[i,], aes(label = Sample)) +
      ggtext::geom_textbox(x = 0, y = 1, width = 0.9, hjust = 0, vjust = 1, size = 3, box.colour = "white") +
      theme_void()
    ggsave(tec, p, width = 1000, height = 1200, units = "px", bg = "white")
}

效果不佳，因为它在文本和裁剪部分之间没有任何余地。

image_trim()

似乎更有前途，但我不知道如何将其调整为不同的图像。

现在，代码要求用户手动尝试不同的文本尺寸，以确定在循环中使用的值。自动化此过程将是很棒的，以便可以在没有用户的决定的情况下运行代码的一部分。

任何帮助都将不胜感激！

我怀疑您对
1. image_crop

   的最初尝试是必经之路。
   

   要在修剪的图像周围添加边距，您可以使用

   image_trim()

   。
image_border()
在图像周围创造了20px高和宽的边界。

https：//cran.r-project.org/web/packages/magick/vignettes/intro.html

Answer 1

文本尺寸

对于文本大小，如果性能不是一个巨大的问题，您将计算出来：

开始了一个很好的猜测。说5.

运行计算，但要使图像的高度大得多。
run装饰。如果修剪的图像大于您所需的1000px的高度，则文本大小太大。减少它，然后重试。

如果修剪的图像小于所需的高度，请尝试增加它。如果那变得太大，您就会知道原始的猜测是正确的。

这种蛮力技术只有在您的性能不重要的情况下起作用，因为它涉及将所有图像转换应用于每次迭代。 另一方面，使用单层字体将允许您计算特定文本块所需的确切行数，这应该使您可以计算给定值的文本大小的所需高度。没有单拼字体，我担心由于字体的自动调整和压缩而导致字体的自动调整和压缩，因此计算文本大小而不实际渲染文本会非常困难。

，例如，在这种字体中，L和L占据了截然不同的空间。同样在给定字母之前或之后的字母中，可以调整间距以使其看起来更自然。

{ggplot2}的INSTEAD我依靠编写HTML文件并使用JavaScript检查溢出。 使用

---

image_border(image, "white", "20x20")

一些功能

library(chromote)
library(htmltools)
library(magick)
library(purrr)
library(stringi)
library(tidyverse)

示例用法

write_text_html <- function(
  text, 
  file,
  font_size = 12, 
  font_family = "Courier New",
  dimensions = c(992, 744),
  width = dimensions[1], 
  height = dimensions[2], 
  border = c(0, 0),
  border_width = border[1],
  border_height = border[2]
) {
  css <- sprintf(
    paste(
      c(
        "",
        ".content {",
        "  display: flex;",
        "  justify-content: center;",
        "  align-items: center;",
        "  width: %spx;",
        "  height: %spx;",
        "  font-family: '%s';",
        "  font-size: %spx;",
        "  padding-left: %spx;",
        "  padding-bottom: %spx;",
        "  padding-right: %spx;",
        "  padding-top: %spx;",
        "  overflow: hidden;",
        "}",
        ""
      ),
      collapse = "\n"
    ), 
    width - 2 * border_width, 
    height - 2 * border_height, 
    font_family, 
    font_size,
    border_width,
    border_height,
    border_width,
    border_height
  )
  
  htmltools::tagList(
    htmltools::tags$style(css),
    htmltools::tags$body(
      htmltools::tags$div(id = "content", class = "content", text)
    )
  ) %>% 
    htmltools::html_print()
}

path_to_uri <- function(path) {
  path %>% 
    # get forward slash on windows
    normalizePath(winslash = "/") %>% 
    # replace drive:/ with drive:// so C:/ becomes C://
    gsub(x = ., pattern = ":/", replacement = "://") %>%
    # appends file:/// to make valid uri
    paste0("file:///", .)
}

html_has_overflow <- function(html) {
  b <- chromote::ChromoteSession$new() # new session or tab
  
  html %>% 
    path_to_uri() %>% 
    b$Page$navigate()
  
  Sys.sleep(3)
  
  x <- b$Runtime$evaluate(paste0(
    "var obj = document.getElementById('content');",
    "obj.scrollHeight > obj.offsetHeight"
  ))
  
  Sys.sleep(3)
  
  b$close() # close tab
  
  return(x$result$value)
}

write_html_png <- function(
  html, 
  png, 
  dimensions = c(992, 744),
  width = dimensions[1], 
  height = dimensions[2]
) {
  b <- chromote::ChromoteSession$new() # new session or tab
  
  html %>% 
    path_to_uri() %>% 
    b$Page$navigate()
  
  Sys.sleep(3)
  
  b$screenshot(png, selector = ".content")
  
  Sys.sleep(3)
  
  b$close() # close tab
  
  magick::image_blank(width, height, color = "white") %>% 
    magick::image_composite(
      magick::image_read(png), 
      gravity = "center"
    ) %>% 
    magick::image_write(png)
}

max_font_size_no_overflow <- function(
  text,
  font_size_range,
  font_size_min = min(font_size_range),
  font_size_max = max(font_size_range),
  font_family = "Courier New",
  border = c(0, 0),
  border_width = border[1],
  border_height = border[2],
  target_dimensions = c(992, 744),
  target_width = target_dimensions[1],
  target_height = target_dimensions[2]
) {
  mfsno <- purrr::map_dfr(
    font_size_min:font_size_max, 
    ~ {
      has_overflow <- write_text_html(
        text = text,
        file = tempfile(fileext = ".html"),
        font_size = ., 
        font_family = font_family,
        dimensions = c(target_width, target_height),
        border = c(border_width, border_height)
      ) %>% 
        html_has_overflow()
      
      dplyr::tibble(font_size = ., has_overflow)
    }
  ) %>% 
    dplyr::filter(!has_overflow) %>% 
    dplyr::arrange(dplyr::desc(font_size)) %>% 
    dplyr::slice(1) %>% 
    dplyr::pull(font_size)
  
  if(length(mfsno) != 1)
    stop("Maximum font size unidentified.")
  else
    mfsno
}

输出

1.png

2.png

Answer 2

3.png

4.png

5.png

用Reprexv2.0.2于2022-11-01创建