6

我正在尝试使用 R 来测量感兴趣的对象之间的距离（在这个例子中，树上的年轮）。我之前的尝试非常复杂，以至于我很难使用不同类型的数字来重现类似类型问题的解决方案。我认为必须有一种更简单的方法来进行测量。尽管 ImageJ 可能用于图片分析，但我发现它太笨拙，无法用于重复性工作。为什么不使用图像处理程序用不同的颜色标记感兴趣的对象并尝试提取有关其位置的信息？（这不是问题）。这是一个例子：

在此处输入图像描述

（将图片另存为tree.jpg）。为了测量从开始（蓝点）到红点和绿点的距离（代表两个不同的任意测量值），我需要提取每个点的质心和颜色特征（即点是绿色、蓝色还是红色）图片中的点。

我使用的颜色如下：

cols <- list(red = rgb(255/255, 0/255, 0/255), green = rgb(0/255, 255/255, 0/255), blue = rgb(0/255, 0/255, 255/255))

我设法打开文件并绘制它：

library("jpeg")
img <- readJPEG("tree.jpg")
ydim <- attributes(img)$dim[1] # Image dimension y-axis
xdim <- attributes(img)$dim[2] # Image dimension x-axis
plot(c(0,xdim), c(0,ydim), type='n')
rasterImage(img, 0,0,xdim,ydim)

在此处输入图像描述

图中的尺寸以像素为单位。我还可以在其中一个 RGB 通道中提取信息（此处为绿色）：

plot(c(0,xdim), c(0,ydim), type='n')
rasterImage(img[,,2], 0,0,xdim,ydim)

在此之后，我开始遇到问题。我发现Momocspackage可能能够从 RGB 通道矩阵中提取形状，但我怀疑它是否是解决这个问题的正确工具。也许其中一个空间包可以工作？（不过，我没有找到用于此目的的功能）。如何使用 R 从图像中提取彩色点的位置（使用任意坐标系以像素为单位）？

4

1 回答 1

6

也许已经有一些库可以做到这一点，但这里有一些我写的实用函数来提供帮助：

# What are the cartesian coordinates of pixels within the tolerance?
extract.coord<-function(channel,tolerance=0.99){
  positions<-which(img[,,channel]>=tolerance) 
  row<-nrow(img) - (positions %% nrow(img))
  col<-floor(positions / nrow(img))  +1
  data.frame(x=col,y=row)
}

# Do these two pixels touch? (Diagonal touch returns TRUE)
touches<-function(coord1,coord2)
  coord2$x <= (coord1$x+1) & coord2$x >= (coord1$x-1) & coord2$y <= (coord1$y+1) & coord2$y >= (coord1$y-1)

# Does this pixel touch any pixel in this list?
touches.list<-function(coord1,coord.list)
  any(sapply(1:nrow(coord.list),function(x)touches(coord.list[x,],coord1)))

# Given a data.frame of pixel coordinates, give me a list of data frames
# that contain the "blobs" of pixels that all touch.
extract.pixel.blobs<-function(coords){
  blob.list<-list()
  for(row in 1:nrow(coords)){
    coord<-coords[row,]
    matched.blobs<-sapply(blob.list,touches.list,coord1=coord)
    if(!any(matched.blobs)){
      blob.list[[length(blob.list)+1]]<-coords[row,,drop=FALSE]
    } else {
      if(length(which(matched.blobs))==1) {
        blob.list[[which(matched.blobs)]]<-rbind(blob.list[[which(matched.blobs)]],coords[row,,drop=FALSE])
      } else { # Pixel touches two blobs
        touched.blobs<-blobs[which(matched.blobs)]
        blobs<-blobs[-which(matched.blobs)]
        combined.blobs<-do.call(rbind,touched.blobs)
        combined.blobs<-rbind(combined.blobs,coords[row,,drop=FALSE])
        blobs[[length(blob.list)+1]]<-combined.blobs
      }
    }
  }
  blob.list
}

# Not exact center, but maybe good enough?
extract.center<-function(coords){
  round(c(mean(coords$x),mean(coords$y))) # Good enough?
}

使用如下函数：

coord.list<-lapply(1:3,extract.coord)
names(coord.list)<-c('red','green','blue')
pixel.blobs<-lapply(coord.list,extract.pixel.blobs)
pixel.centers<-lapply(pixel.blobs,function(x) do.call(rbind,lapply(x,extract.center)))

# $red
# [,1] [,2]
# [1,]   56   60
# [2,]   62   65
# [3,]  117  123
# [4,]  154  158
# 
# $green
# [,1] [,2]
# [1,]   72   30
# [2,]   95   15
# 
# $blue
# [,1] [,2]
# [1,]   44   45
于 2013-11-12T17:48:31.007 回答