Merge branch 'master' into devel

Former-commit-id: 2673aaa

.Rbuildignore

@@ -11,3 +11,4 @@
 ^docs$
 ^prepare_package.r$
 ^data-raw$
+^D:\GIT\rangl\docs$

.gitignore

@@ -2,4 +2,5 @@
 .Rhistory
 .RData
 .Ruserdata
-*.Rproj
+*.Rproj
+inst/doc

.travis.yml

@@ -5,13 +5,30 @@ sudo: required
 cache: packages
 
 apt_packages:
+ - libhdf5-dev
+ - libhdf5-serial-dev
  - libproj-dev
-
+ - libgdal-dev
+ - libgeos++-dev
+
 before_install:
+  - sudo mv /etc/apt/sources.list.d/pgdg* /tmp
+  - sudo apt-get remove postgis libpq5 libpq-dev postgresql-9.1-postgis postgresql-9.1-postgis-2.2-scripts postgresql-9.2-postgis postgresql-9.3-postgis postgresql-9.1 postgresql-9.2 postgresql-9.3 libgdal1
+  - sudo add-apt-repository -y ppa:ubuntugis/ubuntugis-unstable
+  - sudo add-apt-repository -y ppa:marlam/gta
+  - sudo apt-get update -qq
+  - sudo apt-get install python-numpy postgis postgresql-9.1 postgresql-client-9.1 postgresql-9.1-postgis-2.1 postgresql-9.1-postgis-2.1-scripts libpq-dev libpng12-dev libjpeg-dev libgif-dev liblzma-dev libgeos-dev libcurl4-gnutls-dev libproj-dev libxml2-dev libexpat-dev libxerces-c-dev libnetcdf-dev netcdf-bin libpoppler-dev libspatialite-dev gpsbabel swig libhdf4-alt-dev libhdf5-serial-dev libpodofo-dev poppler-utils libfreexl-dev unixodbc-dev libwebp-dev openjdk-7-jdk libepsilon-dev libgta-dev liblcms2-2 libpcre3-dev mercurial cmake libcrypto++-dev
+  - sudo apt-get install python-lxml
+  - sudo apt-get install python-pip
+  - sudo apt-get install libogdi3.2-dev
   - "export RGL_USE_NULL=TRUE"
+  - echo "options(repos = c(CRAN='http://cran.rstudio.com'))" > ~/.Rprofile
+
+# We use clang, --without-libtool and --with-debug for faster build
+compiler:
+  - clang
 
 after_success:
   - Rscript -e 'covr::codecov()'
 
-r_binary_packages:
-  - rgdal
+

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: rangl
 Type: Package
 Title: Tidy Flexible Spatial
-Version: 0.3.0.9001
+Version: 0.4.5.9001
 Authors@R: person("Michael D.","Sumner", role = c("aut", "cre"), email =
     "[email protected]")
-Description: Create tidy tables for topological, triangulated, and other spatial data structures.
+Description: Tabular storage for topological data structures based on primitives.
 License: GPL-3
 Imports:
     dplyr,
@@ -13,18 +13,28 @@ Imports:
     raster,
     rgl,
     RTriangle,
+    sf,
     sp,
-    spbabel (> 0.4.0),
+    spbabel (> 0.4.5),
     tibble, 
     viridis
-Suggests: 
+Suggests:
     covr, 
+    ggplot2,
+    ggpolypath,
+    graticule,
     maptools,
+    purrr,
+    rgdal,
+    rworldmap,
     rworldxtra,
     testthat, 
-    trip
+    trip,
+    knitr,
+    rmarkdown
 SystemRequirements: PROJ.4
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 5.0.1
-Remotes: mdsumner/spbabel, mdsumner/trip
+RoxygenNote: 6.0.1
+VignetteBuilder: knitr
+

NAMESPACE

@@ -11,14 +11,19 @@ S3method(rangl,SpatialMultiPoints)
 S3method(rangl,SpatialPoints)
 S3method(rangl,SpatialPolygons)
 S3method(rangl,mesh3d)
