R编程：向量之间的差异

Question

我试图在R中做一个函数，使得 如果X是一个向量而Y是一个向量是X的一个子集，X和Y可能包含一个重复元素，则XY包含其余元素（可能仍包含重复元素）。我尝试使用setdiff()，但我认为它不适用于重复元素。例如，

d<-c(1,1,1,5,5,5,3,0,10,10) 
b<-c(1,1,0) 
e<-setdiff(d,b) 
e 
[1] 5 3 10 

，但它应该是

c(1,5,5,5,3,10,10) 

所以我做了一个功能

my.sample<-function(d,b){ 
    y<-numeric() 
    u<-numeric() 
    t<-list() 
    x<-numeric() 
    rd<-rle(d) 
    rb<-rle(b) 
    h<-numeric() 
    d.data<-data.frame(rd$lengths,rd$values) 
    b.data<-data.frame(rb$lengths,rb$values) 

    for(i in 1:nrow(b.data)){ 
    y[i]<-b.data[i,2] 
    u[i]<-b.data[i,1] 
    h[i]<-(d.data[d.data$rd.values==y[i],1]-u[i]) 
    d.data[d.data$rd.values==y[i],1]<-h[i] 
    } 
    x<-d.data[,1] 
    for(j in 1:length(x)) 
    { 
    t[[j]]<-rep(d.data[j,2],x[j])   
    } 
    return(unlist(t))   
} 

所以我尝试

my.sample(d,b) 
[1] 1 5 5 5 3 10 10 

，所以我想我做出了正确的算法,,但是当我尝试使用它来更多compli cated矢量像

x<-rpois(100,10) 
y<-sample(x,25,replace=F) 
my.sample(x,y) 

Error in rep(d.data[j, 2], x[j]) : invalid 'times' argument 
In addition: There were 21 warnings (use warnings() to see them) 

有突发错误和警告21 :(，你们可以给我的手，请通过我在编程新手，所以请帮助我的方式。由于

Answer 1

另一个功能：

f <- function(d, b) 
    d[-unlist(tapply(b, b, function(y) head(which(d == y[1]), length(y))))]  

# first example: 
f(d, b) 
# [1] 1 5 5 5 3 10 10 

# second example: 
set.seed(42) 
x <- rpois(100,10) 
y <- sample(x,90,replace=F) 
f(x,y) 
# [1] 11 12 9 10 10 9 10 4 9 6 

Answer 2

因为你允许重复你有递归的一个问题，其中最简单的 ，最适合 的解决方案是超过b元素使用for循环来循环使用match从d一次一个删除其仅查找匹配的第一个匹配项。这个功能也首先检查x是y一个子集：

f <- function(x,y){ 
    if(all(x %in% y)) 
    for(i in x) y <- y[ -match(i , y) ] 
    return(y) 
} 

f(b,d) 
#[1] 1 5 5 5 3 10 10 

和使用第二个例子......

set.seed(42) 
x<-rpois(100,10) 
y<-sample(x,25,replace=F) 
f(y,x) 
# [1] 11 12 9 10 10 9 10 4 9 6 

Answer 3

试试这个：

d<-c(1,1,1,5,5,5,3,0,10,10) 
b<-c(1,1,0) 
d[!(d %in% b)] 

Answer 4

编辑：尚最快的已发布的答案：

carl2<-function(x,y) { 
xfact<-as.numeric(names(table(xfoo))) 
tx<-table(xfoo) 
yfact<-as.numeric(names(table(yfoo))) 
ty<-table(yfoo) 
gotit<- ave(c(tx,ty),c(xfact,yfact),FUN=function(a) if(length(a)==2) a[1]-a[2] else a[1]) 
gotx<-gotit[1:length(tx)] 
fakerle<-data.frame(values=as.numeric(names(gotx)),lengths=gotx) 
finalx<-inverse.rle(fakerle) 
} 

它可能比下面的最佳基准速度快25％。好吧，我现在就停止这个废话。

这里的另一种方法：

Rgames> ds<-sort(d) 
Rgames> db<-sort(b) 
Rgames> ds[(length(db)+1):length(ds)] 
[1] 1 3 5 5 5 10 10 

完全不起作用，原因显而易见。我最喜爱的工具救援：

Rgames> set.seed(1) 
Rgames> x<-rpois(100,10) 
Rgames> y<-sample(x,25,replace=F) 
Rgames> rx<-rle(sort(x)) 
Rgames> ry<-rle(sort(y)) 
Rgames> for(j in ry$values) rx$lengths[which(rx$values==j)] <- rx$lengths[which(rx$values==j)] - ry$lengths[ry$values==j] 
Rgames> 
Rgames> newx<-inverse.rle(rx[rx$values>0]) 
Rgames> newx 
[1] 3 4 5 5 5 5 5 6 6 7 7 7 7 7 7 7 7 7 7 8 8 8 
[23] 8 8 8 8 9 9 9 9 9 9 9 9 9 10 10 10 10 10 10 10 11 11 
[45] 11 11 11 11 11 11 11 11 12 12 12 12 12 12 12 12 12 13 13 13 13 13 
[67] 13 14 14 14 14 14 15 15 16 

希望的OP不关心输出的元素的顺序！

编辑，只是为了圆满的线程，现在与正确的顺序参数，可悲的西蒙不再赢。好吧。

Rgames> microbenchmark(sven(x,y),simon(y,x),carl(x,y)) 
Unit: milliseconds 
     expr  min   lq  median   uq  max 
    sven(x, y) 1.724172 1.803495 1.858658 1.975400 2.073966 
simon(y, x) 104.202881 105.159258 105.928977 106.315333 190.408444 
    carl(x, y) 1.705784 1.806489 1.845403 1.927078 22.150382