2014-10-21 2 views
2

У нас есть отсортированный вектор foo, для каждого элемента i мы хотим найти самый большой j такой, что . Например, когдаСамый дальний элемент в пределах ограниченного расстояния для отсортированного вектора

foo <- c(1,2,5,7,13,17,25,33,85) 

ответ:

bar <- c(4,4,5,5,6,7,8,8,9) 

(. Для i=1, крупнейший j является 4, поскольку foo[4]-foo[1]=7-1<10 Поэтому первый пункт bar является 4).

Мы можем легко вычислить bar, используя петлю for и while. Но я ищу эффективный код в R. Любые идеи?

+1

Если вы хотите что-то быстро и память эффективной, вы должны просто перевести 'for' и' а 'loops to Rcpp. – Roland

ответ

3

Обновлено решение с использованием не-следу Соединения:

В последнее время в current development version of data.table, v1.9.7 были введены соединения non-equi. Это довольно просто с помощью этой функции:

require(data.table) # v1.9.7+ 
dt1 = data.table(x=foo) 
dt2 = data.table(y=foo+10L) 
dt1[dt2, on=.(x < y), mult="last", which=TRUE] 
# [1] 4 4 5 5 6 7 8 8 9 

На 100000 элементов, это быстрее, чем foverlaps:

Обратите внимание, что эта операция может быть сделано непосредственно следующим образом:

ans <- data.table(x=foo)[.(y=x+10L), on=.(x < y), mult="last", which=TRUE] 

Старый подход с использованием foverlaps:

Вот такой метод, который, вероятно, будет лучше масштабироваться. Использование перекрытия диапазона соединяет функцию foverlaps() от data.table версии 1.9.4:

require(data.table) ## 1.9.4+ 
x = data.table(start=foo, end=foo+9L) 
lookup = data.table(start=foo, end=foo) 
setkey(lookup) ## order doesn't change, as 'foo' is already sorted 
foverlaps(x, lookup, mult="last", which=TRUE) 
# [1] 4 4 5 5 6 7 8 8 9 

газораспределительного на 100000 номеров:

set.seed(45L) 
foo <- sort(sample(1e6, 1e5, FALSE)) 
arun <- function(foo) { 
    x = data.table(start=foo, end=foo+9L) 
    lookup = data.table(start=foo, end=foo) 
    setkey(lookup) 
    foverlaps(x, lookup, mult="last", which=TRUE) 
} 
system.time(arun(foo)) 
# user system elapsed 
# 0.142 0.009 0.153 
+0

В то время как другие решения работают, этот метод быстрее – Ali

1

Попробуйте

sapply(foo, function(x) {m1 <-foo-x; which.max(m1[m1<10])}) 
#[1] 4 4 5 5 6 7 8 8 9 
1

Предполагая, что нет NA значения:

apply(as.matrix(dist(foo)), 1, function(x) { 
    which.max(cumsum(x < 10)) 
    }) 
#1 2 3 4 5 6 7 8 9 
#4 4 5 5 6 7 8 8 9 

А вот решение, использующее только разреженные матрицы:

library(spam) 
res <- apply.spam(as.spam(dist(foo)), 2, function(x) { 
    test <- cumsum(x < 10) 
    if (sum(test) > 0) which.max(test) else (0) 
    }) + seq_along(foo) 
res[length(res)] <- length(res) 
#[1] 4 4 5 5 6 7 8 8 9 
Смежные вопросы