Merge pull request #33 from wpgp/dev

Improvements to ver 0.6
wpgp · Nov 20, 2020 · 598596a · 598596a
2 parents 21e468e + 87ab235
commit 598596a
Show file tree

Hide file tree

Showing 41 changed files with 596 additions and 354 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: foot
 Title: An R package for processing building footprint morphometrics
-Version: 0.5
-Date: 2020-10-19
+Version: 0.6
+Date: 2020-11-18
 Authors@R: 
 	c(person(given="WorldPop Research Group, University of Southampton", 
 			 role="aut"),

diff --git a/NAMESPACE b/NAMESPACE
@@ -17,8 +17,8 @@ S3method(fs_nnindex,sfc)
 S3method(fs_nnindex,sp)
 S3method(gridTiles,RasterLayer)
 S3method(gridTiles,stars)
+S3method(zonalIndex,Raster)
 S3method(zonalIndex,character)
-S3method(zonalIndex,raster)
 S3method(zonalIndex,sf)
 S3method(zonalIndex,sfc)
 S3method(zonalIndex,sp)

diff --git a/R/calculate_footstats.R b/R/calculate_footstats.R
@@ -264,6 +264,73 @@ calc_fs_internal <- function(X, zone, what, how,
     controlDist[names(controlDist) %in% names(providedDist)] <- providedDist
   }
 
+  if(controlZone$method %in% c("centroid", "intersect")){ 
+    # pre-calculate 'whats'
+    if('area' %in% uchars |
+       !is.null(filter$minArea) | !is.null(filter$maxArea)){
+      if(!'area' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating areas \n") }
+        X[['area']] <- fs_area(X, unit=controlUnits$areaUnit)
+      } else{
+        if(verbose){ cat("Area data column already exists \n") }
+      }
+    }
+
+    if('perimeter' %in% uchars){
+      if(!'perimeter' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating perimeters \n") }
+        X[['perimeter']] <- fs_perimeter(X, unit=controlUnits$perimUnit)
+      } else{
+        if(verbose){ cat("Perimeter data column already exists \n") }
+      }
+    }
+
+    if('angle' %in% uchars){
+      if(!'angle' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating angles \n") }
+        X[['angle']] <- fs_mbr(X, returnShape=FALSE)
+      } else{
+        if(verbose){ cat("Angle data column already exists \n") }
+      }
+    }
+
+    if('shape' %in% uchars){
+      if(!'shape' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating shape \n") }
+        X[['shape']] <- fs_shape(X, unit=controlUnits$areaUnit)
+      } else{
+        if(verbose){ cat("Shape data column already exists \n") }
+      }
+    }
+
+    if('compact' %in% uchars){
+      if(!'compact' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating compactness \n") }
+        X[['compact']] <- fs_compact(X)
+      } else{
+        if(verbose){ cat("Shape data column already exists \n") }
+      }
+    }
+
+    if('settled' %in% uchars){
+      if(!'settled' %in% colnames(X)){
+        X[['settled']] <- 1
+      } 
+    }
+
+    if('nndist' %in% uchars & calcD){
+      if(!'dist' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating nearest neighbour distances \n") }
+        X[['nndist']] <- fs_nndist(X, 
+                                   maxSearch=controlDist$maxSearch, 
+                                   method=controlDist$method, 
+                                   unit=controlUnits$distUnit)
+      } else{
+        if(verbose){ cat("NN distance data column already exists. \n") }
+      }
+    }
+  }
+
   # create zonal index
   if(!is.null(zone)){
     if(verbose){ cat("Creating zonal index \n") }
@@ -336,14 +403,70 @@ calc_fs_internal <- function(X, zone, what, how,
     return(NULL)
   }
 
-  # pre-calculate 'whats'
-  if('area' %in% uchars |
-     !is.null(filter$minArea) | !is.null(filter$maxArea)){
-    if(!'area' %in% colnames(X)){
-      if(verbose){ cat("Pre-calculating areas \n") }
-      X[['area']] <- fs_area(X, unit=controlUnits$areaUnit)
-    } else{
-      if(verbose){ cat("Area data column already exists \n") }
+  if(controlZone$method == 'clip'){
+    # pre-calculate 'whats' after splitting with zonal index
+    if('area' %in% uchars |
+       !is.null(filter$minArea) | !is.null(filter$maxArea)){
+      if(!'area' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating areas \n") }
+        X[['area']] <- fs_area(X, unit=controlUnits$areaUnit)
+      } else{
+        if(verbose){ cat("Area data column already exists \n") }
+      }
+    }
+
+    if('perimeter' %in% uchars){
+      if(!'perimeter' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating perimeters \n") }
+        X[['perimeter']] <- fs_perimeter(X, unit=controlUnits$perimUnit)
+      } else{
+        if(verbose){ cat("Perimeter data column already exists \n") }
+      }
+    }
+
+    if('angle' %in% uchars){
+      if(!'angle' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating angles \n") }
+        X[['angle']] <- fs_mbr(X, returnShape=FALSE)
+      } else{
+        if(verbose){ cat("Angle data column already exists \n") }
+      }
+    }
+
+    if('shape' %in% uchars){
+      if(!'shape' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating shape \n") }
+        X[['shape']] <- fs_shape(X, unit=controlUnits$areaUnit)
+      } else{
+        if(verbose){ cat("Shape data column already exists \n") }
+      }
+    }
+
+    if('compact' %in% uchars){
+      if(!'compact' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating compactness \n") }
+        X[['compact']] <- fs_compact(X)
+      } else{
+        if(verbose){ cat("Shape data column already exists \n") }
+      }
+    }
+
+    if('settled' %in% uchars){
+      if(!'settled' %in% colnames(X)){
+        X[['settled']] <- 1
+      } 
+    }
+
+    if('nndist' %in% uchars & calcD){
+      if(!'dist' %in% colnames(X)){
+        if(verbose){ cat("Pre-calculating nearest neighbour distances \n") }
+        X[['nndist']] <- fs_nndist(X, 
+                                   maxSearch=controlDist$maxSearch, 
+                                   method=controlDist$method, 
+                                   unit=controlUnits$distUnit)
+      } else{
+        if(verbose){ cat("NN distance data column already exists. \n") }
+      }
     }
   }
 
@@ -370,60 +493,6 @@ calc_fs_internal <- function(X, zone, what, how,
     return(NULL)
   }
 
-  if('perimeter' %in% uchars){
-    if(!'perimeter' %in% colnames(X)){
-      if(verbose){ cat("Pre-calculating perimeters \n") }
-      X[['perimeter']] <- fs_perimeter(X, unit=controlUnits$perimUnit)
-    } else{
-      if(verbose){ cat("Perimeter data column already exists \n") }
-    }
-  }
-
-  if('angle' %in% uchars){
-    if(!'angle' %in% colnames(X)){
-      if(verbose){ cat("Pre-calculating angles \n") }
-      X[['angle']] <- fs_mbr(X, returnShape=FALSE)
-    } else{
-      if(verbose){ cat("Angle data column already exists \n") }
-    }
-  }
-
-  if('shape' %in% uchars){
-    if(!'shape' %in% colnames(X)){
-      if(verbose){ cat("Pre-calculating shape \n") }
-      X[['shape']] <- fs_shape(X, unit=controlUnits$areaUnit)
-    } else{
-      if(verbose){ cat("Shape data column already exists \n") }
-    }
-  }
-
-  if('compact' %in% uchars){
-    if(!'compact' %in% colnames(X)){
-      if(verbose){ cat("Pre-calculating compactness \n") }
-      X[['compact']] <- fs_compact(X)
-    } else{
-      if(verbose){ cat("Shape data column already exists \n") }
-    }
-  }
-
-  if('settled' %in% uchars){
-    if(!'settled' %in% colnames(X)){
-      X[['settled']] <- 1
-    } 
-  }
-
-  if('nndist' %in% uchars & calcD){
-    if(!'dist' %in% colnames(X)){
-      if(verbose){ cat("Pre-calculating nearest neighbour distances \n") }
-        X[['nndist']] <- fs_nndist(X, 
-                                   maxSearch=controlDist$maxSearch, 
-                                   method=controlDist$method, 
-                                   unit=controlUnits$distUnit)
-    } else{
-      if(verbose){ cat("NN distance data column already exists. \n") }
-    }
-  }
-
   if(is.null(how)){
     if(verbose){ cat("No summary functions found, returning metrics. \n\n") }
     return(data.table::data.table(sf::st_drop_geometry(X[, uchars])))