R 如何从jpeg图像中提取彩色点的坐标？

我试图用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))

---

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

也许有一些库已经可以做到这一点，但下面是我编写的一些实用函数，以帮助您：

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

公差范围内像素的笛卡尔坐标是多少？

---

extract.coord这并不是您想要的答案，但我建议您提取一条直线上的所有点，然后处理这条直线（例如，使用微分过滤器，并查找零交叉点）。一旦图像被表示为2D矩阵，您应该能够很容易地沿直线插值像素（不需要特殊的图像处理软件包）。如果您相信所需的“红色”点在红色层中具有较大的值，那么

哪个（img[，，1]>x，array.indexs=TRUE）

将定位这些点（选择一些阈值

x

值）。如果第一层不是红色的，请道歉。如果需要找到簇的质心，请查看

spatstat

是否有帮助。Momocs更适合黑色遮罩，可能不是最合适的工具。

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

# 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