我正在尝试使用R来测量感兴趣的对象之间的距离(在这个示例中,年份在树中响起)My earlier attempt非常复杂,以至于我难以使用不同类型的类似问题再现解决方案数字。我认为必须有一种更简单的方法来进行测量。尽管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)
在此之后我开始遇到问题。我发现Momocs
package可能能够从RGB通道矩阵中提取形状,但我怀疑它是解决这个问题的正确工具。也许其中一个空间包可以工作? (但我没有为此目的找到功能)。如何使用R?
答案 0 :(得分:4)
也许有一些库可以做到这一点,但这里有一些我写的帮助实用程序函数:
# 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