2016-02-13 103 views
1

我希望按行查找兩個模式的第一個實例。具體而言,我想查找的每一行中第一次出現c(1,0)和第一次出現c(1,1)。下面的代碼使用嵌套的for-loops這樣做,但對於大型數據集非常慢。按行查找模式的第一個匹配項

有沒有辦法在基地R有效地做到這一點?這個問題是相似的:

Finding pattern in a matrix in R

這是我的代碼,如果該圖案在第1列開始,並且在第2列和結束如果圖案不連續發生返回0它返回一個2

n <- 5 

my.data <- expand.grid(rep(list(1:0), n)) 
my.data <- my.data[do.call(order, as.list(my.data)),] 
my.data <- my.data[order(nrow(my.data):1),] 

first.11 <- rep(0, nrow(my.data)) 
first.10 <- rep(0, nrow(my.data)) 

for(i in 1:nrow(my.data)) { 
    for(j in 1:(ncol(my.data)-1)) { 

    if(first.11[i] == 0 & my.data[i,j] == 1 & my.data[i,(j+1)] == 1) first.11[i] = j+1 
    if(first.10[i] == 0 & my.data[i,j] == 1 & my.data[i,(j+1)] == 0) first.10[i] = j+1 

    } 
} 

my.data2 <- data.frame(my.data, first.11, first.10) 
my.data2 

# Var1 Var2 Var3 Var4 Var5 first.11 first.10 
#1  1 1 1 1 1  2  0 
#17 1 1 1 1 0  2  5 
#9  1 1 1 0 1  2  4 
#25 1 1 1 0 0  2  4 
#5  1 1 0 1 1  2  3 
#21 1 1 0 1 0  2  3 
#13 1 1 0 0 1  2  3 
#29 1 1 0 0 0  2  3 
#3  1 0 1 1 1  4  2 
#19 1 0 1 1 0  4  2 
#11 1 0 1 0 1  0  2 
#27 1 0 1 0 0  0  2 
#7  1 0 0 1 1  5  2 
#23 1 0 0 1 0  0  2 
#15 1 0 0 0 1  0  2 
#31 1 0 0 0 0  0  2 
#2  0 1 1 1 1  3  0 
#18 0 1 1 1 0  3  5 
#10 0 1 1 0 1  3  4 
#26 0 1 1 0 0  3  4 
#6  0 1 0 1 1  5  3 
#22 0 1 0 1 0  0  3 
#14 0 1 0 0 1  0  3 
#30 0 1 0 0 0  0  3 
#4  0 0 1 1 1  4  0 
#20 0 0 1 1 0  4  5 
#12 0 0 1 0 1  0  4 
#28 0 0 1 0 0  0  4 
#8  0 0 0 1 1  5  0 
#24 0 0 0 1 0  0  5 
#16 0 0 0 0 1  0  0 
#32 0 0 0 0 0  0  0 
+2

模式的「長度」總是2嗎?你可以嘗試像'max.col((my.data [,-ncol(my.data)] == 1L)&(my.data [,-1L] == 0L),「first」)+ 1L'在處理'rowSums == 0'的情況下。 –

+0

@alexis_laz謝謝。是的,我只考慮了兩個模式的長度。也許在某些時候,我可能想要概括它。 –

回答

3

另一個想法是檢查沿圖案之前的比賽下列:此外,在較長的模式

ff = function(x, pat) 
{ 
    nc = ncol(x) - (length(pat) - 1L) 
    ans = arrayInd(seq_len(nrow(x) * nc), c(nrow(x), nc)) 
    for(i in seq_along(pat)) { 
     ans = ans[x[ans] == pat[[i]], ] 
     ans[, 2L] = ans[, 2L] + 1L 
    } 
    inds = aggregate(list(ans[, 2L] - 1L), list(ans[, 1L]), min) 
    ret = integer(nrow(x)) 
    ret[inds[[1L]]] = inds[[2L]] 
    ret 
} 
all.equal(ff(my.data, c(1, 1)), my.data2$first.11) 
#[1] TRUE 
all.equal(ff(my.data, c(1, 0)), my.data2$first.10) 
#[1] TRUE 

而且,:

ff(my.data, c(1, 0, 1, 1)) 
# [1] 0 0 0 0 5 0 0 0 4 4 0 0 0 0 0 0 0 0 0 0 5 0 0 0 0 0 0 0 0 0 0 0 
4

也許粘貼然後使用正則表達式?

t(
    sapply(
    # paste all columns 
    do.call(paste0, my.data), 
    function(i){ 
     c(first.11 = regexpr("11", i)[1] + 1, 
     first.10 = regexpr("10", i)[1] + 1) 
    }) 
) 

編輯:

ff_regex <- function(x, pat){ 
    pat <- paste(pat,collapse = "") 
    sapply(
     # paste all columns 
     do.call(paste0, x), 
     function(i){ 
     regexpr(pat, i)[1] + 1 
     }) 
    } 

# benchmark 
#test if results match 
all(ff(my.data, c(1, 1)) == my.data2$first.11) 
#[1] TRUE 
all(ff_regex(my.data, c(1, 1)) == my.data2$first.11) 
#[1] TRUE 

library(microbenchmark) 
microbenchmark(
    ff(my.data, c(1, 1)), 
    ff_regex(my.data, c(1, 1)), 
    times = 10000 
) 

# Unit: microseconds 
#      expr  min  lq  mean median  uq  max neval cld 
#  ff(my.data, c(1, 1)) 836.442 902.013 958.7856 919.687 943.064 43851.35 10000 b 
# ff_regex(my.data, c(1, 1)) 199.845 218.376 240.5664 226.929 240.043 42231.78 10000 a 
+0

我也喜歡這個,但無法很快弄清楚如何從輸出中提取兩個向量進行後期處理。 –

+0

@MarkMiller如果我們將解決方案分配給對象'res',那麼它就像'my.data2 <--cbind(my.data,res)'一樣容易,不是嗎?或者我們可以像在亞歷克西斯的解決方案中那樣將它包裝在一個函數中。 – zx8754

+1

@MarkMiller見編輯,轉換爲功能並添加基準。 – zx8754