The goal of this analysis is to delineate watersheds for points associated with the CBW-LULC project. This script relies on both the spatial capabilities of R (Raster, sp, and RGDAL packages) in addition to the hydrologic analysis tools in WhiteBox Tools scripting software. Required datasets inlcude a NHDplus 30m DEM, the gagesII database, and finally, NLCD-LULC data from the USGS. All code is house at GitHub
For more on wateshed delineation in WhiteBox GAT and WhiteBoxTools, see this block post from Jon Lindsay.
Note, data is currently housed in Nate's SESYNC workspace. He will eventually migrate this to the Palmer Lab folder.
#Clear Memory rm(list=ls(all=TRUE)) #Define relevant working directories data_dir<-"//storage.research.sesync.org/njones-data/Research Projects/LULC_CBW/Spatial_Data/" scratch_dir<-"C:\\ScratchWorkspace/" wbt_dir<-"C:\\WBT/whitebox_tools" #Add appropriate libararies library(sf) library(raster) library(rgdal) library(rgeos) library(dplyr) library(devtools) #Download package from GIT install_github("FloodHydrology/InundationHydRology") library(InundationHydRology) #Download required data dem<-raster(paste0(data_dir,"NHDPlus02/Elev_Unit_a/elev_cm")) p<-dem@crs HUC08<-st_read(paste0(data_dir,"NHDPlus02/Subbasin.shp")) HUC08<-st_transform(HUC08, crs=paste(p))
Step 2: Delineate watershed using the WatershedAnalysis r_script in the InundationHydRology package.
#Define pnts pnts<-read.csv(paste0(data_dir,"input_CPB.csv")) pnts<-st_as_sf(pnts, coords=c("Longitude","Latitude"), crs="+proj=longlat +ellps=GRS80 +datum=NAD83 +no_defs") pnts<-st_transform(pnts, paste(p)) #Select Subbasin mask<-HUC08 mask<-mask[pnts,] #Create wrapper function fun<-function(n){ tryCatch(WatershedAnalysis( dem=dem, pnts=pnts, unique_id = "CBW_ID", mask=mask[n,], threshold=111, snap_dist=300, scratch_dir=scratch_dir, data_dir = data_dir, wbt_dir = wbt_dir, output_dir = paste0(data_dir,"watershed/")), error=function(e) c(n, rep(0,24)))} #Run function lapply(seq(1,length(mask$OBJECTID)), fun)
#Define pnts pnts<-read.csv(paste0(data_dir,"input_MBSS.csv")) pnts$Longitude83<-pnts$Longitude83*-1 pnts<-st_as_sf(pnts, coords=c("Longitude83", "Latitude83"), crs="+proj=longlat +ellps=GRS80 +datum=NAD83 +no_defs") pnts<-st_transform(pnts, paste(p)) #Select Subbasin mask<-HUC08 mask<-mask[pnts,] #Create wrapper function fun<-function(n){ tryCatch(WatershedAnalysis( dem=dem, pnts=pnts, unique_id = "CBW_ID", mask=mask[n,], threshold=111, snap_dist=300, scratch_dir=scratch_dir, data_dir = data_dir, wbt_dir = wbt_dir, output_dir = paste0(data_dir,"watershed/")), error=function(e) c(n, rep(0,24)))} #Run function lapply(seq(1,length(mask$OBJECTID)), fun)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.