R/10fig_check_lado.R

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

#' check_lado
#' 
#' @description
#' Should not be called directly by users.
#' \code{check_lado} plots left and right buffer polygons.
#'
#' @param x List with data, spatial lines and polygons generated by \code{area_calc}.
#' @param cl_epsg EPSG code for projected buffers.
#'
#' @return Figure with left and right buffers.
#' @importFrom graphics legend par text title
#' @export
#'
#' @examples
#' \dontrun{
#' }
check_lado <- function(x, cl_epsg=3395){
  require(sp)
  require(rgdal)
  mycrs <- paste("+init=epsg:", cl_epsg,sep="")
  
  #if(class(x$ladobuff_SpatialLinesAll$'ladobuf_22m') != "SpatialPolygonsDataFrame" ) 
  #  stop("Buffer not created. Check option faixa_lado. Results must include 22m buffer")
  
  # start and finish
  dfp <- x$data$coords
  selP <- which(dfp$seg_id == min(dfp$seg_id) | dfp$seg_id == max(dfp$seg_id))
  dfp <- dfp[selP, ]
  dfp$mycol <- ifelse(dfp$seg_id == min(dfp$seg_id), "green", "red")
  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))
  
  # 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
  
 # plot 
  par(mfrow=c(2, 2), mar = c(1, 2, 4, 1))
 if (class(x$ladobuff_SpatialLinesAll$'ladobuf_22m')=="logical"){
   plot(0,xaxt='n',yaxt='n',bty='n',pch='',ylab='',xlab='')
 }else{
  plot(x$ladobuff_SpatialLinesAll$'ladobuf_22m', 
       col = x$ladobuff_SpatialLinesAll$'ladobuf_22m'$mycol)
  plot(linesall, col="yellow", lwd=2.8, add=TRUE)
  points(dfp, pch=21, bg = dfp$mycol, cex = 1.5)
  text(coordinates(dfp)[,1], coordinates(dfp)[,2], labels = dfp$dist_m,
       pos = 2, cex = 1.5)
  legend("topleft", 
         #inset = c(0,0.4), 
         cex = 1.5, 
         bty = "n", 
         legend = c("left", "right"), 
         col = c("grey80", "grey60"), 
         pch = c(15,15))
  title(main = myt1)  
 }
 
 if (class(x$ladobuff_SpatialLinesRemoveTrilha$'ladobuf_22m')=="logical"){
   plot(0,xaxt='n',yaxt='n',bty='n',pch='',ylab='',xlab='')
 }else{
  plot(x$ladobuff_SpatialLinesRemoveTrilha$'ladobuf_22m', 
       col = x$ladobuff_SpatialLinesRemoveTrilha$'ladobuf_22m'$mycol)
  plot(linesall, lty=5, add=TRUE)
  plot(linesrt, col="yellow", lwd=2.8,add=TRUE)
 points(dfp, pch=21, bg = dfp$mycol, cex = 1.5)
 text(coordinates(dfp)[,1], coordinates(dfp)[,2], labels = dfp$dist_m,
      pos = 2, cex = 1.5)
  title(main = myt2)
 }
  
 if (class(x$ladobuff_SpatialLinesRemoveAngle$'ladobuf_22m')=="logical"){
   plot(0,xaxt='n',yaxt='n',bty='n',pch='',ylab='',xlab='')
 }else{
  plot(x$ladobuff_SpatialLinesRemoveAngle$'ladobuf_22m',
       col=  x$ladobuff_SpatialLinesRemoveAngle$'ladobuf_22m'$mycol)
  plot(linesall, lty=5, add=TRUE)
  plot(linesran, col="yellow", lwd=2.8,add=TRUE)
  points(dfp, pch=21, bg = dfp$mycol, cex = 1.5)
  text(coordinates(dfp)[,1], coordinates(dfp)[,2], labels = dfp$dist_m,
       pos = 2, cex = 1.5)
  title(main = myt3)
 }
 
 if (class(x$ladobuff_SpatialLinesRemoveAll$'ladobuf_22m')=="logical"){
   plot(0,xaxt='n',yaxt='n',bty='n',pch='',ylab='',xlab='')
 }else{
  plot(x$ladobuff_SpatialLinesRemoveAll$'ladobuf_22m',
       col = x$ladobuff_SpatialLinesRemoveAll$'ladobuf_22m'$mycol)
  plot(linesall, lty=5, add=TRUE)
  plot(linesrall, col="yellow", lwd=2.8,add=TRUE)
  points(dfp, pch=21, bg = dfp$mycol, cex = 1.5)
  text(coordinates(dfp)[,1], coordinates(dfp)[,2], labels = dfp$dist_m,
       pos = 2, cex = 1.5)
  title(main = myt4)
}


}