+S3method(rangl,sf)
 S3method(rangl,trip)
 export(globe)
 export(mesh)
 export(rangl)
 export(tri_mesh)
 importFrom(RTriangle,pslg)
 importFrom(RTriangle,triangulate)
+importFrom(dplyr,"%>%")
+importFrom(dplyr,arrange)
+importFrom(dplyr,distinct)
 importFrom(dplyr,inner_join)
+importFrom(dplyr,mutate)
 importFrom(dplyr,semi_join)
 importFrom(methods,slotNames)
 importFrom(raster,projection)

NEWS.md

@@ -1,4 +1,10 @@
-# rangl dev
+# rangl 0.4.5
+
+* release codename Just Work in Master, Dude
+
+* old functions made defunct
+
+* points now have meta table (it was missing), and singular points are now supported
 
 * raster package is now an Import
 

R/globe.r

@@ -13,7 +13,9 @@
 #' library(maptools)
 #' data(wrld_simpl)
 #' g <- globe(rangl(as(wrld_simpl, "SpatialLinesDataFrame")))
-#' plot(g, lwd = 3)
+#' if (interactive()) {
+#'  plot(g, lwd = 3)
+#'  }
 globe <- function(x, ...) {
   UseMethod("globe")
 }

R/plot.r

@@ -1,18 +1,15 @@
-
-#' plot the triangles in the tables
-#'
-#' plot
+#' Plot objects in OpenGL
+#' 
+#' Plot using the \code{\link[rgl]{rgl-package}}. 
 #'
+#' The data structures from \code{\link{rangl}} are converted to their analogous forms
+#' used by the \code{\link[rgl]{rgl}} package and plotted. These plot methods return
+#' the rgl form invisibly. 
 #' @param x object from \code{\link{rangl}}
 #' @param ... args for underlying plotting
 #' @return the rgl mesh3d object, invisibly
 #' @export
 #' @importFrom rgl shade3d
