#' 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"))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.