Что не так с кодом для алгоритма floodFill в R? - PullRequest
Новая
       29

Что не так с кодом для алгоритма floodFill в R?

0 голосов
/ 14 июня 2019

Я взял алгоритм из https://rosettacode.org/wiki/Bitmap/Flood_fill и протестировал его на языке R. Добавлено сопоставление диагональных соседей (например, Queeni 

floodfill <- function(row, col, tcol, rcol) {
  if (tcol == rcol) return()
  if (M[row, col] != tcol) return()
  Q <- matrix(c(row, col), 1, 2)
  while (dim(Q)[1] > 0) {
    n <- Q[1, , drop = FALSE]
    west  <- cbind(n[1]    , n[2] - 1)
    east  <- cbind(n[1]    , n[2] + 1)
    north <- cbind(n[1] + 1, n[2]    )
    south <- cbind(n[1] - 1, n[2]    )
    nwest  <- cbind(n[1] - 1, n[2] - 1)
    neast  <- cbind(n[1] - 1, n[2] + 1)
    swest  <- cbind(n[1] + 1, n[2] - 1)
    seast  <- cbind(n[1] + 1, n[2] + 1)
    Q <- Q[-1, , drop = FALSE]
    if (M[n] == tcol) {
      M[n] <<- rcol
      if (M[west] == tcol)  Q <- rbind(Q, west)
      if (M[east] == tcol)  Q <- rbind(Q, east)
      if (M[north] == tcol) Q <- rbind(Q, north)
      if (M[south] == tcol) Q <- rbind(Q, south)
      if (M[nwest] == tcol)  Q <- rbind(Q, nwest)
      if (M[neast] == tcol)  Q <- rbind(Q, neast)
      if (M[swest] == tcol)  Q <- rbind(Q, swest)
      if (M[seast] == tcol)  Q <- rbind(Q, seast)
    }
  }
  return("filling completed")
}

Я не уверен, что делаешь неправильно. Я получаю ошибку за такое выполнение:

Матрица: 

M = matrix(c(c(1,0,0,0,0,0,0,1),
             c(0,1,0,0,0,1,1,0),
             c(0,0,1,1,1,1,1,0),
             c(0,0,0,0,1,1,0,0),
             c(0,0,0,0,0,1,0,1),
             c(0,0,0,1,0,1,0,1)), nrow = 6, byrow = T)

звонок: 

> floodfill(row=3, col=3, tcol=1, rcol=2)
Error in if (M[west] == tcol) Q <- rbind(Q, west) : 
  argument is of length zero

Начиная с (3,3), оно заполняется в начале, но заполнение останавливается где-то в столбце 6, а остальное не заменяется на 2 с. Мои модификации неверны или код Rosetta?

1 Ответ

1 голос
/ 15 июня 2019

«Решение», представленное на розеттском камне, не проверяет границы массива. Вот альтернатива, которая делает 

floodfill <- function(row, col, tcol, rcol) {
  if (tcol == rcol) return()
  if (M[row, col] != tcol) return()
  Q <- matrix(c(row, col), 1, 2)
  moves <- matrix(c(-1, 0, 1, -1, 1, -1, 0, 1,
                    -1, -1, -1, 0, 0, 1, 1, 1), ncol=2)
  check <- function(p) {
    if(p[,1] >= 1 & p[,1] <= nrow(M) & p[,2] >= 1 & p[,2] <= ncol(M)) {
      if (M[p] == tcol)  
        Q <<- rbind(Q, p)
    }
  }
  while (dim(Q)[1] > 0) {
    n <- Q[1, , drop = FALSE]
    dirs <- cbind(n[1] + moves[,1], n[2] + moves[,2])
    Q <- Q[-1, , drop = FALSE]
    if (M[n] == tcol) {
      M[n] <<- rcol
      for(i in seq.int(nrow(dirs)))
        check(dirs[i, , drop=FALSE])
    }
  }
  return("filling completed")
}
...