-#' @examples
-#' example(rangl)
-#' if(exists("b")) { 
-#'  plot(b)
-#'  }
 #' @name plot-rangl
 #' @aliases plot
 plot.trimesh <- function(x,  ...) {
@@ -43,7 +40,7 @@ plot.trimesh <- function(x,  ...) {
   invisible(tt)
 }
 
-#' @rdname plot-rangl
+#' @name plot-rangl
 #' @export
 plot.linemesh <- function(x,  ...) {
   if (!"color_" %in% names(x$o)) {
@@ -72,7 +69,7 @@ plot.linemesh <- function(x,  ...) {
   invisible(list(v = vb, it = itex))
 }
 
-#' @rdname plot-rangl
+#' @name plot-rangl
 #' @export
 plot.pointmesh <- function(x,  ...) {
   if (!"color_" %in% names(x$o)) {
@@ -101,3 +98,14 @@ plot.pointmesh <- function(x,  ...) {
 
   invisible(list(v = vb, material = list(col = pindex$color_)))
 }
+
+#' @name plot-rangl
+#' @export
+#' @seealso \code{\link{rangl.RasterLayer}}
+plot.quad_mesh <- function(x, ...) {
+  ## etc blah
+  ob <- mkq_3d()
+  ob$vb <- t(cbind(as.matrix(x$v[, c("x_", "y_", "z_")]), 1))
+  ob$ib <- matrix(x$qXv$vertex_, nrow = 4)
+  invisible(rgl::shade3d(ob, col = trimesh_cols(nrow(x$qd))[ob$ib], ...))
+}

R/rangl-defunct.r

@@ -0,0 +1,16 @@
+#' Deprecated from rangl
+#' @rdname rangl-defunct
+#' @name rangl-defunct
+#' @param x nothing
+#' @param ... ignored
+#' @export
+tri_mesh <- function(x, ...) {
+  .Defunct("rangl", package= "rangl")
+}
+
+#' @rdname rangl-defunct
+#' @name rangl-defunct
+#' @export
+mesh <- function(x, ...) {
+  .Deprecated("rangl", package= "rangl", old = "mesh")
+}

R/rangl-lines.r

@@ -15,20 +15,20 @@
 #' data(wrld_simpl)
 #' b <- rangl(wrld_simpl)
 #' plot(b)
-#' if (require(rworldxtra)) {
+#' #if (require(rworldxtra)) {
 #'
-#' data(countriesHigh)
-#' sv <- c("New Zealand", "Antarctica", "Papua New Guinea",
-#'  "Indonesia", "Malaysia", "Fiji", "Australia")
-#' a <- subset(countriesHigh, SOVEREIGNT %in% sv)
-#' b7 <- rangl(a, max_area = 0.5)
-#' plot(globe(b7))
-#' }
+#' #data(countriesHigh)
+#' #sv <- c("New Zealand", "Antarctica", "Papua New Guinea",
+#' #  "Indonesia", "Malaysia", "Fiji", "Australia")
+#' #a <- subset(countriesHigh, SOVEREIGNT %in% sv)
+#' #b7 <- rangl(a, max_area = 0.5)
+#' #plot(globe(b7))
+#' #}
 #' ## -----------------------------------------------
 #' ## LINES
-#' l1 <- rangl(as(a, "SpatialLinesDataFrame") )
-#' plot(l1)
-#' plot(globe(l1))
+#' #l1 <- rangl(as(a, "SpatialLinesDataFrame") )
+#' #plot(l1)
+#' #plot(globe(l1))
 rangl <- function(x, ...) {
   UseMethod("rangl")
 }
@@ -50,6 +50,7 @@ line_mesh_map_table1 <- function(tabs) {
   tabs
 }
 #' @rdname rangl
+#' @importFrom dplyr %>%  arrange distinct mutate
 #' @export
 rangl.SpatialLines <- function(x, ...) {
   pr4 <- proj4string(x)
@@ -85,6 +86,53 @@ rangl.SpatialLines <- function(x, ...) {
   outlist
 }
 
-
-
-
+# rangl.SpatialLines <- function(x, ...) {
+#   pr4 <- proj4string(x)
+#   if (! "data" %in% slotNames(x)) {
+#     dummy <- data.frame(row_number = seq_along(x))
+#     x <- sp::SpatialLinesDataFrame(x, dummy, match.ID = FALSE)
+#   }
+#   tabs <- spbabel::map_table(x)
+#   ll <- vector("list", nrow(tabs$o))
+#   for (i_obj in seq(nrow(tabs$o))) {
+#     tabs_i <- tabs; tabs_i$o <- tabs_i$o[i_obj, ]
+#     tabs_i <- semi_cascade(tabs_i)
+#     tt_i <- line_mesh_map_table1(tabs_i)
+#     ll[[i_obj]] <- tt_i
+#   }
+#   
+#   outlist <- vector("list", length(ll[[1]]))
+#   nms <- names(ll[[1]])
+#   names(outlist) <- nms
+#   for (i in seq_along(outlist)) {
+#     outlist[[i]] <- dplyr::bind_rows(lapply(ll, "[[", nms[i]))
+#   }
+#   
+#   ## renormalize the vertices
+#   allverts <- dplyr::inner_join(outlist$lXv, outlist$v, "vertex_")
+#   allverts$uvert <- as.integer(factor(paste(allverts$x_, allverts$y_, sep = "_")))
+#   allverts$vertex_ <- spbabel:::id_n(length(unique(allverts$uvert)))[allverts$uvert]
+#   outlist$lXv <- allverts[, c("segment_", "vertex_")]
+#   
+#   ## normalize segments
+#   ## this arrange was borkifying
+#   a <- outlist$lXv #%>% dplyr::arrange(segment_, vertex_)
+#   lista <- split(a, a$segment_)
+#   f <- factor(unlist(lapply(lista, function(x) paste(x$vertex_, collapse = "_"))))
+#   outlist$lXv <- a %>% inner_join(tibble(segment_ = names(lista), usegment = as.integer(f))) %>% mutate(segment_ = segment_[usegment]) %>% 
+#     dplyr::select(segment_, vertex_) %>% distinct()
+#   outlist$l <- outlist$l %>% inner_join(tibble(segment_ = names(lista), usegment = as.integer(f))) %>% 
+#     mutate(segment_ = segment_[usegment]) %>% 
+#     dplyr::select(segment_, object_)
+#   
+#   
+#   outlist$v <- dplyr::distinct_(allverts, "x_", "y_", "vertex_")
+#   ## finally add longitude and latitude
+#   outlist$meta <- tibble::tibble(proj = pr4, x = "x_", y = "y_", ctime = format(Sys.time(), tz = "UTC"))
+#   class(outlist) <- "linemesh"
+#   outlist
+# }
+# 
+# 
+# 
+# 

R/rangl-package.r

@@ -1,18 +1,17 @@
 #' Tidy tables for topological spatial data structures.
 #'
-#' The 'rangl' package helps transcend the following problems in R and GIS generally: 
-#' 
+#' The 'rangl' package helps transcend the following general limitations:  
 #' \itemize{
 #'  \item coordinates beyond X and Y, or longitude and latitude
-#'  \item attributes stored where appropriate, on vertices, primitives, branches, or objects
-#'  \item topology and geometry are not conflated
+#'  \item storing attributes on vertices, primitives, branches (parts), or objects
+#'  \item topology and geometry are properly separated
 #'  \item spatial data can be properly represented as a graph of spatial primitives
 #'  \item polygons as true surfaces, not just glorified lines with a path-filling rule
 #'  \item TBD higher dimensional primitives are possible
 #'  \item TBD n-dimensional rasters with curvilinear coordinates, and the discrete-continuous distinction 
 #' }
 #'
-#' @name rangl
+#' @name rangl-package
 #' @docType package
 #' @section I. Creation:
 #' \tabular{ll}{
@@ -28,3 +27,5 @@
 #' }
 #'
 NULL
+
+

R/rangl-points.r

@@ -8,6 +8,8 @@ rangl.SpatialMultiPoints <- function(x, ...) {
     x <- sp::SpatialMultiPointsDataFrame(x, dummy, match.ID = FALSE)
   }
   tabs <- spbabel::map_table(x)
+  tabs$meta <- tibble::tibble(proj = pr4, x = "x_", y = "y_", ctime = format(Sys.time(), tz = "UTC"))
+
   class(tabs) <- "pointmesh"
   tabs
 }
@@ -16,15 +18,16 @@ rangl.SpatialMultiPoints <- function(x, ...) {
 #' @rdname rangl
 #' @export
 rangl.SpatialPoints <- function(x, ...) {
-  stop("you don't really need this function, just use `as.data.frame(x)`")
-  # pr4 <- proj4string(x)
-  # if (! "data" %in% slotNames(x)) {
-  #   dummy <- data.frame(row_number = seq_along(x))
-  #   x <- sp::SpatialPointsDataFrame(x, dummy, match.ID = FALSE)
-  # }
-  # tabs <- spbabel::map_table(x)
-  # class(tabs) <- "pointmesh"
-  # tabs
+   pr4 <- proj4string(x)
+   if (! "data" %in% slotNames(x)) {
+     dummy <- data.frame(row_number = seq_along(x))
+     x <- sp::SpatialPointsDataFrame(x, dummy, match.ID = FALSE)
+   }
+   tabs <- spbabel::map_table(x)
+  tabs$meta <- tibble::tibble(proj = pr4, x = "x_", y = "y_", ctime = format(Sys.time(), tz = "UTC"))
+
+  class(tabs) <- "pointmesh"
+   tabs
 }