Rutils/maybe-not-useful/pixel.poly.r

In manfredo89/ED2io: Manages Input/Output for Ecosystem Demography 2 Model

#==========================================================================================#
#==========================================================================================#
#      Pixel.poly: this function creates polygons for all pixels, based on the grid        #
# resolution.                                                                              #
#------------------------------------------------------------------------------------------#
pixel.poly <<- function(x,y,dx,dy){
   #----- Central point. ------------------------------------------------------------------#
   xy = rbind(x = x, y = y)
   #---------------------------------------------------------------------------------------#

   #----- Corners. ------------------------------------------------------------------------#
   sw = data.frame(xy + 0.5*c(-dx,-dy))
   nw = data.frame(xy + 0.5*c(-dx,+dy))
   ne = data.frame(xy + 0.5*c(+dx,+dy))
   se = data.frame(xy + 0.5*c(+dx,-dy))
   #---------------------------------------------------------------------------------------#


   #------ Find all polygons. -------------------------------------------------------------#
   ans = mapply(FUN=one.pixel.poly,sw=sw,nw=nw,ne=ne,se=se,SIMPLIFY=FALSE)
   return(ans)
   #---------------------------------------------------------------------------------------#
}#end pixel.poly
#==========================================================================================#
#==========================================================================================#




#==========================================================================================#
#==========================================================================================#
#      This function creates a polygon from one set of corners.                            #
#------------------------------------------------------------------------------------------#
one.pixel.poly <<- function(sw,nw,ne,se){
   #----- Append points. ------------------------------------------------------------------#
   ans        = data.frame(rbind(v1=sw,v2=nw,v3=ne,v4=se,v5=sw))
   names(ans) = c("x","y")
   return(ans)
   #---------------------------------------------------------------------------------------#
}#end one.pixel.poly
#==========================================================================================#
#==========================================================================================#




#==========================================================================================#
#==========================================================================================#
#      This function calculates the intersection area.                                     #
#------------------------------------------------------------------------------------------#
area.intersect <<- function(x,y,relative=TRUE){
   #----- Append points. ------------------------------------------------------------------#
   xpoly = as(x,"gpc.poly")
   ypoly = as(y,"gpc.poly")
   ans   = try(area.poly(gpclib::intersect(xpoly,ypoly)),silent=TRUE)
   if ("try-error" %in% is(ans)) browser()
   return(ans)
   #---------------------------------------------------------------------------------------#
}#end one.pixel.poly
#==========================================================================================#
#==========================================================================================#