使用imager包，如何获取图像（与内核）的相关性？

Question

我有这张照片：

我想获得名为该图像与离散内核的“相关性”的图像，矩阵如下。我首先尝试使用

correlate

功能：

kernel <- rbind(
  c( 0, 1, 1, 2, 2, 2, 1, 1, 0 )
  , c( 1,  2,  4, 5, 5, 5, 4, 2, 1 )
  , c( 1,  4,  5, 3, 0, 3, 5, 4, 1 )
  , c( 2,  5,  3, -12, -24, -12, 3, 5, 2 )
  , c( 2,  5,  0, -24, -40, -24, 0, 5, 2 )
  , c( 2,  5,  3, -12, -24, -12, 3, 5, 2 )
  , c( 1,  4,  5, 3, 0, 3, 5, 4, 1 )
  , c( 1,  2,  4, 5, 5, 5, 4, 2, 1 )
  , c( 0,  1,  1, 2, 2, 2, 1, 1, 0 )
)

library(imager)
im <- load.image("mypic.png")
img <- correlate(im, as.cimg(kernel))
plot(img)

这给出了这个灰色图像：

现在我手动尝试，不考虑边框：

RED <- red <- 255*as.matrix(R(im)[, , 1, 1])
GRE <- gre <- 255*as.matrix(G(im)[, , 1, 1])
BLU <- blu <- 255*as.matrix(B(im)[, , 1, 1])

for(r in 10:500) {
  for(c in 10:500){
    red[r, c] <- gre[r, c] <- blu[r, c] <- 0
    for(u in 1:9){
      for(v in 1:9) {
        red[r, c] <- red[r, c] + kernel[u, v] * RED[r+u-5, c+v-5]
        gre[r, c] <- gre[r, c] + kernel[u, v] * GRE[r+u-5, c+v-5]
        blu[r, c] <- blu[r, c] + kernel[u, v] * BLU[r+u-5, c+v-5]
      }
    }
  }
}

img <- as.cimg(abind::abind(red, gre, blu, along = 3L))
plot(img)

这也会给出灰色图像。

灰色图像不是正确的结果。我可以使用 magick 包获得预期的结果：

library(magick)
im <- image_read("mypic.png")
kern <- "9x9:
    0    1    1    2    2    2    1    1    0
    1    2    4    5    5    5    4    2    1
    1    4    6    3    0    3    6    4    1
    2    5    3  -12  -24  -12    3    5    2
    2    5    0  -24  -40  -24    0    5    2
    2    5    3  -12  -24  -12    3    5    2
    1    4    6    3    0    3    6    4    1
    1    2    4    5    5    5    4    2    1
    0    1    1    2    2    2    1    1    0"
image_morphology(im, kernel = kern, method = "Correlate")

我知道这是预期的结果，因为我用 Haskell 得到的结果几乎相同（除了颜色相反）。那么如何使用

imager::correlate

和手动操作呢？

Answer 1

我认为正确的信息是存在的，但对比度很差。如果你设置的话你会看得更清楚

normalise = TRUE

library(imager)

load.image("Klein.png") |>
  correlate(as.cimg(kernel), normalise = TRUE) |> 
  plot()

问题似乎是 LoG 可以给出正值和负值，我们期望没有发生变化的像素为 0。由于负像素是暗的，正像素是亮的，所以 0 值将是灰色的。如果我们将所有负像素设置为 0，我们会得到更接近期望的结果：

arr <- correlate(im, as.cimg(kernel), norm = TRUE) |> as.array()
arr[arr < 0] <- 0
as.cimg(arr) |> plot()