Update make_flow_list.R

R/GIS_read.R

@@ -144,9 +144,10 @@ GIS_read = function(maps_in, type = "raster", typepars, map_info = NULL, seq_pat
       NAs_in_wrld[[map_info[map_info[, 1] == "streams", 2]]] = NULL
     }
     if (any(NAs_in_wrld > 0) ) {
-      cat("One or more maps have NAs within the bounds of the world map, see maps and counts of NAs below:\n")
+      cat("Warning: One or more maps have NAs within the bounds of the world map, see maps and counts of NAs below:\n")
       print(NAs_in_wrld[NAs_in_wrld > 0])
-      stop("See above and check your input maps.")
+      #09282022: LML for some layers, it's okay to have NA values
+      #stop("See above and check your input maps.")
     }
   }
 

R/RHESSysPreprocess.R

@@ -46,6 +46,7 @@ RHESSysPreprocess = function(template,
                              streams = NULL,
                              overwrite = FALSE,
                              roads = NULL,
+                             road_width = NULL,
                              impervious = NULL,
                              roofs = NULL,
                              header = FALSE,
@@ -78,12 +79,12 @@ RHESSysPreprocess = function(template,
     basename = substr(basename, 0, nchar(basename) - 5)
   }
   name_clean = file.path(dirname(name), basename)
-  worldfile = name_clean
-  flownet_name = name_clean
+  worldfile = paste(name_clean, ".world", sep = "")
+  flownet_name = paste(name_clean,".flow", sep = "")
 
   if (!dir.exists(dirname(name))) { # check if output dir exists, menu to create
     t = utils::menu(
-      c("Yes", "No [Exit]"),
+      c("Yes", "No [Skip]"),
       title = paste("Ouput directory path:",dirname(name),"is not valid. Create folder(s)?"))
     if (t == 1) {
       dir.create(dirname(name), recursive = TRUE)
@@ -103,54 +104,60 @@ RHESSysPreprocess = function(template,
 
   # ---------- Run world_gen ----------
   cat("Begin world_gen.R\n")
-
+  t = 1
   if (file.exists(worldfile) & overwrite == FALSE) { # check for worldfile overwrite
-    t = utils::menu(c("Yes", "No [Exit]"), title = noquote(paste(
+    t = utils::menu(c("Yes", "No [Skip]"), title = noquote(paste(
       "Worldfile", worldfile, "already exists. Overwrite?"
     )))
     if (t == 2) {
-      stop("RHESSysPreprocess.R exited without completing")
+      #stop("RHESSysPreprocess.R exited without completing")
+      cat("Use existing world file\n")
     }
   }
-
-  world_gen_out = world_gen(template = template,
+  if (t == 1) {
+    world_gen_out = world_gen(template = template,
                             worldfile = worldfile,
                             type = type,
                             typepars = typepars,
-                            overwrite = overwrite,
+                            overwrite = TRUE,
                             header = header,
                             unique_strata_ID = unique_strata_ID,
                             asprules = asprules)
+  }
 
   #readin = world_gen_out[[1]]
   #asp_rules = world_gen_out[[2]]
 
   # ---------- Run create_flownet ----------
   cat("Begin create_flownet.R")
 
+  t = 1
   if (file.exists(flownet_name) & overwrite == FALSE) { # check for flownet overwrite
-    t = utils::menu(c("Yes", "No [Exit]"), title = noquote(paste(
+    t = utils::menu(c("Yes", "No [Skip]"), title = noquote(paste(
       "Flowtable", flownet_name, "already exists. Overwrite?"
     )))
     if (t == 2) {
-      stop("RHESSysPreprocess.R exited without completing")
+      #stop("RHESSysPreprocess.R exited without completing")
+      cat("Use existing flownet file\n")
     }
   }
-
-  create_flownet(flownet_name = flownet_name,
+  if (t == 1) {
+    create_flownet(flownet_name = flownet_name,
                 template = template,
                 type = type,
                 typepars = typepars,
                 asprules = asprules,
                 streams = streams,
-                overwrite = overwrite,
+                overwrite = TRUE,
                 roads = roads,
+                road_width = road_width,
                 impervious = impervious,
                 roofs = roofs,
                 wrapper = wrapper,
                 parallel = parallel,
                 make_stream = make_stream,
                 skip_hillslope_check = skip_hillslope_check)
+  }
 
   # ---------- Run build_meta ----------
   # if (meta) {

R/create_flownet.R

@@ -92,12 +92,14 @@ create_flownet = function(flownet_name,
   } else {
     raw_slope_data = map_list[[unique(cfmaps[cfmaps[, 1] == "slope", 2])]]
   }
+
   if ("z" %in% notamap) {
     raw_patch_elevation_data = raw_patch_data
     raw_patch_elevation_data[!is.na(raw_patch_elevation_data)] = as.numeric(cfmaps[cfmaps[,1] == "z",2])
   } else {
     raw_patch_elevation_data = map_list[[unique(cfmaps[cfmaps[, 1] == "z", 2])]]
   }
+
   cell_length = readmap@grid@cellsize[1]
   # Roads
   raw_road_data = NULL
@@ -120,7 +122,6 @@ create_flownet = function(flownet_name,
   if (!is.null(asprules)) {
     asp_map = template_clean[[which(var_names == "asp_rule")]][3] # get rule map/value
     patch_map = map_df[[cfmaps[cfmaps[,1] == "patch",2]]] # set for use later - overwrite if using mode
-
     if (suppressWarnings(is.na(as.numeric(asp_map)))) { # if it's a map
       asp_map = gsub(".tif|.tiff","",asp_map)
       asp_mapdata = as.data.frame(readmap)[asp_map]
@@ -177,7 +178,7 @@ create_flownet = function(flownet_name,
   }
 
   # ------------------------------ Make flownet list ------------------------------
-  cat("Building flowtable")
+  cat("Building flowtable\n")
   CF1 = make_flow_list(
     raw_patch_data = raw_patch_data,
     raw_patch_elevation_data = raw_patch_elevation_data,

R/find_stream.R

@@ -1,40 +1,42 @@
-# Searches through nodes, if a node has a road, it finds the nearest stream in the nodes descendants.
-# If there are no streams it uses the final basin (sum of gamma ==0). Once the stream is found, the
-# landtype is changed to 2, and the roadtype variable gets the node number.
-find_stream<-function(flw,road_width){
-  len_flw<-length(flw)
-  for (i in 1:len_flw){
-    if ((flw[[i]]$Roadtype==1)&(sum(flw[[i]]$Gamma_i)!=0)){
-
-      # returns a list of all nodes that can be reached from start_node
-        len<-length(flw)
-        clist_bool<-rep(FALSE,len)
-        clist_bool<-find_children(flw,i,clist_bool)
-        if (sum(clist_bool)==0){   #if there are no downstream nodes, return 0
-          desc = 0
-        } else {    # otherwise, return a list of all downstream nodes.
-          desc<-seq.int(1,len)[clist_bool]
-        }
-
-      strm_chld<-c()  #list of descendants with a stream or bottom
-      strm_dist<-c()  # 2d distance to each stream
-      for (j in desc) {
-        if ((flw[[j]]$Landtype==1)|(sum(flw[[j]]$Gamma_i)==0)) { #has a stream or is bottom
-          strm_chld<-c(strm_chld,j)
-          # find 2d distance between two nodes
-          strm_dist<-c(strm_dist,sqrt((flw[[i]]$Centroidx-flw[[j]]$Centroidx)^2+(flw[[i]]$Centroidy-flw[[j]]$Centroidy)^2))
-        }
-      }
-      strm_chld<-strm_chld[order(strm_dist)] # order list by 2d distance
-      flw[[i]]$Roadtype<-strm_chld[[1]]  #pick closest one
-    }
-  }
-  for (i in 1:len_flw){
-    if (flw[[i]]$Roadtype!=0){
-      strm<-flw[[i]]$Roadtype
-      flw[[i]]$Landtype<-2
-      flw[[i]]$Roadtype<-c(flw[[strm]]$PatchID,flw[[strm]]$ZoneID,flw[[strm]]$HillID,road_width)
-    }
-  }
-  return(flw)
-}
+# Searches through nodes, if a node has a road, it finds the nearest stream in the nodes descendants.
+# If there are no streams it uses the final basin (sum of gamma ==0). Once the stream is found, the
+# landtype is changed to 2, and the roadtype variable gets the node number.
+find_stream<-function(flw,road_width){
+  len_flw<-length(flw)
+  for (i in 1:len_flw){
+    if ((flw[[i]]$Roadtype==1)&(sum(flw[[i]]$Gamma_i)!=0)){
+
+      # returns a list of all nodes that can be reached from start_node
+        len<-length(flw)
+        clist_bool<-rep(FALSE,len)
+        clist_bool<-find_children(flw,i,clist_bool)
+        if (sum(clist_bool)==0){   #if there are no downstream nodes, return 0
+          desc = 0
+        } else {    # otherwise, return a list of all downstream nodes.
+          desc<-seq.int(1,len)[clist_bool]
+        }
+
+      strm_chld<-c()  #list of descendants with a stream or bottom
+      strm_dist<-c()  # 2d distance to each stream
+      for (j in desc) {
+        if ((flw[[j]]$Landtype==1)|(sum(flw[[j]]$Gamma_i)==0)) { #has a stream or is bottom
+          strm_chld<-c(strm_chld,j)
+          # find 2d distance between two nodes
+          strm_dist<-c(strm_dist,sqrt((flw[[i]]$Centroidx-flw[[j]]$Centroidx)^2+(flw[[i]]$Centroidy-flw[[j]]$Centroidy)^2))
+        }
+      }
+      if(length(strm_dist) > 0) {
+        strm_chld<-strm_chld[order(strm_dist)] # order list by 2d distance
+        flw[[i]]$Roadtype<-strm_chld[[1]]  #pick closest one
+      }
+    }
+  }
+  for (i in 1:len_flw){
+    if (flw[[i]]$Roadtype!=0){
+      strm<-flw[[i]]$Roadtype
+      flw[[i]]$Landtype<-2
+      flw[[i]]$Roadtype<-c(flw[[strm]]$PatchID,flw[[strm]]$ZoneID,flw[[strm]]$HillID,road_width)
+    }
+  }
+  return(flw)
+}