如何从向量(R)中移除子列表元素的任何共现项

这里有两个解决方案。第一个显然更简单,如果您喜欢清晰性和可维护性,那么将使用第一个,而第二个没有包依赖性,并且速度更快。

1)动物园 使用移动窗口比较c的每个子序列( main_list, sub_list) 具有所需长度的 sub_list . (我们附加 子目录 以确保始终有要删除的内容。)此语句根据当前位置是否是匹配子序列的结尾返回TRUE或FALSE。然后计算真正的索引数,并从中移除所有要移除的元素的索引并移除它们。

library(zoo)

w <- length(sub_list)
r <- rollapplyr(c(main_list, sub_list), w, identical, sub_list, fill = FALSE)
main_list[-c(outer(which(r), seq_len(w) - 1, "-"))]
## [1] 2 3 4 2 2 1

2)基R . 中线设置 r 与(1)中的对应行具有相同的用途,最后一行与(2)中的最后一行相同,除非我们使用 + 而不是 - 因为事实上 embed 有效地使用左对齐。

w <- length(sub_list)
r <- colSums(t(embed(c(main_list, sub_list), w)) == rev(sub_list)) == w
main_list[-c(outer(which(r), seq_len(w) - 1, "+"))]
## [1] 2 3 4 2 2 1

这是一个函数,它可以做这个一般的事情。

• xm 是整数/字符/逻辑值的主列表;
• xs 是整数/字符/逻辑值的子列表。

要求 length(xm) > length(xs) 但现在还没有这样的支票。

foo <- function (xm, xs) {
  nm <- length(xm)
  ns <- length(xs)
  shift_ind <- outer(0:(ns - 1), 1:(nm - ns + 1), "+")
  d <- xm[shift_ind] == xs
  first_drop_ind <- which(.colSums(d, ns, length(d) / ns) == ns)
  if (length(first_drop_ind) > 0L) {
    drop_ind <- outer(0:(ns - 1), first_drop_ind, "+")
    return(xm[-drop_ind])
    } else {
    return(xm)
    }
  }

main_list = c(2, 1, 2, 3, 1, 2, 4, 2, 2 ,1)
sub_list = c(1,2)
foo(main_list, sub_list)
#[1] 2 3 4 2 2 1

解释

xm <- main_list
xs <- sub_list

nm <- length(xm)
ns <- length(xs)
shift_ind <- outer(0:(ns - 1), 1:(nm - ns + 1), "+")
MAT <- matrix(xm[shift_ind], ns)
#     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
#[1,]    2    1    2    3    1    2    4    2    2
#[2,]    1    2    3    1    2    4    2    2    1

所以第一步是移位和矩阵表示,如上所述。

LOGIC <- MAT == xs
#      [,1] [,2]  [,3]  [,4] [,5]  [,6]  [,7]  [,8]  [,9]
#[1,] FALSE TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE
#[2,] FALSE TRUE FALSE FALSE TRUE FALSE  TRUE  TRUE FALSE

如果找到一个共现项,则列应包含 TRUE ,即 colSums 应该是 ns . 这样我们就可以确定匹配的第一个值的位置。

first_drop_ind <- which(colSums(LOGIC) == ns)
#[1] 2 5

现在我们需要扩展它来覆盖那些初始匹配之后的后续值。

drop_ind <- outer(0:(ns - 1), first_drop_ind, "+")
#     [,1] [,2]
#[1,]    2    5
#[2,]    3    6

最后,我们将这些位置的值从 圣诞节 :

xm[-drop_ind]
#[1] 2 3 4 2 2 1

注意,在函数中,矩阵不是显式形成的。 .colSums 是用来代替 科尔苏姆 .

小心虫子

这个 if ... else ... 在功能上是必要的。如果找不到匹配项,则 drop_ind 会是 integer(0) ,并使用 xm[-drop_ind] 给予 xm[integer(0)] 那就是 整数(0) .

与 zoo::rollapplyr

## require package `zoo`
bar <- function (xm, xs) {
  w <- length(xs)
  r <- rollapplyr(xm, w, identical, xs, fill = FALSE)
  if (length(r) > 0L) {
    return(xm[-c(outer(which(r), seq_len(w) - 1, "-"))])
    } else {
    return(xm)
    }
  }

set.seed(0)
xm <- sample.int(10, 10000, TRUE)
xs <- 1:2

library(zoo)

system.time(a <- foo(xm, xs))
#   user  system elapsed 
#  0.004   0.000   0.001 

system.time(b <- bar(xm, xs))
#   user  system elapsed 
#  0.276   0.000   0.273 

all.equal(a, b)
#[1] TRUE

我想是的 rollapplyr 比较慢是因为

• 它需要先强迫 圣诞节 “动物园”的目标;
• 内部使用 lapply 所以在R和C之间有一个频繁的跳跃。