R/read_polygon_edges.R

Defines functions read_polygon_edges

Documented in read_polygon_edges

#' read_polygon_edges
#'
#' Special reader function for polygon edge output of voro++.
#'
#' @param x character vector with raw, linewise output of voro++ as produced with 
#' \link{tessellate} when \code{output_definition = "\%i*\%P*\%t"} 
#'
#' @return data.frame with columns for the coordinates x, y and z of the starting and 
#' end point of each polygon edge
#' 
#' @export
read_polygon_edges <- function(x) {

  # decide if lapply or pblapply should be used
  if (length(x) <= 500) {
    map_fun <- lapply
  } else {
    map_fun <- pbapply::pblapply
  }
  
  polygon_edges_list <- map_fun(
    x,
    function(x) {
      
      string_elems <- unlist(strsplit(x, "\\*"))
      
      # read id    
      id <- as.numeric(string_elems[1])
      
      # parse polygon vertex coordinates
      vertices_one_poly <- lapply(strsplit(gsub("\\(|\\)", "", unlist(strsplit(string_elems[2], " "))), ","), as.numeric)
      one_poly_many_vertices <- data.table::as.data.table(data.table::transpose(vertices_one_poly))
      colnames(one_poly_many_vertices) <- c("x", "y", "z")
      one_poly_many_vertices$in_poly_id <- 0:(nrow(one_poly_many_vertices) - 1)
      
      # parse polygon edge lines
      faces_one_poly <- lapply(strsplit(gsub("\\(|\\)", "", unlist(strsplit(string_elems[3], " "))), ","), as.numeric)
      one_poly_many_connections <- data.table::rbindlist(
        lapply(
          faces_one_poly,
          function(y) {
            data.frame(
              start = y,
              stop = y[c(2:length(y), 1)]
            )
          }
        )
      )
      
      connections.a <- data.table::merge.data.table(
        one_poly_many_vertices,
        one_poly_many_connections,
        by.x = "in_poly_id",
        by.y = "start"
      )
      
      connections <- data.table::merge.data.table(
          connections.a,
          one_poly_many_vertices,
          by.x = "stop",
          by.y = "in_poly_id",
          suffixes = c(".a", ".b")
        ) 

      connections$id <- id
      
      return(connections)
    }
  )
  
  polygon_edges <- data.table::rbindlist(polygon_edges_list)
  
  return(tibble::as_tibble(polygon_edges[,-c(1, 2)]))

}
nevrome/bleiglas documentation built on Jan. 6, 2020, 12:45 a.m.