快速檢查一個向量是否是另一個向量的一部分

Question

我有一個向量列表，例如vecs = list(vec1=1:3, vec2=1:5, vec3=2:6, vec4=1:7)。我想刪除所有列表成員，如果它包含在另一個列表成員中。例如，vecs$vec1是vecs$vec2（或vecs$vec4）的一部分，因此我想將其刪除。

我想要一個非常快速的實現，因爲length(vecs)是非常大的。我所做的是第一排序vecs成員長度vecs = vecs[ order(unlist(lapply(vecs, length))) ]，然後爲check_member = vecs[i]，檢查是否是vecs[ i+1 ], vecs[ i+2 ]...的一部分。是否有更好的策略？完整代碼：

vecs = list(vec1=1:3, vec2=1:5, vec3=2:6, vec4=1:7, vec5=2:3) 
vecs = vecs[ order(unlist(lapply(vecs, length))) ] ##sort by member length 
vecs_len = length(vecs) 
toRemove = numeric(vecs_len) ##record whether to remove this member 
for(i in 1:(vecs_len-1)) 
for(j in (i+1):(vecs_len)) 
{ 
    if(length(setdiff(vecs[[i]],vecs[[j]]))==0 ) {toRemove[i] = 1; break} ##check whether vecs[[i]] is part of vecs[[j]] 

} 
vecs = vecs[!toRemove] 

Answer 1

請試試這個對你的大量數據。正如你在評論中澄清的那樣，我從角色的載體開始。我也假設載體不（通過lapply(vecs, unique)容易解決，如果他們這樣做）包含重複

vecs <- list(vec1=letters[1:3], 
      vec2=letters[1:5], 
      vec3=letters[2:6], 
      vec4=letters[1:7]) 

首先，把你的數據轉換成的因素（即整數）共享同一級別的列表：

vlevels <- unique(unlist(vecs)) 
nlev <- length(vlevels) 
fvecs <- lapply(vecs, factor, levels = vlevels) 

然後，我將數據轉換成的0基質和1對於包括/不包括：

vtabs <- vapply(fvecs, tabulate, integer(nlev), nbins = nlev) 
#  vec1 vec2 vec3 vec4 
# [1,] 1 1 0 1 
# [2,] 1 1 1 1 
# [3,] 1 1 1 1 
# [4,] 0 1 1 1 
# [5,] 0 1 1 1 
# [6,] 0 0 1 1 
# [7,] 0 0 0 1 

接着，我計算的CRO sproduct查看兩個向量有多少共同的元素，並與每個向量的長度進行比較以確定第一個是否是第二個向量的子集。

num.match <- crossprod(vtabs) 
vlen <- sapply(vecs, length) 
is.subset.mat <- num.match == vlen 
diag(is.subset.mat) <- FALSE 
#  vec1 vec2 vec3 vec4 
# vec1 FALSE TRUE FALSE TRUE 
# vec2 FALSE FALSE FALSE TRUE 
# vec3 FALSE FALSE FALSE TRUE 
# vec4 FALSE FALSE FALSE FALSE 

最後，我總結逐行說，如果每個矢量是任何其他的子集：

is.subset <- rowSums(is.subset.mat) > 0L 
# vec1 vec2 vec3 vec4 
# TRUE TRUE TRUE FALSE 

你只剩下過濾：

out <- vecs[!is.subset] 

如果您的初始列表太大以至於太慢，那麼我建議你逐塊運行它，然後再運行結果。

Answer 2

我認爲類似下面的內容應該可以工作。它會給你一個列表，這些列表是其他列表的子集。它將成爲它自身的一個子集 - 所以我只對那些至少是兩個向量（即它自己和另外一個向量）的子集進行處理。在％函數中相當於https://stat.ethz.ch/pipermail/r-help/2005-March/068491.html％。

dfSubsets <- list() 

ds <- lapply(vecs,function(x){ 
     subsets = 0 
     lapply(vecs, function(y){ 
      if(all(x %in% y)){subsets <<- subsets + 1} 
     }) 
     if(subsets > 1){ 
      dfSubsets <<- c(dfSubsets,list(x)) 
     } 
} 
) 

dfSubsets 

如果你想要那些子集的向量列表，讓我知道。

我確信dplyr可能也有幫助，但我並不熟悉這一點。

應用通常會提高效率 - 當然，如果您只關心它是否是一個向量的子集，使用for循環和中斷有時會更快，但您無法事先知道。

此方法適用於字符串或整數。

Answer 3

在做了一些基準測試之後，我們可以看到你可以稍微修改一下你原來的代碼以獲得一個很好的加速。使用%in%和any比setdiff和length更有效。

# Your code 
fun1 <- function(vecs){ 
    vecs_len = length(vecs) 
    toRemove = numeric(vecs_len) ##record whether to remove this member 
    for(i in 1:(vecs_len-1)) 
    for(j in (i+1):(vecs_len)) 
    { 
     if(length(setdiff(vecs[[i]],vecs[[j]]))==0 ) toRemove[i] = 1 ##check whether vecs[[i]] is part of vecs[[j]] 

    } 
    vecs = vecs[!toRemove] 
    return(vecs) 
} 

# flodel's code 
fun2 <- function(vecs){ 
    vlevels <- unique(unlist(vecs)) 
    nlev <- length(vlevels) 
    fvecs <- lapply(vecs, factor, levels = vlevels) 
    vtabs <- vapply(fvecs, tabulate, integer(nlev), nbins = nlev) 
    num.match <- crossprod(vtabs) 
    vlen <- sapply(vecs, length) 
    is.subset.mat <- num.match == vlen 
    diag(is.subset.mat) <- FALSE 
    is.subset <- rowSums(is.subset.mat) > 0L 
    out <- vecs[!is.subset] 
    return(out) 
} 

# slight modification 
fun3 <- function(vecs){ 
    vecs_len = length(vecs) 
    toRemove = numeric(vecs_len) ##record whether to remove this member 
    for(i in 1:(vecs_len-1)) 
    for(j in (i+1):(vecs_len)) 
    { 
     if(any(vecs[[i]] %in% vecs[[j]]) ) toRemove[i] = 1 ##check whether vecs[[i]] is part of vecs[[j]] 

    } 
    vecs = vecs[!toRemove] 
    return(vecs) 
} 

microbenchmark(fun1(vecs), fun2(vecs), fun3(vecs), times=100L) 
Unit: microseconds 
     expr  min  lq  mean median  uq  max neval 
fun1(vecs) 154.919 166.4245 179.62297 172.5880 180.3950 356.681 100 
fun2(vecs) 220.255 231.5555 279.99874 237.7185 290.9335 609.398 100 
fun3(vecs) 50.544 54.0370 64.86082 57.3250 64.5155 291.345 100