#' makeSeg
#'
#' @description
#' Should not be called directly by users.
#' \code{makeSeg} generates segments from coordinates generated by \code{getCoords}.
#'
#' @param df.coords Data.frame generated by \code{getCoords}
#'
#' @return data.frame with segments
#' @export
#'
#' @examples
#' \dontrun{
#' }
makeSeg <- function(df.coords){
dft <- df.coords
dft$long_x <- dft$coord_x
dft$lat_y <- dft$coord_y
#
dft_pontos <- dplyr::mutate(dft,
lead_x = dplyr::lead(coord_x, order_by = seg_id),
lead_y = dplyr::lead(coord_y, order_by = seg_id)
)
# sort by seg_id
dft_pontos <- dft_pontos[ order(dft_pontos$seg_id), ]
# 02. identify start and end of sections
minR <- min(which(dft_pontos$remove_all==0))
maxR <- max(which(dft_pontos$remove_all==0))
dft_s <- dplyr::mutate(dft_pontos[minR:maxR , ],
end_flag = dplyr::lead(remove_all, order_by = seg_id),
start_flag = dplyr::lag(remove_all, order_by = seg_id)
)
# 03. Unique ID for different sections ..............................
# tidy NA introduced with lead/lag then get row names
# repeat for start and end
dft_s$start_flag <- ifelse(is.na(dft_s$start_flag) == TRUE,
1, dft_s$start_flag)
dft_s$start_flag <- ifelse(dft_s$start_flag > 0,
dft_s$start_flag, NA)
dft_s$end_flag <- ifelse(is.na(dft_s$end_flag)==TRUE,
1,dft_s$end_flag)
dft_s$end_flag <- ifelse(dft_s$end_flag > 0,
dft_s$end_flag, NA)
dft_pontos <-
merge(dft_pontos, dft_s[,c('seg_id', 'end_flag', 'start_flag')],
all.x = TRUE, by.x = "seg_id", by.y = "seg_id")
dft_pontos <- dft_pontos[ order(dft_pontos$seg_id), ]
rownames(dft_pontos) <- NULL # reset rownames so follows order of seg_id
dft_pontos$row_id <- as.integer(rownames(dft_pontos))
# save in temporary data frame
dftmp <- data.frame(plot_id = dft_pontos[1,'plot_id'],
sec_start = na.omit(dft_pontos$start_flag * row(dft_pontos))[,1],
sec_end = na.omit(dft_pontos$end_flag * row(dft_pontos))[,1]
)
dftmp$sec_id <- rank(dftmp$sec_start)
# function to make data frame with section id
# and associated rows in the dft_pontos
start_stop <- function(x){
df <- data.frame(row_id = c(x$sec_start: x$sec_end), sec_id = as.numeric(x$sec_id))
}
df.sec <- plyr::ddply(dftmp,c("sec_id"),.fun = start_stop)
seldup <- which(duplicated(df.sec$row_id)==FALSE)
df.sec <- df.sec[seldup, ]
# add section id to corresponding rows
dft_pontos <- merge(dft_pontos,df.sec, all.x = TRUE)
# remove plot end point
selBada <- which(is.na(dft_pontos$lead_x)==TRUE)
dfla <- dft_pontos[-selBada,]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.