R/09fig_check_area.R

In darrennorris/parcelareadev: To test and develop parcel area calculations

#' check_area
#' 
#' @description
#' Should not be called directly by users.
#' \code{check_area} plots buffer (spatial polygons) for widths around central line.
#'
#' @param x List with data, spatial lines and polygons generated by \code{area_calc}.
#' @param c_epsg EPSG code for projected buffers.
#'
#' @return Figure with polygons of widths.
#' @importFrom graphics legend par text title
#' @export
#'
#' @examples
#' \dontrun{
#' }
check_area <- function(x, c_epsg = 3395){
  require(sp)
  require(rgdal)
  mycrs <- paste("+init=epsg:", c_epsg,sep="")
  # points 
  dfp <- x$data$coords
  dfp$dist_m <- (dfp$seg_id -1) * 10
  coordinates(dfp)  <- ~coord_x+coord_y
  proj4string(dfp) <- CRS("+init=epsg:4326")
  dfp <- spTransform(dfp, CRS(mycrs))
  
  #start and finish
  selP <- which(dfp$seg_id == min(dfp$seg_id) | dfp$seg_id == max(dfp$seg_id))
  dfp_sf <- dfp[selP, ]
  dfp_sf$mycol <- ifelse(dfp_sf$seg_id == min(dfp_sf$seg_id), "green", "red")
  dfp_sf$dist_m <- (dfp_sf$seg_id -1) * 10

  # show those removed and buffers for area calculation
  df <- data.frame(x$SpatialLines_proj$SpatialLinesAll)
  dfa <- df[which(df$remove_angle==1), ]
  dft <- df[which(df$remove_trilha==1), ]
  
  tit <- x$SpatialLines_proj$SpatialLinesAll@data[1,'plot_id']
  am <- paste("rm.angulo.dist:", toString((dfa$seg_id-1)*10))
  tm <- paste("rm.trilha.dist:", toString((dft$seg_id-1)*10))
  myt1 <- paste(tit," all\n")
  myt2 <- paste(tit," remove trilha\n", "(", tm, ")")
  myt3 <- paste(tit," remove angulo\n", "(",am, ")")
  myt4 <- paste(tit," remove all\n", "(",am,";\n", tm, ")")
  
  linesall <- x$SpatialLines_proj$SpatialLinesAll
  linesrt <- x$SpatialLines_proj$SpatialLinesRemoveTrilha
  linesran <- x$SpatialLines_proj$SpatialLinesRemoveAngle
  linesrall <- x$SpatialLines_proj$SpatialLinesRemoveAll
 
  
  # check that buffers have been calcuated
  if(class(x$buff_SpatialLinesAll$buf_20m) != "SpatialPolygons" | 
     class(x$buff_SpatialLinesAll$buf_10m) != "SpatialPolygons" |
     class(x$buff_SpatialLinesAll$buf_22m) != "SpatialPolygons") 
    stop("Buffer not created. Check option faixa_dist. Results must include 10m, 20m and 22m buffers")
  
 # limits
 mylim <- bbox(x$buff_SpatialLinesAll$buf_22m)
 x_min <- mylim[1,1] - (mylim[1,1] * 0.000003)
 x_max <- mylim[1,2] + (mylim[1,2] * 0.000003)
 y_min <- mylim[2,1] - (mylim[2,1] * 0.000003)
 y_max <- mylim[2,2] + (mylim[2,2] * 0.000003)
 # plot
  par(mfrow=c(2, 2), mar = c(0.5, 1, 4, 1), oma=c(0.1,0.1,0.1,0.1))
 plot(x$buff_SpatialLinesAll$buf_20m, col="grey80")
  plot(x$buff_SpatialLinesAll$buf_10m, col="green", add=TRUE)
  plot(linesall, col="yellow", lwd=2.8, add=TRUE)
 plot(dfp, add=TRUE)
 points(dfp_sf, pch=21, bg = dfp_sf$mycol, cex = 1.5)
 text(coordinates(dfp_sf)[,1], coordinates(dfp_sf)[,2], labels = dfp_sf$dist_m,
      pos = 2, cex = 1.5)
  title(main = myt1)  
  
  plot(x$buff_SpatialLinesRemoveTrilha$buf_20m, col="grey80",
       xlim=c(x_min,x_max),ylim=c(y_min,y_max))
  plot(x$buff_SpatialLinesRemoveTrilha$buf_10m, col="green", add=TRUE)
  plot(linesall, lty=5, add=TRUE)
  plot(linesrt, col="yellow", lwd=2.8,add=TRUE) 
 plot(dfp, add=TRUE)
 points(dfp_sf, pch=21, bg = dfp_sf$mycol, cex = 1.5)
 text(coordinates(dfp_sf)[,1], coordinates(dfp_sf)[,2], labels = dfp_sf$dist_m,
      pos = 2, cex = 1.5)
  title(main = myt2)
  
  plot(x$buff_SpatialLinesRemoveAngle$buf_20m, col="grey80",
       xlim=c(x_min,x_max),ylim=c(y_min,y_max))
  plot(x$buff_SpatialLinesRemoveAngle$buf_10m, col="green", add=TRUE)
  plot(linesall, lty=5, add=TRUE)
  plot(linesran, col="yellow", lwd=2.8,add=TRUE) 
 plot(dfp, add=TRUE)
 points(dfp_sf, pch=21, bg = dfp_sf$mycol, cex = 1.5)
 text(coordinates(dfp_sf)[,1], coordinates(dfp_sf)[,2], labels = dfp_sf$dist_m,
      pos = 2, cex = 1.5)
  title(main = myt3)
  
  plot(x$buff_SpatialLinesRemoveAll$buf_20m, col="grey80",
       xlim=c(x_min,x_max),ylim=c(y_min,y_max))
  plot(x$buff_SpatialLinesRemoveAll$buf_10m, col="green", add=TRUE)
  plot(linesall, lty=5, add=TRUE)
  plot(linesrall, col="yellow", lwd=2.8,add=TRUE) 
 plot(dfp, add=TRUE)
 points(dfp_sf, pch=21, bg = dfp_sf$mycol, cex = 1.5)
 text(coordinates(dfp_sf)[,1], coordinates(dfp_sf)[,2], labels = dfp_sf$dist_m,
      pos = 2, cex = 1.5)
  title(main = myt4)
    #legend("topleft",legend=c("bom" , "remove angulo", "remove trilha" ), 
        # lty=c(5,1,1), lwd=c(1,2,2), col=c("grey", "red", "black"))

}