Получить расстояние до нулевого соседа в матрице

Question

Может ли кто-нибудь сказать мне разумный способ, как рассчитать расстояние до ненулевых соседей в разреженной матрице? Причиной этого является то, что я хочу идентифицировать «дыры» в большой многомерной матрице.

В качестве примера: Давайте предположим, что у меня есть 10x10 матрицы заполнены с большим количеством нулей и некоторых 1s:

f<-ceiling((runif(100,0,1))-.6) 
a <- matrix(f, ncol=10L, nrow=10L) 
rownames(a) = seq(1,10,1) 
colnames(a) = seq(1,10,1) 

может быть

> a 
    1 2 3 4 5 6 7 8 9 10 
1 0 0 0 0 1 0 0 1 1 0 
2 1 0 0 0 1 0 0 0 0 0 
3 0 1 1 0 1 1 0 0 1 1 
4 0 0 1 1 0 1 0 1 0 0 
5 0 0 0 1 0 1 0 0 0 1 
6 1 0 0 0*0*1 0 1 0 0 
7 0 1 1 1 1 1 1 0 1 0 
8 1 0 1 0 1 0 0 0 1 1 
9 1 1 1 0 0 0 0 0 0 0 
10 1 1 1 1 1 0 1 0 1 0 

Что мне нужно, как результат является Матрица 10x10 со средним расстоянием всех четырех направлений (по два для каждого измерения) для всех нулевых точек.

E.g. точка a[6,5] равна нулю и имеет 4 соседей. Расстояние слева - 5, справа - 1, вверх - 3, а вниз - 1. Таким образом, среднее значение будет 2,5. Если соседей не существует, среднее значение должно рассчитываться для остальных соседей.

Как обычно, моя первая идея была пучком для циклов, ища каждое значение матрицы во всех направлениях и возвращала расстояния. Но это должно быть тупым способом сделать это ...

Answer 1

мне понравилось эта проблеме много! Вот решение, не обязательно быстрое, но оно выполняет эту работу.

Сначала давайте воссоздать ваши данные:

a <- matrix(scan(textConnection(" 
    0 0 0 0 1 0 0 1 1 0 
    1 0 0 0 1 0 0 0 0 0 
    0 1 1 0 1 1 0 0 1 1 
    0 0 1 1 0 1 0 1 0 0 
    0 0 0 1 0 1 0 0 0 1 
    1 0 0 0 0 1 0 1 0 0 
    0 1 1 1 1 1 1 0 1 0 
    1 0 1 0 1 0 0 0 1 1 
    1 1 1 0 0 0 0 0 0 0 
    1 1 1 1 1 0 1 0 1 0 
")), 10, 10, byrow = TRUE) 

---

Вот, давайте разделить ваши строки и столбцы в четырех ориентированных списков векторов:

rev.list <- function(l) lapply(l, rev) 

v1 <- split(a, row(a)) # rows left to right 
v2 <- rev.list(v1)  # rows right to left 
v3 <- split(a, col(a)) # cols up to down 
v4 <- rev.list(v3)  # cols down to up 

Здесь мы создаем и применить функцию (от https://stackoverflow.com/a/17929557/1201032) для вычисления однонаправленных расстояний:

dir.dist <- function(v) { 
    out <- seq_along(v) - cummax(seq_along(v) * v) 
    out[seq_len(match(1, v) - 1)] <- NA 
    out 
} 

dist1.list <- lapply(v1, dir.dist) # dist to closest on left 
dist2.list <- lapply(v2, dir.dist) # dist to closest on right 
dist3.list <- lapply(v3, dir.dist) # dist to closest up 
dist4.list <- lapply(v4, dir.dist) # dist to closest dn 

Теперь давайте все обратно в четырех матриц:

nr <- nrow(a) 
nc <- ncol(a) 

list.to.mat <- function(l, revert = FALSE, byrow = FALSE, 
          nrow = nr, ncol = nc) { 
    x <- unlist(if (revert) rev.list(l) else l) 
    matrix(x, nrow, ncol, byrow) 
} 

m1 <- list.to.mat(dist1.list, revert = FALSE, byrow = TRUE) 
m2 <- list.to.mat(dist2.list, revert = TRUE, byrow = TRUE) 
m3 <- list.to.mat(dist3.list, revert = FALSE, byrow = FALSE) 
m4 <- list.to.mat(dist4.list, revert = TRUE, byrow = FALSE) 

Наконец, давайте вычислим средства, используя pmean функцию вдохновленный от https://stackoverflow.com/a/13123779/1201032:

pmean <- function(..., na.rm = FALSE) { 
    dat <- do.call(cbind, list(...)) 
    res <- rowMeans(dat, na.rm = na.rm) 
    idx_na <- !rowSums(!is.na(dat)) 
    res[idx_na] <- NA 
    res 
} 

final <- matrix(pmean(as.vector(m1), 
         as.vector(m2), 
         as.vector(m3), 
         as.vector(m4), na.rm = TRUE), nr, nc) 

final 
#  [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] 
# [1,] 2.50 2.50 2.00 2.00 0.00 1.67 3.00 0.0 0.00 1.50 
# [2,] 0.00 1.67 1.67 2.00 0.00 1.00 3.50 2.0 2.00 3.00 
# [3,] 1.67 0.00 0.00 1.00 0.00 0.00 2.33 1.5 0.00 0.00 
# [4,] 2.00 1.67 0.00 0.00 1.50 0.00 1.67 0.0 1.67 1.33 
# [5,] 2.33 2.00 1.33 0.00 1.50 0.00 2.00 1.5 2.00 0.00 
# [6,] 0.00 2.25 2.00 1.75 *2.25* 0.00 1.00 0.0 1.67 1.67 
# [7,] 1.00 0.00 0.00 0.00 0.00 0.00 0.00 1.0 0.00 1.33 
# [8,] 0.00 1.00 0.00 1.25 0.00 1.67 1.75 2.0 0.00 0.00 
# [9,] 0.00 0.00 0.00 1.33 1.33 2.50 2.33 4.0 2.67 4.00 
# [10,] 0.00 0.00 0.00 0.00 0.00 1.67 0.00 2.0 0.00 1.50 

Answer 2

Для вашей матрицы можно преобразовать в разреженный г х вида С с which:

rc <- which(a>0, arr.ind=TRUE) 
rc[rc[,1] == 6, 2] # 1, 6,8 candidates for "row-neighbors" 
rc[rc[,2] == 5, 1] # 1,2,3, 7,8,10 col-neighbors