CRAN submission - introduce rasterToContourPoly - deprecate contourSt…

…ewart.
riatelab · Mar 18, 2016 · 0fc21e0 · 0fc21e0
1 parent 0f6c1f6
commit 0fc21e0
Show file tree

Hide file tree

Showing 19 changed files with 314 additions and 392 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: SpatialPosition
 Title: Spatial Position Models
-Version: 1.0.9000
-Date: 2015-12-04
+Version: 1.1
+Date: 2016-03-18
 Authors@R: c(
       person("Timothée", "Giraud", email = "[email protected]", role = c("cre","aut")),
       person("Hadrien", "Commenges", email = "[email protected]", role = c("aut")), 

diff --git a/NAMESPACE b/NAMESPACE
@@ -11,6 +11,7 @@ export(quickStewart)
 export(rasterHuff)
 export(rasterReilly)
 export(rasterStewart)
+export(rasterToContourPoly)
 export(reilly)
 export(stewart)
 import(raster)

diff --git a/NEWS b/NEWS
@@ -1,12 +1,14 @@
-SpatialPosition version 1.1 (Release date: 2016-)
+SpatialPosition version 1.1 (Release date: 2016-03-18)
 ==============
 
 Major changes:  
-* Introduce the quickStewart function that outputs contour polygons easily
+* Introduce the quickStewart function that outputs stewart contour polygons easily. Ratio of potentials are allowed.
+* Introduce rasterToContourPoly to replace contourStewart. 
+* contourStewart is now deprecated. Use rasterToContour from raster to output contour lines and rasterToContourPoly from SpatialPosition to output polygons.
 
 Minor changes:  
-* A resolution is set by default in CreateGrid
-
+* A resolution is set by default in CreateGrid.
+* Vignettes are updated to reflect major changes.
 
 
 

diff --git a/R/contourStewart.R b/R/contourStewart.R
@@ -1,7 +1,11 @@
 #' @title Create a SpatialPolygonsDataFrame or a SpatialLinesDataFrame from a 
 #' Stewart Raster
 #' @name contourStewart
-#' @description This function creates a SpatialPolygonsDataFrame or SpatialLinesDataFrame contour from the Stewart raster.
+#' @description 
+#' \code{contourStewart} is deprecated. \cr
+#' To obtain contour lines use \code{\link{rasterToContour}} from raster package. \cr
+#' To obtain contour polygons use \code{\link{rasterToContourPoly}} from SpatialPosition package. \cr\cr\cr
+#' This function creates a SpatialPolygonsDataFrame or SpatialLinesDataFrame contour from the Stewart raster.
 #' @param x raster; output of the \code{\link{rasterStewart}} function. The raster must contain only positive values.
 #' @param breaks numeric; a vector of break values. 
 #' @param mask SpatialPolygonsDataFrame; mask used to clip contour shapes.
@@ -27,6 +31,7 @@
 #' @import raster
 #' @examples
 #' data("spatData")
+#' \dontrun{
 #' #### Example with type = "line"
 #' mystewart <- stewart(knownpts = spatPts, varname = "Capacite",
 #'                      typefct = "exponential", span = 1000, beta = 3,
@@ -48,7 +53,6 @@
 #' 
 #' 
 #' #### Example with type = "poly"
-#' \dontrun{
 #' mystewart <- stewart(knownpts = spatPts, varname = "Capacite",
 #'                      typefct = "exponential", span = 1000, beta = 3,
 #'                      resolution = 50, longlat = FALSE,
@@ -83,103 +87,11 @@
 #' @export
 contourStewart <- function(x, breaks, mask, type = "line"){
   if (type=="line"){
+    .Deprecated(new = "rasterToContour", package = "raster") 
     return(rasterToContour(x = x, levels = breaks[1:(length(breaks)-1)]))
   } 
   if (type=="poly"){
-    if (!requireNamespace("rgeos", quietly = TRUE)) {
-      stop("'rgeos' package needed for this function to work. Please install it.",
-           call. = FALSE)
-    }
-    if(!'package:rgeos' %in% search()){
-      attachNamespace('rgeos')
-    }
-
-
-    myproj <- mask@proj4string
-    # breaks
-    breakss <- breaks
-    # raster resolution
-    myres <- res(x)[1]
-
-    # union the mask
-    mask <- rgeos::gUnaryUnion(spgeom = mask, id = NULL)
-
-    # buffer around the mask
-    maskbuff <- rgeos::gBuffer(mask, byid = FALSE, width = 5 * myres )
-
-    # use a mask around the raster with the maskbuff
-    x <- mask(x,maskbuff, updatevalue = -1)
-    x[is.na(x)] <- -1
-
-    # adapt the breaks to the masked raster
-    minx <- min(x[x!=-1])
-    maxx <- max(x[x!=-1])
-    breaks <- breakss[(breakss>=minx & breakss<maxx)]
-    breaks <- c(breakss[which(min(breaks)==breakss)-1],breaks)
-
-
-
-    # test breaks
-    if(length(breaks)<2){stop("break values do not fit the raster values", 
-                              call. = FALSE)}
-    # build the contour lines
-    cl <- rasterToContour(x, levels = breaks)
-
-    cl$level <- as.numeric (as.character(cl$level))
-    SPlist <- list()
-    SPlevels <- character()
-    for (i in cl$level){ 
-      linex <- cl[cl@data$level == i,]
-      linex <- linex@lines
-      linex <- linex[[1]]
-      linex <- linex@Lines
-      Plist <- NULL
-      Plist <- list()
-      for (j in 1:length(linex)){
-        x <- linex[[j]]@coords
-        x <- sp::Polygon(coords =  x, hole = F)
-        x <- sp::Polygons(srl = list(x), ID = j)
-        Plist[j] <- x
-      }  
-      x <- sp::SpatialPolygons(Srl = Plist)
-      x <- rgeos::union(x = x)
-      if (class(x) != "SpatialPolygonsDataFrame"){
-        x <- sp::SpatialPolygonsDataFrame(Sr = x, 
-                                          data = data.frame(
-                                            level = rep(i, length(x))))
-      } else {
-        x <- x[x@data$count < 2,]
-        x@data <- data.frame(level = rep(i, dim(x)[1]))
-      }
-      SPlist <- c(SPlist , x@polygons  )
-      SPlevels <- c(SPlevels,x@data$level)
-    }
-    for (i in 1:length(SPlist)){
-      SPlist[[i]]@ID <- as.character(i)
-    }
-    x <- sp::SpatialPolygons(Srl = SPlist, proj4string = myproj)
-    x <- sp::SpatialPolygonsDataFrame(Sr = x, 
-                                      data = data.frame(levels = SPlevels))
-    # manage attributes data of the contour spdf
-    breaks <- c(breaks, maxx)
-
-    x@data <- data.frame(id = paste("id_",row.names(x),sep=""),
-                         min = breaks[match(x$levels, breaks)], 
-                         max = breaks[match(x$levels, breaks)+1],
-                         mean = NA, 
-                         stringsAsFactors = FALSE)
-    x@data$mean <- (x$min+x$max) / 2 
-    row.names(x) <- x$id
-
-    # clip the contour spdf with the mask
-    final <- rgeos::gIntersection(spgeom1 = x, spgeom2 = mask, byid = TRUE, 
-                                  id = row.names(x))
-    df <- data.frame(id = sapply(methods::slot(final, "polygons"), 
-                                 methods::slot, "ID"))
-    row.names(df) <- df$id
-    final <- sp::SpatialPolygonsDataFrame(Sr = final, data = df)
-    final@data <- data.frame(id = final$id, x[match(final$id, x$id),2:4])
-    final@plotOrder <- 1:nrow(final)
-    return(final)
+    .Deprecated("rasterToContourPoly", package = "SpatialPosition")
+    return(rasterToContourPoly(r = x, breaks = breaks, mask = mask))
   }
 }
diff --git a/R/package.R b/R/package.R
@@ -9,8 +9,8 @@
 #'  - \code{vignette(topic = "SpatialPosition")}\cr
 #' A Stewart potentials use case:\cr
 #'  - \code{vignette(topic = "StewartExample")}.
-#' @seealso  \link{stewart}, \link{rasterStewart}, \link{plotStewart}, 
-#' \link{contourStewart}, \link{huff}, \link{rasterHuff}, \link{plotHuff},\link{reilly}, 
+#' @seealso  \link{stewart}, \link{rasterStewart}, \link{plotStewart},  \link{quickStewart}, 
+#' \link{rasterToContourPoly}, \link{huff}, \link{rasterHuff}, \link{plotHuff},\link{reilly}, 
 #' \link{rasterReilly}, \link{plotReilly}, 
 #' \link{CreateGrid}, \link{CreateDistMatrix}.
 #' @docType package

diff --git a/R/quickStewart.R b/R/quickStewart.R
@@ -1,7 +1,8 @@
 #' @title Create a SpatialPolygonsDataFrame of Potentials Contours
 #' @name quickStewart
 #' @description 
-#' This function is a wrapper around \link{stewart}, \link{rasterStewart} and \link{contourStewart} functions. 
+#' This function is a wrapper around \link{stewart}, \link{rasterStewart} 
+#' and \link{rasterToContourPoly} functions. 
 #' Providing only the main parameters of these functions, it simplifies a lot the computation of potentials. 
 #' This function creates a SpatialPolygonsDataFrame of potential values. 
 #' It also allows to compute directly the ratio between the potentials of two variables. 
@@ -34,7 +35,7 @@
 #' If var2 is provided the ratio between the potentials of var (numerator) 
 #' and var2 (denominator) is computed.
 #' @seealso \link{stewart}, \link{rasterStewart}, \link{plotStewart}, 
-#' \link{contourStewart}, \link{CreateGrid}, \link{CreateDistMatrix}.
+#' \link{rasterToContourPoly}, \link{CreateGrid}, \link{CreateDistMatrix}.
 #' @import sp
 #' @import raster
 #' @export
@@ -52,7 +53,7 @@
 #' if(require("cartography")){
 #'   breaks <- c(unique(pot.spdf$min), max(pot.spdf$max))
 #'   cartography::choroLayer(spdf = pot.spdf, df = pot.spdf@data,
-#'                           var = "mean", breaks = breaks, 
+#'                           var = "center", breaks = breaks, 
 #'                           legend.pos = "topleft",
 #'                           legend.title.txt = "Nb. of Beds")
 #' }
@@ -72,7 +73,7 @@
 #' if(require("cartography")){
 #'   breaks <- c(unique(pot2.spdf$min), max(pot2.spdf$max))
 #'   cartography::choroLayer(spdf = pot2.spdf, df = pot2.spdf@data,
-#'                           var = "mean", breaks = breaks, 
+#'                           var = "center", breaks = breaks, 
 #'                           legend.pos = "topleft",legend.values.rnd = 3,
 #'                           legend.title.txt = "Nb. of Beds")
 #' }
@@ -82,7 +83,6 @@ quickStewart <- function(spdf, df, spdfid = NULL, dfid = NULL, var,
                          beta, resolution = NULL, 
                          mask = NULL, 
                          nclass = 8, breaks = NULL){
-
   # IDs  
   if (is.null(spdfid)){spdfid <- names(spdf@data)[1]}
   if (is.null(dfid)){dfid <- names(df)[1]}
@@ -92,22 +92,7 @@ quickStewart <- function(spdf, df, spdfid = NULL, dfid = NULL, var,
                           df[match(spdf@data[,spdfid], df[,dfid]),])
   spdf <- spdf[!is.na(spdf@data[,dfid]),]
 
-  # Missing mask 
-  if(is.null(mask)){
-    bb <- bbox(spdf)
-    mm <- matrix(data = c(bb[1,1], bb[2,1], 
-                          bb[1,2], bb[2,1], 
-                          bb[1,2], bb[2,2], 
-                          bb[1,1], bb[2,2], 
-                          bb[1,1], bb[2,1]), 
-                 nrow = 5, byrow = T)
-    mask <- SpatialPolygons(
-      Srl = list(Polygons(
-        srl = list(Polygon(coords = mm, hole = FALSE)), ID = "id")), 
-      proj4string = spdf@proj4string)
-  }
-
-  # pot computation
+   # pot computation
   pot <- stewart(knownpts = spdf, 
                  varname = var, 
                  typefct = typefct, 
@@ -128,18 +113,11 @@ quickStewart <- function(spdf, df, spdfid = NULL, dfid = NULL, var,
   }else{
     ras <- rasterStewart(pot)
   }
-  # missing break
-  if(is.null(breaks)){
-    breaks <- seq(from = cellStats(ras, min, na.rm = TRUE), 
-                  to = cellStats(ras, max, na.rm = TRUE), 
-                  length.out = (nclass+1))
-  }
-breaks
+
   # Spdf creation
-  pot.spdf <- contourStewart(x = ras, 
-                             breaks = unique(breaks), 
-                             mask = mask, 
-                             type = "poly")
-  plot(pot.spdf)
+  pot.spdf <- rasterToContourPoly(r =  ras,
+                                  nclass = nclass, 
+                                  breaks = breaks, 
+                                  mask = mask)
   return(pot.spdf)
 }