R中EBImage计算字符周长复杂度结果偏低的问题排查与修正

我尝试用R语言的EBImage包获取二值图像的周长与面积，用于中英文字符分析。计算中文汉字“爱”的周长复杂度（公式：$\frac{(\text{周长})^2}{4\times\text{面积}\times\pi}$）时，结果始终在1.5以下，但Mathematica数据库得出的数值约为35，二者差异极大。以下是初始实现代码：

#### Load Library ####
library(EBImage)

#### Create Text Image Function ####
textPlot <- function(plotname, string,cex=20){
  par(mar=c(0,0,0,0))
  jpeg(paste0(plotname, ".jpg"))
  plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
  text(x = 0.5, y = 0.5, paste(string), cex = cex, col = "black", family="serif", font=2, adj=0.5)
  dev.off()
}

#### Generate Images for W and 爱 ####
textPlot("w","w",20)
textPlot("ai","爱",20)

#### Pre-Process Image ####
path <- "C:/Users/User/Desktop/main_projects/ai.jpg" # set wd
img <- readImage(path) # original image
gray_img <- channel(img, "gray") # converts to grayscale
binary_img <- gray_img > 0.5 # creates threshold for binary
labeled_img <- bwlabel(binary_img) # labels binary objects

#### Compare Images ####
plot(img)
plot(gray_img)
plot(binary_img)

#### Compute Shape Features (Perimeter/Area) ####
shape_features <- computeFeatures.shape(labeled_img)
perimeters <- shape_features[, "s.perimeter"]
areas <- shape_features[, "s.area"]

#### Display Original Image w/ Labeled Boundaries ####
display(img, method = "raster")
highlight <- paintObjects(labeled_img, img, col = "red")
display(highlight, method = "raster")

#### Print Perimeter and Area ####
perimeters
areas
pc <- (sum(perimeters)^2) / (4*sum(areas)*pi)
pc # both chars only slight diff., always changes when inc. size

差异成因 #

1. 二值化方向完全错误
   原代码中，gray_img > 0.5提取的是白色背景区域（灰度值接近1），而非黑色字符区域（灰度值接近0）。bwlabel标记的是背景对象，计算的是背景的周长与面积，而非目标字符，这是结果偏离的核心原因。

2. 图像格式导致边缘失真
   使用JPEG格式生成图像时，有损压缩会模糊字符边缘，二值化后丢失大量精细边缘细节，进一步低估周长。

3. 周长计算的精度差异
   EBImage的computeFeatures.shape采用像素级连通性计算周长，对字符的曲线边缘近似程度低；而Mathematica使用矢量轮廓或亚像素级计算，能保留字符的精细轮廓，周长计算更接近真实值。

4. 固定阈值的局限性
   硬编码的0.5阈值无法适应字体渲染后的灰度渐变，会误判边缘浅灰色像素为背景，丢失边缘细节。

修改后的代码与优化步骤 #

#### Load Library ####
library(EBImage)

#### Create Text Image Function (改用无损PNG格式) ####
textPlot <- function(plotname, string, cex=20){
  par(mar=c(0,0,0,0))
  # 使用PNG避免JPEG压缩失真
  png(paste0(plotname, ".png"), type = "cairo")
  plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
  text(x = 0.5, y = 0.5, string, cex = cex, col = "black", family="serif", font=2, adj=0.5)
  dev.off()
}

#### Generate Images for W and 爱 ####
textPlot("w","w",20)
textPlot("ai","爱",20)

#### Pre-Process Image (修正二值化方向+自动阈值) ####
path <- "C:/Users/User/Desktop/main_projects/ai.png" 
img <- readImage(path)
gray_img <- channel(img, "gray")

# 使用Otsu自动阈值法提取字符区域，修正二值化方向
threshold <- otsu(gray_img)
binary_img <- gray_img < threshold 

# 填充字符内部的封闭孔洞（可选，根据面积计算需求调整）
binary_img <- fillHull(binary_img)

# 标记字符对象
labeled_img <- bwlabel(binary_img)

#### Compute Shape Features ####
shape_features <- computeFeatures.shape(labeled_img)
perimeters <- shape_features[, "s.perimeter"]
areas <- shape_features[, "s.area"]

#### Display Results ####
display(img, method = "raster")
highlight <- paintObjects(labeled_img, img, col = "red")
display(highlight, method = "raster")

#### Calculate and Print Perimeter Complexity ####
pc <- (sum(perimeters)^2) / (4*sum(areas)*pi)
cat("周长:", perimeters, "\n面积:", areas, "\n周长复杂度:", pc, "\n")

关键优化说明 #

• 改用PNG格式：避免JPEG的有损压缩，保留字符边缘的精细细节。
• 修正二值化方向：通过gray_img < threshold正确提取黑色字符区域。
• Otsu自动阈值：自动适应图像的灰度分布，更准确地分离字符与背景。
• 填充内部孔洞：fillHull确保字符的内部封闭区域被计入面积（若需求为字符的整体占位面积，可启用；若仅计算笔画面积则跳过）。

内容的提问来源于stack exchange，提问作者Shawn Hemelstrand