Моя проблема концептуально проста. Я ищу эффективное с вычислительной точки зрения решение (мое собственное я прикрепляю в конце).
Предположим, у нас есть потенциально очень большая разреженная матрица, подобная той, что слева внизу, и мы хотим «назвать» каждую область смежных ненулевых элементов отдельным кодом (см. матрицу справа)
1 1 1 . . . . . 1 1 1 . . . . .
1 1 1 . 1 1 . . 1 1 1 . 4 4 . .
1 1 1 . 1 1 . . 1 1 1 . 4 4 . .
. . . . 1 1 . . ---> . . . . 4 4 . .
. . 1 1 . . 1 1 . . 3 3 . . 7 7
1 . 1 1 . . 1 1 2 . 3 3 . . 7 7
1 . . . 1 . . . 2 . . . 5 . . .
1 . . . . 1 1 1 2 . . . . 6 6 6
В моем приложении смежные элементы будут образовывать прямоугольники, линии или отдельные точки, и они могут касаться друг друга только вершинами (т.е. в матрице не будет неправильных/непрямоугольных областей).
Решение, которое я придумал, состоит в том, чтобы сопоставить индексы строк и столбцов разреженного матричного представления с вектором с соответствующими значениями (кодами «имени»). Мое решение использует несколько for loops
и отлично работает для малых и средних матриц, но быстро застревает в циклах, когда размеры матрицы становятся большими (> 1000). Вероятно, это зависит от того, что я не настолько продвинут в программировании на R - я не смог найти какой-либо вычислительный трюк/функцию, чтобы решить ее лучше.
Может ли кто-нибудь предложить более эффективный в вычислительном отношении способ сделать это в R?
Мое решение:
mySolution <- function(X){
if (class(X) != "ngCMatrix") {stop("Input must be a Sparse Matrix")}
ind <- which(X == TRUE, arr.ind = TRUE)
r <- ind[,1]
c <- ind[,2]
lr <- nrow(ind)
for (i in 1:lr) {
if(i == 1) {bk <- 1}
else {
if (r[i]-r[i-1] == 1){bk <- c(bk, bk[i-1])}
else {bk <- c(bk, bk[i-1]+1)}
}
}
for (LOOP in 1:(lr-1)) {
tr <- r[LOOP]
tc <- c[LOOP]
for (j in (LOOP+1):lr){
if (r[j] == tr) {
if(c[j] == tc + 1) {bk[j] <- bk[LOOP]}
}
}
}
val <- unique(bk)
for (k in 1:lr){
bk[k] <- which(val==bk[k])
}
return(sparseMatrix(i = r, j = c, x = bk))
}
Заранее спасибо за любую помощь или указатель.
Rcpp
. Ваш код кажется достаточно простым для перевода - person Aurèle   schedule 03.02.2017Rcpp
виньетки, и если мне нужно знатьC++
язык, как кажется, это не для меня, к сожалению... - person GiuGe   schedule 03.02.2017m
— это ваш ngCMatrix, вы можете попытаться найти способ заставить что-то вродеsm = summary(m); sparseMatrix(i = sm$i, j = sm$j, x = cutree(hclust(dist(sm, "maximum")), h = 2))
работать должным образом. - person alexis_laz   schedule 03.02.2017sm = as.matrix(summary(m)); d = as.dist(sapply(1:nrow(sm), function(i) rowSums(abs(sm[i, col(sm)] - sm))))
, использованиеsparseMatrix(i = sm[, "i"], j = sm[, "j"], x = cutree(hclust(d, "single"), h = 1))
, кажется, отлично работает для текущего примера, хотя я склонен полагать, что будет много случаев, которые его нарушат. - person alexis_laz   schedule 05.02.2017d
наd <- dist(sm, method = "manhattan")
, потому что это в основном то, что вы там делаете. Агрегация с одной связью и разрез из трех на высоте 1 эффективно различают области, которые «соприкасаются» друг с другом в вершине (и, следовательно, находятся на расстоянии 2 шагов друг от друга): как я сказал в своем вопросе, это ситуация, которую я имею в мои данные, так что это нормально. Пара симуляций с моей функцией и вашим методом говорят, что ваш метод быстрее в 4 раза с матрицами 200x200. Почему бы вам не опубликовать свой ответ ниже? Спасибо - person GiuGe   schedule 06.02.2017