r - 有没有一种快速的方法来读取 R 中的图像尺寸(W x H)

Question

我有一个包含 9000 万张图片的文件夹。我有一个表，其中有一列 file_path，其中包含每个文件的完整路径。我需要读取文件夹中所有图像的图像高度和宽度。并将结果保存为可读入 R 的表格。

我已经尝试在 R 中使用 exifr 包(使用 exiftool 来完成工作)但是它很慢(>3 小时来扫描我的文件夹)。有没有更快的方法来实现我的目标？我不受限于使用原生 R 函数，但如果使用 system 以不同的语言使用，我希望能够从 R 调用该工具或 system2。

library(exifr)
dat<-data.frame(file_path = list.files("path/to/folder", 
                                       pattern =".jpg$",
                                       full.names = TRUE,
                                       recursive = TRUE))

im_dims<-read_exif(dat$file_path,tags = c("ExifImageWidth", "ExifImageHeight"))

Answer 1

不知道多快ImageMagick是与 exifr 相比，但它是以下 3 个选项中最快的。我包含的 R 函数来自 this SO answer并且包含在内是为了让 reprex 开心。请注意，我在文件夹 Pictures 中有 33 个文件，总大小为 3.7 MB。

library(jpeg)

get_image_dimensions <- function(path) {
  # Ensure file exists
  if(!file.exists(path)) 
    stop("No file found", call. = FALSE)
  
  # Ensure file ends with .png or .jpg or jpeg
  if (!grepl("\\.(png|jpg|jpeg)$", x = path, ignore.case = TRUE))
    stop("File must end with .png, .jpg, or .jpeg", call. = FALSE)
  
  # Get return of file system command
  s <- system(paste0("file ", path), intern = TRUE)
  
  # Extract width and height from string
  width <- regmatches(s, gregexpr("(?<=, )[0-9]+(?=(x| x )[0-9]+,)", s, perl = TRUE))[[1]]
  height <- regmatches(s, gregexpr(", [0-9]+(x| x )\\K[0-9]+(?=,)", s, perl = TRUE))[[1]] 
  setNames(as.numeric(c(width, height)), c("Width", "Height"))
}

magick_dim <- function(x, path = "."){
  fls <- list.files(path = path, pattern = x, full.names = TRUE)
  cmd <- 'magick'
  args <- c('identify', '-format', '"%w %h\n"', fls)
  d <- system2(cmd, args, stdout = TRUE)
  d <- strsplit(d, " ")
  y <- lapply(d, as.integer)
  setNames(y, basename(fls))
}

magick_dim("\\.jpg")
#> named list()

od <- getwd()
setwd("~/Rui/Pictures")
fls <- list.files(pattern = "\\.jpg")

length(fls)
#> [1] 33

library(microbenchmark)

mb <- microbenchmark(
  readJPEG = lapply(fls, \(x) dim(readJPEG(x))),
  Colitti = lapply(fls, get_image_dimensions),
  magick = magick_dim("\\.jpg"),
  times = 5
)
print(mb, order = "median")
#> Unit: milliseconds
#>      expr       min        lq     mean    median       uq      max neval cld
#>    magick  896.0296  983.3561 1037.211  992.1392 1115.144 1199.387     5 a  
#>  readJPEG 2252.2964 2346.6609 2510.984 2350.2388 2572.611 3033.112     5  b 
#>   Colitti 7271.8500 7382.9254 7540.919 7618.5121 7692.957 7738.351     5   c

^{由 reprex package 创建于 2022-03-29 (v2.0.1)}