diff --git a/HARP-2023-Summer/Mapping/Config/mapstyle_config.R b/HARP-2023-Summer/Mapping/Config/mapstyle_config.R index 4a4f6abf..10159a6f 100644 --- a/HARP-2023-Summer/Mapping/Config/mapstyle_config.R +++ b/HARP-2023-Summer/Mapping/Config/mapstyle_config.R @@ -175,12 +175,12 @@ run_sets <- list( list( data_set = 'rseg_no_geom', metric='l30_Qout', - column_name='percentDiff_l30_Qout_runid_0_runid_601', + column_name='percentDiff_l30_Qout_runid_0_runid_600', run_label = '2040 WSP L30 %', show_map = TRUE, ramp = 'default', - tables_cols = c('name', 'riverseg', 'Metric', 'runid_401_l30_Qout', 'runid_601_l30_Qout', 'percentDiff_l30_Qout_runid_0_runid_601'), - sort_col = 'percentDiff_l30_Qout_runid_401_runid_601', + tables_cols = c('name', 'riverseg', 'Metric', 'runid_400_l30_Qout', 'runid_600_l30_Qout', 'percentDiff_l30_Qout_runid_0_runid_600'), + sort_col = 'percentDiff_l30_Qout_runid_400_runid_600', floor = NULL, ceiling = NULL, n_entries = NULL, @@ -190,12 +190,12 @@ run_sets <- list( list( data_set = 'rseg_no_geom', metric='7q10', - column_name='percentDiff_7q10_runid_0_runid_601', + column_name='percentDiff_7q10_runid_0_runid_600', run_label = '2040 WSP 7q10 %', show_map = TRUE, ramp = 'default', - tables_cols = c('name', 'riverseg', 'Metric', 'runid_401_7q10', 'runid_601_7q10', 'percentDiff_7q10_runid_0_runid_601'), - sort_col = 'percentDiff_7q10_runid_401_runid_601', + tables_cols = c('name', 'riverseg', 'Metric', 'runid_400_7q10', 'runid_600_7q10', 'percentDiff_7q10_runid_0_runid_600'), + sort_col = 'percentDiff_7q10_runid_400_runid_600', floor = NULL, ceiling = NULL, n_entries = NULL, @@ -205,12 +205,42 @@ run_sets <- list( list( data_set = 'rseg_no_geom', metric='Smin_L30_mg', - column_name='runid_601_Smin_L30_mg', + column_name='runid_600_Smin_L30_mg', run_label = 'Minimum Storage', show_map = TRUE, ramp = 'default', - tables_cols = c('name', 'riverseg', 'Metric', 'runid_401_Smin_L30_mg', 'runid_601_Smin_L30_mg', 'percentDiff_Smin_L30_mg_runid_0_runid_601'), - sort_col = 'runid_601_Smin_L30_mg', + tables_cols = c('name', 'riverseg', 'Metric', 'runid_400_Smin_L30_mg', 'runid_600_Smin_L30_mg', 'percentDiff_Smin_L30_mg_runid_0_runid_600'), + sort_col = 'runid_600_Smin_L30_mg', + floor = NULL, + ceiling = NULL, + n_entries = NULL, + sort = 'increasing', + exlude_NAs = FALSE + ), + list( + data_set = 'facils_nogeom', + metric='base_demand_mgd', #replace with unmet demand req + column_name='runid_600_base_demand_mgd', + run_label = 'Highest 30 Day Potential Unmet Demand (MGD)', + show_map = FALSE, + ramp = 'default', + tables_cols = c('Facility', 'Facility_hydroid', 'riverseg', 'runid_400_base_demand_mgd', 'runid_600_base_demand_mgd', 'runid_18_base_demand_mgd' ,'gw_frac'), + sort_col = 'runid_600_base_demand_mgd', + floor = NULL, #floor = 0.001, + ceiling = NULL, + n_entries = 999, + sort = 'decreasing', + exlude_NAs = TRUE #exlude_NAs = FALSE + ), + list( + data_set = 'rseg_no_geom', + metric='wd_cumulative_mgd', + column_name='runid_18_wd_cumulative_mgd', + run_label = 'Minimum Storage', + show_map = TRUE, + ramp = 'default', + tables_cols = c('name', 'riverseg', 'Metric', 'runid_400_wd_cumulative_mgd', 'runid_600_wd_cumulative_mgd', 'percentDiff_wd_cumulative_mgd_runid_0_runid_600'), + sort_col = 'runid_600_wd_cumulative_mgd', floor = NULL, ceiling = NULL, n_entries = NULL, diff --git a/HARP-2023-Summer/Mapping/Dataframe_Generator.Rmd b/HARP-2023-Summer/Mapping/Dataframe_Generator.Rmd index 7e614256..7e02fc5d 100644 --- a/HARP-2023-Summer/Mapping/Dataframe_Generator.Rmd +++ b/HARP-2023-Summer/Mapping/Dataframe_Generator.Rmd @@ -12,6 +12,7 @@ params: rivseg_metric: ["l90_Qout", "l30_Qout", "7q10", "Qout", "Smin_L30_mg"] #l30_Qout, l90_Qout, 7q10 baseline_runid_list: [ "runid_11", "runid_1000" ] crs_default: 4326 + region_extent: FALSE #region_extent = c(-77.66502, 37.12323, -76.78439, 37.58390) limit_featrs_to_origin: FALSE #if TRUE -> featrs will be cutoff at the region/locality specified #if FALSE --> all featrs in the associated basins will be plotted overwrite_files: TRUE #if FALSE -> will stop execution if rivseg and feature files already exist @@ -43,6 +44,13 @@ if (is.logical(foundation_path)) { foundation_path <- foundation_location } +if (!is.logical(region_extent)) { + names(region_extent) = c("xmin","ymin","xmax","ymax") + region_extent = st_as_sfc(st_bbox(region_extent), crs=crs_default) + region_extent = st_set_crs(region_extent,crs_default) +} + + #note: the variables "github_location" and "export_path" should be defined in config.local #github_location provides easy access to functions & dataset resources ; export_path is where generated dataframes will output ``` @@ -369,13 +377,17 @@ if (origin_type=="basin") { #finding upstream riversegs for basin maps } #---Sources/featrs--- #filtering data to only points within the extent of interest, either locality/region boundary or the basins/riversegs intersecting the extent -if (limit_featrs_to_origin==FALSE | origin_type=="basin") { - featrs <- st_filter(featrs, rsegs) -} else if (limit_featrs_to_origin==TRUE){ - if(origin_type=="locality"){ - featrs <- st_filter(featrs, counties[counties$name==origin, ]) - } else if (origin_type=="region") { - featrs <- st_filter(featrs, regions[regions$region==origin,]) +if (!is.logical(region_extent)) { + featrs <- st_filter(featrs, region_extent) +} else { + if (limit_featrs_to_origin==FALSE | origin_type=="basin") { + featrs <- st_filter(featrs, rsegs) + } else if (limit_featrs_to_origin==TRUE){ + if(origin_type=="locality"){ + featrs <- st_filter(featrs, counties[counties$name==origin, ]) + } else if (origin_type=="region") { + featrs <- st_filter(featrs, regions[regions$region==origin,]) + } } } ``` diff --git a/HARP-2023-Summer/Mapping/Functions/fn_nhd_labs.R b/HARP-2023-Summer/Mapping/Functions/fn_nhd_labs.R index 6ed7d7e8..1dae7161 100644 --- a/HARP-2023-Summer/Mapping/Functions/fn_nhd_labs.R +++ b/HARP-2023-Summer/Mapping/Functions/fn_nhd_labs.R @@ -1,60 +1,65 @@ -#NHD data labeling prep -- originally part of fn_labelprep.R -# for current specific use: -# data = nhd - -# JK 8.8.23: Need to load the config file for this to run -# Will need to explicitly pass in params such as nhd_rivname_pattern -source(paste0(github_uri,"/HARP-2023-Summer/Mapping/Config/mapstyle_config.R"),local = TRUE) #load mapping aesthetics -fn_nhd_labs <- function(data) { - - for(d in 1:length(data)){ - ## NHD Data - # First organize flowline data with major rivers/streams - ## major rivs = orders 5 & 6; streams = order 4 - flow <- nhd$flowline[nhd$flowline$gnis_name!=' ' & #name!=blank & order 4, 5, or 6 - (nhd$flowline$StreamOrde==6 | nhd$flowline$StreamOrde==5 | nhd$flowline$StreamOrde==4),] - ## no duplicate names; prioritize higher order names and then the longest segment of each duplicate - flow <- flow[order(-flow$StreamOrde, flow$gnis_name, -flow$LENGTHKM) & !duplicated(flow$gnis_name),] - ## shorten long names - flow$gnis_name <- mgsub(flow$gnis_name, - nhd_rivname_pattern, #pattern - nhd_rivname_replacements) #replacement - flow$StreamOrde <- mgsub(flow$StreamOrde, nhd_streamorders, nhd_streamclasses) - flow <- flow[,c("gnis_name","StreamOrde")] #geometry is still attached - colnames(flow) <- gsub("StreamOrde", "class", colnames(flow)) - - # Now do the same for the water bodies - wtbd <- rbind(nhd$network_wtbd, nhd$off_network_wtbd) - ## remove ones without names and ponds/swamps - wtbd <- wtbd[!(wtbd$gnis_name==' ' | wtbd$gnis_name=='Noname'),] - wtbd <- wtbd[!grepl(c(wtbd_names_rm), wtbd$gnis_name),] #remove certain names from waterbody labeling, wtbd_names_rm from mapstyles_config - wtbd <- wtbd[!is.na(wtbd$lakevolume),] - #wtbd <- wtbd[!grepl("Millpond", wtbd$gnis_name),] - # wtbd <- wtbd[!grepl("Swamp", wtbd$gnis_name),] - - - #classification of waterbodies with classes based on their size - wtbd_small <- wtbd[wtbd$lakevolume > quantile(wtbd$lakevolume, wtbd_sm_pct_range[1], na.rm = T) & - wtbd$lakevolume < quantile(wtbd$lakevolume, wtbd_sm_pct_range[2], na.rm = T),] - wtbd_small$class <- rep("waterbody_sm", nrow(wtbd_small)) #add class column - - wtbd_med <- wtbd[wtbd$lakevolume > quantile(wtbd$lakevolume, wtbd_med_pct_range[1], na.rm = T) & - wtbd$lakevolume < quantile(wtbd$lakevolume, wtbd_med_pct_range[2], na.rm = T),] - wtbd_med$class <- rep("waterbody_med", nrow(wtbd_med)) #add class column - - wtbd_large <- wtbd[wtbd$lakevolume > quantile(wtbd$lakevolume, wtbd_med_pct_range[2], na.rm = T),] - wtbd_large$class <- rep("waterbody_lg", nrow(wtbd_large)) #add class column - - ##something wrong -- too many bodies classified as large - - wtbd <- rbind(wtbd_small,wtbd_med,wtbd_large) - wtbd <- wtbd[,c("gnis_name","class")] - wtbd <- wtbd[!is.na(wtbd$gnis_name),] - - nhdlabs <- rbind(flow, wtbd) - names(nhdlabs)[names(nhdlabs) == 'gnis_name'] <- 'label' - # now it is ready to have coords calculated like the rest of the labeling data -# assign('data', data, envir = globalenv())#save df to environment - } - return(nhdlabs) +#NHD data labeling prep -- originally part of fn_labelprep.R +# for current specific use: +# data = nhd + +# JK 8.8.23: Need to load the config file for this to run +# Will need to explicitly pass in params such as nhd_rivname_pattern +source(paste0(github_uri,"/HARP-2023-Summer/Mapping/Config/mapstyle_config.R"),local = TRUE) #load mapping aesthetics +fn_nhd_labs <- function(data) { + + for(d in 1:length(data)){ + ## NHD Data + # First organize flowline data with major rivers/streams + ## major rivs = orders 5 & 6; streams = order 4 + flow <- nhd$flowline[nhd$flowline$gnis_name!=' ' & #name!=blank & order 4, 5, or 6 + (nhd$flowline$StreamOrde==6 | nhd$flowline$StreamOrde==5 | nhd$flowline$StreamOrde==4),] + ## no duplicate names; prioritize higher order names and then the longest segment of each duplicate + flow <- flow[order(-flow$StreamOrde, flow$gnis_name, -flow$LENGTHKM) & !duplicated(flow$gnis_name),] + ## shorten long names + flow$gnis_name <- mgsub(flow$gnis_name, + nhd_rivname_pattern, #pattern + nhd_rivname_replacements) #replacement + flow$StreamOrde <- mgsub(flow$StreamOrde, nhd_streamorders, nhd_streamclasses) + flow <- flow[,c("gnis_name","StreamOrde")] #geometry is still attached + colnames(flow) <- gsub("StreamOrde", "class", colnames(flow)) + + # Now do the same for the water bodies + wtbd <- rbind(nhd$network_wtbd, nhd$off_network_wtbd) + ## remove ones without names and ponds/swamps + wtbd <- wtbd[!(wtbd$gnis_name==' ' | wtbd$gnis_name=='Noname'),] + if (!is.null(wtbd)) { + wtbd <- wtbd[!grepl(c(wtbd_names_rm), wtbd$gnis_name),] #remove certain names from waterbody labeling, wtbd_names_rm from mapstyles_config + wtbd <- wtbd[!is.na(wtbd$lakevolume),] + #wtbd <- wtbd[!grepl("Millpond", wtbd$gnis_name),] + # wtbd <- wtbd[!grepl("Swamp", wtbd$gnis_name),] + + + #classification of waterbodies with classes based on their size + wtbd_small <- wtbd[wtbd$lakevolume > quantile(wtbd$lakevolume, wtbd_sm_pct_range[1], na.rm = T) & + wtbd$lakevolume < quantile(wtbd$lakevolume, wtbd_sm_pct_range[2], na.rm = T),] + wtbd_small$class <- rep("waterbody_sm", nrow(wtbd_small)) #add class column + + wtbd_med <- wtbd[wtbd$lakevolume > quantile(wtbd$lakevolume, wtbd_med_pct_range[1], na.rm = T) & + wtbd$lakevolume < quantile(wtbd$lakevolume, wtbd_med_pct_range[2], na.rm = T),] + wtbd_med$class <- rep("waterbody_med", nrow(wtbd_med)) #add class column + + wtbd_large <- wtbd[wtbd$lakevolume > quantile(wtbd$lakevolume, wtbd_med_pct_range[2], na.rm = T),] + wtbd_large$class <- rep("waterbody_lg", nrow(wtbd_large)) #add class column + + ##something wrong -- too many bodies classified as large + + wtbd <- rbind(wtbd_small,wtbd_med,wtbd_large) + wtbd <- wtbd[,c("gnis_name","class")] + wtbd <- wtbd[!is.na(wtbd$gnis_name),] + + nhdlabs <- rbind(flow, wtbd) + } else { + nhdlabs <- flow + } + + names(nhdlabs)[names(nhdlabs) == 'gnis_name'] <- 'label' + # now it is ready to have coords calculated like the rest of the labeling data +# assign('data', data, envir = globalenv())#save df to environment + } + return(nhdlabs) } \ No newline at end of file diff --git a/HARP-2023-Summer/Mapping/Functions/fns_mapgen.R b/HARP-2023-Summer/Mapping/Functions/fns_mapgen.R index ee1609c7..8436fcc0 100644 --- a/HARP-2023-Summer/Mapping/Functions/fns_mapgen.R +++ b/HARP-2023-Summer/Mapping/Functions/fns_mapgen.R @@ -511,6 +511,7 @@ fn_gw_mapgen <- function(bbox, crs_default, mp_layer, featr_type, fn_labelsAndFilter(maplabs, bbox_coords, nhd, roads, map_style_set, bbox_sf, crs_default, rsegs) #begin mapping: map <- ggplot() + coord_sf(xlim=bbox_coords$lng,ylim=bbox_coords$lat) + map$errors = c() map <- fn_catchMapErrors(map_layer = ggplot2::theme(text=ggplot2::element_text(size=20), title=ggplot2::element_text(size=40), #setting text sizes legend.title = ggplot2::element_text(size=25), diff --git a/HARP-2023-Summer/Mapping/WSP_Regional_Summaries.Rmd b/HARP-2023-Summer/Mapping/WSP_Regional_Summaries.Rmd index 6e5c07c6..97d7c149 100644 --- a/HARP-2023-Summer/Mapping/WSP_Regional_Summaries.Rmd +++ b/HARP-2023-Summer/Mapping/WSP_Regional_Summaries.Rmd @@ -24,7 +24,6 @@ params: featrs_file: "C:/Users/ejp42531/Documents/R Exports//SoutheastVirginia_featrs_sf.csv" featrs_file_map_bubble_column: ["wsp2020_2040_mgy"] #runid & metric featrs_file_table_column: ["Use_Type","runid_11_wd_mgd","runid_13_wd_mgd","wsp2020_2040_mgy"] - rsegs_file: "C:/Users/ejp42531/Documents/R Exports//SoutheastVirginia_rsegs_sf.csv" rivseg_metric: ["l30_Qout", "l90_Qout"] #right now these arent exact column names in the resegs_file run_set: ['wsp_2020_2040'] # new method of specifying river metric maps and tables @@ -35,6 +34,7 @@ params: map_style: ["custom"] #determining map aesthetics like colors, fonts, font sizes bbox_type: ["auto"] #either 'auto' to force automatic for all, or 'custom' show_map: TRUE #either TRUE or FALSE + region_extent: FALSE #region_extent = c(-77.66502, 37.12323, -76.78439, 37.58390) --- ```{r setup, include=FALSE, warning=FALSE, echo=FALSE} @@ -76,7 +76,7 @@ crs_default <- params$crs_default map_style <- params$map_style bbox_type <- params$bbox_type show_map <- params$show_map - + ``` ```{r TOC, echo = FALSE} @@ -131,6 +131,14 @@ legend_titling <- function(metric, runid_list){ for(i in 1:length(params)){ assign(names(params[i]), params[[i]]) } + +region_extent <- params$region_extent +if (!is.logical(region_extent)) { + names(region_extent) = c("xmin","ymin","xmax","ymax") + region_extent = st_as_sfc(st_bbox(region_extent), crs=crs_default) + region_extent = st_set_crs(region_extent,crs_default) +} + generate_rmetrics = TRUE run_config = NULL if (!is.null(params$run_set)) { @@ -281,15 +289,12 @@ If a local government or regional planning unit boundary intersects the groundwa # Legend Bins #create human-readable title based on origin & type +origin_readable <- gsub("([a-z])([A-Z])","\\1 \\2", origin) +title_main <- paste0( gsub("_", " ", origin_readable) , " Region") if (origin_type == "basin") { title_main <- (paste("Basin Upstream of", rsegs$name[rsegs$riverseg==origin] , origin, sep=" ")) } else if (origin_type == "locality") { - origin_readable <- gsub("([a-z])([A-Z])","\\1 \\2", origin) title_main <- paste0(counties[["name"]][counties[["dh_fips"]]==origin]," Locality") -} else if (origin_type == "region") { - origin_readable <- gsub("([a-z])([A-Z])","\\1 \\2", origin) - title_main <- paste0( gsub("_", " ", origin_readable) , " Region") - } if (show_map == TRUE) { @@ -565,87 +570,100 @@ GWMA_wkt <- st_as_sf(GWMA_wkt, wkt = "Geometry", crs = st_crs(4326)) ## Need to determine if the area intersects the aquifer to create the maps #### Or at least the critical cell part -if (origin_type == 'region') { - ## Gets the shape to use as a boundary - origin_shape <- regions[regions$region == origin,] -} else if (origin_type == 'locality') { - origin_shape <- regions[regions$region == counties$Region[counties$hydrocode == origin],] +if (!is.logical(region_extent)) { + message("Using value from region_extent for origin_shape") + origin_shape <- region_extent +} else { + if (origin_type == 'region') { + ## Gets the shape to use as a boundary + origin_shape <- regions[regions$region == origin,] + } else if (origin_type == 'locality') { + origin_shape <- regions[regions$region == counties$Region[counties$hydrocode == origin],] + } else { + region_extent = st_as_sfc(st_bbox(rsegs), crs=crs_default) + origin_shape = st_set_crs(region_extent,crs_default) + } } ## Checking for intersection insidegwma <- st_intersection(origin_shape,GWMA_wkt ) ## First checks all of them, to determine if there is any intersection. If so, add section title -if (nrow(insidegwma) > 0) { - - cat('\n## Groundwater Critical Cell Maps \n') - - ### Potomac - aquifer <- 'Potomac' - - ## Calls fn_gw_mapgen. Basically a stripped version of fn_mapgen that adds in aquifer_shp - potomac_map <- fn_gw_mapgen(bbox, crs_default, mp_layer, featr_type, - maptitle=paste0(origin_readable," Critical Cells in ", aquifer), - maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, - aquifer_shp = potomac, origin_shape) - - ## Saves the file - ggsave(filename = paste0(export_path,origin,'_',aquifer,'.png'), - plot = potomac_map,width=25,height=20) - - ## Includes the saved file - cat(paste0('![](',export_path,origin,'_',aquifer,'.png)')) - - ### Aquia - aquifer <- 'Aquia' - - aquia_map <- fn_gw_mapgen(bbox, crs_default, mp_layer, featr_type, - maptitle=paste0(origin_readable," Critical Cells in ", aquifer), - maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, - aquifer_shp = aquia, origin_shape) - - ggsave(filename = paste0(export_path,origin,'_Aquia.png'), - plot = aquia_map,width=25,height=20) - - ## Includes the saved file - cat(paste0('![](',export_path,origin,'_',aquifer,'.png)')) - - ### Piney Point - aquifer <- 'Piney Point' - - pineypoint_map <- fn_gw_mapgen(bbox, crs_default, mp_layer, featr_type, - maptitle=paste0(origin_readable," Critical Cells in ", aquifer), - maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, - aquifer_shp = pineypoint, origin_shape) - - ## Piney Point cant have a space in the filename - ggsave(filename = paste0(export_path,origin,'_Piney_Point.png'), - plot = pineypoint_map,width=25,height=20) +if (!is.null(nrow(insidegwma))) { + if (nrow(insidegwma) > 0) { + + cat('\n## Groundwater Critical Cell Maps \n') + + ### Potomac + aquifer <- 'Potomac' + + ## Calls fn_gw_mapgen. Basically a stripped version of fn_mapgen that adds in aquifer_shp + potomac_map <- fn_gw_mapgen( + bbox, crs_default, mp_layer, featr_type, + maptitle=paste0(origin_readable," Critical Cells in ", aquifer), + maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, + aquifer_shp = potomac, origin_shape) + map_objects[[length(map_objects) + 1]] <- potomac_map + ## Saves the file + ggsave(filename = paste0(export_path,origin,'_',aquifer,'.png'), + plot = potomac_map,width=25,height=20) + + ## Includes the saved file + cat(paste0('![](',export_path,origin,'_',aquifer,'.png)')) + + ### Aquia + aquifer <- 'Aquia' + + aquia_map <- fn_gw_mapgen( + bbox, crs_default, mp_layer, featr_type, + maptitle=paste0(origin_readable," Critical Cells in ", aquifer), + maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, + aquifer_shp = aquia, origin_shape) + map_objects[[length(map_objects) + 1]] <- aquia_map + ggsave(filename = paste0(export_path,origin,'_Aquia.png'), + plot = aquia_map,width=25,height=20) + + ## Includes the saved file + cat(paste0('![](',export_path,origin,'_',aquifer,'.png)')) + + ### Piney Point + aquifer <- 'Piney Point' + + pineypoint_map <- fn_gw_mapgen( + bbox, crs_default, mp_layer, featr_type, + maptitle=paste0(origin_readable," Critical Cells in ", aquifer), + maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, + aquifer_shp = pineypoint, origin_shape) + map_objects[[length(map_objects) + 1]] <- pineypoint_map + ## Piney Point cant have a space in the filename + ggsave(filename = paste0(export_path,origin,'_Piney_Point.png'), + plot = pineypoint_map,width=25,height=20) + + ## Includes the saved file + cat(paste0('![](',export_path,origin,'_Piney_Point.png)')) + + ### Yorktown Eastover + # if (length(potomac_int) > 0 & show_map == TRUE) { + # ## If there is no intersection, then the length of the output is 0, so cant check the value + # #### So it only gets here if there IS intersection + # + # aquifer <- 'Potomac' + # + # potomac_map <- fn_gw_mapgen(bbox, crs_default, mp_layer, featr_type, + # maptitle=paste0(origin_readable," critical cells in ", aquifer), + # maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, + # aquifer_shp = potomac) + # + # } - ## Includes the saved file - cat(paste0('![](',export_path,origin,'_Piney_Point.png)')) + ## Adds a pagebreak IF there are GW maps -### Yorktown Eastover -# if (length(potomac_int) > 0 & show_map == TRUE) { -# ## If there is no intersection, then the length of the output is 0, so cant check the value -# #### So it only gets here if there IS intersection -# -# aquifer <- 'Potomac' -# -# potomac_map <- fn_gw_mapgen(bbox, crs_default, mp_layer, featr_type, -# maptitle=paste0(origin_readable," critical cells in ", aquifer), -# maplabs, nhd, roads, map_style_set, rivmap_ramp=NULL, -# aquifer_shp = potomac) -# -# } - - ## Adds a pagebreak IF there are GW maps + cat("\n\n\\pagebreak\n") + + ## End of GW mapping section + } - cat("\n\n\\pagebreak\n") - - ## End of GW mapping section } - ``` ## Facility Table (Table 1): @@ -977,9 +995,7 @@ if(message_nonexisting_cols){ ```{r Generate Errors Summary, echo=FALSE} #if there are any mapping errors or other messages to the user, output a separate file containing them -allmaps <- grep("gg", eapply(.GlobalEnv, class), value=TRUE) -allmaps <- mget(names(allmaps), .GlobalEnv, mode = "list") -#allmaps = map_objects +allmaps = map_objects maperrors <- data.frame(maptitle=character(0), errors=character(0), mapnum=character(0), var_name=character(0) ) for(i in 1:length(allmaps)){ @@ -987,13 +1003,15 @@ for(i in 1:length(allmaps)){ if (is.null(allmaps[[i]][["mapnum"]])) { allmaps[[i]][["mapnum"]] = 2 } - maperrors <- rbind(maperrors, - data.frame(maptitle = allmaps[[i]][["labels"]][["title"]], - errors = allmaps[[i]][["errors"]], - mapnum = allmaps[[i]][["mapnum"]], - var_name = names(allmaps[i]) - ) - ) + maperrors <- rbind( + maperrors, + data.frame( + maptitle = allmaps[[i]][["labels"]][["title"]], + errors = paste(allmaps[[i]][["errors"]], collapse = " "), + mapnum = allmaps[[i]][["mapnum"]], + var_name = names(allmaps[i]) + ) + ) } }