R/rasterizeROI.R

In xROI: Delineate Region of Interests (ROI's) and Extract Time-Series Data from Digital Repeat Photography Images

#' Rasterize ROI Polygons
#'
#' This function convert point-based polygons to raster format
#' @param pnts a numeric matrix. a two column matrix of points as relative x and y values (0 to 1)
#' @param imgSize a numeric vector, size of the final raster
#' @return a binary matrix. matrix of the mask file.
#' @keywords  Rasterize ROI Polygons
#' @rawNamespace import(raster, except = c(intersect, union, quantile))
#' @export
#' @examples
#'
#' pnts <- matrix(c(0.1, 0.2,
#'                  0.1, 0.4,
#'                  0.5, 0.4,
#'                  0.5, 0.2),
#'                  4, 2, byrow= TRUE)
#' imgSize <- c(300, 400)
#' m <- rasterizeROI(pnts, imgSize)
#' xROI::addMask(m, add = FALSE)
#'
rasterizeROI <- function(pnts, imgSize){

  pnts <- t(apply(pnts, 1, '*', imgSize))
  ext <- extent(1, imgSize[1], 1, imgSize[2])
  poly <- as(ext  ,"SpatialPolygons")
  # poly@polygons[[1]]@Polygons[[1]]@coords <- as.matrix(pnts)

  tbl <- as.data.table(na.omit(cbind(pnts,cumsum(is.na(pnts[,1]))+1 )))
  colnames(tbl) <- c('x', 'y', 'z')
  ng <- table(tbl$z)

  polyList <- list()
  np <- length(ng[which(ng>=3)])

  for(gi in 1:np)
    polyList[[gi]] <- as.matrix(tbl[z==gi, .(x,y)])

  polys <- SpatialPolygons(
    lapply(1:np,
           function(x){
             p <- slot(poly@polygons[[1]], "Polygons")[[1]]
             slot(p, "coords") <- polyList[[x]]
             pp <- Polygons(list(p), ID = x)
             return(pp)
           })
  )

  r <- rasterize(polys, raster(ext, nrow = imgSize[2], ncol = imgSize[1]))
  r[!is.na(r)] <- 1

  m1 <- as.matrix(r)
  m <- m1
  m[m1==0|is.na(m1)] <- 1
  m[m1!=0] <- 0
  m
}