R 映射多个值

我需要像你这样的专家帮助解决一个问题，这个问题对我的R技能来说太大了

我有一个向量和一个data.frame：

vec = c("v1;v2","v3","v4","v5;v6")

vecNames = c("v1","v2","v3","v4","v5","v6")
vecNames
## [1] "v1" "v2" "v3" "v4" "v5" "v6"

vecDescription = c("descr1","descr2","descr3","descr4","descr5","descr6")
vecDescription
## [1] "descr1" "descr2" "descr3" "descr4" "descr5" "descr6"

df = data.frame(vecNames, vecDescription)
df
  vecNames vecDescription
1       v1         descr1
2       v2         descr2
3       v3         descr3
4       v4         descr4
5       v5         descr5
6       v6         descr6

data.frame用于注释

mapping = df$vecDescription[match(vec, df$vecNames)]

产出如预期：

as.vector(mapping)
## [1] NA "descr3" "descr4" NA

但我想：

## [1] "descr1;descr2" "descr3" "descr4" "descr5;descr6"  

---

我成功地使用了for循环，但这种方法在应用于500k线路时速度非常慢

您需要执行以下操作：

df = data.frame(vecNames, vecDescription, stringsAsFactors = FALSE)
elts = strsplit(vec, ";")
mapping = df$vecDescription[match(do.call(c, elts), df$vecNames)]
tapply(mapping, rep(1:length(elts), sapply(elts, length)), 
       paste, collapse = ';')

请注意data.frame定义中的stringsAsFactors=FALSE。基本上，仍然有一个使用tapply的循环，但我认为它不能被矢量化

library(data.table)
library(reshape2)

dt = as.data.table(df) # or use setDT to convert in place

setkey(dt, vecNames)

dt[melt(strsplit(vec, split = ";"))][,
   paste(vecDescription, collapse = ";"), by = L1][, V1]
#[1] "descr1;descr2" "descr3"        "descr4"        "descr5;descr6"

对于大数据，

melt

将成为瓶颈，您可以使用以下功能：

melt2 = function(l) data.table(value = unlist(l, use.names = F),
                               L1    = unlist(lapply(seq_along(l), 
                                                     function(i) rep(i, length(l[[i]]))),
                                              use.names = F))

---

下面是另一个base R快速解决方案

vec <- strsplit(vec, ";")
sapply(vec, function(x) with(df, paste(vecDescription[vecNames %in% x], collapse = ";")))
## [1] "descr1;descr2" "descr3"        "descr4"        "descr5;descr6"

---

还有一个基本的R解决方案：

  L <- strsplit(vec,split = ';')
  R <- as.character(df$vecDescription)[match(unlist(L),df$vecNames)]
  sapply(relist(R, L), paste, collapse=';')

[更新]

正如@eddi正确指出的那样，应该使用更大的数据集来进行更现实的基准测试，因此我们开始：

n <- 1000
set.seed(1)
sample1 <- sample(n)
sample2 <- sample(n)
vec <- sapply(sample1, function(i) if (runif(1)>0.5) paste0('v',c(i,sample(n,size=1)),collapse=';') else paste0('v',i))
vecNames <- paste0('v', sample2)
vecDescription <- paste0('descr', sample2)
df = data.frame(vecNames, vecDescription)
df2 = data.frame(vecNames, vecDescription, stringsAsFactors = FALSE)

library('microbenchmark')

现在champ是

f.j（）

，比

f.m2（）

快两倍，其他函数大约慢一个数量级

[更新2]

在这个基准测试中，n=5000，所有函数都以

df2

作为输入（字符串是字符）：

另一个基准，n=50000：

Unit: milliseconds
                expr      min       lq     mean   median        uq       max neval cld
      f.m2(vec, df2) 551.7985 602.0489 659.5792 638.6707  685.9923 1135.1548   100  b 
       f.j(vec, df2) 340.2615 415.2678 454.9885 447.5994  494.9217  661.5898   100 a  
   f.eddi2(vec, df2) 833.3205 920.6528 979.3859 963.0641 1018.2014 1519.3684   100   c
 f.Metrics(vec, df2) 795.4200 895.8132 970.6516 954.8318 1001.6742 1427.0432   100   c

最后一个，n=500000：

Unit: seconds
                expr       min        lq      mean    median        uq       max neval  cld
      f.m2(vec, df2)  7.420941  7.645800  8.047706  7.978916  8.301547  9.134872    10  b  
       f.j(vec, df2)  5.043295  5.316371  5.925725  5.514834  6.288766  8.289737    10 a   
   f.eddi2(vec, df2) 11.190716 11.373425 12.144147 11.935814 12.487354 14.798366    10   c 
 f.Metrics(vec, df2) 13.086297 13.859301 14.143273 14.149004 14.524544 15.151098    10    d

---

x1使用我维护的qdap模拟：

