R/03makeSeg.R

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

#' 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,] 

}