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