合并(折叠)字符串向量的某些元素，但不是 R 中的所有元素

Question

我有一个非常奇特的问题，我无法处理。我有一个字符串向量，每个元素代表小说的一个句子。

我需要做的是仅折叠同一对话中的那些行。例如，以以下行为例：

snap <- c("It was a few seconds before Mr Dursley realised that the man was wearing a violet cloak.",
      "He didn't seem at all upset at being almost knocked to the ground.",
      "On the contrary, his face split into a wide smile and he said in a squeaky voice that made passers-by stare: "Don't be sorry, my dear sir, for nothing could upset me today!",
      "Rejoice, for You-Know-Who has gone at last!",
      "Even Muggles like yourself should be celebrating, this happy, happy day!"",
      "And the old man hugged Mr Dursley around the middle and walked off."
      )

第 3 行到第 5 行属于同一对话，因此必须折叠它们，结果向量为：

snap.2 <- c("It was a few seconds before Mr Dursley realised that the man was wearing a violet cloak.",
      "He didn't seem at all upset at being almost knocked to the ground.",
      "On the contrary, his face split into a wide smile and he said in a squeaky voice that made passers-by stare: "Don't be sorry, my dear sir, for nothing could upset me today! Rejoice, for You-Know-Who has gone at last! Even Muggles like yourself should be celebrating, this happy, happy day!"",
      "And the old man hugged Mr Dursley around the middle and walked off."
      )

我可以使用以下方法检测不平衡的双引号：

which((str_count(snap, """) %% 2) != 0)
[3 5]

但是我不知道如何合并，就像上面的例子一样，第 3、4 和 5 行

知道如何做到这一点吗？

Answer 1

我们可以将它们paste在一起，然后根据正则表达式进行拆分

out <- strsplit(paste(snap, collapse=' '), '(?<=\.)\s*|(?<=["])\s', perl = TRUE)[[1]]
identical(out, snap.2)
#[1] TRUE

注意：目前尚不清楚模式。

Answer 2

这可能不是最好的方法(非常丑陋的代码(，但它有效。基本上：

1. 将which的输出分成两对(这对将代表对话开始和结束偏移(
2. 使用 dplyr 的领先和滞后查找上一个和下一个对话的偏移量
3. 用假夫妻填补空白，其中 dialogue.start = dialogue.end for not 对话行
4. 使用输出数据集作为粘贴索引

在代码中：

dialogue.start <- which((str_count(snap, """) %% 2) != 0)
quotes.fill <- data.frame(dialogue.start) %>%
  mutate(n = row_number())
quotes.fill$dialogue.end <- ifelse((quotes.fill$n %% 2) != 0, lead(quotes.fill$dialogue.start, 1), NA)
quotes.fill$dialogue.next <- ifelse((quotes.fill$n %% 2) != 0, lead(quotes.fill$dialogue.start, 2, default = NROW(snap)), NA)
quotes.fill$dialogue.before <- ifelse((quotes.fill$n %% 2) != 0, lag(quotes.fill$dialogue.start, 2, default = 0), NA)

quotes.fill <- quotes.fill %>% filter(!is.na(dialogue.end)) %>%
  select(-n)
quotes.gaps <- do.call(rbind, lapply(split(quotes.fill, seq(nrow(quotes.fill))), function(x) { 
  prologue <- NULL
  dialogue.hold <- seq(to = (x$dialogue.next - 1), from = (x$dialogue.end + 1))
  dialogue.prologue <- seq(to = (x$dialogue.start - 1), from = (x$dialogue.before + 1))
  if(x$dialogue.before == 0 & x$dialogue.start > 0) prologue <- data.frame(dialogue.start = dialogue.prologue, dialogue.end = dialogue.prologue, stringsAsFactors = FALSE)
  if((x$dialogue.end + 1) >= x$dialogue.next) return(rbind(prologue, x[,c("dialogue.start", "dialogue.end")]))

  return(rbind(prologue, x[,c("dialogue.start", "dialogue.end")], data.frame(dialogue.start = dialogue.hold, dialogue.end = dialogue.hold, stringsAsFactors = FALSE)))
})
)
snap.2 <- do.call(c, lapply(split(quotes.gaps, seq(nrow(quotes.gaps))), function(c, novel) {
  paste(novel[c$dialogue.start:c$dialogue.end], collapse = " ")
}, novel = snap))