Найти элементы в вектор в R

Question

Матрица У меня имеет ровно 2 строк и п столбцов пример

c(0,0,0,0,1,0,2,0,1,0,1,1,1,0,2)->a1 
c(0,2,0,0,0,0,2,1,1,0,0,0,0,2,0)->a2 
rbind(a1,a2)->matr 

для конкретного столбца (в данном примере 9 с 1 в обоих рядах) мне нужно найти к слева и справа первый экземпляр 2/0 или 0/2 - в этом примере слева - 2, а другой - 14)

Элементы каждой строки могут быть либо 0,1,2 - ничего еще. Есть ли способ быстро выполнить эту операцию на больших матрицах (с двумя строками)? Мне нужно это 600k раз, поэтому скорость может быть рассмотрена

Answer 1

Объедините информацию, возведя в квадрат строки и добавив их. Правильный результат должен быть 4. Затем просто найдите первый столбец, который меньше 9 (rev(which())[1]), и первый столбец, который больше 9 (which()[1]).

fun <- function(matr, col){ 
    valid <- which((matr[1,]^2 + matr[2,]^2) == 4) 
    if (length(valid) == 0) return(c(NA,NA)) 

    left <- valid[rev(which(valid < col))[1]] 
    right <- valid[which(valid > col)[1]] 

    c(left,right) 

    } 

fun(matr,9) 
# [1] 2 14 

fun(matr,1) 
# [1] NA 2 

fun(matrix(0,nrow=2,ncol=100),9) 
# [1] NA NA 

Benchmark

set.seed(1) 
test <- rbind(sample(0:2,1000000,replace=T), 
       sample(0:2,1000000,replace=T)) 

microbenchmark::microbenchmark(fun(test,9)) 
# Unit: milliseconds 
#   expr  min  lq  mean median  uq  max neval 
# fun(test, 9) 22.7297 27.21038 30.91314 27.55106 28.08437 51.92393 100 

Edit: Спасибо @MatthewLundberg за указание много ошибок.

Answer 2

я был медленнее, чем @Laterow, но так или иначе, это подобный подход

foo <- function(mtr, targetcol) { 
    matr1 <- colSums(mtr) 
    matr2 <- apply(mtr, 2, function(x) x[1]*x[2]) 
    cols <- which(matr1 == 2 & matr2 == 0) - targetcol 
    left <- cols[cols < 0] 
    right <- cols[cols > 0] 
    c(ifelse(length(left) == 0, NA, targetcol + max(left)), 
    ifelse(length(right) == 0, NA, targetcol + min(right))) 
} 

foo(matr,9) #2 14 

Answer 3

Это интересный вопрос. Вот как я буду обращаться к нему.

Первый вектор определен, который содержит продукт каждой колонки:

a3 <- matr[1,]*matr[2,] 

Тогда мы можем найти столбцы с парами (0/2) или (2/0) довольно легко, так как мы знаем, что матрица может содержать только значения 0, 1 и 2:

the02s <- which(colSums(matr)==2 & a3==0) 

Далее мы хотим, чтобы найти пары (0/2) или (2/0), которые ближе всего к данному номеру столбца, слева и справа от этой колонки. Номер столбца может быть 9, например:

thecol <- 9 

Теперь у нас в основном все, что нам нужно найти индекс (номер столбца в матрице) сочетания (0/2) или (2/0), который ближе всего к столбцу thecol. Нам просто нужно использовать выход findInterval():

pos <- findInterval(thecol,the02s) 
pos <- c(pos, pos+1) 
pos[pos==0] <- NA # output NA if no column was found on the left 

И результат:

the02s[pos] 
# 2 14 

Так индексы ближайших колонн по обе стороны от thecol выполняющей необходимое условие будет 2 и 14 в этом случае, и мы можем подтвердить, что эти номера столбцов оба содержат один из соответствующих комбинаций:

matr[,14] 
#a1 a2 
# 0 2 
matr[,2] 
#a1 a2 
# 0 2 

Ed it: Я изменил ответ таким образом, что NA возвращается в случае, если столбец не существует слева и/или справа от thecol в матрице, которая удовлетворяет требуемому условию.

Answer 4

library(compiler) 
myfun <- cmpfun(function(m, cl) { 
    li <- ri <- cl 
    nc <- ncol(m) 
    repeat { 
    li <- li - 1 
    if(li == 0 || ((m[1, li] != 1) && (m[1, li] + m[2, li] == 2))) { 
     l <- li 
     break 
    } 
    } 
    repeat { 
    ri <- ri + 1 
    if(ri == nc || ((m[1, ri] != 1) && (m[1, ri] + m[2, ri] == 2))) { 
     r <- ri 
     break 
    } 
    } 
    c(l, r) 
}) 

и, принимая во внимание @Martin наблюдений Моргана,

set.seed(1) 
N <- 1000000 
test <- rbind(sample(0:2, N, replace = TRUE), 
       sample(0:2, N, replace = TRUE)) 

library(microbenchmark) 
microbenchmark(myfun(test, N/2), fun(test, N/2), foo(test, N/2), 
       AWebb(test, N/2), RHertel(test, N/2)) 
# Unit: microseconds 
       expr   min   lq   mean  median   uq   max neval cld 
# myfun(test, N/2)  4.658  20.033 2.237153e+01  22.536  26.022  85.567 100 a 
#  fun(test, N/2) 36685.750 47842.185 9.762663e+04 65571.546 120321.921 365958.316 100 b 
#  foo(test, N/2) 2622845.039 3009735.216 3.244457e+06 3185893.218 3369894.754 5170015.109 100 d 
# AWebb(test, N/2) 121504.084 142926.590 1.990204e+05 193864.670 209918.770 489765.471 100 c 
# RHertel(test, N/2) 65998.733 76805.465 1.187384e+05 86089.980 144793.416 385880.056 100 b 

set.seed(123) 
test <- rbind(sample(0:2, N, replace = TRUE, prob = c(5, 90, 5)), 
       sample(0:2, N, replace = TRUE, prob = c(5, 90, 5))) 
microbenchmark(myfun(test, N/2), fun(test, N/2), foo(test, N/2), 
       AWebb(test, N/2), RHertel(test, N/2)) 
# Unit: microseconds 
#    expr   min   lq   mean  median   uq   max neval cld 
# myfun(test, N/2)  81.805  103.732  121.9619  106.459  122.36  307.736 100 a 
#  fun(test, N/2) 26362.845 34553.968 83582.9801 42325.755 106303.84 403212.369 100 b 
#  foo(test, N/2) 2598806.742 2952221.561 3244907.3385 3188498.072 3505774.31 4382981.304 100 d 
# AWebb(test, N/2) 109446.866 125243.095 199204.1013 176207.024 242577.02 653299.857 100 c 
# RHertel(test, N/2) 56045.309 67566.762 125066.9207 79042.886 143996.71 632227.710 100 b 

Answer 5

Если вы делаете это много раз, предвычисления всех мест

loc <- which((a1==2 & a2==0) | (a1==0 & a2==2)) 

Вы можете найти первые влево и вправо с findInterval

i<-findInterval(9,loc);loc[c(i,i+1)] 
# [1] 2 14 

Обратите внимание, что findInterval векторизован, если вы хотите указать несколько целевых столбцов.