Merge pull request #5 from USEPA/spatial_changes

Spatial changes

.Rbuildignore

@@ -43,3 +43,7 @@ reviews
 ^docs$
 ^pkgdown$
 ^nsink-1.2.0\.zip$
+^doc$
+^Meta$
+^paper_files$
+^paper_cache$

.gitignore

@@ -37,3 +37,6 @@ archive_it
 docs
 nsink-1.2.0.zip
 huc_data
+nsink_test_data
+/doc/
+/Meta/

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: nsink
 Title: Flow path nitrogen removal estimation
-Version: 1.3.4
+Version: 2.0.0
 Authors@R: c(person(given = "Jeffrey",
            family = "Hollister",
            role = c("aut", "cre"),
@@ -56,7 +56,6 @@ Imports:
   raster,
   httr,
   dplyr,
-  fasterize,
   zoo,
   igraph,
   lwgeom,
@@ -70,7 +69,8 @@ Imports:
   future, 
   stars,
   units,
-  archive
+  archive,
+  terra
 Remotes: ropensci/FedData
 License: MIT + file LICENSE
 Encoding: UTF-8

NAMESPACE

@@ -18,14 +18,12 @@ importFrom(dplyr,filter)
 importFrom(dplyr,group_indices)
 importFrom(dplyr,near)
 importFrom(dplyr,tibble)
-importFrom(fasterize,fasterize)
 importFrom(igraph,edge_attr)
 importFrom(igraph,graph_from_data_frame)
 importFrom(igraph,shortest_paths)
 importFrom(lwgeom,st_split)
 importFrom(methods,as)
 importFrom(raster,extract)
-importFrom(raster,merge)
 importFrom(raster,plot)
 importFrom(raster,projection)
 importFrom(raster,raster)

R/nsink_build.R

@@ -83,6 +83,7 @@ nsink_build <- function(huc, projection,
 
   # Write everything out to a folder
   message("Writing files...")
+
   nsink_write_prepped_data(nsink_prepped_data, output_dir)
   save(nsink_removal, file=paste0(output_dir, "removal.rda"), compress = "xz")
   nsink_write_static_maps(nsink_static_maps, output_dir)
@@ -97,6 +98,7 @@ nsink_build <- function(huc, projection,
 #' @param output_dir Output folder to save processed nsink files to
 #' @keywords internal
 nsink_write_prepped_data <- function(prepped_data, output_dir) {
+
   suppressWarnings(sf::st_write(prepped_data$streams, paste0(output_dir, "streams.shp"),
     delete_layer = TRUE, quiet = TRUE
   ))
@@ -110,14 +112,14 @@ nsink_write_prepped_data <- function(prepped_data, output_dir) {
   suppressWarnings(sf::st_write(prepped_data$huc, paste0(output_dir, "huc.shp"),
     delete_layer = TRUE, quiet = TRUE
   ))
-  raster::writeRaster(prepped_data$fdr, paste0(output_dir, "fdr.tif"),
+  terra::writeRaster(prepped_data$fdr, paste0(output_dir, "fdr.tif"),
     overwrite = TRUE
   )
-  raster::writeRaster(prepped_data$impervious,
+  terra::writeRaster(prepped_data$impervious,
     paste0(output_dir, "impervious.tif"),
     overwrite = TRUE
   )
-  raster::writeRaster(prepped_data$nlcd, paste0(output_dir, "nlcd.tif"),
+  terra::writeRaster(terra::as.int(prepped_data$nlcd), paste0(output_dir, "nlcd.tif"),
     overwrite = TRUE
   )
   readr::write_csv(prepped_data$q, paste0(output_dir, "q.csv"))
@@ -136,19 +138,19 @@ nsink_write_prepped_data <- function(prepped_data, output_dir) {
 #' @param output_dir Output folder to save .tif static maps to
 #' @keywords internal
 nsink_write_static_maps <- function(static_maps, output_dir) {
-  raster::writeRaster(static_maps$removal_effic,
+  terra::writeRaster(static_maps$removal_effic,
     paste0(output_dir, "removal_effic.tif"),
     overwrite = TRUE
   )
-  raster::writeRaster(static_maps$loading_idx,
+  terra::writeRaster(static_maps$loading_idx,
     paste0(output_dir, "loading_idx.tif"),
     overwrite = TRUE
   )
-  raster::writeRaster(static_maps$transport_idx,
+  terra::writeRaster(static_maps$transport_idx,
     paste0(output_dir, "transport_idx.tif"),
     overwrite = TRUE
   )
-  raster::writeRaster(static_maps$delivery_idx,
+  terra::writeRaster(static_maps$delivery_idx,
     paste0(output_dir, "delivery_idx.tif"),
     overwrite = TRUE
   )

R/nsink_generate_flowpath.R

@@ -33,9 +33,16 @@ nsink_generate_flowpath <- function(starting_location, input_data){
     stop(paste0("The coordinate reference systems for your starting location and the input data do not match.  Re-project to a common reference system."))
   }
 
-  starting_location <- st_transform(starting_location, st_crs(input_data$fdr))
-  fp <- raster::flowPath(input_data$fdr, st_coordinates(starting_location))
-  fp <- raster::xyFromCell(input_data$fdr, fp)
+  starting_location <- st_transform(starting_location, crs = st_crs(input_data$fdr))
+  # flowPath code borrowed directly from raster, modified to work with terra
+
+  fp <- flowPath(input_data$fdr, st_coordinates(starting_location))
+  if(is.null(fp)){
+    warning("Flowpath returned NULL.")
+    return(list(flowpath_ends = NULL, flowpath_network = NULL))
+  } else {
+  fp <- terra::xyFromCell(input_data$fdr, fp)
+  }
   # Fixes cases with a single point flowpath: rare but annoying
   if(nrow(fp) == 1){
     dist <- units::set_units(1, "m")
@@ -138,7 +145,7 @@ nsink_get_flowline <- function(flowpath_ends, streams, tot){
   streams_tot <- suppressMessages(left_join(streams, tot))
   streams_tot <- filter(streams_tot, !is.na(.data$fromnode))
   streams_tot <- filter(streams_tot, !is.na(.data$tonode))
-  streams_df <- select(streams_tot, .data$fromnode, .data$tonode, .data$stream_comid)
+  streams_df <- select(streams_tot, "fromnode", "tonode", "stream_comid")
   st_geometry(streams_df) <- NULL
   streams_df <- mutate_all(streams_df, as.character)
   streams_g <- graph_from_data_frame(streams_df, directed = TRUE)
@@ -149,8 +156,8 @@ nsink_get_flowline <- function(flowpath_ends, streams, tot){
   to_nd_idx <- unlist(st_is_within_distance(flowpath_ends[2,], streams_tot, dist))
   from_nd <- streams_df[from_nd_idx,]$fromnode
   to_nd <- streams_df[to_nd_idx,]$tonode
-  #to_nd <- filter(streams_df, !.data$tonode %in% .data$fromnode)
-  #to_nd <- unique(pull(to_nd, .data$tonode))
+  #to_nd <- filter(streams_df, !tonode %in% fromnode)
+  #to_nd <- unique(pull(to_nd, tonode))
   idx <- shortest_paths(streams_g, from_nd, to_nd, output = "epath",
                         mode = "out")$epath[[1]]
   if(length(idx) == 0){
@@ -175,7 +182,7 @@ nsink_get_flowline <- function(flowpath_ends, streams, tot){
   fp_flowlines <- lwgeom::st_split(fp_flowlines, st_combine(fp_end_pt))
   fp_flowlines <- suppressWarnings(st_collection_extract(fp_flowlines,
                                                          "LINESTRING"))
-  #browser()
+
   #fp_flowlines1 <- filter(fp_flowlines, !st_overlaps(st_snap(fp_flowlines,
   #                                                          flowpath_ends[1,],
   #                                                          tol01),