hypertidy / silicate

A general form for complex data
https://hypertidy.github.io/silicate/
53 stars 4 forks source link

TRI0 model #98

Closed mdsumner closed 4 years ago

mdsumner commented 4 years ago

WIP

triangulate_00 <- function(x, ...){
  ## assume x is PATH0
  ##x <- PATH0(minimal_mesh)
  v <- sc_vertex(x)
  v$vertex_ <- 1:nrow(v)

  obj <- sc_object(x)
  count <- 0
  trilist <- list()
  for (i in seq_len(nrow(obj))) {
  ## split x$object$path_ on subobject
  topol <- obj$path_[[i]]
  lsubs <- split(topol, topol$subobject)

  ## j is sub polygons
  for (j in seq_along(lsubs)) {
    vidx <- lsubs[[j]]
    verts <- inner_join(vidx[c("vertex_", "path_")], v[c("x_", "y_", "vertex_")], "vertex_")
    ## identify holes (path_ within subobject)
    holes <- which(c(0, abs(diff(as.integer(as.factor(verts$path_))))) > 0)
    if (length(holes) < 1) holes <- 0
    count <- count + 1
    trindex <- decido::earcut(cbind(verts[["x_"]], verts[["y_"]]), holes)
    trimat <- matrix(trindex, ncol = 3L, byrow = TRUE)
    print(trindex)
    trilist[[count]] <- tibble::tibble(.vx0 = verts$vertex_[trimat[,1L]],
                                      .vx1 = verts$vertex_[trimat[,2L]],
                                      .vx2 = verts$vertex_[trimat[,3L]])

    }
  }

  ## build TRI0
  obj$path_ <- NULL
  obj$topology_ <- trilist
  meta <- x$meta[1, ]
  meta$ctime <- Sys.time()
  structure(list(object = obj, vertex = sc_vertex(x), meta = rbind(meta, x$meta)), class = c("TRI0", "sc")) 
}

plot.TRI0 <- function(x, ...) {
  v <- sc_vertex(x)
  plot(v$x_, v$y_, type = "n", asp = 1)
  vps <- gridBase::baseViewports()
  grid::pushViewport(vps$inner, vps$figure, vps$plot)
  xx <- v %>% x$triangle
  grid::grid.polygon(xx$x, xx$y, xx$id, gp = grid::gpar(col = NA, fill = xx$col),
                     default.units = "native")
  grid::popViewport(3)

}
mdsumner commented 4 years ago

See also https://github.com/hypertidy/silicate/issues/93

mdsumner commented 4 years ago

New behaviour: