如何用imager包及手动方法实现图像与离散核的相关运算？

我有如下原图：

想要计算该图像与给定离散核的相关（correlation）图像。首先尝试使用imager包的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包的image_morphology函数选择Correlate方法可得到预期结果：

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函数及手动方法得到正确结果？

问题根源分析 #

1. 核定义不一致：你在imager和手动计算中使用的核，第三行的第3、7位是5，但magick中使用的核对应位置是6，这会直接导致计算结果偏离预期。
2. 像素值范围未归一化：
   • imager加载的图像像素值是0-1的浮点数，相关计算后会产生正负值，直接绘图时会被截断到0-1区间，导致细节丢失，呈现灰色。
   • 手动计算时将图像转成0-255整数，计算后的结果数值范围极大且包含正负，未做归一化就转成图像，同样会导致显示异常。

修正后的imager::correlate代码 #

library(imager)

# 修正核定义，和magick使用的核一致
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, 6, 3, 0, 3, 6, 4, 1), # 此处将5改为6
  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, 6, 3, 0, 3, 6, 4, 1), # 此处将5改为6
  c(1, 2, 4, 5, 5, 5, 4, 2, 1),
  c(0, 1, 1, 2, 2, 2, 1, 1, 0)
)

im <- load.image("mypic.png")
# 对每个颜色通道分别计算相关
img_corr <- correlate(im, as.cimg(kernel))

# 归一化像素值到0-1区间：将最小值映射到0，最大值映射到1
img_normalized <- (img_corr - min(img_corr)) / (max(img_corr) - min(img_corr))
plot(img_normalized)

修正后的手动计算代码 #

library(imager)
library(abind)

# 使用修正后的核
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, 6, 3, 0, 3, 6, 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, 6, 3, 0, 3, 6, 4, 1),
  c(1, 2, 4, 5, 5, 5, 4, 2, 1),
  c(0, 1, 1, 2, 2, 2, 1, 1, 0)
)

im <- load.image("mypic.png")
# 转成0-255整数矩阵
RED <- 255 * as.matrix(R(im)[,,1,1])
GRE <- 255 * as.matrix(G(im)[,,1,1])
BLU <- 255 * as.matrix(B(im)[,,1,1])

red <- RED
gre <- GRE
blu <- BLU

# 遍历计算相关，修正边界范围避免越界
rows <- nrow(RED)
cols <- ncol(RED)
for(r in 5:(rows - 4)) {
  for(c in 5:(cols - 4)){
    red[r, c] <- 0
    gre[r, c] <- 0
    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]
      }
    }
  }
}

# 对三个通道分别归一化到0-255
normalize <- function(x) {
  (x - min(x)) / (max(x) - min(x)) * 255
}
red_norm <- normalize(red)
gre_norm <- normalize(gre)
blu_norm <- normalize(blu)

# 组合成彩色图像并转换为cimg格式
img <- as.cimg(abind(red_norm, gre_norm, blu_norm, along = 3L))
plot(img)

补充说明 #

• 归一化是关键步骤：相关计算会产生正负值，且数值范围远超出图像显示的0-1（或0-255）区间，必须将结果映射到可显示范围才能看到正确的色彩细节。
• 核的一致性：确保不同方法使用的核完全相同，否则计算结果必然存在差异。

内容的提问来源于stack exchange，提问作者Stéphane Laurent