example hen

image processing

You can also embed plots, for example:

setwd(dir)
ll<-list.files(pattern = "*.csv")
length(ll)

## [1] 633

lt<-list.files(pattern = "*.txt")
length(lt)

## [1] 633

#arrays for hen, background and timeframe
img<-array(0,dim=c(length(ROI[[1]]),length(ROI[[2]]),length(ll)))
im_f<-array(0,dim=c(length(ROI[[1]]),length(ROI[[2]]),length(ll)))
timestamp<-frame<-rep(0,times=length(lt))


kern=makeBrush(2,"disc")

## Warning in makeBrush(2, "disc"): 'size' was rounded to the next odd number: 3

for (i in 1:length(ll)){
  mat<- t(read.csv(ll[i],header = F)) #read depth
  meta<-read.table(lt[i],header = F,sep=":",nrows = 4) #read metadata
  frame[i]<-meta[2,2] #frame number
  timestamp[i]<-as.numeric(meta[3,2])/1000000 #timestamp
  
  pr = as.matrix(mat[ROI[[1]],ROI[[2]]]) #cut pen ROI
  idx = pr<threshold_hen #get hen's ROI
  bn<-1*(idx) #mask
  
  #morphology transformation: NEEDS TO BE OPTIMIZED/IMPROVED!
  for (j in 1:1){
    bn=erode(bn,kern)
  }
  for (j in 1:1){
    bn=dilate(bn,kern)
  }
  img[,,i] <- bn*pr  #save masked depth image for hen PROBLEM: get rid of small objects
  im_f[,,i]<-(1-bn)*pr #save masked depth image for bkg
}
  #compute area in pixels
pix<-apply(img>0,3,sum) #problem: we don't have a good measure of the area in cm2... can we get it?
                      #easy way: go with camera parameters


#measure distance to floor with camera
floordistance<-apply(im_f,3,function(x) median(x[x>0]))

#measure distance to the closest point to the camera within the hen mask
distance_chicken<-apply(img,3,function(x) min(x[x>0]))

#chicken height 
heigh_chicken<-median(floordistance)-distance_chicken

#this is necesary to keep track of time and frames
frame<-as.numeric(frame)-min(as.numeric(frame))+1

timestamp<-timestamp-min(timestamp)
results<-tibble(order=1:length(frame),frame=as.numeric(frame),time=timestamp,
                camera_h=floordistance,chicken_h=heigh_chicken,
                chicken_a=pix)

#Results Look first at the graphics and print the maximum height

p1<-ggplot(results,aes(x=time,y=chicken_h))+geom_line()+
  ylab("Max height in m")+xlab("time in seconds")
p2<-ggplot(results,aes(x=time,y=chicken_a))+geom_line()+
  ylab("Area in pixels")+xlab("time in seconds")
grid.arrange(p1,p2)

#actual height
filter(results,chicken_h==max(chicken_h))

## # A tibble: 1 x 6
##   order frame  time camera_h chicken_h chicken_a
##   <int> <dbl> <dbl>    <dbl>     <dbl>     <int>
## 1    16    31  1.00     2.60     0.552      2897

maxh<-filter(results,chicken_h==max(chicken_h))

#Now a “visual” check of location of maximum

xx<-img[,,maxh$order]
xx[xx<=0]<-1000
mx<-which(xx==min(xx), arr.ind=T)
xx[mx]

## [1] 2.044 2.044

display(img[,,maxh$order],method = "raster")
points(mx,pch=20,col="red")

example hen

How to estimate the heigh and area occupied by a (wing flapping) hen

image processing