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

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

#------------------------------------------------------------------------------------------#
#      This function cleans the number of segments of the polygon.                         #
#------------------------------------------------------------------------------------------#
clean.poly <<- function(u){


   if (any(is.na(u$x) | is.na(u$y))){
      cat(" + Cleaning polygon file...","\n")
      #----- Find the number of break points. ---------------------------------------------#
      na.lines   = which(is.na(u$x) | is.na(u$y))
      n.na.lines = length(na.lines)
      #------------------------------------------------------------------------------------#



      #------------------------------------------------------------------------------------#
      #    Loop until it converges.                                                        #
      #------------------------------------------------------------------------------------#
      iterate = TRUE
      it      = 0
      while (iterate){
         #----- Update count and let the user know. ---------------------------------------#
         it              = it+1
         n.na.lines.last = n.na.lines
         cat(" + Iteration: ",it,"; # of segments: ",n.na.lines+1,"...",sep="","\n")
         #---------------------------------------------------------------------------------#



         #----- Limits of the segments. ---------------------------------------------------#
         idx.a    = c(1,na.lines+1)
         idx.z    = c(na.lines-1,nrow(u))
         #---------------------------------------------------------------------------------#



         #---------------------------------------------------------------------------------#
         #      Initiliase the corrected data.                                             #
         #---------------------------------------------------------------------------------#
         n  = NULL
         nl = 0
         for (i in sequence(n.na.lines+1)){
            #----- Grab edges for this segment. -------------------------------------------#
            na    = idx.a[i]
            nz    = idx.z[i]
            #------------------------------------------------------------------------------#


            #---- Forward and backward sequences. -----------------------------------------#
            f.idx = seq(from=na,to=nz,by=+1)
            b.idx = seq(from=nz,to=na,by=-1)
            #------------------------------------------------------------------------------#

            #---- Decide what to do based on matches. -------------------------------------#
            if (nl == 0){
               #---- First block, use forward. --------------------------------------------#
               n  = rbind(n,u[f.idx,])
               nl = nz
               #---------------------------------------------------------------------------#
            }else{
               #---- Check whether the next block is reversed or not. ---------------------#
               if ( all(u[na,] == u[nl,])){
                  #----- Not reversed. ----------------------------------------------------#
                  n  = rbind(n,u[f.idx,])
                  nl = nz
                  #------------------------------------------------------------------------#
               }else if (all(u[nz,] == u[nl,])){
                  #----- Reversed. --------------------------------------------------------#
                  n  = rbind(n,u[b.idx,])
                  nl = na
                  #------------------------------------------------------------------------#
               }else{
                  #---- Apparently a new polygon, keep the NA line in between. ------------#
                  n  = rbind(n,c(NA,NA),u[f.idx,])
                  nl = nz
                  #------------------------------------------------------------------------#
               }#end if
               #---------------------------------------------------------------------------#
            }#end if
            #------------------------------------------------------------------------------#
         }#end for
         #---------------------------------------------------------------------------------#


         #----- Check whether we are still doing progress here. ---------------------------#
         u          = n
         na.lines   = which(is.na(u$x) | is.na(u$y))
         n.na.lines = length(na.lines)
         iterate    = (n.na.lines > 0) && (n.na.lines < n.na.lines.last)
         #---------------------------------------------------------------------------------#
      }#end while
      #------------------------------------------------------------------------------------#
   }#end if (any(is.na(u$x) | is.na(u$y)))

   return(u)
}#end function
#------------------------------------------------------------------------------------------#