从 dplyr 中以空格分隔的字符串中提取第 n 个位置

Question

我有一个看起来像这样的数据框：

data <- data.frame(label = c('S', 'SH', 'S', 'S', 'SH'),
               word = c('sip', 'shoe', 'plaster', 'reception', 'reception'),
               word.segs = c('S IH1 P', 'SH UW1', 'P L AE1 S T AH0', 'R AH0 S EH1 P SH AH0 N', 'R AH0 S EH1 P SH AH0 N'),
               seg.index = c(1, 1, 4, 3, 6))

'word.segs' 包含 'word' 列中单词的音标，'seg.index' 中的值是指感兴趣的片段 - 该转录中的第 n 个片段。我想做的是创建两个新列，其中包含 after 这两个段，即 seg.index+1 和 seg.index+2。

我已经在下面的循环中尝试过，它有效，但它需要很长时间（而且我有 100k 行，所以在这里有一个有效的解决方案很重要）

for (x in 1:nrow(data)){
  data[x, ]$fol.seg = unlist(data$word.segs[x])[data[x, ]$seg.index+1]
  data[x, ]$fol.seg2 = unlist(data$word.segs[x])[data[x, ]$seg.index+2]
}

（请注意，我也尝试过只取消列出一次，将其保存到单独的对象中，然后提取两个感兴趣的值，但这似乎并没有明显更快）

我还在 dplyr 中尝试了另一种方法，希望它可能更有效：

data <- data %>%
  mutate(fol.seg = word.segs %>%
  strsplit(split = " ") %>%
  unlist() %>%
  nth(seg.index+1))

但我收到以下错误消息，我不知道为什么它不起作用：

mutate_impl(.data, dots) 中的错误： 评估错误：length(n) == 1 is not TRUE.

任何帮助将不胜感激！

Answer 1

这行得通，只需使用基础 R。您也许可以使用 purrr 来设计它。

library(dplyr)

try_pull = function(x, i) {
  if (i > length(x)) NA else x[[i]]
}

res = data %>%
  mutate(seg_list = strsplit(word.segs, split = " "),
         seg1 = Map(f = try_pull, seg_list, seg.index + 1),
         seg2 = Map(f = try_pull, seg_list, seg.index + 2)
  )
res
#   label      word              word.segs seg.index                      seg_list seg1 seg2
# 1     S       sip                S IH1 P         1                     S, IH1, P  IH1    P
# 2    SH      shoe                 SH UW1         1                       SH, UW1  UW1   NA
# 3     S   plaster        P L AE1 S T AH0         4          P, L, AE1, S, T, AH0    T  AH0
# 4     S reception R AH0 S EH1 P SH AH0 N         3 R, AH0, S, EH1, P, SH, AH0, N  EH1    P
# 5    SH reception R AH0 S EH1 P SH AH0 N         6 R, AH0, S, EH1, P, SH, AH0, N  AH0    N

Answer 2

dplyr 的另一种可能性可能是：

data %>%
 rowwise() %>%
 mutate(seg1 = sapply(strsplit(as.character(word.segs), " "), function(x) x[seg.index + 1]),
        seg2 = sapply(strsplit(as.character(word.segs), " "), function(x) x[seg.index + 2]))

  label word      word.segs              seg.index seg1  seg2 
  <fct> <fct>     <fct>                      <dbl> <chr> <chr>
1 S     sip       S IH1 P                        1 IH1   P    
2 SH    shoe      SH UW1                         1 UW1   <NA> 
3 S     plaster   P L AE1 S T AH0                4 T     AH0  
4 S     reception R AH0 S EH1 P SH AH0 N         3 EH1   P    
5 SH    reception R AH0 S EH1 P SH AH0 N         6 AH0   N

在这里，它通过strsplit() 拆分“word.segs”，然后使用sapply() 选择所需的元素。

或者使用您原始帖子中的想法：

data %>%
 rowwise %>%
 mutate(seg1 = strsplit(as.character(word.segs), " ") %>%
         unlist() %>%
         nth(seg.index + 1),
        seg2 = strsplit(as.character(word.segs), " ") %>%
         unlist() %>%
         nth(seg.index + 2))

Answer 3

以下 data.table 方法应该既快速又灵活，可以选择 seg.index 之后的所有段或仅选择前两个段

library(data.table)
data <- data.frame(label = c('S', 'SH', 'S', 'S', 'SH'),
                   word = c('sip', 'shoe', 'plaster', 'reception', 'reception'),
                   word.segs = c('S IH1 P', 'SH UW1', 'P L AE1 S T AH0', 'R AH0 S EH1 P SH AH0 N', 'R AH0 S EH1 P SH AH0 N'),
                   seg.index = c(1, 1, 4, 3, 6),stringsAsFactors = F)
data$id <- 1:nrow(data)

dt <- as.data.table(data,stringsAsFactors=F)
setkeyv(dt,"id")

segdt<-dt[,list(seg.index=seg.index,seg=unlist(strsplit(word.segs,"\\s+"))),by="id"][,n:=1:.N,by="id"]

segdt<-segdt[n>seg.index][,`:=`(seg.col=paste0("seg",1:.N),seg.num=1:.N),by="id"]
#dt[segdt[,list(index.word.segs=paste(seg,collapse=",")),by="id"]] #rejoin original table and all segs after seg.index

widesegs <- dcast.data.table(segdt[seg.num<=2,.(id,seg,seg.col)],id ~ seg.col,value.var="seg") #only first two segs after seg.index or NA

dt[widesegs]

结果：

> dt[widesegs]
   label      word              word.segs seg.index id seg1 seg2
1:     S       sip                S IH1 P         1  1  IH1    P
2:    SH      shoe                 SH UW1         1  2  UW1   NA
3:     S   plaster        P L AE1 S T AH0         4  3    T  AH0
4:     S reception R AH0 S EH1 P SH AH0 N         3  4  EH1    P
5:    SH reception R AH0 S EH1 P SH AH0 N         6  5  AH0    N

替代结果：

保持所有段大于 seg.index：

widesegs <- dcast.data.table(segdt[,.(id,seg,seg.col)],id ~ seg.col,value.var="seg") #all segs after seg.index or NA

dt[widesegs]
> dt[widesegs]
   label      word              word.segs seg.index id seg1 seg2 seg3 seg4 seg5
1:     S       sip                S IH1 P         1  1  IH1    P   NA   NA   NA
2:    SH      shoe                 SH UW1         1  2  UW1   NA   NA   NA   NA
3:     S   plaster        P L AE1 S T AH0         4  3    T  AH0   NA   NA   NA
4:     S reception R AH0 S EH1 P SH AH0 N         3  4  EH1    P   SH  AH0    N
5:    SH reception R AH0 S EH1 P SH AH0 N         6  5  AH0    N   NA   NA   NA