R/08fig_check_linha.R

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

#' check_linha
#'
#' @description
#' Should not be called directly by users.
#' \code{check_linha} plots central line and distances.
#' @param x List with data, spatial lines and polygons generated by \code{area_calc}.
#'
#' @return Figure with center lines.
#' @importFrom graphics legend par text title
#' @export
#'
#' @examples
#' \dontrun{
#' }
check_linha <- function(x){
  require(sp)
  require(rgdal)
  # show which are to be removed
  linha <- x$SpatialLines_wgs84$SpatialLinesAll
  df <- data.frame(linha)
  dfa <- df[which(df$remove_angle==1), ]
  dft <- df[which(df$remove_trilha==1), ]
  
  # start and finish
  dfp <- x$data$coords
  dfp$dist_m <- (dfp$seg_id -1) * 10
  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")
  coordinates(dfp_sf)  <- ~coord_x+coord_y
  proj4string(dfp_sf) <- CRS("+init=epsg:4326")
  
  # points
  dfp_e <- dfp
  even <- seq_len(length(dfp_e$dist_m)) %% 2   # index
  even<- even[c(-1,-length(even))]
  seln <- which(even==1)
  dfp_e <- dfp_e[seln, ]
  coordinates(dfp_e)  <- ~coord_x+coord_y
  proj4string(dfp_e) <- CRS("+init=epsg:4326")  
    
  tit <- linha@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))
  myt <- paste(tit,"\n(",am,";", tm, ")", collapse = "\n")
  mycol <- ifelse(linha$removeF==0,NA,linha$removeF)
  plot(linha, lty=5,lwd=2.8, col="grey")
  plot(linha, col= mycol, lwd=3.8, add=TRUE)
  plot(dfp_e, add=TRUE)
  plot(dfp_sf, pch=21, bg = dfp_sf$mycol, cex = 1.5, add=TRUE)
  text(coordinates(dfp_e)[,1], coordinates(dfp_e)[,2], labels = dfp_e$dist_m,
       pos = 2, cex = 0.9)
  text(coordinates(dfp_sf)[,1], coordinates(dfp_sf)[,2], labels = dfp_sf$dist_m,
       pos = 4, cex = 1.5)
  title(main = myt)
  legend("topleft",legend=c("bom" , "remove angulo", "remove trilha" ), 
         lty=c(5,1,1), lwd=c(1,2,2), col=c("grey", "red", "black"))
}