如何从jpeg图像中提取彩色圆点的坐标?

时间:2021-12-28 00:49:05

I am trying to measure distances between objects of interests (in this example year rings in trees) using R. My earlier attempt was so complicated that I have difficulties reproducing the solution for a similar type of a problem using different kinds of figures. I think that there must be an easier way of doing the measurements. As nice as ImageJ might be for picture analysis, I find it too clumsy to use for repetitive work. Why not just to mark the objects of interest with different colors using an image handling program and trying to extract the information about their position? (this is not the question). Here is an example:

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

如何从jpeg图像中提取彩色圆点的坐标?

(Save the picture as tree.jpg). In order to measure the distance from the beginning (blue dot) to the red and green dots (representing two different arbitrary measurements), I need to extract the centroid and color characteristic (i.e. whether the dot is green, blue or red) of each dot in the picture.

(将图片保存为tree.jpg)。为了测量从开始(蓝点)到红点和绿点(表示两个不同的任意测量)的距离,我需要提取每个的质心和颜色特征(即点是绿色,蓝色还是红色)点在图片中。

The colors I have used are following:

我使用的颜色如下:

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))

I have managed to open the file and plot it:

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

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)

如何从jpeg图像中提取彩色圆点的坐标?

Dimensions in the plot are in pixels. I can also extract the information in one of the RGB channels (here in green):

图中的尺寸以像素为单位。我还可以在其中一个RGB通道中提取信息(这里是绿色):

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

After this I am starting to experience problems. I have found out that Momocs package, might be able to extract the shapes from RGB channel matrices, but I doubt that it is the right tool for this problem. Maybe one of the spatial packages could work? (I did not find a function for this purpose, though). How do I extract the position (in pixels using an arbitrary coordinate system) of colored dots from an image using R?

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

1 个解决方案

#1


4  

Maybe there is some library that can do this already, but here are some utility functions that I wrote to help:

也许有一些库可以做到这一点,但这里有一些我写的帮助实用函数:

# 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?
}

Use the functions like this:

使用这样的功能:

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

#1


4  

Maybe there is some library that can do this already, but here are some utility functions that I wrote to help:

也许有一些库可以做到这一点,但这里有一些我写的帮助实用函数:

# 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?
}

Use the functions like this:

使用这样的功能:

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