Merge branch 'master' of https://github.com/RHESSys/RHESSysPreprocessing

Author: ryanrbart

R/CreateFlownet.R

@@ -2,20 +2,17 @@
 #'
 #' Creates the flow networkd table used by RHESSys
 #' @param flownet_name The name of the flow network file to be created.  Will be coerced to have ".flow" extension if not already present.
-#' @param readin readin indicates the maps to be used. If CreateFlowmet.R is run it's own, this should point to the template which references the maps(or values)
-#' used for the various levels and statevars. Otherwise, if run inside of RHESSysPreprocess, readin will use the map data from world_gen.R,
-#' Streams map, and other optional maps, still need to be specified.
-#' @param asp_rules List of aspatial structure and inputs. Also can be path to rules file - must be used along with template input.
+#' @param asprules List of aspatial structure and inputs. Also can be path to rules file - must be used along with template input.
 #' @param road_width >0, defaults to 1.
 #' @inheritParams RHESSysPreprocess
 #' @author Will Burke
 #' @export
 
 CreateFlownet = function(flownet_name,
-                         readin = NULL,
+                         template = NULL,
                          type = "raster",
                          typepars = NULL,
-                         asp_rules = NULL,
+                         asprules = NULL,
                          streams = NULL,
                          overwrite = FALSE,
                          roads = NULL,
@@ -39,15 +36,11 @@ CreateFlownet = function(flownet_name,
   if (!is.logical(overwrite)) {stop("overwrite must be logical")} # check overwrite inputs
   if (file.exists(flownet_name) & overwrite == FALSE) {stop(noquote(paste("Flowtable",flownet_name,"already exists.")))}
 
-  if (!wrapper & is.character(readin)) { #if run outside of rhessyspreprocess.R, and if readin is character. readin is the template (and path)
-    template_list = template_read(readin)
-    template_clean = template_list[[1]] # template in list form
-    var_names = template_list[[2]] # names of template vars
-    map_info = template_list[[5]] # tables of maps and their inputs/names in the template
-    cfmaps = rbind(map_info,c("cell_length","none"), c("streams","none"), c("roads","none"), c("impervious","none"),c("roofs","none"))
-  } else if (wrapper | (!wrapper & is.matrix(readin))) { # map info is passsed directly from world gen - either in wrapper or outside of wrapper and readin is matrix
-    cfmaps = readin
-  }
+  template_list = template_read(template)
+  template_clean = template_list[[1]] # template in list form
+  var_names = template_list[[2]] # names of template vars
+  map_info = template_list[[5]] # tables of maps and their inputs/names in the template
+  cfmaps = rbind(map_info,c("cell_length","none"), c("streams","none"), c("roads","none"), c("impervious","none"),c("roofs","none"))
 
   # Check for streams map, menu allows input of stream map
   if (is.null(streams) & (cfmaps[cfmaps[,1] == "streams",2] == "none" | is.na(cfmaps[cfmaps[,1] == "streams",2]))) {
@@ -80,7 +73,7 @@ CreateFlownet = function(flownet_name,
   }
 
   # check inputs are maps or values
-  notamap = cfmaps[suppressWarnings( which(!is.na(as.numeric(cfmaps[,2])))),1]
+  notamap = cfmaps[suppressWarnings(which(!is.na(as.numeric(cfmaps[,2])))),1]
   maps_in = unique(cfmaps[cfmaps[,2] != "none" & !cfmaps[,1] %in% notamap,2])
 
   # ------------------------------ Use GIS_read to get maps ------------------------------
@@ -116,22 +109,29 @@ CreateFlownet = function(flownet_name,
   raw_impervious_data = NULL
   if (!is.null(impervious)) {raw_impervious_data =  map_list[[cfmaps[cfmaps[,1] == "impervious",2]]]}
 
+  # TODO - this should get cleaned up eventually - there's at least 2 different versions of the maps being used
+  if (length(readmap@data[,1]) == 1) {
+    map_df = as.data.frame(readmap@data) # works for 1 patch world
+  } else {
+    map_df = as.data.frame(readmap) #make data frame for ease of use
+  }
+
   # read aspatial rules if needed
-  if (!is.null(asp_rules) && is.character(asp_rules)) {
+  if (!is.null(asprules)) {
     asp_map = template_clean[[which(var_names == "asp_rule")]][3] # get rule map/value
-    if (suppressWarnings(any(is.na(as.numeric(asp_map))))) { # if it's a map
+    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]
 
       # --- doing manipulation of the asp map if needed here ---
-      if (template_clean[[which(var_names == "asp_rule")]][2] == "mode" ) {
-
+      if (template_clean[[which(var_names == "asp_rule")]][2] == "mode") {
         # mode for aggregating by mode
         mode_fun = function(x) {
           ux <- unique(x)
           ux[which.max(tabulate(match(x, ux)))]
         }
-
         # fun to check if rules are all unique per patch (kinda slow but oh well) -----
         check_rules = function(patches, asp_rules) {
           patches_u = unique(patches[!is.na(patches)])
@@ -155,28 +155,25 @@ CreateFlownet = function(flownet_name,
                                map_info[map_info[, 1] == "strata", 2]))
         level_names = unique(gsub(".tiff|.tif|.asc","",level_names))
 
-        if (length(readmap@data[,1]) == 1) {
-          map_df = as.data.frame(readmap@data) # works for 1 patch world
-        } else {
-          map_df = as.data.frame(readmap) #make data frame for ease of use
-        }
-
-        asp_maps = aggregate(map_df$asprule, by = map_df[level_names], FUN = mode_fun, simplify = T)
+        asp_maps = aggregate(map_df[[cfmaps[cfmaps[,1] == "asp_rule",2]]], by = map_df[level_names], FUN = mode_fun, simplify = T)
         names(asp_maps)[which(names(asp_maps) == "x")] = "asprule"
 
-        rules_out = check_rules(patches = asp_maps$pch_30m1000, asp_rules = asp_maps$asprule)
+        patch_map = asp_maps[[cfmaps[cfmaps[,1] == "patch",2]]]
+
+        rules_out = check_rules(patches = patch_map, asp_rules = asp_maps$asprule)
+
         if (!is.null(rules_out)) {
           print(rules_out)
           stop("Mode of rules was attempted but there are still patches with multiple rules. Check input maps.")
         }
-
         asp_mapdata = asp_maps$asprule
       }
 
-    } else if (suppressWarnings(all(!is.na(as.numeric(asp_map))))) { # if is a single number
-      asp_mapdata = as.numeric(asp_map)
+    } else { # if is a single number
+      asp_mapdata = map_df[[cfmaps[cfmaps[,1] == "basin",2]]]
+      asp_mapdata[!is.na(asp_mapdata)] = as.numeric(asp_map)
     }
-    asp_list = aspatial_patches(asprules = asp_rules, asp_mapdata = asp_mapdata)
+    asp_list = aspatial_patches(asprules = asprules, asp_mapdata = asp_mapdata)
   }
 
   # ------------------------------ Make flownet list ------------------------------
@@ -197,15 +194,8 @@ CreateFlownet = function(flownet_name,
     skip_hillslope_check = skip_hillslope_check)
 
   # ------------------------------ Multiscale routing/aspatial patches ------------------------------
-  if (!is.null(asp_rules)) {
-    if ("asp_rule" %in% notamap) {
-      map_list[["asp_rule"]] = raw_basin_data
-      map_list[["asp_rule"]][!is.na(map_list[["asp_rule"]])] = as.numeric(cfmaps[cfmaps[,1] == "asp_rule",2])
-      #cfmaps = rbind(cfmaps, c("asp_rule", "asp_rule"))
-      cfmaps[cfmaps[,1] == "asp_rule", 2] = "asp_rule"
-    }
-
-    CF1 = multiscale_flow(CF1 = CF1, asp_maps = asp_maps, cfmaps = cfmaps, asp_list = asp_list)
+  if (!is.null(asprules)) {
+    CF1 = multiscale_flow(CF1 = CF1, asp_map = asp_mapdata, patch_map = patch_map, asp_list = asp_list)
   }
 
   # ---------- Flownet list to flow table file ----------