r - 创建一个函数，在 R 中字符变量的每个字母之间插入换行符

Question

我想要的:创建一个函数，在 R 中的字符变量的每个字母之间插入换行符。

我尝试过:但没有成功

wrap_letters <- function(x){ 
  z <- substring(x, 1, 1) # Take the first letter of x and save it in z
  for(i in 2:stri_length(x)) { #from the second to the length of x
  w  <- substring(x, i, 1)  #take the respective letter and save it to w
  z <- paste0(z,"\n",  w) #paste z, "\n", w
  }
 z #return z
}

可重现的数据示例(使用 R 中的 ToothGrowth):

df <- ToothGrowth %>%
   mutate(dose = factor(dose),
          supp = case_when(
             supp=="OJ" ~ "orange juice", 
             T ~ "ascorbic acid"),
          supp_label = wrap_letters(supp))

应用:在facet_grid图中垂直写入标签:我想将字母旋转到正常位置(即水平)，但将字母放在彼此下方，所以它们不会占用太多宽度:

bp <- ggplot(df, aes(x=dose, y=len, group=dose)) + 
   geom_boxplot(aes(fill=dose)) +
   theme(
      strip.text.y = element_text(angle = 0)
   ) +
   facet_grid(supp_label ~ dose)
bp

期望的结果:

df <- ToothGrowth %>%
   mutate(dose = factor(dose),
          supp_label = case_when(
             supp=="OJ" ~ "o\nr\na\nn\ng\ne\n \nj\nu\ni\nc\ne", 
             T ~ "a\ns\nc\no\nr\nb\ni\nc\n \na\nc\ni\nd"))

bp <- ggplot(df, aes(x=dose, y=len, group=dose)) + 
   geom_boxplot(aes(fill=dose)) +
   scale_y_continuous(position = "right") +
   facet_grid(supp_label ~ dose, switch = "y") +
   theme(
      strip.text.y.left = element_text(angle = 0, size = 12, face = "bold"), 
      strip.text.x = element_text(angle = 0, size = 12, face = "bold")
   )
bp

注意:这是一个可重现的小示例，我的数据框中有更多类别，我想让所有内容都可重现，这就是我需要一个函数的原因。

Answer 1

wrap_letters 可以写成:

wrap_letters <- function(x) {
  sapply(strsplit(x, ''), paste0, collapse = '\n')
}

您可以将向量传递给它并进行绘图。

library(dplyr)
library(ggplot2)

ToothGrowth %>%
  mutate(dose = factor(dose),
         supp = case_when(supp=="OJ" ~ "orange juice", 
                          TRUE ~ "ascorbic acid"),
         supp_label = wrap_letters(supp)) %>%
  ggplot(aes(x=dose, y=len, group=dose)) + 
  geom_boxplot(aes(fill=dose)) +
  theme(strip.text.y = element_text(angle = 0)) +
  facet_grid(supp_label ~ dose)