Минимальное расстояние между элементами в двух логических векторах

Question

У меня есть два логических вектора x а также y и взвешенные значения, z соответствует каждому индексу. Для колонки x значения, которые TRUE Я хотел бы найти ближайший y индекс столбца, который также TRUE, Затем возьмите sum из z между мин {x_i, y_i}. Если есть две минуты {x_i, y_i} тогда чем меньше sum из z используется.

       x     y          z
1  FALSE  TRUE 0.05647057
2  FALSE FALSE 0.09577802
3   TRUE FALSE 0.04150954
4  FALSE FALSE 0.07242995
5  FALSE  TRUE 0.06220041
6  FALSE FALSE 0.01861535
7  FALSE FALSE 0.05056971
8   TRUE FALSE 0.07726933
9  FALSE  TRUE 0.04669694
10  TRUE  TRUE 0.02312497

Есть 3 x значения, которые TRUE поэтому мы будем называть их {x_1, x_2, x_3}. Здесь я демонстрирую суммирование минимальных индексов между каждым x_i и это ближайший y_i сосед. Что является наиболее эффективным способом Base R для достижения этой цели. У меня есть метод в конце, который использует 2 lapply говорит мне, что это, вероятно, не эффективно. У меня нет математического фона, и обычно есть какой-то алгебраический способ решения задач такого рода, который векторизован с помощью грубой вычислительной мощности.

## x_1
sum(z[3:5]) ## This one is smaller so use it
sum(z[1:3])

## x_2
sum(z[8:9])

## x_3
sum(z[10])

c(sum(z[3:5]), sum(z[8:9]), sum(z[10]))
[1] 0.17613990 0.12396627 0.02312497

MWE:

x <- y <- rep(FALSE, 10)
x[c(3, 8, 10)] <- TRUE
y[c(1, 5, 9, 10)] <- TRUE
set.seed(15)
z <- rnorm(10, .5, .25)/10
data.frame(x=x, y=y, z=z)

Вот подход, который является менее чем оптимальным:

dat <- data.frame(x=x, y=y, z=z)
sapply(which(dat[, "x"]), function(x) {
    ylocs <- which(dat[, "y"])
    dists <- abs(x - ylocs)
    min.ylocs <- ylocs[min(dists) == dists]
    min(sapply(min.ylocs, function(y, x2 = x) {
        sum(dat[, "z"][x2:y])
    }))
})

## [1] 0.17613990 0.12396627 0.02312497

Я бы предпочел оставить решение в базе.

Answer 1

При этом не используются циклы и не применяются функции. Мы используем na.locf из зоопарка переместить указатель последней ИСТИНЫ y до предоставления fwd и следующий ИСТИННЫЙ y задняя подача bck, Наконец, мы определяем, какая из двух соответствующих сумм больше. Это зависит от na.locf в пакете zoo, но в конце мы извлекаем основной код из zoo, чтобы избежать зависимости:

library(zoo) # na.locf

x <- dat$x
y <- dat$y
z <- dat$z

yy <- ifelse(y, TRUE, NA) * seq_along(y)
fwd <- na.locf(yy, fromLast = FALSE)[x]
bck <- na.locf(yy, fromLast = TRUE)[x]

cs <- cumsum(z)
pmin(cs[x] - cs[fwd] + z[fwd], cs[bck] - cs[x] + z[x])

Последняя строка дает:

[1] 0.17613990 0.12396627 0.02312497

Вот мини версия na.locf, Вызов библиотеки выше может быть заменен этим.

# code extracted from zoo package
na.locf <- function(x, fromLast = FALSE) {
   L <- !is.na(x)
   if (fromLast) rev(c(NA, rev(which(L)))[cumsum(rev(L)) + 1])
   else c(NA, which(L))[cumsum(L)+1L]
}

ПЕРЕСМОТРЕНО: некоторые улучшения.