diff --git a/DESCRIPTION b/DESCRIPTION index 60c2107..b1e70c1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: StreamCatTools Type: Package Title: 'StreamCatTools' -Version: 0.9.1 +Version: 0.10.0 Authors@R: c(person(given = "Marc", family = "Weber", role = c("aut", "cre"), @@ -10,6 +10,10 @@ Authors@R: c(person(given = "Marc", family = "Hill", role = "ctb", email = "hill.ryan@epa.gov"), + person(given = "Selia", + family = "Markley", + role = "ctb", + email = "markley.selia@epa.gov"), person(given = "Travis", family = "Hudson", role = "ctb", @@ -39,10 +43,14 @@ Imports: nhdplusTools, jsonlite, httr2, - curl (>= 6.0.0) + curl (>= 6.0.0), + ggpattern, + patchwork, + cowplot, + tigris, + ggplot2 Suggests: dplyr, - ggplot2, mapview, testthat, knitr, @@ -53,7 +61,9 @@ Suggests: readr, tidyr, stringr, - purrr + purrr, + lifecycle, + tidyselect Encoding: UTF-8 URL: https://usepa.github.io/StreamCatTools/, https://github.com/USEPA/StreamCatTools BugReports: https://github.com/USEPA/StreamCatTools/issues diff --git a/NAMESPACE b/NAMESPACE index 4ac1597..f332a1b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,11 +4,20 @@ export(lc_fullname) export(lc_get_comid) export(lc_get_data) export(lc_get_metric_names) +export(lc_get_nlcd) +export(lc_get_nni) export(lc_get_params) export(lc_nlcd) +export(lc_plotnni) export(sc_fullname) export(sc_get_comid) export(sc_get_data) export(sc_get_metric_names) +export(sc_get_nlcd) +export(sc_get_nni) export(sc_get_params) export(sc_nlcd) +export(sc_plotnni) +import(ggpattern) +import(ggplot2) +importFrom(curl,curl_fetch_memory) diff --git a/NEWS.md b/NEWS.md index dfbce09..40491ca 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,22 @@ +# StreamCatTools 0.10.0 + +- Adds new functions `sc_get_nni()` and `lc_get_nni()` for ease of access to + National Nutrient Inventory data in StreamCat +- Adds new functions `sc_plot()` and `lc_plot` for plotting nitrogen and + phosphorus budgets for watersheds +- Adds a new article describing functions for plotting National Nutrient + Inventory data in StreamCat + +# StreamCatTools 0.9.1 + +- Handles a web service being down in testing using `testthat::skip_on_cran()` +- Converts most vignettes to articles and adds one new `Start Here` vignette +======= # StreamCatTools 0.9.1 - Handles a web service being down in testing using `testthat::skip_on_cran()` - Converts most vignettes to articles and adds one new `Start Here` vignette + # StreamCatTools 0.9.0 diff --git a/R/lc_get_data.R b/R/lc_get_data.R index 4d3200f..e4aec98 100644 --- a/R/lc_get_data.R +++ b/R/lc_get_data.R @@ -171,6 +171,8 @@ lc_get_data <- function(comid = NULL, #' @title Get NLCD Data #' #' @description +#' `r lifecycle::badge("deprecated")` +#' `lc_nlcd()` was renamed to `lc_get_nlcd()` to create a more consistent API. #' Function to specifically retrieve all NLCD metrics for a given year using the StreamCat API. #' #' @author @@ -205,23 +207,32 @@ lc_get_data <- function(comid = NULL, #' @examples #' \dontrun{ #' -#' df <- lc_nlcd(comid='23783629', year='2019', aoi='ws') -#' -#' df <- lc_nlcd(year='2016', aoi='cat', +#' df <- lc_nlcd(comid='23783629', year='2019', aoi='ws') # Will show a deprecation warning +#' +#' df <- lc_get_nlcd(comid='23783629', year='2019', aoi='ws') +#' +#' df <- lc_get_nlcd(year='2016', aoi='cat', #' comid='23783629,23794487,23812618', showAreaSqKm=FALSE, showPctFull=TRUE) #' -#' df <- lc_nlcd(year='2016', aoi='cat', +#' df <- lc_get_nlcd(year='2016', aoi='cat', #' comid='23783629,23794487,23812618', countOnly=TRUE) #' -#' df <- lc_nlcd(year='2016, 2019', aoi='cat,ws', +#' df <- lc_get_nlcd(year='2016, 2019', aoi='cat,ws', #' comid='23783629,23794487,23812618') #' } #' @export -lc_nlcd <- function(year = '2019', aoi = NULL, comid = NULL, - showAreaSqKm = NULL, showPctFull = NULL, - countOnly = NULL) { +lc_get_nlcd <- function(year = '2019', + comid = NULL, + aoi = NULL, + showAreaSqKm = NULL, + showPctFull = NULL, + state = NULL, + county = NULL, + region = NULL, + conus = NULL, + countOnly = NULL) { # year must be a character string. year_chr <- as.character(year) # split multiple years supplied as a single string into @@ -282,3 +293,184 @@ lc_nlcd <- function(year = '2019', aoi = NULL, comid = NULL, # End of function. Return a data frame. return(final_df) } + +#' @rdname lc_get_nlcd +#' @export +#' @keywords internal +lc_nlcd <- function(year = '2019', + comid = NULL, + aoi = NULL, + showAreaSqKm = NULL, + showPctFull = NULL, + state = NULL, + county = NULL, + region = NULL, + conus = NULL, + countOnly = NULL) { + lifecycle::deprecate_warn("0.10.0", "lc_nlcd()", "lc_get_nlcd()") + lc_get_nlcd(year = '2019', + comid = NULL, + aoi = NULL, + showAreaSqKm = NULL, + showPctFull = NULL, + state = NULL, + county = NULL, + region = NULL, + conus = NULL, + countOnly = NULL) +} + +#' @title Get NNI +#' +#' @description +#' Function to get all NNI data available for a given year. +#' +#' @author +#' Selia Markley +#' +#' @param year Years(s) of NNI metrics to query. +#' Only valid NNI years are accepted (1987:2017) +#' Syntax: year=, +#' +#' @param aoi Specify the area of interest described by a metric. By default, all available areas of interest +#' for a given metric are returned. +#' Syntax: areaOfInterest=, +#' Values: catchment|watershed +#' +#' @param comid Return metric information for specific COMIDs +#' Syntax: comid=, +#' +#' @param showAreaSqKm Return the area in square kilometers of a given area of interest. +#' The default value is true. +#' Values: true|false +#' +#' @param showPctFull Return the pctfull for each dataset. The default value is false. +#' Values: true|false +#' +#' @param countOnly Return a CSV containing only the row count (ROWCOUNT) and the column +#' count (COLUMNCOUNT) that the server expects to return in a request. The default value is false. +#' Values: true|false +#' +#' @return A tibble of desired StreamCat metrics +#' @export +#' +#' @examples\donttest{ +#' df <- lc_get_nni(year='1987, 1990, 2005, 2017', aoi='cat,ws', +#' comid='23783629,23794487,23812618') +#' +#' df <- lc_get_nni(year='2015', aoi='cat', +#' comid='23783629', countOnly=TRUE) +#' +#' df <- lc_get_nni(comid='23783629', year='2011, 2012', aoi='ws') +#' } + +lc_get_nni <- function(year, aoi = NULL, comid = NULL, + showAreaSqKm = TRUE, showPctFull = NULL, + countOnly = NULL) { + # year must be a character string. + year_chr <- as.character(year) + # split multiple years supplied as a single string into + # a vector of years. + year_vec <- unlist(strsplit(x = year_chr, + split = ",|, ")) + # Vector of valid NNI years to check inputs against. + valid_years <- c('1987', + '1988', + '1989', + '1990', + '1991', + '1992', + '1993', + '1994', + '1995', + '1996', + '1997', + '1998', + '1999', + '2000', + '2001', + '2002', + '2003', + '2004', + '2005', + '2006', + '2007', + '2008', + '2009', + '2010', + '2011', + '2012', + '2013', + '2014', + '2015', + '2016', + '2017') + # Stop early if any of the year(s) supplied are not found in the valid + # years vec. + stopifnot( + "year must be a valid NNI year" = any(year_vec %in% valid_years) + ) + # Vector of NNI metric names. + nni <- c( + 'n_leg_', + 'n_ags_', + 'n_ff_', + 'n_uf_', + 'n_cf_', + 'n_cr_', + 'n_hw_', + 'n_lw_', + 'p_leg_', + 'p_ags_', + 'p_ff_', + 'p_uf_', + 'p_cr_', + 'p_hw_', + 'p_lw_' + ) + # Add n_dep for available years + ndep_year_vec <- year_vec[!year_vec %in% c('1987', '1988', '1989')] + ndep_comb <- expand.grid('n_dep_', ndep_year_vec) + ndep_mets <- paste0(ndep_comb$Var1, + ndep_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Add p_dep for available years + pdep_year_vec <- year_vec[!year_vec %in% c('1987', '1988', '1989', '1990', '1991', '1992', '1993', '1994', '1995', '1996', + '2014', '2015', '2016', '2017')] + pdep_comb <- expand.grid('p_dep_', pdep_year_vec) + pdep_mets <- paste0(pdep_comb$Var1, + pdep_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Add n_usgsww and p_usgsww for available years + ww_year_vec <- year_vec[year_vec %in% c('1988', '1990', '1992', '1996', '2000', '2004', '2008', '2012')] + ww_comb <- expand.grid(c('p_usgsww_', 'n_usgsww_'), ww_year_vec) + ww_mets <- paste0(ww_comb$Var1, + ww_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Create a data frame of all NNI Metric and year combinations. + all_comb <- expand.grid(nni, year_vec) + # Concatenate the NLCD metric name with the supplied year(s) to create + # valid metric names to submit to the API. + nni_mets <- paste0(all_comb$Var1, + all_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Combine all NNI metrics + nni_mets_all <- paste0(nni_mets, ",", ndep_mets, ",", pdep_mets, ",", ww_mets) + + # Query the API. + final_df <- lc_get_data( + metric = nni_mets_all, + aoi = aoi, + comid = comid, + showAreaSqKm = showAreaSqKm, + showPctFull = showPctFull, + countOnly = countOnly + ) + # End of function. Return a data frame. + return(final_df) +} + diff --git a/R/lc_plot.R b/R/lc_plot.R new file mode 100644 index 0000000..a1d6346 --- /dev/null +++ b/R/lc_plot.R @@ -0,0 +1,334 @@ +#' Plot National Nutrient Inventory data for lakes +#' +#' @description +#' Function to plot time series of nitrogen and phosphorus budgets for a given lake +#' COMID. This function allows a user to return a time series of major inputs, +#' outputs, and derived metrics of nitrogen and phosphorus. Plot is returned as an +#' object +#' +#' @author +#' Selia Markley +#' +#' @param comid Identifier of lake COMID user wants to plot NNI data for. Must be a character string +#' with the COMID digit. +#' Syntax: com= +#' +#' @param include.nue Include time series of nitrogen use efficiency in the returned plot. +#' The default value is false. +#' Values: true|false +#' +#' @return +#' Return plot as an object. +#' @export +#' +#' @examples +#' \dontrun{ +#' p <- lc_plotnni(comid='23794487') +#' p <- lc_plotnni(comid='23794487', include.nue=TRUE) +#' } + +lc_plotnni <- function(comid, include.nue = FALSE){ + + # Get StreamCat data + nni <- lc_get_data(metric = 'n_dep_1990,n_ff_1990,n_uf_1990,n_lw_1990,n_hw_1990,n_ags_1990,n_cf_1990,n_cr_1990,p_cr_1990,p_lw_1990,p_hw_1990,p_uf_1990,p_ff_1990,p_ags_1990,n_dep_1991,n_ff_1991,n_uf_1991,n_lw_1991,n_hw_1991,n_ags_1991,n_cf_1991,n_cr_1991,p_cr_1991,p_lw_1991,p_hw_1991,p_uf_1991,p_ff_1991,p_ags_1991,n_dep_1992,n_ff_1992,n_uf_1992,n_lw_1992,n_hw_1992,n_ags_1992,n_cf_1992,n_cr_1992,p_cr_1992,p_lw_1992,p_hw_1992,p_uf_1992,p_ff_1992,p_ags_1992,n_dep_1993,n_ff_1993,n_uf_1993,n_lw_1993,n_hw_1993,n_ags_1993,n_cf_1993,n_cr_1993,p_cr_1993,p_lw_1993,p_hw_1993,p_uf_1993,p_ff_1993,p_ags_1993,n_dep_1994,n_ff_1994,n_uf_1994,n_lw_1994,n_hw_1994,n_ags_1994,n_cf_1994,n_cr_1994,p_cr_1994,p_lw_1994,p_hw_1994,p_uf_1994,p_ff_1994,p_ags_1994,n_dep_1995,n_ff_1995,n_uf_1995,n_lw_1995,n_hw_1995,n_ags_1995,n_cf_1995,n_cr_1995,p_cr_1995,p_lw_1995,p_hw_1995,p_uf_1995,p_ff_1995,p_ags_1995,n_dep_1996,n_ff_1996,n_uf_1996,n_lw_1996,n_hw_1996,n_ags_1996,n_cf_1996,n_cr_1996,p_cr_1996,p_lw_1996,p_hw_1996,p_uf_1996,p_ff_1996,p_ags_1996,n_dep_1997,n_ff_1997,n_uf_1997,n_lw_1997,n_hw_1997,n_ags_1997,n_cf_1997,n_cr_1997,p_cr_1997,p_lw_1997,p_hw_1997,p_uf_1997,p_ff_1997,p_ags_1997,n_dep_1998,n_ff_1998,n_uf_1998,n_lw_1998,n_hw_1998,n_ags_1998,n_cf_1998,n_cr_1998,p_cr_1998,p_lw_1998,p_hw_1998,p_uf_1998,p_ff_1998,p_ags_1998,n_dep_1999,n_ff_1999,n_uf_1999,n_lw_1999,n_hw_1999,n_ags_1999,n_cf_1999,n_cr_1999,p_cr_1999,p_lw_1999,p_hw_1999,p_uf_1999,p_ff_1999,p_ags_1999,n_dep_2000,n_ff_2000,n_uf_2000,n_lw_2000,n_hw_2000,n_ags_2000,n_cf_2000,n_cr_2000,p_cr_2000,p_lw_2000,p_hw_2000,p_uf_2000,p_ff_2000,p_ags_2000,n_dep_2001,n_ff_2001,n_uf_2001,n_lw_2001,n_hw_2001,n_ags_2001,n_cf_2001,n_cr_2001,p_cr_2001,p_lw_2001,p_hw_2001,p_uf_2001,p_ff_2001,p_ags_2001,n_dep_2002,n_ff_2002,n_uf_2002,n_lw_2002,n_hw_2002,n_ags_2002,n_cf_2002,n_cr_2002,p_cr_2002,p_lw_2002,p_hw_2002,p_uf_2002,p_ff_2002,p_ags_2002,n_dep_2003,n_ff_2003,n_uf_2003,n_lw_2003,n_hw_2003,n_ags_2003,n_cf_2003,n_cr_2003,p_cr_2003,p_lw_2003,p_hw_2003,p_uf_2003,p_ff_2003,p_ags_2003,n_dep_2004,n_ff_2004,n_uf_2004,n_lw_2004,n_hw_2004,n_ags_2004,n_cf_2004,n_cr_2004,p_cr_2004,p_lw_2004,p_hw_2004,p_uf_2004,p_ff_2004,p_ags_2004,n_dep_2005,n_ff_2005,n_uf_2005,n_lw_2005,n_hw_2005,n_ags_2005,n_cf_2005,n_cr_2005,p_cr_2005,p_lw_2005,p_hw_2005,p_uf_2005,p_ff_2005,p_ags_2005,n_dep_2006,n_ff_2006,n_uf_2006,n_lw_2006,n_hw_2006,n_ags_2006,n_cf_2006,n_cr_2006,p_cr_2006,p_lw_2006,p_hw_2006,p_uf_2006,p_ff_2006,p_ags_2006,n_dep_2007,n_ff_2007,n_uf_2007,n_lw_2007,n_hw_2007,n_ags_2007,n_cf_2007,n_cr_2007,p_cr_2007,p_lw_2007,p_hw_2007,p_uf_2007,p_ff_2007,p_ags_2007,n_dep_2008,n_ff_2008,n_uf_2008,n_lw_2008,n_hw_2008,n_ags_2008,n_cf_2008,n_cr_2008,p_cr_2008,p_lw_2008,p_hw_2008,p_uf_2008,p_ff_2008,p_ags_2008,n_dep_2009,n_ff_2009,n_uf_2009,n_lw_2009,n_hw_2009,n_ags_2009,n_cf_2009,n_cr_2009,p_cr_2009,p_lw_2009,p_hw_2009,p_uf_2009,p_ff_2009,p_ags_2009,n_dep_2010,n_ff_2010,n_uf_2010,n_lw_2010,n_hw_2010,n_ags_2010,n_cf_2010,n_cr_2010,p_cr_2010,p_lw_2010,p_hw_2010,p_uf_2010,p_ff_2010,p_ags_2010,n_dep_2011,n_ff_2011,n_uf_2011,n_lw_2011,n_hw_2011,n_ags_2011,n_cf_2011,n_cr_2011,p_cr_2011,p_lw_2011,p_hw_2011,p_uf_2011,p_ff_2011,p_ags_2011,n_dep_2012,n_ff_2012,n_uf_2012,n_lw_2012,n_hw_2012,n_ags_2012,n_cf_2012,n_cr_2012,p_cr_2012,p_lw_2012,p_hw_2012,p_uf_2012,p_ff_2012,p_ags_2012,n_dep_2013,n_ff_2013,n_uf_2013,n_lw_2013,n_hw_2013,n_ags_2013,n_cf_2013,n_cr_2013,p_cr_2013,p_lw_2013,p_hw_2013,p_uf_2013,p_ff_2013,p_ags_2013,n_dep_2014,n_ff_2014,n_uf_2014,n_lw_2014,n_hw_2014,n_ags_2014,n_cf_2014,n_cr_2014,p_cr_2014,p_lw_2014,p_hw_2014,p_uf_2014,p_ff_2014,p_ags_2014,n_dep_2015,n_ff_2015,n_uf_2015,n_lw_2015,n_hw_2015,n_ags_2015,n_cf_2015,n_cr_2015,p_cr_2015,p_lw_2015,p_hw_2015,p_uf_2015,p_ff_2015,p_ags_2015,n_dep_2016,n_ff_2016,n_uf_2016,n_lw_2016,n_hw_2016,n_ags_2016,n_cf_2016,n_cr_2016,p_cr_2016,p_lw_2016,p_hw_2016,p_uf_2016,p_ff_2016,p_ags_2016,n_dep_2017,n_ff_2017,n_uf_2017,n_lw_2017,n_hw_2017,n_ags_2017,n_cf_2017,n_cr_2017,p_cr_2017,p_lw_2017,p_hw_2017,p_uf_2017,p_ff_2017,p_ags_2017', + aoi='ws', + comid = comid, + showAreaSqKm = FALSE, + showPctFull = FALSE) + + # Declare NULL metrics created w/in function + year <- NULL + value <- NULL + ags <- NULL + cr <- NULL + totag <- NULL + metric <- NULL + estimated <- NULL + + # Create N inputs df + nin <- nni[, grepl("^(n)", names(nni)) & !grepl("(cr)", names(nni)) & !grepl("(ags)", names(nni))] + + names(nin) <- sapply(names(nin), function(col){ + substr(col, 3, nchar(col) -2) + }) + + nin <- nin |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric", "year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) + + #Create P inputs df + + pin <- nni[, grepl("^(p)", names(nni)) & !grepl("(cr)", names(nni)) & !grepl("(ags)", names(nni))] + + names(pin) <- sapply(names(pin), function(col){ + substr(col, 3, nchar(col) -2) + }) + + pin <- pin |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric", "year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) + + #Create N dfs for lines (cr, agsur, nue) + + nlines <- nni[, grepl("^n_cr|^n_ags", names(nni))] + + names(nlines) <- sapply(names(nlines), function(col){ + substr(col, 3, nchar(col) -2) + }) + + nlines <- nlines |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric","year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) |> + tidyr::pivot_wider( + names_from = 'metric', + values_from = 'value' + ) |> + dplyr::mutate(totag = ags + cr) |> + dplyr::mutate(nue = (cr / totag) * 100) |> + tidyr::pivot_longer( + cols = !year, + names_to="metric", + values_to="value") + + ncrag <- nlines |> + dplyr::filter(metric %in% c('ags', 'cr')) + + nue <- nlines |> + dplyr::filter(metric == 'nue') |> + tidyr::pivot_wider(names_from = 'metric', + values_from = 'value') + + #Create P dfs for lines (cr, agsur, pue) + + plines <- nni[, grepl("^p_cr|^p_ags", names(nni))] + + names(plines) <- sapply(names(plines), function(col){ + substr(col, 3, nchar(col) -2) + }) + + + plines <- plines |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric","year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) |> + tidyr::pivot_wider( + names_from = 'metric', + values_from = 'value' + ) |> + dplyr::mutate(totag = ags + cr) |> + dplyr::mutate(nue = (cr / totag) * 100) |> + tidyr::pivot_longer( + cols = !year, + names_to="metric", + values_to="value") + + pcrag <- plines |> + dplyr::filter(metric %in% c('ags', 'cr')) + + pue <- plines |> + dplyr::filter(metric == 'nue') |> + tidyr::pivot_wider(names_from = 'metric', + values_from = 'value') + + pdf <- dplyr::bind_rows(plines, pin) + + ndf <- dplyr::bind_rows(nlines, nin) + + #create estimate column + knownfertyrs <- c(1987,1988,1989,1990,1991,1992,1993,1994,1995,1996,1997,1998,1999,2000,2001,2002,2003,2004, + 2005,2006,2007,2008,2009,2010,2011,2012,2017) + nwsin <- nin |> + dplyr::mutate(estimated=dplyr::case_when( + metric == "dep" ~ FALSE, + metric == "hw" ~ FALSE, + metric == "cf" & year %in% c(1987,1992,1997,2002,2007,2012, 2017) ~ FALSE, + metric == "ff" & year %in% knownfertyrs ~ FALSE, + metric == "uf" & year %in% knownfertyrs ~ FALSE, + metric == "lw" & year %in% c(1987,1992,1997,2002,2007,2012,2017) ~ FALSE, + TRUE ~ TRUE + )) + + pwsin <- pin |> + dplyr::filter(metric != 'cr') |> + dplyr::mutate(estimated=dplyr::case_when( + metric == "hw" ~ FALSE, + metric == "lw" & year %in% c(1987,1992,1997,2002,2007,2012,2017) ~ FALSE, + metric == "ff" & year %in% knownfertyrs ~ FALSE, + metric == "uf" & year %in% knownfertyrs ~ FALSE, + TRUE ~ TRUE + )) + + #get ready for plot + colorsn <- c('ff' = '#A3CC51', 'lw'='#B26F2C','hw'='#E51932','uf'='black', 'dep'='#6db6ff', 'cf'='#FFD700') + colorsp <- c('ff' = '#A3CC51', 'lw'='#B26F2C','hw'='#E51932','uf'='black') + + nwsin$metric <- factor(nwsin$metric, levels = c('uf','hw','dep','lw','cf','ff')) + pwsin$metric <- factor(pwsin$metric, levels = c('uf','hw','lw','ff')) + + + #create titles with higher level include.nue param + if (include.nue == TRUE){ + nbartitle <- 'b)' + pbartitle <- 'd)' + nuetitle <- 'a)' + puetitle <- 'c)' + } else{ + nbartitle <- 'a)' + pbartitle <- 'b)' + nuetitle <- ' ' + puetitle <- ' ' + } + + #create N bar plot + nbar <- ggplot() + + ggpattern::geom_bar_pattern(data = nwsin, + aes(x=year,y=value, fill=metric, + pattern=factor(estimated, levels=c(TRUE,FALSE), + labels=c('Estimated','Non-Estimated'))), + pattern = ifelse(nwsin$estimated, 'stripe','none'), + pattern_color='white', + pattern_density=0.05, + pattern_fill = 'white', + pattern_alpha = 0.5, + pattern_spacing=0.025, + stat='identity', position='stack', + pattern_size=0.05) + + labs(title = 'Nitrogen (million kg)', + y = "Budget", + x = " ") + + scale_fill_manual(values=colorsn, + labels = c('ff' = 'Farm Fertilizer', + 'uf' = 'Urban Fertilizer', + 'cf' = 'Crop N-Fixation', + 'lw' = 'Livestock Manure', + 'hw' = 'Human Waste', + 'dep' = 'Total Deposition')) + + scale_pattern_manual(name='Estimate Status', + values=c('Estimated'='stripe','Non-estimated'='none')) + + geom_line(data=ncrag, + aes(x=year,y=value, linetype=metric), + linewidth=1.25, color="black") + + scale_linetype_manual(values = + c("ags"="solid", "cr"="dotted"), + labels = c('ags' = 'Agricultural Surplus', + 'cr' = 'Crop Removal')) + + guides(fill= + guide_legend(order=1, override.aes = list(pattern='none')), + pattern= + guide_legend(order=2, override.aes = list(fill='grey')), + linetype= + guide_legend(title=NULL)) + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + scale_color_manual(values=c("Agricultural Surplus"="black"), + guide = 'none') + + theme_bw() + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.y = element_text(size=9), + legend.background = element_rect(fill="white", colour = "black"), + legend.title = element_blank()) + + #create p bar plot + pbar <- ggplot() + + ggpattern::geom_bar_pattern(data = pwsin, + aes(x=year,y=value, fill=metric, + pattern=factor(estimated, levels=c(TRUE,FALSE), + labels=c('Estimated','Non-Estimated'))), + pattern = ifelse(pwsin$estimated, 'stripe','none'), + pattern_color='white', + pattern_density=0.05, + pattern_fill = 'white', + pattern_alpha = 0.5, + pattern_spacing=0.025, + stat='identity', position='stack', pattern_size=0.05) + + labs(title = 'Phosphorus (million kg)', + y = "Budget", + x = " ") + + scale_fill_manual(values=colorsp) + + scale_pattern_manual(name='Estimate Status', + values=c('Estimated'='stripe', + 'Non-estimated'='none')) + + geom_line(data=pcrag, + aes(x=year,y=value, + linetype=metric), + linewidth=1.25, color="black") + + scale_linetype_manual(values = + c("ags"="solid", "cr"="dotted")) + + guides(fill= + guide_legend(order=1, override.aes = list(pattern='none')), + pattern= + guide_legend(order=2, override.aes = list(fill='grey')), + linetype= + guide_legend(title=NULL)) + + guides(fill="none", pattern = "none", linetype="none") + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + scale_color_manual(values=c("Agricultural Surplus"="black"), + guide = 'none') + + theme_bw() + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.y = element_text(size=9), + legend.background = element_rect(fill="white", colour = "black"), + legend.title = element_blank()) + + #create nue line plots + nue <- ggplot() + + geom_line(data=nue, aes(x=year,y=nue), linewidth=1.25, color='seagreen')+ + theme_bw() + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + labs(title = 'Nitrogen Use Efficiency', + y = "%", + x=" ") + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.x = element_text(size=9), + axis.title.y = element_text(size=9)) + + pue <- ggplot() + + geom_line(data=pue, aes(x=year,y=nue, lty='Nutrient Use Efficiency'), linewidth=1.25, color="seagreen") + + theme_bw() + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + labs(title = 'Phosphorus Use Efficiency', + y = "%", + x="Year") + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.x = element_text(size=9), + axis.title.y = element_text(size=9, hjust=0.5), + legend.background = element_rect(fill="white", colour = "black"), + legend.title = element_blank()) + + guides(fill="none", pattern = "none", linetype="none") + + #export final figure + inputs <- patchwork::wrap_plots(nbar, pbar, ncol=1, guides="collect") + nue <- patchwork::wrap_plots(nue, pue, ncol=1, guides="collect") + + if (include.nue == TRUE){ + timenni <- patchwork::wrap_plots(nue, inputs, ncol=2) + } + else { + timenni <- inputs + } + + return(timenni) + +} diff --git a/R/sc_get_data.R b/R/sc_get_data.R index 906be8f..4be402d 100644 --- a/R/sc_get_data.R +++ b/R/sc_get_data.R @@ -188,8 +188,11 @@ sc_get_data <- function(comid = NULL, #' @title Get NLCD Data #' #' @description +#' `r lifecycle::badge("deprecated")` +#' `sc_nlcd()` was renamed to `sc_get_nlcd()` to create a more consistent API. #' Function to retrieve all NLCD metrics for a given year using the StreamCat API. #' +#' #' @author #' Marc Weber #' @@ -236,22 +239,25 @@ sc_get_data <- function(comid = NULL, #' #' @examples #' \dontrun{ -#' df <- sc_nlcd(year='2001', aoi='cat',comid='179,1337,1337420') +#' +#' df <- sc_nlcd(year='2001', aoi='cat',comid='179') # Will show a deprecation warning +#' +#' df <- sc_get_nlcd(year='2001', aoi='cat',comid='179,1337,1337420') #' -#' df <- sc_nlcd(year='2001', aoi='ws', region='Region01') +#' df <- sc_get_nlcd(year='2001', aoi='ws', region='Region01') #' -#' df <- sc_nlcd(year='2001', aoi='ws', region='Region01', +#' df <- sc_get_nlcd(year='2001', aoi='ws', region='Region01', #' countOnly=TRUE) #' #' df <- sc_nlcd(year='2001', aoi='ws', region='Region01', #' showAreaSqKm=FALSE, showPctFull=TRUE) #' -#' df <- sc_nlcd(year='2001, 2006', aoi='cat,ws', +#' df <- sc_get_nlcd(year='2001, 2006', aoi='cat,ws', #' comid='179,1337,1337420') #' } #' @export -sc_nlcd <- function(year = '2019', +sc_get_nlcd <- function(year = '2019', comid = NULL, aoi = NULL, showAreaSqKm = NULL, @@ -326,6 +332,208 @@ sc_nlcd <- function(year = '2019', return(final_df) } -ignore_unused_imports <- function() { - curl::curl_parse_url() +#' @rdname sc_get_nlcd +#' @export +#' @keywords internal +sc_nlcd <- function(year = '2019', + comid = NULL, + aoi = NULL, + showAreaSqKm = NULL, + showPctFull = NULL, + state = NULL, + county = NULL, + region = NULL, + conus = NULL, + countOnly = NULL) { + lifecycle::deprecate_warn("0.10.0", "sc_nlcd()", "sc_get_nlcd()") + sc_get_nlcd(year = '2019', + comid = NULL, + aoi = NULL, + showAreaSqKm = NULL, + showPctFull = NULL, + state = NULL, + county = NULL, + region = NULL, + conus = NULL, + countOnly = NULL) +} + +#' @title Get NNI +#' +#' @description +#' Function to get all NNI data available for a given year. +#' +#' @author +#' Selia Markley +#' +#' @param year Years(s) of NNI metrics to query. +#' Only valid NNI years are accepted (1987:2017) +#' Syntax: year=, +#' +#' @param aoi Specify the area of interest described by a metric. By default, all available areas of interest +#' for a given metric are returned. +#' Syntax: areaOfInterest=, +#' Values: catchment|watershed +#' +#' @param comid Return metric information for specific COMIDs +#' Syntax: comid=, +#' +##' @param state Return metric information for COMIDs within a specific state. Use a state's abbreviation to +#' query for a given state. +#' Syntax: state=, +#' +#' @param county Return metric information for COMIDs within a specific county. +#' Users must use the FIPS code, not county name, as a way to disambiguate counties. +#' Syntax: county=, +#' +#' @param region Return metric information for COMIDs within a specified hydroregion. +#' Syntax: region=, +#' +#' @param conus Return all COMIDs in the conterminous United States. +#' The default value is false. +#' Values: true|false +#' +#' @param showAreaSqKm Return the area in square kilometers of a given area of interest. +#' The default value is true. +#' Values: true|false +#' +#' @param showPctFull Return the pctfull for each dataset. The default value is false. +#' Values: true|false +#' +#' @param countOnly Return a CSV containing only the row count (ROWCOUNT) and the column +#' count (COLUMNCOUNT) that the server expects to return in a request. The default value is false. +#' Values: true|false +#' +#' @return A tibble of desired StreamCat metrics +#' +#' @examples +#' \dontrun{ +#' +#' df <- sc_get_nni(year='1987, 1990, 2005, 2017', aoi='cat,ws', +#' comid='179,1337,1337420') +#' +#' df <- sc_get_nni(year='2015', aoi='cat', +#' comid='179', countOnly=TRUE) +#' +#' df <- sc_get_nni(comid='179', year='2011, 2012', aoi='ws') +#' +#' df <- sc_get_nni(year='2015, 2016, 2017', county='41003', aoi='ws') +#' } +#' @export + +sc_get_nni <- function(year, aoi = NULL, comid = NULL, + showAreaSqKm = TRUE, state = NULL, + county = NULL, region = NULL,conus = NULL, + showPctFull = NULL,countOnly = NULL) { + # year must be a character string. + year_chr <- as.character(year) + # split multiple years supplied as a single string into + # a vector of years. + year_vec <- unlist(strsplit(x = year_chr, + split = ",|, ")) + # Vector of valid NNI years to check inputs against. + valid_years <- c('1987', + '1988', + '1989', + '1990', + '1991', + '1992', + '1993', + '1994', + '1995', + '1996', + '1997', + '1998', + '1999', + '2000', + '2001', + '2002', + '2003', + '2004', + '2005', + '2006', + '2007', + '2008', + '2009', + '2010', + '2011', + '2012', + '2013', + '2014', + '2015', + '2016', + '2017') + # Stop early if any of the year(s) supplied are not found in the valid + # years vec. + stopifnot( + "year must be a valid NNI year" = any(year_vec %in% valid_years) + ) + # Vector of NNI metric names. + nni <- c( + 'n_leg_', + 'n_ags_', + 'n_ff_', + 'n_uf_', + 'n_cf_', + 'n_cr_', + 'n_hw_', + 'n_lw_', + 'p_leg_', + 'p_ags_', + 'p_ff_', + 'p_uf_', + 'p_cr_', + 'p_hw_', + 'p_lw_' + ) + # Add n_dep for available years + ndep_year_vec <- year_vec[!year_vec %in% c('1987', '1988', '1989')] + ndep_comb <- expand.grid('n_dep_', ndep_year_vec) + ndep_mets <- paste0(ndep_comb$Var1, + ndep_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Add p_dep for available years + pdep_year_vec <- year_vec[!year_vec %in% c('1987', '1988', '1989', '1990', '1991', '1992', '1993', '1994', '1995', '1996', + '2014', '2015', '2016', '2017')] + pdep_comb <- expand.grid('p_dep_', pdep_year_vec) + pdep_mets <- paste0(pdep_comb$Var1, + pdep_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Add n_usgsww and p_usgsww for available years + ww_year_vec <- year_vec[year_vec %in% c('1988', '1990', '1992', '1996', '2000', '2004', '2008', '2012')] + ww_comb <- expand.grid(c('p_usgsww_', 'n_usgsww_'), ww_year_vec) + ww_mets <- paste0(ww_comb$Var1, + ww_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Create a data frame of all NNI Metric and year combinations. + all_comb <- expand.grid(nni, year_vec) + # Concatenate the NLCD metric name with the supplied year(s) to create + # valid metric names to submit to the API. + nni_mets <- paste0(all_comb$Var1, + all_comb$Var2, + collapse = ",", + recycle0 = TRUE) + # Combine all NNI metrics + nni_mets_all <- paste0(nni_mets, ",", ndep_mets, ",", pdep_mets, ",", ww_mets) + + # Query the API. + final_df <- sc_get_data( + metric = nni_mets_all, + aoi = aoi, + comid = comid, + state = state, + county = county, + showAreaSqKm = showAreaSqKm, + showPctFull = showPctFull, + conus = conus, + countOnly = countOnly + ) + # End of function. Return a data frame + return(final_df) } + +#' @importFrom curl curl_fetch_memory +NULL diff --git a/R/sc_plot.R b/R/sc_plot.R new file mode 100644 index 0000000..59ee018 --- /dev/null +++ b/R/sc_plot.R @@ -0,0 +1,355 @@ +#' @title Plot National Nutrient Inventory data for streams +#' +#' @description +#' Function to plot time series of nitrogen and phosphorus budgets for a given stream +#' COMID. This function allows a user to return a time series of major inputs, +#' outputs, and derived metrics of nitrogen and phosphorus. Plot is returned as an +#' object +#' +#' @author +#' Selia Markley +#' +#' @param comid Identifier of stream COMID user wants to plot NNI data for. Must be a character string +#' with the COMID digit. +#' Syntax: com= +#' +#' @param include.nue Include time series of nitrogen use efficiency in the returned plot. +#' The default value is false. +#' Values: true|false +#' +#' @param include.inset Include inset map that shows the location of the COMID and its basin. +#' The default value is true. +#' Values: true|false +#' +#' @return +#' Return plot as an object. +#' @export +#' +#' @import ggplot2 +#' @import ggpattern +#' +#' @examples +#' \dontrun{ +#' p <- sc_plotnni(comid='1337420') +#' p <- sc_plotnni(comid='1337420', include.nue=TRUE) +#' p <- sc_plotnni(comid='1337420', include.inset=FALSE) +#' } + + +sc_plotnni <- function(comid, include.nue = FALSE, include.inset = TRUE){ + message("If the plot does not render to the plot window when calling the function either save the plot or resize the plot window") + # Get StreamCat data + nni <- sc_get_data(metric = 'n_dep_1990,n_ff_1990,n_uf_1990,n_lw_1990,n_hw_1990,n_ags_1990,n_cf_1990,n_cr_1990,p_cr_1990,p_lw_1990,p_hw_1990,p_uf_1990,p_ff_1990,p_ags_1990,n_dep_1991,n_ff_1991,n_uf_1991,n_lw_1991,n_hw_1991,n_ags_1991,n_cf_1991,n_cr_1991,p_cr_1991,p_lw_1991,p_hw_1991,p_uf_1991,p_ff_1991,p_ags_1991,n_dep_1992,n_ff_1992,n_uf_1992,n_lw_1992,n_hw_1992,n_ags_1992,n_cf_1992,n_cr_1992,p_cr_1992,p_lw_1992,p_hw_1992,p_uf_1992,p_ff_1992,p_ags_1992,n_dep_1993,n_ff_1993,n_uf_1993,n_lw_1993,n_hw_1993,n_ags_1993,n_cf_1993,n_cr_1993,p_cr_1993,p_lw_1993,p_hw_1993,p_uf_1993,p_ff_1993,p_ags_1993,n_dep_1994,n_ff_1994,n_uf_1994,n_lw_1994,n_hw_1994,n_ags_1994,n_cf_1994,n_cr_1994,p_cr_1994,p_lw_1994,p_hw_1994,p_uf_1994,p_ff_1994,p_ags_1994,n_dep_1995,n_ff_1995,n_uf_1995,n_lw_1995,n_hw_1995,n_ags_1995,n_cf_1995,n_cr_1995,p_cr_1995,p_lw_1995,p_hw_1995,p_uf_1995,p_ff_1995,p_ags_1995,n_dep_1996,n_ff_1996,n_uf_1996,n_lw_1996,n_hw_1996,n_ags_1996,n_cf_1996,n_cr_1996,p_cr_1996,p_lw_1996,p_hw_1996,p_uf_1996,p_ff_1996,p_ags_1996,n_dep_1997,n_ff_1997,n_uf_1997,n_lw_1997,n_hw_1997,n_ags_1997,n_cf_1997,n_cr_1997,p_cr_1997,p_lw_1997,p_hw_1997,p_uf_1997,p_ff_1997,p_ags_1997,n_dep_1998,n_ff_1998,n_uf_1998,n_lw_1998,n_hw_1998,n_ags_1998,n_cf_1998,n_cr_1998,p_cr_1998,p_lw_1998,p_hw_1998,p_uf_1998,p_ff_1998,p_ags_1998,n_dep_1999,n_ff_1999,n_uf_1999,n_lw_1999,n_hw_1999,n_ags_1999,n_cf_1999,n_cr_1999,p_cr_1999,p_lw_1999,p_hw_1999,p_uf_1999,p_ff_1999,p_ags_1999,n_dep_2000,n_ff_2000,n_uf_2000,n_lw_2000,n_hw_2000,n_ags_2000,n_cf_2000,n_cr_2000,p_cr_2000,p_lw_2000,p_hw_2000,p_uf_2000,p_ff_2000,p_ags_2000,n_dep_2001,n_ff_2001,n_uf_2001,n_lw_2001,n_hw_2001,n_ags_2001,n_cf_2001,n_cr_2001,p_cr_2001,p_lw_2001,p_hw_2001,p_uf_2001,p_ff_2001,p_ags_2001,n_dep_2002,n_ff_2002,n_uf_2002,n_lw_2002,n_hw_2002,n_ags_2002,n_cf_2002,n_cr_2002,p_cr_2002,p_lw_2002,p_hw_2002,p_uf_2002,p_ff_2002,p_ags_2002,n_dep_2003,n_ff_2003,n_uf_2003,n_lw_2003,n_hw_2003,n_ags_2003,n_cf_2003,n_cr_2003,p_cr_2003,p_lw_2003,p_hw_2003,p_uf_2003,p_ff_2003,p_ags_2003,n_dep_2004,n_ff_2004,n_uf_2004,n_lw_2004,n_hw_2004,n_ags_2004,n_cf_2004,n_cr_2004,p_cr_2004,p_lw_2004,p_hw_2004,p_uf_2004,p_ff_2004,p_ags_2004,n_dep_2005,n_ff_2005,n_uf_2005,n_lw_2005,n_hw_2005,n_ags_2005,n_cf_2005,n_cr_2005,p_cr_2005,p_lw_2005,p_hw_2005,p_uf_2005,p_ff_2005,p_ags_2005,n_dep_2006,n_ff_2006,n_uf_2006,n_lw_2006,n_hw_2006,n_ags_2006,n_cf_2006,n_cr_2006,p_cr_2006,p_lw_2006,p_hw_2006,p_uf_2006,p_ff_2006,p_ags_2006,n_dep_2007,n_ff_2007,n_uf_2007,n_lw_2007,n_hw_2007,n_ags_2007,n_cf_2007,n_cr_2007,p_cr_2007,p_lw_2007,p_hw_2007,p_uf_2007,p_ff_2007,p_ags_2007,n_dep_2008,n_ff_2008,n_uf_2008,n_lw_2008,n_hw_2008,n_ags_2008,n_cf_2008,n_cr_2008,p_cr_2008,p_lw_2008,p_hw_2008,p_uf_2008,p_ff_2008,p_ags_2008,n_dep_2009,n_ff_2009,n_uf_2009,n_lw_2009,n_hw_2009,n_ags_2009,n_cf_2009,n_cr_2009,p_cr_2009,p_lw_2009,p_hw_2009,p_uf_2009,p_ff_2009,p_ags_2009,n_dep_2010,n_ff_2010,n_uf_2010,n_lw_2010,n_hw_2010,n_ags_2010,n_cf_2010,n_cr_2010,p_cr_2010,p_lw_2010,p_hw_2010,p_uf_2010,p_ff_2010,p_ags_2010,n_dep_2011,n_ff_2011,n_uf_2011,n_lw_2011,n_hw_2011,n_ags_2011,n_cf_2011,n_cr_2011,p_cr_2011,p_lw_2011,p_hw_2011,p_uf_2011,p_ff_2011,p_ags_2011,n_dep_2012,n_ff_2012,n_uf_2012,n_lw_2012,n_hw_2012,n_ags_2012,n_cf_2012,n_cr_2012,p_cr_2012,p_lw_2012,p_hw_2012,p_uf_2012,p_ff_2012,p_ags_2012,n_dep_2013,n_ff_2013,n_uf_2013,n_lw_2013,n_hw_2013,n_ags_2013,n_cf_2013,n_cr_2013,p_cr_2013,p_lw_2013,p_hw_2013,p_uf_2013,p_ff_2013,p_ags_2013,n_dep_2014,n_ff_2014,n_uf_2014,n_lw_2014,n_hw_2014,n_ags_2014,n_cf_2014,n_cr_2014,p_cr_2014,p_lw_2014,p_hw_2014,p_uf_2014,p_ff_2014,p_ags_2014,n_dep_2015,n_ff_2015,n_uf_2015,n_lw_2015,n_hw_2015,n_ags_2015,n_cf_2015,n_cr_2015,p_cr_2015,p_lw_2015,p_hw_2015,p_uf_2015,p_ff_2015,p_ags_2015,n_dep_2016,n_ff_2016,n_uf_2016,n_lw_2016,n_hw_2016,n_ags_2016,n_cf_2016,n_cr_2016,p_cr_2016,p_lw_2016,p_hw_2016,p_uf_2016,p_ff_2016,p_ags_2016,n_dep_2017,n_ff_2017,n_uf_2017,n_lw_2017,n_hw_2017,n_ags_2017,n_cf_2017,n_cr_2017,p_cr_2017,p_lw_2017,p_hw_2017,p_uf_2017,p_ff_2017,p_ags_2017', + aoi='ws', + comid = comid, + showAreaSqKm = FALSE, + showPctFull = FALSE) + # declare NULL metrics created w/in function + year <- NULL + value <- NULL + ags <- NULL + cr <- NULL + totag <- NULL + metric <- NULL + estimated <- NULL + STUSPS <- NULL + #Create N inputs df + nin <- nni[, grepl("^(n)", names(nni)) & !grepl("(cr)", names(nni)) & !grepl("(ags)", names(nni))] + + names(nin) <- sapply(names(nin), function(col){ + substr(col, 3, nchar(col) -2) + }) + + nin <- nin |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric", "year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) + + #Create P inputs df + + pin <- nni[, grepl("^(p)", names(nni)) & !grepl("(cr)", names(nni)) & !grepl("(ags)", names(nni))] + + names(pin) <- sapply(names(pin), function(col){ + substr(col, 3, nchar(col) -2) + }) + + pin <- pin |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric", "year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) + + #Create N dfs for lines (cr, agsur, nue) + + nlines <- nni[, grepl("^n_cr|^n_ags", names(nni))] + + names(nlines) <- sapply(names(nlines), function(col){ + substr(col, 3, nchar(col) -2) + }) + + nlines <- nlines |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric","year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) |> + tidyr::pivot_wider( + names_from = 'metric', + values_from = 'value' + ) |> + dplyr::mutate(totag = ags + cr) |> + dplyr::mutate(nue = (cr / totag) * 100) |> + tidyr::pivot_longer( + cols = !year, + names_to="metric", + values_to="value") + + ncrag <- nlines |> + dplyr::filter(metric %in% c('ags', 'cr')) + + nue <- nlines |> + dplyr::filter(metric == 'nue') |> + tidyr::pivot_wider(names_from = 'metric', + values_from = 'value') + + #Create P dfs for lines (cr, agsur, pue) + + plines <- nni[, grepl("^p_cr|^p_ags", names(nni))] + + names(plines) <- sapply(names(plines), function(col){ + substr(col, 3, nchar(col) -2) + }) + + + plines <- plines |> + tidyr::pivot_longer( + cols = tidyselect::everything(), + names_to = c("metric","year"), + names_sep = "_", + values_to = "value" + ) |> + dplyr::mutate(year = as.integer(year)) |> + dplyr::mutate(value = value / 1000000) |> + tidyr::pivot_wider( + names_from = 'metric', + values_from = 'value' + ) |> + dplyr::mutate(totag = ags + cr) |> + dplyr::mutate(nue = (cr / totag) * 100) |> + tidyr::pivot_longer( + cols = !year, + names_to="metric", + values_to="value") + + pcrag <- plines |> + dplyr::filter(metric %in% c('ags', 'cr')) + + pue <- plines |> + dplyr::filter(metric == 'nue') |> + tidyr::pivot_wider(names_from = 'metric', + values_from = 'value') + + pdf <- dplyr::bind_rows(plines, pin) + + ndf <- dplyr::bind_rows(nlines, nin) + + #create estimate column + knownfertyrs <- c(1987,1988,1989,1990,1991,1992,1993,1994,1995,1996,1997,1998,1999,2000,2001,2002,2003,2004, + 2005,2006,2007,2008,2009,2010,2011,2012,2017) + nwsin <- nin |> + dplyr::mutate(estimated=dplyr::case_when( + metric == "dep" ~ FALSE, + metric == "hw" ~ FALSE, + metric == "cf" & year %in% c(1987,1992,1997,2002,2007,2012, 2017) ~ FALSE, + metric == "ff" & year %in% knownfertyrs ~ FALSE, + metric == "uf" & year %in% knownfertyrs ~ FALSE, + metric == "lw" & year %in% c(1987,1992,1997,2002,2007,2012,2017) ~ FALSE, + TRUE ~ TRUE + )) + + pwsin <- pin |> + dplyr::filter(metric != 'cr') |> + dplyr::mutate(estimated=dplyr::case_when( + metric == "hw" ~ FALSE, + metric == "lw" & year %in% c(1987,1992,1997,2002,2007,2012,2017) ~ FALSE, + metric == "ff" & year %in% knownfertyrs ~ FALSE, + metric == "uf" & year %in% knownfertyrs ~ FALSE, + TRUE ~ TRUE + )) + + #get ready for plot + colorsn <- c('ff' = '#A3CC51', 'lw'='#B26F2C','hw'='#E51932','uf'='black', 'dep'='#6db6ff', 'cf'='#FFD700') + colorsp <- c('ff' = '#A3CC51', 'lw'='#B26F2C','hw'='#E51932','uf'='black') + + nwsin$metric <- factor(nwsin$metric, levels = c('uf','hw','dep','lw','cf','ff')) + pwsin$metric <- factor(pwsin$metric, levels = c('uf','hw','lw','ff')) + + #Get COMID location and states for inset map + #states + states <- + tigris::states(cb = TRUE, progress_bar = FALSE) |> + dplyr::filter(!STUSPS %in% c('HI', 'PR', 'AK', 'MP', 'GU', 'AS', 'VI')) |> + sf::st_transform(crs = 5070) + + #comid + comidint <- as.integer(comid) + flowline <- nhdplusTools::get_nhdplus(comid = comidint, realization = "flowline") + point <- sf::st_centroid(flowline) + + #create N bar plot + nbar <- ggplot() + + ggpattern::geom_bar_pattern(data = nwsin, + aes(x=year,y=value, fill=metric, + pattern=factor(estimated, levels=c(TRUE,FALSE), + labels=c('Estimated','Non-Estimated'))), + pattern = ifelse(nwsin$estimated, 'stripe','none'), + pattern_color='white', + pattern_density=0.05, + pattern_fill = 'white', + pattern_alpha = 0.5, + pattern_spacing=0.025, + stat='identity', position='stack', + pattern_size=0.05) + + labs(title = 'Nitrogen (million kg/year)', + y = "Budget", + x = " ") + + scale_fill_manual(values=colorsn, + labels = c('ff' = 'Farm Fertilizer', + 'uf' = 'Urban Fertilizer', + 'cf' = 'Crop N-Fixation', + 'lw' = 'Livestock Manure', + 'hw' = 'Human Waste', + 'dep' = 'Total Deposition')) + + scale_pattern_manual(name='Estimate Status', + values=c('Estimated'='stripe','Non-estimated'='none')) + + geom_line(data=ncrag, + aes(x=year,y=value, linetype=metric), + linewidth=1.25, color="black") + + scale_linetype_manual(values = + c("ags"="solid", "cr"="dotted"), + labels = c('ags' = 'Agricultural Surplus', + 'cr' = 'Crop Removal')) + + guides(fill= + guide_legend(order=1, override.aes = list(pattern='none')), + pattern= + guide_legend(order=2, override.aes = list(fill='grey')), + linetype= + guide_legend(title=NULL)) + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + scale_color_manual(values=c("Agricultural Surplus"="black"), + guide = 'none') + + theme_bw() + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.y = element_text(size=9), + legend.background = element_rect(fill="white", colour = "black"), + legend.title = element_blank()) + + #create p bar plot + pbar <- ggplot() + + ggpattern::geom_bar_pattern(data = pwsin, + aes(x=year,y=value, fill=metric, + pattern=factor(estimated, levels=c(TRUE,FALSE), + labels=c('Estimated','Non-Estimated'))), + pattern = ifelse(pwsin$estimated, 'stripe','none'), + pattern_color='white', + pattern_density=0.05, + pattern_fill = 'white', + pattern_alpha = 0.5, + pattern_spacing=0.025, + stat='identity', position='stack', pattern_size=0.05) + + labs(title = 'Phosphorus (million kg/year)', + y = "Budget", + x = " ") + + scale_fill_manual(values=colorsp) + + scale_pattern_manual(name='Estimate Status', + values=c('Estimated'='stripe', + 'Non-estimated'='none')) + + geom_line(data=pcrag, + aes(x=year,y=value, + linetype=metric), + linewidth=1.25, color="black") + + scale_linetype_manual(values = + c("ags"="solid", "cr"="dotted")) + + guides(fill= + guide_legend(order=1, override.aes = list(pattern='none')), + pattern= + guide_legend(order=2, override.aes = list(fill='grey')), + linetype= + guide_legend(title=NULL)) + + guides(fill="none", pattern = "none", linetype="none") + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + scale_color_manual(values=c("Agricultural Surplus"="black"), + guide = 'none') + + theme_bw() + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.y = element_text(size=9), + legend.background = element_rect(fill="white", colour = "black"), + legend.title = element_blank()) + + #create nue line plots + nue <- ggplot() + + geom_line(data=nue, aes(x=year,y=nue), linewidth=1.25, color='seagreen')+ + theme_bw() + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + labs(title = 'Nitrogen Use Efficiency', + y = "%", + x=" ") + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.x = element_text(size=9), + axis.title.y = element_text(size=9)) + + pue <- ggplot() + + geom_line(data=pue, aes(x=year,y=nue, lty='Nutrient Use Efficiency'), linewidth=1.25, color="seagreen") + + theme_bw() + + scale_x_continuous(breaks=seq(1987,2017,by=5)) + + labs(title = 'Phosphorus Use Efficiency', + y = "%", + x="Year") + + theme(plot.title = element_text(size=9, face="bold"), + axis.title.x = element_text(size=9), + axis.title.y = element_text(size=9, hjust=0.5), + legend.background = element_rect(fill="white", colour = "black"), + legend.title = element_blank()) + + guides(fill="none", pattern = "none", linetype="none") + + #Create inset map + inset <- ggplot() + + geom_sf(data = states, color = "grey", fill = 'transparent', lwd = .2) + + geom_sf(data = point, size = 3.5, color = "red") + theme_void() + + #export final figure + inputs <- patchwork::wrap_plots(nbar, pbar, ncol=1, guides="collect") + nue <- patchwork::wrap_plots(nue, pue, ncol=1, guides="collect") + + if (include.nue == TRUE){ + timenni <- patchwork::wrap_plots(nue, inputs, ncol=2) + } + else { + timenni <- inputs + } + + if (include.inset == TRUE){ + timenni <- cowplot::plot_grid( + timenni, inset, + ncol = 1, + rel_heights = c(3,1) + ) + return(timenni) + } + else { + return(timenni) + } + +} diff --git a/README.md b/README.md index 381901c..777c5f1 100644 --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ [![cran checks](https://badges.cranchecks.info/worst/StreamCatTools.svg)](https://cran.r-project.org/web/checks/check_results_StreamCatTools.html) [![R-CMD-check](https://github.com/USEPA/StreamCatTools/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/USEPA/StreamCatTools/actions/workflows/R-CMD-check.yaml) [![Downloads](https://cranlogs.r-pkg.org/badges/grand-total/StreamCatTools)](https://cran.r-project.org/package=StreamCatTools) -[![CodeCov](https://img.shields.io/badge/test%20coverage-86.9%25-388600.svg)](https://img.shields.io/badge/test%20coverage-86.9%25-388600.svg) +[![CodeCov](https://img.shields.io/badge/test%20coverage-82.62%25-388600.svg)](https://img.shields.io/badge/test%20coverage-82.62%25-388600.svg) ## StreamCatTools: Tools to work with the [StreamCat](https://www.epa.gov/national-aquatic-resource-surveys/streamcat-dataset) API within R and access the full suite of StreamCat and [LakeCat](https://www.epa.gov/national-aquatic-resource-surveys/lakecat-dataset) metrics. @@ -49,7 +49,7 @@ Contributions to development of the package are welcome and encouraged. Please c - If you contribute to documentation, running `devtools::document()` and then `pkgdown::build_site()` will refresh the help docs and pkgdown pages (but do not push these packagedown changes - they are to verify changes locally) ### Python Implementation of StreamCat API -[PyNHD](https://github.com/hyriver/pynhd), part of the [HyRiver](https://github.com/hyriver) suite of Python packages, also provides access to StreamCat data via the API in Python, along with other NHDPlus value-added attributes for catchments and catchment and network accumulated values for catchments available via [USGS ScienceBase](https://www.sciencebase.gov/catalog/) +[PyNHD](https://github.com/hyriver/pynhd), part of the [HyRiver](https://github.com/hyriver) suite of Python packages, also provides access to StreamCat data via the API in Python, along with other NHDPlus value-added attributes for catchments and catchment and network accumulated values for catchments available via [USGS ScienceBase](https://www.usgs.gov/tools/sciencebase) ### Recommended Citation: ``` diff --git a/_pkgdown.yml b/_pkgdown.yml index cd7863d..603e689 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -8,4 +8,5 @@ articles: - StartHere - Articles/Introduction - Articles/LakeCat + - Articles/NNI - Articles/Applications \ No newline at end of file diff --git a/cran-comments.md b/cran-comments.md index a7fb6bb..97e3f25 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,14 +1,11 @@ This is a patch update that: -- Handles a web service being down in testing using `testthat::skip_on_cran()` -- Handles a web service being down in vignettes by converting most vignettes to - articles and leaving just one `Start Here` vignette -- Due to the lapse in government funding in federal agencies in the US, - the web service StreamCatTools is built around may be down for some time -- Because of the lapse in government funding in federal agencies in the US, I - may not be able to respond readily to any CRAN emails to my government - email account weber.marc@epa.gov but my personal email is mweber36@gmail.com - +- Adds new functions `sc_get_nni()` and `lc_get_nni()` for ease of access to + National Nutrient Inventory data in StreamCat +- Adds new functions `sc_plot()` and `lc_plot` for plotting nitrogen and + phosphorus budgets for watersheds +- Adds a new article describing functions for plotting National Nutrient + Inventory data in StreamCat ------- @@ -18,9 +15,9 @@ This is a resubmission. ## R CMD check results -Here is the output from `devtools::check()` on R Version R version 4.5.0, +Here is the output from `devtools::check()` on R Version R version 4.5.2, devtools version 2.4.6, and Windows 11 x64 operating system -Duration: 2m 20.4s +Duration: 3m 55s 0 errors ✔ | 0 warnings ✔ | 0 notes ✔ diff --git a/docs/404.html b/docs/404.html index 451d7fb..30da3c0 100644 --- a/docs/404.html +++ b/docs/404.html @@ -26,7 +26,7 @@ StreamCatTools - 0.9.1 + 0.10.0