library(qdap)
mgsub(vecNames, vecDescription, vec)

## [1] "descr1;descr2" "descr3"        "descr4"        "descr5;descr6"

如果您正在对开发版本的qdap进行基准测试，那么
mgsub
对内存的负担会大大减少，而且速度会更快。此简短脚本将下载开发版本：

if (!require("pacman")) install.packages("pacman")
pacman::p_load_gh("trinker/qdap")

我们回到今晚早些时候的
match
参数：）噢，noo数据表nooo发生了什么事@发生rawr微秒级比较；Marat——在如此微小的数据上进行这些基准测试并不是很有用；此外，我认为只有
f.da
可以正常工作，请在
df[c（1:6,1,2），]
上全部试用。我会尝试修复我的-它得到了正确数量的项目，但打乱了顺序。
df$vecNames
不是被认为是唯一的吗，因为
df
是一种映射数据帧吗？使用
melt2
和
df2
，
数据。对于上面的示例，表
与
f.j
相对，不确定其余部分是如何生成的-顺便说一句，您可以使用以下方法更快地生成
vec
：例如：
data.table（sample1，cumsum（runif（n）>0.5））[，粘贴（paste0（'v'，sample1），collapse=“；”，by=V2]$V1
您可以再次检查第二个解决方案吗？它为
vec@MaratTalipov-hmm，谢谢：）给出了一个错误的结果，让我想想——显然有两个命令需要担心about@MaratTalipov我现在太困惑了，需要什么，如果
df
应该是字典，那么原版才是出路，我对副本的评论与您的解决方案无关，但是它似乎比当前的领导者要慢得多。
f.j（）
（在我的笔记本电脑上，n=1000是83毫秒，而8.3毫秒；n是vecNames/vecDescription的长度，详见我的答案）@MaratTalipov的开发版本？我想是这样的——我遵循了你答案中的说明，
sessionInfo（）
说，[1]qdap\u 2.2.1`谢谢，是的，
mgsub
中有一些不需要的保护。感谢您的测试。我猜瓶颈是由
for
循环每次迭代时
text.var
的重新分配造成的，这在长
模式下可能会变得昂贵。
Unit: milliseconds
                expr        min         lq       mean     median         uq        max neval  cld
      f.m2(vec, df2)   44.97854   47.12005   51.13561   48.58260   55.11687   85.57911   100  b  
       f.j(vec, df2)   24.03023   26.03697   28.10994   27.09699   28.45757   39.77269   100 a   
     f.da2(vec, df2) 1150.06311 1236.57530 1276.34064 1269.03829 1296.79251 1583.44486   100    d
   f.eddi2(vec, df2)   65.88291   68.06959   72.89662   70.05462   76.19301  178.73181   100   c 
 f.Metrics(vec, df2)   54.54662   57.37777   59.95356   58.41737   62.15440   69.84452   100  b  

Unit: milliseconds
                expr      min       lq     mean   median        uq       max neval cld
      f.m2(vec, df2) 551.7985 602.0489 659.5792 638.6707  685.9923 1135.1548   100  b 
       f.j(vec, df2) 340.2615 415.2678 454.9885 447.5994  494.9217  661.5898   100 a  
   f.eddi2(vec, df2) 833.3205 920.6528 979.3859 963.0641 1018.2014 1519.3684   100   c
 f.Metrics(vec, df2) 795.4200 895.8132 970.6516 954.8318 1001.6742 1427.0432   100   c

Unit: seconds
                expr       min        lq      mean    median        uq       max neval  cld
      f.m2(vec, df2)  7.420941  7.645800  8.047706  7.978916  8.301547  9.134872    10  b  
       f.j(vec, df2)  5.043295  5.316371  5.925725  5.514834  6.288766  8.289737    10 a   
   f.eddi2(vec, df2) 11.190716 11.373425 12.144147 11.935814 12.487354 14.798366    10   c 
 f.Metrics(vec, df2) 13.086297 13.859301 14.143273 14.149004 14.524544 15.151098    10    d

x1<-strsplit(vec,";")
x2<-data.frame(do.call(rbind,x1))
x3<-df$vecDescription[df$vecNames %in% x2[,1]]
x4<-df$vecDescription[df$vecNames %in% x2[,2]]
x5<-lapply(1:length(x1),function(i){ifelse(x3[i]!=x4[i],paste(x3[i],x4[i],sep=";"),paste(x3[i]))})

> x5
[[1]]
[1] "descr1;descr2"

[[2]]
[1] "descr3"

[[3]]
[1] "descr4"

[[4]]
[1] "descr5;descr6"

library(qdap)
mgsub(vecNames, vecDescription, vec)

## [1] "descr1;descr2" "descr3"        "descr4"        "descr5;descr6"

if (!require("pacman")) install.packages("pacman")
pacman::p_load_gh("trinker/qdap")