diff --git a/.github/workflows/build_fredi.yml b/.github/workflows/build_fredi.yml index 463b354f..11e55b31 100644 --- a/.github/workflows/build_fredi.yml +++ b/.github/workflows/build_fredi.yml @@ -6,7 +6,7 @@ ### For uploading artifacts: ### "path:" is the output path where Pandoc will write the compiled PDF. ### Note, this should be the same directory as the input paper.md -name: Build FrEDI Package +name: 4. Build FrEDI Package on: [workflow_dispatch] diff --git a/.github/workflows/test_fredi.yml b/.github/workflows/test_fredi.yml index f7db3799..b940696c 100644 --- a/.github/workflows/test_fredi.yml +++ b/.github/workflows/test_fredi.yml @@ -6,7 +6,7 @@ ### For uploading artifacts: ### "path:" is the output path where Pandoc will write the compiled PDF. ### Note, this should be the same directory as the input paper.md -name: Test FrEDI Package +name: 3. Test FrEDI Package # on: [workflow_dispatch] on: @@ -14,14 +14,28 @@ on: inputs: run_tests: type: choice - description: Run general tests + description: Run general tests? required: true options: - no - yes - make_figures: + figH_results: type: choice - description: Create report figures + description: Fig H results? + required: true + options: + - no + - yes + make_appx_figs: + type: choice + description: Create appendix figures for report? + required: true + options: + - no + - yes + make_tots_figs: + type: choice + description: Make figures for impact type totals? required: true options: - no @@ -40,7 +54,7 @@ jobs: - name: Send input status run: | - echo "${{ inputs.run_tests }} ${{ inputs.make_figures }}" + echo "${{ inputs.run_tests }} ${{ inputs.figH_results }} ${{ inputs.make_appx_figs }} ${{ inputs.make_tots_figs }}" - name: Setup R uses: r-lib/actions/setup-r@v2 @@ -67,15 +81,12 @@ jobs: upgrade = "never", force = TRUE, type = "source" - )' + ) + ' - - name: Run create_DoW_results + - name: Run tests & create figures run: | Rscript -e ' - ### Which tests to do - do_tests <- "${{ inputs.run_tests }}" == "true" - do_figs <- "${{ inputs.make_figures }}" == "true" - ### Main repo path, FrEDI project path, scripts path rPath0 <- "."; pPath0 <- rPath0 |> file.path("FrEDI") @@ -89,19 +100,36 @@ jobs: tFiles0 <- tPath0 |> list.files(full.names=TRUE) for(file_i in tFiles0){file_i |> source(); rm(file_i)} + ### Load source + sPath0 |> file.path("create_DoW_results.R") |> source() + + ### Which tests to do + do_tests <- "${{ inputs.run_tests }}" == "true" + do_figH <- "${{ inputs.figH_results }}" == "true" + do_appx <- "${{ inputs.make_appx_figs }}" == "true" + do_tots <- "${{ inputs.make_tots_figs }}" == "true" + do_figs <- do_appx | do_tots + ### Where to save results oPath0 <- pPath0 |> file.path("data_tests") oPath1 <- oPath0 |> file.path("general") oPath2 <- oPath0 |> file.path("report_figures") + ### Whether paths exist + exists0 <- oPath0 |> dir.exists() + exists1 <- oPath1 |> dir.exists() + exists2 <- oPath2 |> dir.exists() + + ### Check if path exists and, if not, create it + if(!exists0){ oPath0 |> dir.create(recursive = TRUE)} + if(!exists1){ oPath1 |> dir.create(recursive = TRUE)} + if(!exists2){ oPath2 |> dir.create(recursive = TRUE)} + ### Test results if(do_tests){ - ### Check if path exists and, if not, create it - exists0 <- oPath1 |> dir.exists() - if(!exists0){oPath1 |> dir.create(recursive = TRUE)} - ### Run FrEDI results0 <- run_fredi() + ### Run tests tests0 <- results0 |> general_fredi_test( outPath = oPath1, @@ -115,35 +143,37 @@ jobs: save0 <- listResults |> save(file= oPath1 |> file.path("defaultScenarioTotals.rda")) |> try() ### Remove results - rm(results0, tests0, listResults) - } + rm(exists0, results0, tests0, listResults, save0) + } ### End if(do_tests) - ### Create report results + ### Create Fig H results + if(do_figH){ + ### Figure H results + results0 <- run_fredi(aggLevels=c("modelaverage", "national", "impactYear")) + results0 <- results0 |> filter(year %in% seq(2010, 2090, by=5)) + save0 <- results0 |> write.csv(file=oPath2 |> file.path("FigH_results.csv"), row.names=F) |> try() + + ### Remove reslts + rm(results0, save0) + } ### End if(do_figH) + + ### Create report figures if(do_figs){ ### Load source sPath0 |> file.path("create_DoW_results.R") |> source() - ### Check if path exists and, if not, create it - exists0 <- oPath2 |> dir.exists() - if(!exists0){oPath2 |> dir.create(recursive = TRUE)} - - ### Create report figures reports0 <- create_DoW_results( outPath = oPath2, saveFile = TRUE, loadCode = "project", + totals = do_tots, silent = FALSE, testing = TRUE, return = FALSE, fpath = pPath0 ) - - ### Figure H results - results0 <- run_fredi(aggLevels=c("modelaverage", "national", "impactYear")) - results0 <- results0 |> filter(year %in% seq(2010, 2090, by=5)) - save0 <- results0 |> write.csv(file=oPath2 |> file.path("FigH_results.csv"), row.names=F) |> try() - } + } ### End if(do_figs) ' - name: Upload Tests @@ -156,12 +186,32 @@ jobs: ./FrEDI/data_tests/general/defaultScenarioTotals.rda ./FrEDI/data_tests/general/testResults_fredi_general.xlsx - - name: Upload Report Figures + + - name: Upload FigH Results + if: | + inputs.figH_results == 'true' + uses: actions/upload-artifact@v3 + with: + name: FigH results + path: | + ./FrEDI/data_tests/report_figures/ + + + - name: Upload Report Appendix Figures + if: | + inputs.make_appx_figs == 'true' + uses: actions/upload-artifact@v3 + with: + name: Report appendix figures & data + path: | + ./FrEDI/data_tests/report_figures/ + + - name: Upload Report Fig7 Figures if: | - inputs.make_figures == 'true' + inputs.make_tots_figs == 'true' uses: actions/upload-artifact@v3 with: - name: Report Data + name: Fig7 report figures & data path: | ./FrEDI/data_tests/report_figures/ # ./FrEDI/data_tests/general/FigH_results.csv diff --git a/.github/workflows/update_base_data.yml b/.github/workflows/update_base_data.yml index 9283b552..08fcee92 100644 --- a/.github/workflows/update_base_data.yml +++ b/.github/workflows/update_base_data.yml @@ -1,4 +1,4 @@ -name: Update Base System Data +name: 1. Update Base System Data on: workflow_dispatch: diff --git a/.github/workflows/update_sv_impactsList.yml b/.github/workflows/update_sv_impactsList.yml index 5b6106a6..0b4a7340 100644 --- a/.github/workflows/update_sv_impactsList.yml +++ b/.github/workflows/update_sv_impactsList.yml @@ -1,4 +1,4 @@ -name: Update SV ImpactsList Data +name: 2. Update SV ImpactsList Data (as needed) on: workflow_dispatch: diff --git a/FrEDI/R/FrEDI-package.R b/FrEDI/R/FrEDI-package.R index b7489494..a4f930fe 100644 --- a/FrEDI/R/FrEDI-package.R +++ b/FrEDI/R/FrEDI-package.R @@ -2,18 +2,24 @@ #' README #' FrEDI: The Framework for Evaluating Damages and Impacts #' -#' [FrEDI] is an R package being developed by the U.S. Environmental Protection Agency (EPA). The functions and data provided by this package can be used to estimate climate change impacts for the contiguous United States (CONUS) using the Framework for Evaluating Damages and Impacts (FrEDI), developed as part of EPA's [Climate Change Impacts and Risk Analysis](https://epa.gov/cira/) (CIRA) project. [FrEDI] contains R code that implement FrEDI and allow users to project impacts from climate change and sea level rise for a selected set of sectors. #' -#' For help getting started with [FrEDI], visit . +#' FrEDI is an R package being developed by the U.S. Environmental Protection Agency (EPA). The functions and data provided by this package can be used to estimate climate change impacts for the contiguous United States (CONUS) using the [Framework for Evaluating Damages and Impacts (FrEDI)](https://epa.gov/cira/FrEDI/), developed as part of EPA's [Climate Change Impacts and Risk Analysis](https://epa.gov/cira/) (CIRA) project. FrEDI contains R code that implement FrEDI and allow users to project impacts from climate change and sea level rise for a selected set of sectors. +#' +#' +#' +#' For help getting started with FrEDI, visit . #' #' For additional package documentation, see . #' #' For more information on the Framework and the CIRA project, visit , especially . #' +#' +#' #' @section Overview of Functions: -#' The function [FrEDI::run_fredi()] provided in this package is the primary function implementing the [`FrEDI`](https://epa.gov/cira/FrEDI/) developed by the U.S. EPA for projecting annual climate impacts. The main inputs to [FrEDI::run_fredi()] are climate scenarios (temperature in degrees Celsius, global mean sea level rise in centimeters) and socioeconomic scenarios (U.S. gross domestic product, state population). #' -#' [FrEDI] also contains functions to assist in the pre-processing of input scenarios and the post-processing of outputs. +#' The function [FrEDI::run_fredi()] provided in this package is the primary function implementing the [Framework for Evaluating Damages and Impacts (FrEDI)](https://epa.gov/cira/FrEDI/), developed by the U.S. EPA for projecting annual climate impacts. The main inputs to [FrEDI::run_fredi()] are climate scenarios (temperature in degrees Celsius, global mean sea level rise in centimeters) and socioeconomic scenarios (U.S. gross domestic product, state population). +#' +#' FrEDI also contains functions to assist in the pre-processing of input scenarios and the post-processing of outputs. #' #' * Pre-processing functions include [FrEDI::get_sectorInfo()], [FrEDI::import_inputs()], [FrEDI::convertTemps()], [FrEDI::temps2slr()]. #' * [FrEDI::get_sectorInfo()] allows users to access a list of sectors within `FrEDI` and related sector information. @@ -21,42 +27,52 @@ #' * [FrEDI::convertTemps()] helps users to convert between global mean temperature and temperatures for the contiguous United States (CONUS) (both in degrees Celsius). #' * [FrEDI::temps2slr()] helps users to estimate global mean sea level rise (GMSL, in centimeters) from global mean temperature in degrees Celsius. #' -#' [FrEDI::aggregate_impacts()] is a post-processing helper function that helps users to aggregate and summarize the outputs of [FrEDI]. [FrEDI::aggregate_impacts()] can be used to calculate national totals, model averages, sum over impact types, and interpolate between multiple impact years (note that [FrEDI::run_fredi()] will automatically run [FrEDI::aggregate_impacts()] before returning outputs if the `aggLevels` argument is not `"none"`). +#' [FrEDI::aggregate_impacts()] is a post-processing helper function that helps users to aggregate and summarize the outputs of FrEDI. [FrEDI::aggregate_impacts()] can be used to calculate national totals, model averages, sum over impact types, and interpolate between multiple impact years (note that [FrEDI::run_fredi()] will automatically run [FrEDI::aggregate_impacts()] before returning outputs if the `aggLevels` argument is not `"none"`). #' #' Versions 2.3.0 and above include the `FrEDI` Social Vulnerability (SV) module for estimating impacts on socially vulnerable populations for select sectors. [FrEDI::get_sv_sectorInfo()] allows users to access a list of sectors within the FrEDI SV module and related sector information. The function [FrEDI::run_fredi_sv()] is the main function for the `FrEDI` SV module. [FrEDI::run_fredi_sv()] is designed to calculate impacts for a single sector at a time for a custom population scenario or one or more custom temperature or sea level rise scenarios. For more information on the data underlying the `FrEDI` SV module, see . #' -#' @section Overview of Package Contents: -#' [FrEDI] consists of files in the following directories: +#' +#' +#' @section Overview of Package Contents: +#' +#' FrEDI consists of files in the following directories: #' * __R__. Contains function definitions (files ending in `".R"`) and configuration files (ending in `".rda"`). #' * __data__. Contains R Data files ending in `".rdb"`, `".rds"`, and `".rdx"`, containing data included with the package. #' * __help__ and __html__. Contain documentation for functions available to the user, including function descriptions, lists of arguments and outputs, and examples. See `"html/00Index.html"` or the individual R help functions for more information about individual functions. #' * __Meta__. Contains RDS files (ending in `".rds"`) with information about the package contents. #' * __extdata__. __extdata/scenarios__ Contains four CSV files for users to test the function for importing data. For more information on importing scenarios for use with [FrEDI::run_fredi()], refer to documentation for the function [FrEDI::import_inputs()]. -#' * `"GCAM_scenario.csv"` contains a set of temperature scenarios that can be used with [FrEDI], including the default temperature scenario used by both [FrEDI::run_fredi()] and [FrEDI::run_fredi_sv()] (labeled `"description="Hector_GCAM_v5.3_ECS_3.0_REF"` in `"slr_from_GCAM.csv"` and `"ECS_3.0_ref_0"` in the [FrEDI::gcamScenarios] dataset)). Also see the documentation for the [FrEDI::gcamScenarios] dataset for more information. +#' * `"GCAM_scenario.csv"` contains a set of temperature scenarios that can be used with FrEDI, including the default temperature scenario used by both [FrEDI::run_fredi()] and [FrEDI::run_fredi_sv()] (labeled `"description="Hector_GCAM_v5.3_ECS_3.0_REF"` in `"slr_from_GCAM.csv"` and `"ECS_3.0_ref_0"` in the [FrEDI::gcamScenarios] dataset)). Also see the documentation for the [FrEDI::gcamScenarios] dataset for more information. #' * `"State ICLUS Population.csv"` and `"Region ICLUS Population.csv"` contain the default population scenarios used by [FrEDI::run_fredi()] and [FrEDI::run_fredi_sv()], respectively (see [FrEDI::popScenario] and [FrEDI::popScenario_sv]). #' * `"slr_from_GCAM.csv"` contains global mean sea level rise heights in centimeters (created from the reference temperature scenario). #' * __extdata/sv__ Contains files used by the `FrEDI` SV module to calculate impacts. #' -#' The `FrEDI` package contains a loadable dataset with default results `defaultResults`, which contains annual impacts produced by [FrEDI::run_fredi()] for the with the default options and default default scenarios (i.e., default temperature, GDP and regional population trajectories). Other loadable datasets provided by [FrEDI] are a set of driver scenarios ([FrEDI::gcamScenarios]), a state-level population scenario ([FrEDI::popScenario]) for use with [FrEDI::run_fredi()], and a region-level `popScenario_sv` for use with [FrEDI::run_fredi_sv()]. These data can be loaded into the workspace using the `data()` function. +#' The `FrEDI` package contains a loadable dataset with default results `defaultResults`, which contains annual impacts produced by [FrEDI::run_fredi()] for the with the default options and default scenarios (i.e., default temperature, GDP, and state population trajectories). Other loadable datasets provided by FrEDI are a set of driver scenarios ([FrEDI::gcamScenarios]), a state population scenario ([FrEDI::popScenario]) for use with [FrEDI::run_fredi()] or [FrEDI::import_inputs()], and a regional population scenario (`popScenario_sv`) for use with [FrEDI::run_fredi_sv()]. These data can be loaded into the workspace using the `data()` function. #' #' Typical use will involve `library(FrEDI)` or `require(FrEDI)`. #' #' +#' #' @section Status: #' Disclaimer: All code in this repository is being provided in a "draft" state and has not been reviewed or cleared by U.S. EPA. This status will be updated as models are reviewed. #' +#' +#' #' @section Dependencies: -#' [FrEDI] requires R (>= 4.2.0). +#' FrEDI requires R (>= 4.2.0). #' #' -#' [FrEDI] depends on: +#' FrEDI depends on: #' * [tidyverse] (Easily Install and Load the 'Tidyverse'). The official documentation for [tidyverse] can be found [here](https://cran.r-project.org/web/packages/tidyverse/index.html). [tidyverse] can be installed using `install.packages("tidyverse")`, or see [link](https://tidyverse.tidyverse.org/) for more information. #' * [ggpubr] ('ggplot2' Based Publication Ready Plots). The official documentation for [ggpubr] can be found [here](https://cran.r-project.org/web/packages/ggpubr/index.html). [ggpubr] can be installed using `install.packages("ggpubr")`, or see [link](https://rpkgs.datanovia.com/ggpubr/) for more information. #' * [openxlsx] (Read, Write and Edit `xlsx` Files). The official documentation for [openxlsx] can be found [here](https://cran.r-project.org/web/packages/openxlsx/index.html). [openxlsx] can be installed using `install.packages("openxlsx")`. #' +#' +#' #' @section License: #' This repository is released under the MIT License. #' +#' +#' #' @section EPA Disclaimer: #' The United States Environmental Protection Agency (EPA) GitHub project code is provided on an "as is" basis and the user assumes responsibility for its use. EPA has relinquished control of the information and no longer has responsibility to protect the integrity, confidentiality, or availability of the information. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by EPA. The EPA seal and logo shall not be used in any manner to imply endorsement of any commercial product or activity by EPA or the United States Government. #' diff --git a/FrEDI/R/aggregate_impacts.R b/FrEDI/R/aggregate_impacts.R index 1e889ca5..3c4e706e 100644 --- a/FrEDI/R/aggregate_impacts.R +++ b/FrEDI/R/aggregate_impacts.R @@ -1,32 +1,32 @@ ###### aggregate_impacts ###### ### Created 2021.02.08. -#' Summarize and aggregate impacts from FrEDI (calculate national totals, average across models, sum impact types, and interpolate between impact year estimates) +#' Summarize and aggregate impacts from [FrEDI::run_fredi()] (calculate national totals, average across models, sum impact types, and interpolate between impact year estimates) #' #' @description -#' Summarize and aggregate impacts from FrEDI (calculate national totals, average across models, sum impact types, and interpolate between impact estimate years). +#' Summarize and aggregate impacts from [FrEDI::run_fredi()] (calculate national totals, average across models, sum impact types, and interpolate between impact estimate years). #' #' @param data Data frame of results FrEDI (outputs from [FrEDI::run_fredi()]) -#' @param columns Character vector of columns for which to aggregate results (defaults to `columns=c( "physical_impacts", "annual_impacts")`). -#' @param aggLevels Levels of aggregation at which to summarize data: one or more of `c( "national", "modelAverage", "impactYear", "impactType", "all" )`. Defaults to all levels (i.e., `aggLevels="all"`). Note that, if `"impacttype"` is in `aggLevels` (e.g., `aggLevels= "all"`), column `"physical_measure"` is dropped from the `groupByCols` and column `"physical_impacts"` is dropped from `columns`. This is because aggregating over impact types for some sectors requires summing costs over different types of physical impacts, so reporting the physical impacts would be nonsensical. -#' @param groupByCols Character vector indicating which columns to use for grouping. Defaults to `groupByCols=c( "sector", "variant", "impactYear", "impactType", "model_type", "model", "sectorprimary", "includeaggregate", "physicalmeasure", "region", "state", "postal" )`. Note that the `"variant"` column referred to below contains information about the variant or adaptation name (or `“N/A”`), as applicable. +#' @param columns Character vector of columns for which to aggregate results (defaults to `columns = c( "physical_impacts", "annual_impacts")`). +#' @param aggLevels Levels of aggregation at which to summarize data: one or more of `c("national", "modelAverage", "impactYear", "impactType", "all" )`. Defaults to all levels (i.e., `aggLevels = "all"`). Note that, if `"impacttype"` is in `aggLevels` (e.g., `aggLevels = "all"`), column `"physical_measure"` is dropped from the `groupByCols` and column `"physical_impacts"` is dropped from `columns`. This is because aggregating over impact types for some sectors requires summing costs over different types of physical impacts, so reporting the physical impacts would be nonsensical. +#' @param groupByCols Character vector indicating which columns to use for grouping. Defaults to `groupByCols = c("sector", "variant", "impactYear", "impactType", "model_type", "model", "sectorprimary", "includeaggregate", "physicalmeasure", "region", "state", "postal")`. Note that the `"variant"` column referred to below contains information about the variant or adaptation name (or `“N/A”`), as applicable. #' #' @details -#' This function can be used to aggregate and summarize the FrEDI results to levels of aggregation specified by the user (passed to `aggLevels`). Users can specify all aggregation levels at once by specifying `aggLevels= "all"` (default) or no aggregation levels (`aggLevels= "none"`). Users can specify a single aggregation level or multiple aggregation levels by passing a single character string or character vector to `aggLevels`. Options for aggregation include calculating national totals (`aggLevels= "national"`), averaging across model types and models (`aggLevels= "modelAverage"`), summing over all impact types (`aggLevels= "impactType"`), and interpolating between impact year estimates (`aggLevels= "impactYear"`). +#' This function can be used to aggregate and summarize the FrEDI results to levels of aggregation specified by the user (passed to `aggLevels`). Users can specify all aggregation levels at once by specifying `aggLevels = "all"` (default) or no aggregation levels (`aggLevels = "none"`). Users can specify a single aggregation level or multiple aggregation levels by passing a single character string or character vector to `aggLevels`. Options for aggregation include calculating national totals (`aggLevels= "national"`), averaging across model types and models (`aggLevels = "modelAverage"`), summing over all impact types (`aggLevels = "impactType"`), and interpolating between impact year estimates (`aggLevels = "impactYear"`). #' #' -#' Before aggregating impacts for national totals and/or model averages, [FrEDI::aggregate_impacts()] will drop any pre-summarized results (i.e., values for which `region= "National Total"` and/or for which `model= "Average"`, respectively) that are already present in the data and then re-summarize results at those respective levels. +#' Before aggregating impacts for national totals and/or model averages, [FrEDI::aggregate_impacts()] will drop any pre-summarized results (i.e., values for which `region = "National Total"` and/or for which `model = "Average"`, respectively) that are already present in the data and then re-summarize results at those respective levels. #' -#' If users specify `aggLevels= "none"`, [FrEDI::aggregate_impacts()] returns the data frame passed to the `data` argument. +#' If users specify `aggLevels = "none"`, [FrEDI::aggregate_impacts()] returns the data frame passed to the `data` argument. #' -#' If users specify `aggLevels= "all"` or other combinations of aggregation levels, the [FrEDI::aggregate_impacts()] function uses performs the following calculations using the grouping columns specified by the `groupByCols` argument: `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, `"model"`, `"sectorprimary"`, `"includeaggregate"`, `"physicalmeasure"`, and `"year"`. +#' If users specify `aggLevels = "all"` or other combinations of aggregation levels, the [FrEDI::aggregate_impacts()] function uses performs the following calculations using the grouping columns specified by the `groupByCols` argument: `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, `"model"`, `"sectorprimary"`, `"includeaggregate"`, `"physicalmeasure"`, and `"year"`. #' #' \tabular{ll}{ #' \strong{Aggregation Level} \tab \strong{Description} \cr -#' *`impactyear`* \tab To aggregate over impact years, [FrEDI::aggregate_impacts()] first separates results for sectors with only one impact year estimate (i.e., `impactYear= "N/A"`) from from observations with multiple impact year estimates (i.e., sectors with results for both `impactYear= "2010"` and `impactYear= "2090"`). For these sectors with multiple impact years, physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`) are linearly interpolated between impact year estimates. For any model run years above 2090, annual results for sectors with multiple impact years return the 2090 estimate. The interpolated values are then row-bound to the results for sectors with a single impact year estimate, and column `impactYear` set to `impactYear= "Interpolation"` for all values. If `"impactyear"` is included in `aggLevels` (e.g., `aggLevels= "all"`), [FrEDI::aggregate_impacts()] aggregates over impact years before performing other types of aggregation. \cr +#' *`impactyear`* \tab To aggregate over impact years, [FrEDI::aggregate_impacts()] first separates results for sectors with only one impact year estimate (i.e., `impactYear = "N/A"`) from from observations with multiple impact year estimates (i.e., sectors with results for both `impactYear = "2010"` and `impactYear = "2090"`). For these sectors with multiple impact years, physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`) are linearly interpolated between impact year estimates. For any model run years above 2090, annual results for sectors with multiple impact years return the 2090 estimate. The interpolated values are then row-bound to the results for sectors with a single impact year estimate, and column `impactYear` set to `impactYear = "Interpolation"` for all values. If `"impactyear"` is included in `aggLevels` (e.g., `aggLevels = "all"`), [FrEDI::aggregate_impacts()] aggregates over impact years before performing other types of aggregation. \cr #' -#' *`modelaverage`* \tab To aggregate over models for temperature-driven sectors, [FrEDI::aggregate_impacts()] averages physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all GCM models present in the data. [FrEDI::aggregate_impacts()] drops the column `"model"` from the grouping columns when averaging over models. Averages exclude observations with missing values. However, If all values within a grouping are missing, the model average is set to `NA`. The values in column `"model"` are set to `"Average"` for model averages and the model averages data frame is then row-bound to the main results data frame. For SLR-driven sectors, there is no need for additional model aggregation; these values already have `model="Interpolation"`. If `"modelaverage"` is included in `aggLevels` (e.g., `aggLevels= "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years (if `"impactyear"` present in `aggLevels` or if `aggLevels="all"`) before aggregating over models.\cr +#' *`modelaverage`* \tab To aggregate over models for temperature-driven sectors, [FrEDI::aggregate_impacts()] averages physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all GCM models present in the data. [FrEDI::aggregate_impacts()] drops the column `"model"` from the grouping columns when averaging over models. Averages exclude observations with missing values. However, If all values within a grouping are missing, the model average is set to `NA`. The values in column `"model"` are set to `"Average"` for model averages and the model averages data frame is then row-bound to the main results data frame. For SLR-driven sectors, there is no need for additional model aggregation; these values already have `model = "Interpolation"`. If `"modelaverage"` is included in `aggLevels` (e.g., `aggLevels = "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years (if `"impactyear"` present in `aggLevels` or if `aggLevels = "all"`) before aggregating over models.\cr #' -#' *`national`* \tab To aggregate values to the national level, [FrEDI::aggregate_impacts()] sums physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all regions present in the data. [FrEDI::aggregate_impacts()] drops the columns `"region"`, `"state"`, and `"postal"` when summing over states and regions. Years which have missing column data for all regions return as `NA`. Values for column `"region"` are set to `"National Total"`; values for column `"state"` are set to `All`, and values for column `"postal"` are set to `US`. The data frame with national totals is then row-bound to the main results data frame. If `"national"` is included in `aggLevels` (e.g., `aggLevels= "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years and/or models (if `"impactyear"` and/or `"modelaverage"` are present in `aggLevels` or if `aggLevels= "all"`) before aggregating over models.\cr +#' *`national`* \tab To aggregate values to the national level, [FrEDI::aggregate_impacts()] sums physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all states present in the data. [FrEDI::aggregate_impacts()] drops the columns `"region"`, `"state"`, and `"postal"` when summing over states and regions. Years which have missing column data for all states return as `NA`. Values for columns `"region"`, `"state"`, and `"postal"` are set to `"National Total"`, `All`, and `US`, respectively. The data frame with national totals is then row-bound to the main results data frame. If `"national"` is included in `aggLevels` (e.g., `aggLevels = "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years and/or models (if `"impactyear"` and/or `"modelaverage"` are present in `aggLevels` or if `aggLevels = "all"`) before aggregating over models.\cr #' #' *`impacttype`* \tab To aggregate values over impact types, [FrEDI::aggregate_impacts()] sums annual impacts (column `"annual_impacts"`) across all impact types for each sector. [FrEDI::aggregate_impacts()] drops the column `"impactType"` and `"physicalmeasure"` from the grouping columns when summing over impact types. Years which have missing column data for all impact types return as `NA`. All values in column `"impactType"` are set to `"all"`. Aggregating over impact types, drops columns related to physical impacts (i.e., columns `"physicalmeasure"` and `"physical_impacts"`). These columns are dropped since aggregating over impact types for some sectors requires summing costs over different types of physical impacts, so reporting the physical impacts would be nonsensical.\cr #' } diff --git a/FrEDI/R/import_inputs.R b/FrEDI/R/import_inputs.R index 4a4c9213..c42e3bf7 100644 --- a/FrEDI/R/import_inputs.R +++ b/FrEDI/R/import_inputs.R @@ -1,13 +1,13 @@ #' Import custom scenarios for temperature, global mean sea level rise (GMSL), population, and GDP from user-specified file names #' #' @description -#' This function enables users to import data on custom scenarios for use with [FrEDI::FREDI] (supplied as inputs to [FrEDI::run_fredi()]). Users specify path names to CSV files containing temperature, global mean sea level rise (GMSL), gross domestic product (GDP), and population scenarios. [FrEDI::import_inputs()] reads in and format any specified files as data frames and returns a list of data frames for imported scenarios. +#' This function enables users to import data on custom scenarios for use with [FrEDI::run_fredi()]. Users specify path names to CSV files containing temperature, global mean sea level rise (GMSL), gross domestic product (GDP), and state population scenarios. [FrEDI::import_inputs()] reads in and format any specified files as data frames and returns a list of data frames for imported scenarios. #' #' @param tempfile A character string indicating the location of a CSV file containing a custom temperature scenario (first column contains years; second column contains temperatures, in degrees Celsius, above the 1995 baseline year). The temperature scenario must start in 2000 or earlier and end at or after the maximum model run year (e.g., as specified by the `maxYear` argument to [FrEDI::run_fredi()]). #' @param slrfile A character string indicating the location of a CSV file containing a custom sea level rise scenario (first column contains years; second column contains values for global mean sea level rise (GMSL), in centimeters, above the 2000 baseline). The SLR scenario must start in 2000 or earlier and end at or after the maximum model run year (e.g., as specified by the `maxYear` argument to [FrEDI::run_fredi()]). -#' @param popfile A character string indicating the location of a CSV file containing a custom population scenario for states and NCA regions. The first column contains years in the interval 2010 to 2300. The second column should contain the NCA Region label associated with the state. The third column should contain state names. The fourth column should contain the state postal code abbreviation. The fifth column should contain the population values. The population scenario must start in 2010 or earlier and end at or after the maximum model run year (e.g., as specified by the `maxYear` argument to [FrEDI::run_fredi()]). +#' @param popfile A character string indicating the location of a CSV file containing a custom population scenario for states and NCA regions. The first column contains years in the interval 2010 to 2300. The second column should contain the NCA Region label associated with the state. The third column should contain state names. The fourth column should contain the state postal code abbreviation (e.g., `postal = "ME"` for `state = "Maine"`. The fifth column should contain the state population values. The population scenario must start in 2010 or earlier and end at or after the maximum model run year (e.g., as specified by the `maxYear` argument to [FrEDI::run_fredi()]). #' @param gdpfile A character string indicating the location of a CSV file containing a custom scenario for gross domestic product (GDP) (first column contains years; second column contains values for GDP, in total 2015$). The GDP scenario must start in 2010 or earlier and end at or after the maximum model run year (e.g., as specified by the `maxYear` argument to [FrEDI::run_fredi()]). -#' @param temptype A character string indicating whether the temperature values in the temperature input file (specified by `tempfile` represent global temperature change (`temptype="global"`) or temperature change for the contiguous U.S. (`temptype="conus"`) in degrees Celsius. By default, the model assumes temperatures are CONUS temperatures (i.e., `temptype="conus"`). +#' @param temptype A character string indicating whether the temperature values in the temperature input file (specified by `tempfile` represent global temperature change (`temptype = "global"`) or temperature change for the contiguous U.S. (`temptype = "conus"`) in degrees Celsius. By default, the model assumes temperatures are CONUS temperatures (i.e., `temptype = "conus"`). #' #' #' @@ -17,7 +17,7 @@ #' #' #' * __Temperature Inputs.__ The input temperature scenario requires CONUS temperatures in degrees Celsius relative to 1995 (degrees of warming relative to the baseline year--i.e., the central year of the 1986-2005 baseline). CONUS temperature values must be greater than or equal to zero degrees Celsius. -#' * Users can convert global temperatures to CONUS temperatures using [FrEDI::convertTemps]`(from="global")` (or by specifying [FrEDI::import_inputs]`(temptype="global")` when using [FrEDI::import_inputs()] to import a temperature scenario from a CSV file). +#' * Users can convert global temperatures to CONUS temperatures using [FrEDI::convertTemps]`(from = "global")` (or by specifying [FrEDI::import_inputs]`(temptype = "global")` when using [FrEDI::import_inputs()] to import a temperature scenario from a CSV file). #' * Temperature inputs must have at least one non-missing value in 2000 or earlier and at least one non-missing value in or after the final analysis year (as specified by the [FrEDI::run_fredi()] `maxYear` argument). #' * __SLR Inputs.__ The input SLR scenario requires values for changes in global mean sea level rise (GMSL) heights in centimeters (cm). GMSL heights must be greater than or equal to zero. #' * `slrInput` requires a data frame object with two columns containing the year and global mean sea level rise (GMSL) in centimeters, respectively. @@ -32,9 +32,9 @@ #' #' #' -#' [FrEDI::import_inputs()] outputs a list of data frames that can be passed to the main FREDI function [FrEDI::run_fredi()] using the `inputList` argument. For example, specify `run_fredi(inputsList=x)` to generate impacts for a custom scenario `x` (where `x` is a list of data frames such as that output from [FrEDI::import_inputs()]) (see [FrEDI::run_fredi()]). +#' [FrEDI::import_inputs()] outputs a list of data frames that can be passed to the main FREDI function [FrEDI::run_fredi()] using the `inputList` argument. For example, specify `run_fredi(inputsList = x)` to generate impacts for a custom scenario `x` (where `x` is a list of data frames such as that output from [FrEDI::import_inputs()]) (see [FrEDI::run_fredi()]). #' -#' All inputs to [FrEDI::import_inputs()] are optional. If the user does not specify a file path for `tempfile`, `slrfile`, `gdpfile`, or `popfile` (or if there is an error reading in inputs from those file paths), [FrEDI::import_inputs()] outputs a list with a `NULL` value for the associated list element. [FrEDI::run_fredi()] defaults back to the default scenarios for any elements of the inputs list that are `NULL` or missing. In other words, running `run_fredi(inputsList=list())` returns the same outputs as running [FrEDI::run_fredi()] (see [FrEDI::run_fredi()]). +#' All inputs to [FrEDI::import_inputs()] are optional. If the user does not specify a file path for `tempfile`, `slrfile`, `gdpfile`, or `popfile` (or if there is an error reading in inputs from those file paths), [FrEDI::import_inputs()] outputs a list with a `NULL` value for the associated list element. When using [FrEDI::import_inputs()] with [FrEDI::run_fredi()], [FrEDI::run_fredi()] defaults back to the default scenarios for any elements of the inputs list that are `NULL` or missing. In other words, running `run_fredi(inputsList = list())` returns the same outputs as running [FrEDI::run_fredi()] (see [FrEDI::run_fredi()]). #' #' #' @return diff --git a/FrEDI/R/run_fredi.R b/FrEDI/R/run_fredi.R index 9d06fdf6..d20ea25b 100644 --- a/FrEDI/R/run_fredi.R +++ b/FrEDI/R/run_fredi.R @@ -4,25 +4,25 @@ #' #' #' @description -#' This function allows users to project annual average climate change impacts through 2090 (2010-2090) for available sectors (see [FrEDI::get_sectorInfo()]), with the option to extend results to 2300 (2010-2300). Users may specify custom temperature, U.S. population, and GDP scenarios. The output is an R data frame object containing annual average impacts, by year, for each sector, variant, impact type, region, state, and model. +#' This function allows users to project annual average climate change impacts through 2090 (2010-2090) for available sectors, with the option to extend results to 2300 (2010-2300). Users may specify custom temperature, U.S. population, and GDP scenarios. The output is an R data frame object containing annual average impacts, by year, for each sector, variant, impact type, region, state, and model. #' -#' As of FrEDI Version 4.0.1, [FrEDI::run_fredi()] calculates impacts at the state-level for the following sectors: **ATS Temperature-Related Mortality**, **Asphalt Roads**, **Climate-Driven Changes in Air Quality**, **Electricity Transmission and Distribution**, **Labor**, **Suicide**, **Transportation Impacts from High Tide Flooding**, **Urban Drainage**, **Wildfire**, **Wind Damage**. Eventually, all sectors will be converted to state-level. Sectors that have only region-level impacts will have values in the `"state"` and `"postal"` columns of the outputs data frame set to `"N/A"`. +#' As of FrEDI Version 4.1.0, [FrEDI::run_fredi()] calculates impacts at the state-level for all available sectors. #' -#' @param inputsList=NULL A list of named elements named elements (`names(inputsList) = c( "tempInput", "slrInput", "gdpInput", "popInput" )`), each containing data frames of custom temperature, global mean sea level rise (GMSL), gross domestic product (GDP), and/or population scenarios, respectively, over a continuous period in the range 2010 to 2300. Temperature and sea level rise inputs should start in 2000 or earlier. Values for population and GDP scenarios can start in 2010 or earlier. Values for each scenario type must be within reasonable ranges. For more information, see [FrEDI::import_inputs()]. +#' @param inputsList=NULL A list of named elements named elements (`names(inputsList) = c("tempInput", "slrInput", "gdpInput", "popInput")`), each containing data frames of custom temperature, global mean sea level rise (GMSL), gross domestic product (GDP), and/or state-level population trajectories, respectively, over a continuous period in the range 2010 to 2300. Temperature and sea level rise inputs should start in 2000 or earlier. Values for population and GDP scenarios can start in 2010 or earlier. Values for each scenario type must be within reasonable ranges. For more information, see [FrEDI::import_inputs()]. #' -#' @param sectorList=NULL A character vector indicating a selection of sectors for which to calculate results (see [FrEDI::get_sectorInfo()]). If `NULL`, all sectors are included (i.e., `sectorList=get_sectorInfo()`). +#' @param sectorList=NULL A character vector indicating a selection of sectors for which to calculate results (see [FrEDI::get_sectorInfo()]). If `NULL`, all sectors are included (i.e., `sectorList = get_sectorInfo()`). #' -#' @param aggLevels="all" Levels of aggregation at which to summarize data: one or more of `c("national"`, `"modelaverage"`, `"impactyear"`, `"impacttype"`, `"all"`, `"none")`. Defaults to all levels (i.e., `aggLevels= "all"`). Uses the same aggregation levels as [FrEDI::aggregate_impacts()]. Note that, if `"impacttype"` is in `aggLevels` (e.g., `aggLevels= "all"`), columns `"physical_measure"` and `"physical_impacts"` will be dropped from the results data frame. This is because aggregating over impact types for some sectors requires summing costs over different types of physical impacts, so reporting the physical impacts would be nonsensical. +#' @param aggLevels="all" Levels of aggregation at which to summarize data: one or more of `c("national"`, `"modelaverage"`, `"impactyear"`, `"impacttype"`, `"all"`, `"none")`. Defaults to all levels (i.e., `aggLevels = "all"`). Uses the same aggregation levels as [FrEDI::aggregate_impacts()]. Note that, if `"impacttype"` is in `aggLevels` (e.g., `aggLevels = "all"`), columns `"physical_measure"` and `"physical_impacts"` will be dropped from the results data frame. This is because aggregating over impact types for some sectors requires summing costs over different types of physical impacts, so reporting the physical impacts would be nonsensical. #' -#' @param elasticity=1 A numeric value indicating an elasticity to use for adjusting VSL for applicable sectors and impacts (defaults to `elasticity=1`). Applicable sectors and impacts are: **Climate-Driven Changes in Air Quality** (all impact types), **ATS Temperature-Related Mortality** (`impactType="N/A"`; i.e., all impact types), **CIL Temperature-Related Mortality**, **Extreme Temperature** (all impact types), **Suicide** (`impactType = "N/A"`; i.e., all impact types), **Southwest Dust** (`impactType= "All Mortality"`), **Valley Fever** (`impactType= "Mortality"`), **Vibriosis** (`impactType="N/A"`; i.e., all impact types), and **Wildfire** (`impactType = "Mortality"`). +#' @param elasticity=1 A numeric value indicating an elasticity to use for adjusting VSL for applicable sectors and impacts (defaults to `elasticity = 1`). Applicable sectors and impacts are: **Climate-Driven Changes in Air Quality** (all impact types), **ATS Temperature-Related Mortality** (`impactType = "N/A"`; i.e., all impact types), **CIL Temperature-Related Mortality**, **Extreme Temperature** (all impact types), **Suicide** (`impactType = "N/A"`; i.e., all impact types), **Southwest Dust** (`impactType = "All Mortality"`), **Valley Fever** (`impactType = "Mortality"`), **Vibriosis** (`impactType = "N/A"`; i.e., all impact types), and **Wildfire** (`impactType = "Mortality"`). #' -#' @param maxYear=2090 A numeric value indicating the maximum year for the analysis. The range for `maxYear` is `[2011, 2300]. `Defaults to `maxYear=2090`. +#' @param maxYear=2090 A numeric value indicating the maximum year for the analysis. The range for `maxYear` is `[2011, 2300]`. Defaults to `maxYear = 2090`. #' -#' @param thru2300=FALSE A ` TRUE/FALSE` shortcut that overrides the maxYear argument to run the model to 2300. Defaults to `thru2300=FALSE`. +#' @param thru2300=FALSE A ` TRUE/FALSE` shortcut that overrides the `maxYear` argument to run the model to 2300. Defaults to `thru2300 = FALSE`. #' #' @param outputList=FALSE A ` TRUE/FALSE` value indicating whether to output results as a data frame object (`outputList = FALSE`, default) or to return a list of objects (`outputList = TRUE`) that includes information about model provenance (including input arguments and input scenarios) along with the data frame of results. #' -#' @param allCols=FALSE A `TRUE/FALSE` value indicating whether to include intermediate column values in results (e.g., physical and economic multipliers). Used in testing. Note that aggregation levels must be set to `aggLevels="none"` to properly return the intermediate columns. Defaults to `allCols=FALSE`). +#' @param allCols=FALSE A `TRUE/FALSE` value indicating whether to include intermediate column values in results (e.g., physical and economic multipliers). Used in testing. Note that aggregation levels must be set to `aggLevels = "none"` to properly return the intermediate columns. Defaults to `allCols = FALSE`). #' #' @param silent=TRUE A `TRUE/FALSE` value indicating the level of messaging desired by the user (default=`TRUE`). #' @@ -30,83 +30,82 @@ #' #' @details This function allows users to project annual average climate change impacts through 2300 (2010-2300) for available sectors. [FrEDI::run_fredi()] is the main function in the [FrEDI] R package, described elsewhere (See for more information). #' -#' #' Users can specify an optional list of custom scenarios with `inputsList` (for more information on the format of inputs, see [FrEDI::import_inputs()]). The function [FrEDI::import_inputs()] can be used to importing custom scenarios from CSV files. [FrEDI::import_inputs()] returns a list with elements `tempInput`, `slrInput`, `gdpInput`, and `popInput`, with each containing a data frame with a custom scenario for temperature, GMSL, GDP, and state-level population, respectively. If a user imports scenarios using [FrEDI::import_inputs()], they can pass the outputs of [FrEDI::import_inputs()] directly to the [FrEDI::run_fredi()] argument `inputsList`. Note that the documentation for [FrEDI::import_inputs()] can also provide additional guidance and specification on the formats for each scenario type. #' -#' If `inputsList=NULL`, [FrEDI::run_fredi()] uses defaults for temperature, SLR, GDP, and population. Otherwise, [FrEDI::run_fredi()] looks for a list object passed to the argument `inputsList`. Within that list, [FrEDI::run_fredi()] looks for list elements `tempInput`, `slrInput`, `gdpInput`, and `popInput` containing data frames with custom scenarios for temperature, GMSL, GDP, and regional population, respectively. [FrEDI::run_fredi()] will default back to the default scenarios for any list elements that empty or `NULL` (in other words, running `run_fredi( inputsList = list() )` returns the same outputs as running [FrEDI::run_fredi()]). +#' If `inputsList = NULL`, [FrEDI::run_fredi()] uses defaults for temperature, SLR, GDP, and population. Otherwise, [FrEDI::run_fredi()] looks for a list object passed to the argument `inputsList`. Within that list, [FrEDI::run_fredi()] looks for list elements `tempInput`, `slrInput`, `gdpInput`, and `popInput` containing data frames with custom scenarios for temperature, GMSL, GDP, and regional population, respectively. [FrEDI::run_fredi()] will default back to the default scenarios for any list elements that empty or `NULL` (in other words, running `run_fredi(inputsList = list())` returns the same outputs as running [FrEDI::run_fredi()]). #' #' * __Temperature Inputs.__ The input temperature scenario requires CONUS temperatures in degrees Celsius relative to 1995 (degrees of warming relative to the baseline year--i.e., the central year of the 1986-2005 baseline). CONUS temperature values must be greater than or equal to zero degrees Celsius. -#' * Users can convert global temperatures to CONUS temperatures using [FrEDI::convertTemps]`(from="global")` (or by specifying [FrEDI::import_inputs]`( temptype = "global" )` when using [FrEDI::import_inputs()] to import a temperature scenario from a CSV file). +#' * Users can convert global temperatures to CONUS temperatures using [FrEDI::convertTemps]`(from = "global")` (or by specifying [FrEDI::import_inputs]`(temptype = "global")` when using [FrEDI::import_inputs()] to import a temperature scenario from a CSV file). #' * `tempInput` requires a data frame object with two columns with names `"year"`, and `"temp_C"` containing the year and CONUS temperatures in degrees Celsius, respectively. #' * Temperature inputs must have at least one non-missing value in 2000 or earlier and at least one non-missing value in or after the final analysis year (as specified by `maxYear`). -#' * If the user does not specify an input scenario for temperature (i.e., `inputsList=list(tempInput=NULL)`, [FrEDI::run_fredi()] uses a default temperature scenario. +#' * If the user does not specify an input scenario for temperature (i.e., `inputsList = list(tempInput = NULL)`, [FrEDI::run_fredi()] uses a default temperature scenario. #' * __SLR Inputs.__ The input SLR scenario requires values for changes in global mean sea level rise (GMSL) heights in centimeters (cm). GMSL heights must be greater than or equal to zero. #' * `slrInput` requires a data frame object with two columns with names `"year"`, `"slr_cm"` containing the year and global mean sea level rise (GMSL) in centimeters, respectively. #' * SLR inputs must have at least one non-missing value in 2000 or earlier and at least one non-missing value in or after the final analysis year (as specified by `maxYear`). -#' * If the user does not specify an input scenario for SLR (i.e., `inputsList=list(slrInput=NULL)`, [FrEDI::run_fredi()] first converts the input or default CONUS temperature scenario to global temperatures (using [FrEDI::convertTemps()]) and then converts the global temperatures to a global mean sea level rise (GMSL) height in centimeters (using [FrEDI::temps2slr()]). +#' * If the user does not specify an input scenario for SLR (i.e., `inputsList = list(slrInput = NULL)`, [FrEDI::run_fredi()] first converts the input or default CONUS temperature scenario to global temperatures (using [FrEDI::convertTemps()]) and then converts the global temperatures to a global mean sea level rise (GMSL) height in centimeters (using [FrEDI::temps2slr()]). #' * __GDP Inputs.__ The input scenario for gross domestic product (GDP) requires national GDP values in 2015$. GDP values must be greater than or equal to zero. #' * `gdpInput` requires a data frame object with five columns with names `"year"`, and `"gdp_usd"` containing the year and the national GDP, respectively. GDP values must be greater than or equal to zero. #' * GDP inputs must have at least one non-missing value in 2010 or earlier and at least one non-missing value in or after the final analysis year (as specified by `maxYear`). -#' * If the user does not specify an input scenario for GDP (i.e., `inputsList=list(gdpInput=NULL)`, [FrEDI::run_fredi()] uses a default GDP scenario. +#' * If the user does not specify an input scenario for GDP (i.e., `inputsList = list(gdpInput = NULL)`, [FrEDI::run_fredi()] uses a default GDP scenario. #' * __Population Inputs.__ The input population scenario requires state-level population values. Population values must be greater than or equal to zero. -#' * `popInput` requires a data frame object with five columns with names `"year"`, `"region"`, `"state"`, `"postal"`, and `"state_pop"` containing the year, the NCA region name, and the state, the postal code abbreviation, and the state population, respectively. +#' * `popInput` requires a data frame object with five columns with names `"year"`, `"region"`, `"state"`, `"postal"`, and `"state_pop"` containing the year, the NCA region name, the state name, the postal code abbreviation for the state, and the state population, respectively. #' * Population inputs must have at least one non-missing value in 2010 or earlier and at least one non-missing value in or after the final analysis year (as specified by `maxYear`). -#' * If the user does not specify an input scenario for population (i.e., `inputsList=list(popInput=NULL)`, [FrEDI::run_fredi()] uses a default population scenario. +#' * If the user does not specify an input scenario for population (i.e., `inputsList = list(popInput = NULL)`, [FrEDI::run_fredi()] uses a default population scenario. #' #' #' [FrEDI::run_fredi()] linearly interpolates missing annual values for all input scenarios using non-missing values (each scenario requires at least two non-missing values as detailed above for each scenario type). After interpolation of the input scenarios, [FrEDI::run_fredi()] subsets the input scenarios to values within the analysis period. #' -#' * Temperatures are interpolated using 1995 as the baseline year (i.e., the central year of the 1986-2005 baseline) and GMSL is interpolated using 2000 as the baseline year. In other words, temperature (in degrees Celsius) is set to zero for the year 1995, whereas GMSL is set to zero for the year 2000. The interpolated temperature and GMSL scenarios are combined into a column called `driverValue`, along with additional columns for year, the driver unit (column `"driverUnit"`, with `driverUnit= "degrees Celsius"` and `driverUnit= "cm"` for temperature- and SLR-driven sectors, respectively), and the associated model type (column `"model_type"`, with `model_type="GCM"` and `model_type="SLR"` for temperature- and SLR-driven sectors, respectively +#' * Temperatures are interpolated using 1995 as the baseline year (i.e., the central year of the 1986-2005 baseline) and GMSL is interpolated using 2000 as the baseline year. In other words, temperature (in degrees Celsius) is set to zero for the year 1995, whereas GMSL is set to zero for the year 2000. The interpolated temperature and GMSL scenarios are combined into a column called `driverValue`, along with additional columns for year, the driver unit (column `"driverUnit"`, with `driverUnit = "degrees Celsius"` and `driverUnit = "cm"` for temperature- and SLR-driven sectors, respectively), and the associated model type (column `"model_type"`, with `model_type = "GCM"` and `model_type = "SLR"` for temperature- and SLR-driven sectors, respectively #' * [FrEDI::run_fredi()] calculations national population from state-level values and then calculates GDP per capita from values for GDP and national population. Values for state population, national population, national GDP (in 2015$), and national per capita GDP (in 2015$/capita) are provided in the results data frame in columns `"state_pop"`, `"national_pop"`, `"gdp_usd"`, and `"gdp_percap"`, respectively. #' -#' By default, [FrEDI::run_fredi()] will calculate impacts for all sectors included in the tool. Alternatively, users can pass a character vector specifying a single sector or a subset of sectors using the `sectorList` argument. To see a list of sectors included within [FrEDI], run [FrEDI::get_sectorInfo()]. If `sectorList= NULL` (default), all sectors are included. +#' By default, [FrEDI::run_fredi()] will calculate impacts for all sectors included in the tool. Alternatively, users can pass a character vector specifying a single sector or a subset of sectors using the `sectorList` argument. To see a list of sectors included within [FrEDI], run [FrEDI::get_sectorInfo()]. If `sectorList = NULL` (default), all sectors are included. #' -#' By default, [FrEDI::run_fredi()] calculates impacts starting in the year 2010 and ending in 2090. Specify an alternative end year for the analysis using the `maxYear` argument. `maxYear` has a default value of `2090` and minimum and maximum values of `2011` and `2300`, respectively. Alternatively, users can set argument `thru2300=TRUE` to override the `maxYear` argument and set `maxYear=2300`. Note that the default scenarios included within [FrEDI] stop in the year 2090; users must provide custom input scenarios out to the desired end year **and** specify a `maxYear>=2090` (and `maxYear<=2300`) in order to return non-missing values for years after 2090. +#' By default, [FrEDI::run_fredi()] calculates impacts starting in the year 2010 and ending in 2090. Specify an alternative end year for the analysis using the `maxYear` argument. `maxYear` has a default value of `2090` and minimum and maximum values of `2011` and `2300`, respectively. Alternatively, users can set argument `thru2300 = TRUE` to override the `maxYear` argument and set `maxYear = 2300`. Note that the default scenarios included within [FrEDI] stop in the year 2090; users must provide custom input scenarios out to the desired end year **and** specify a `maxYear >= 2090` (and `maxYear <= 2300`) in order to return non-missing values for years after 2090. #' -#' Annual impacts for each sector, variant, impact type, and impact year combination included in the model are calculated by multiplying scaled climate impacts by a physical scalar and economic scalars and multipliers. Some sectors use Value of a Statistical Life (VSL) to adjust the value non-linearly over time. [FrEDI::run_fredi()] uses a default value of `elasticity=1`to adjust VSL for applicable sectors and impacts (the default value of `elasticity=1` keeps VSL constant over time). A custom elasticity can be passed to the `elasticity` argument.Applicable sectors and impacts are ***Climate-Driven Changes in Air Quality** (all impact types), **ATS Temperature-Related Mortality** (`impactType="N/A"`; i.e., all impact types), **CIL Temperature-Related Mortality**, **Extreme Temperature** (all impact types), **Suicide** (`impactType = "N/A"`; i.e., all impact types), **Southwest Dust** (`impactType= "All Mortality"`), **Valley Fever** (`impactType= "Mortality"`), **Vibriosis** (`impactType="N/A"`; i.e., all impact types), and **Wildfire** (`impactType = "Mortality"`). +#' Annual impacts for each sector, variant, impact type, and impact year combination included in the model are calculated by multiplying scaled climate impacts by a physical scalar and economic scalars and multipliers. Some sectors use Value of a Statistical Life (VSL) to adjust the value non-linearly over time. [FrEDI::run_fredi()] uses a default value of `elasticity = 1`to adjust VSL for applicable sectors and impacts (the default value of `elasticity = 1` keeps VSL constant over time). A custom elasticity can be passed to the `elasticity` argument. Applicable sectors and impacts are ***Climate-Driven Changes in Air Quality** (all impact types), **ATS Temperature-Related Mortality** (`impactType = "N/A"`; i.e., all impact types), **CIL Temperature-Related Mortality**, **Extreme Temperature** (all impact types), **Suicide** (`impactType = "N/A"`; i.e., all impact types), **Southwest Dust** (`impactType = "All Mortality"`), **Valley Fever** (`impactType = "Mortality"`), **Vibriosis** (`impactType = "N/A"`; i.e., all impact types), and **Wildfire** (`impactType = "Mortality"`). #' -#' [FrEDI::run_fredi()] aggregates or summarizes results to level(s) of aggregation specified by the user (passed to `aggLevels`) using the post-processing helper function [FrEDI::aggregate_impacts()]. Users can specify all aggregation levels at once by specifying `aggLevels= "all"` (default) or no aggregation levels (`aggLevels= "none"`). Users can specify a single aggregation level or multiple aggregation levels by passing a single character string or character vector to `aggLevels`. Options for aggregation include calculating national totals (`aggLevels= "national"`), averaging across model types and models (`aggLevels= "modelaverage"`), summing over all impact types (`aggLevels= "impacttype"`), and interpolating between impact year estimates (`aggLevels= "impactYear"`). +#' [FrEDI::run_fredi()] aggregates or summarizes results to level(s) of aggregation specified by the user (passed to `aggLevels`) using the post-processing helper function [FrEDI::aggregate_impacts()]. Users can specify all aggregation levels at once by specifying `aggLevels = "all"` (default) or no aggregation levels (`aggLevels = "none"`). Users can specify a single aggregation level or multiple aggregation levels by passing a single character string or character vector to `aggLevels`. Options for aggregation include calculating national totals (`aggLevels = "national"`), averaging across model types and models (`aggLevels = "modelaverage"`), summing over all impact types (`aggLevels = "impacttype"`), and interpolating between impact year estimates (`aggLevels = "impactYear"`). #' -#' If the user specifies `aggLevels= "none"`, [FrEDI::run_fredi()] returns a data frame with columns: `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, `"model"`, `"sectorprimary"`, `"includeaggregate"`, `"physicalmeasure"`, `"driverType"`, `"driverUnit"`, `"driverValue"`, `"gdp_usd"`, `"national_pop"`, `"gdp_percap"`, `"state_pop"`, `"year"`, `"physical_impacts"`, and `"annual_impacts"`. +#' If the user specifies `aggLevels = "none"`, [FrEDI::run_fredi()] returns a data frame with columns: `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, `"model"`, `"sectorprimary"`, `"includeaggregate"`, `"physicalmeasure"`, `"driverType"`, `"driverUnit"`, `"driverValue"`, `"gdp_usd"`, `"national_pop"`, `"gdp_percap"`, `"state_pop"`, `"year"`, `"physical_impacts"`, and `"annual_impacts"`. #' #' -#' * Columns `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, and `"model"` all contain observation identifiers (sector name, variant (i.e., sector variant or adaptation name), impact type, impact year, region, state, state postal code, model type, and model, respectively). -#' * Column `"sectorprimary"` contains values indicating which variant (i.e., sector variant or adaptation name) is the primary one for the sector (`sectorprimary=1`for primary variants and `sectorprimary=0` for non-primary variants). This column can be used to filter the outputs of [FrEDI::run_fredi()] (e.g., as might be done before aggregating impacts over sectors). -#' * Column `"includeaggregate"` contains values indicating which sectors should be included when aggregating over sectors (`includeaggregate=1`for primary sectors and `includeaggregate=0` for non-primary sectors). For instance, sectors __ATS Temperature-Related Mortality__, __CIL Temperature-Related Mortality__, and __Extreme Temperature__ have values for temperature-related mortality. To avoid double counting, outputs of [FrEDI::run_fredi()] should be filtered to values for which `sectorprimary==1` and `includeaggregate=1`. +#' * Columns `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, and `"model"` all contain observation identifiers (sector name, variant (i.e., sector variant or adaptation name), impact type, impact year, region, state, state postal code abbreviation, model type, and model, respectively). +#' * Column `"sectorprimary"` contains values indicating which variant (i.e., sector variant or adaptation name) is the primary one for the sector (`sectorprimary = 1`for primary variants and `sectorprimary = 0` for non-primary variants). This column can be used to filter the outputs of [FrEDI::run_fredi()] (e.g., as might be done before aggregating impacts over sectors). +#' * Column `"includeaggregate"` contains values indicating which sectors should be included when aggregating over sectors (`includeaggregate = 1`for primary sectors and `includeaggregate = 0` for non-primary sectors). For instance, sectors __ATS Temperature-Related Mortality__, __CIL Temperature-Related Mortality__, and __Extreme Temperature__ have values for temperature-related mortality. To avoid double counting, outputs of [FrEDI::run_fredi()] should be filtered to values for which `sectorprimary = 1` and `includeaggregate = 1`. #' * Columns `"driverType"`, `"driverUnit"`, and `"driverValue"` contain information about the temperature and SLR scenarios. #' * Columns `"gdp_usd"`, `"national_pop"`, `"gdp_percap"`, and `"state_pop"` contain information about the GDP and population scenarios. #' * Columns `"physicalmeasure"` and `"physical_impacts"` contain information about physical impacts. #' * Column `"annual_impacts"` contains information on the economic value associated with annual impacts. #' #' -#' If the user specifies `aggLevels= "all"` or other combinations of aggregation levels, [FrEDI::run_fredi()] passes the results data frame and the `aggLevels` argument to the [FrEDI::aggregate_impacts()] function. [FrEDI::aggregate_impacts()] then performs the following calculations, using the default grouping columns for the [FrEDI::aggregate_impacts()]: `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, `"model"`, `"sectorprimary"`, `"includeaggregate"`, `"physicalmeasure"`, and `"year"` (note that the `"variant"` column referred to below contains information about the variant name (or `“N/A”`), as applicable). +#' If the user specifies `aggLevels = "all"` or other combinations of aggregation levels, [FrEDI::run_fredi()] passes the results data frame and the `aggLevels` argument to the [FrEDI::aggregate_impacts()] function. [FrEDI::aggregate_impacts()] then performs the following calculations, using the default grouping columns for the [FrEDI::aggregate_impacts()]: `"sector"`, `"variant"`, `"impactType"`, `"impactYear"`, `"region"`, `"state"`, `"postal"`, `"model_type"`, `"model"`, `"sectorprimary"`, `"includeaggregate"`, `"physicalmeasure"`, and `"year"` (note that the `"variant"` column referred to below contains information about the variant name (or `“N/A”`), as applicable). #' #' \tabular{ll}{ #' \strong{Aggregation Level} \tab \strong{Description} \cr -#' *`impactyear`* \tab To aggregate over impact years, [FrEDI::aggregate_impacts()] first separates results for sectors with only one impact year estimate (i.e., `impactYear= "N/A"`) from from observations with multiple impact year estimates (i.e., sectors with results for both `impactYear= "2010"` and `impactYear= "2090"`). For these sectors with multiple impact years, physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`) are linearly interpolated between impact year estimates. For any model run years above 2090, annual results for sectors with multiple impact years return the 2090 estimate. The interpolated values are then row-bound to the results for sectors with a single impact year estimate, and column `impactYear` set to `impactYear= "Interpolation"` for all values. If `"impactyear"` is included in `aggLevels` (e.g., `aggLevels= "all"`), [FrEDI::aggregate_impacts()] aggregates over impact years before performing other types of aggregation. \cr +#' *`impactyear`* \tab To aggregate over impact years, [FrEDI::aggregate_impacts()] first separates results for sectors with only one impact year estimate (i.e., `impactYear = "N/A"`) from from observations with multiple impact year estimates (i.e., sectors with results for both `impactYear = "2010"` and `impactYear = "2090"`). For these sectors with multiple impact years, physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`) are linearly interpolated between impact year estimates. For any model run years above 2090, annual results for sectors with multiple impact years return the 2090 estimate. The interpolated values are then row-bound to the results for sectors with a single impact year estimate, and column `impactYear` set to `impactYear = "Interpolation"` for all values. If `"impactyear"` is included in `aggLevels` (e.g., `aggLevels = "all"`), [FrEDI::aggregate_impacts()] aggregates over impact years before performing other types of aggregation. \cr #' -#' *`modelaverage`* \tab To aggregate over models for temperature-driven sectors, [FrEDI::aggregate_impacts()] averages physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all GCM models present in the data. [FrEDI::aggregate_impacts()] drops the column `"model"` from the grouping columns when averaging over models. Averages exclude observations with missing values. However, If all values within a grouping are missing, the model average is set to `NA`. The values in column `"model"` are set to `"Average"` for model averages and the model averages data frame is then row-bound to the main results data frame. For SLR-driven sectors, there is no need for additional model aggregation; these values already have `model="Interpolation"`. If `"modelaverage"` is included in `aggLevels` (e.g., `aggLevels= "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years (if `"impactyear"` present in `aggLevels` or if `aggLevels="all"`) before aggregating over models.\cr +#' *`modelaverage`* \tab To aggregate over models for temperature-driven sectors, [FrEDI::aggregate_impacts()] averages physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all GCM models present in the data. [FrEDI::aggregate_impacts()] drops the column `"model"` from the grouping columns when averaging over models. Averages exclude observations with missing values. However, If all values within a grouping are missing, the model average is set to `NA`. The values in column `"model"` are set to `"Average"` for model averages and the model averages data frame is then row-bound to the main results data frame. For SLR-driven sectors, there is no need for additional model aggregation; these values already have `model = "Interpolation"`. If `"modelaverage"` is included in `aggLevels` (e.g., `aggLevels = "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years (if `"impactyear"` present in `aggLevels` or if `aggLevels = "all"`) before aggregating over models.\cr #' -#' *`national`* \tab To aggregate values to the national level, [FrEDI::aggregate_impacts()] sums physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all regions present in the data. [FrEDI::aggregate_impacts()] drops the columns `"region"`, `"state"`, and `"postal"` when summing over states and regions. Years which have missing column data for all regions return as `NA`. Values for column `"region"` are set to `"National Total"`; values for column `"state"` are set to `All`, and values for column `"postal"` are set to `US`. The data frame with national totals is then row-bound to the main results data frame. If `"national"` is included in `aggLevels` (e.g., `aggLevels= "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years and/or models (if `"impactyear"` and/or `"modelaverage"` are present in `aggLevels` or if `aggLevels= "all"`) before aggregating over models.\cr +#' *`national`* \tab To aggregate values to the national level, [FrEDI::aggregate_impacts()] sums physical impacts and annual costs (columns `"physical_impacts"` and `"annual_impacts"`, respectively) across all states present in the data. [FrEDI::aggregate_impacts()] drops the columns `"region"`, `"state"`, and `"postal"` when summing over states and regions. Years which have missing column data for all regions return as `NA`. Values for columns `"region"`, `"state"`, and `"postal"` are set to `"National Total"`, `All`, and `US`, respectively. The data frame with national totals is then row-bound to the main results data frame. If `"national"` is included in `aggLevels` (e.g., `aggLevels = "all"`), [FrEDI::aggregate_impacts()] first aggregates over impact years and/or models (if `"impactyear"` and/or `"modelaverage"` are present in `aggLevels` or if `aggLevels = "all"`) before aggregating over models.\cr #' #' *`impacttype`* \tab To aggregate values over impact types, [FrEDI::aggregate_impacts()] sums annual impacts (column `"annual_impacts"`) across all impact types for each sector. [FrEDI::aggregate_impacts()] drops the column `"impactType"` and `"physicalmeasure"` from the grouping columns when summing over impact types. Years which have missing column data for all impact types return as `NA`. All values in column `"impactType"` are set to `"all"`. Aggregating over impact types, drops columns related to physical impacts (i.e., columns `"physicalmeasure"` and `"physical_impacts"`). These columns are dropped since aggregating over impact types for some sectors requires summing costs over different types of physical impacts, so reporting the physical impacts would be nonsensical.\cr #' } #' #' After aggregating values, [FrEDI::aggregate_impacts()] joins the data frame of impacts with information about `"driverType"`, `"driverUnit"`, `"driverValue"`, `"gdp_usd"`, `"national_pop"`, `"gdp_percap"`, and `"state_pop"`. #' -#' If `outputList=FALSE` (default), [FrEDI::run_fredi()] returns a data frame of annual average impacts over the analysis period, for each sector, variant, impact type, impact year, region, state, model type (`"GCM"` or `"SLR"`), and model. If `outputList=TRUE`, in addition to the data frame of impacts, [FrEDI::run_fredi()] returns a list object containing information about values for function arguments, driver scenarios, and population and GDP scenarios. +#' If `outputList = FALSE` (default), [FrEDI::run_fredi()] returns a data frame of annual average impacts over the analysis period, for each sector, variant, impact type, impact year, region, state, model type (`"GCM"` or `"SLR"`), and model. If `outputList = TRUE`, in addition to the data frame of impacts, [FrEDI::run_fredi()] returns a list object containing information about values for function arguments, driver scenarios, and population and GDP scenarios. #' #' #' #' @return -#' If `outputList=FALSE`, the output of [FrEDI::run_fredi()] is a dataframe object (described above) containing annual average impacts over the analysis period, for each sector, variant, impact type, impact year, region, state, and model (GCM name for temperature-driven sectors and "Interpolation" for SLR-driven sectors). +#' If `outputList=FALSE`, the output of [FrEDI::run_fredi()] is a data frame object (described above) containing annual average impacts over the analysis period, for each sector, variant, impact type, impact year, region, state, and model (GCM name for temperature-driven sectors and `"Interpolation"` for SLR-driven sectors). #' #' If `outputList=TRUE`, [FrEDI::run_fredi()] returns a list object containing the following: #' #' * __`statusList`__. A list with values for the arguments passed to [FrEDI::run_fredi()] (including defaults if unspecified). #' * __`argsList`__. A list with elements named after [FrEDI::run_fredi()] arguments, containing the values of the arguments passed to [FrEDI::run_fredi()] (or default values if unspecified). #' * __`scenarios`__. A list with named elements `"temp"`, `"slr"`, `"gdp"`, and `"pop"` -- each containing the scenarios for temperature, SLR, GDP, and population as used by the model in calculating impacts. -#' * __`results`__. Containing a data frame of annual impacts (i.e., the same data frame returned if `outputList=FALSE`). +#' * __`results`__. Containing a data frame of annual impacts (i.e., the same data frame returned if `outputList = FALSE`). #' #' #' diff --git a/FrEDI/R/sysdata.rda b/FrEDI/R/sysdata.rda index e7e6634e..f340a98d 100644 Binary files a/FrEDI/R/sysdata.rda and b/FrEDI/R/sysdata.rda differ diff --git a/FrEDI/scripts/create_DoW_results.R b/FrEDI/scripts/create_DoW_results.R index 656902b2..b4a5f680 100644 --- a/FrEDI/scripts/create_DoW_results.R +++ b/FrEDI/scripts/create_DoW_results.R @@ -3,6 +3,7 @@ ###### Load Packages ###### require(tidyverse) require(ggpubr) +# require(arrow) # require(cowplot) # require(FrEDI) @@ -11,13 +12,14 @@ create_DoW_results <- function( sectors = FrEDI::get_sectorInfo(), ### Which sectors gcmYears = c(2090), ### Which years to report on for GCM sectors slrYears = c(2050, 2090), ### Which years to report on for SLR sectors - byState = TRUE, ### Whether values are by state or just by region + byState = TRUE, ### Whether values are by state or just by region + totals = FALSE, ### Whether to do totals silent = TRUE, ### Degree of messaging testing = FALSE, ### Whether to print out extra diagnostic values aggOnly = TRUE, ### Whether to only include sectors for which "includeaggregate==1" in Fig 7 plots loadCode = "project", ### Whether to load code as source or devtools fpath = "." , ### Path to main FrEDI directory to load code from if loadCode == "project" or loadCode == "package" - saveFile = FALSE, ### Save file + saveFile = TRUE, ### Save file outPath = "." |> file.path("report_figures"), ### Path to save results if saveFile == TRUE img_dev = "pdf", ### Image device if saveFile == TRUE return = TRUE ### Whether to return list object @@ -31,37 +33,54 @@ create_DoW_results <- function( # aggOnly = TRUE ### Whether to only include sectors for which "includeaggregate==1" in Fig 7 plots # loadCode = "project" ### Whether to load code as source or devtools # fpath = "." ### Path to main FrEDI directory to load code from if loadCode == "project" or loadCode == "package" - # saveFile = FALSE ### Save file + # saveFile = TRUE ### Save file # outPath = "." |> file.path("report_figures") ### Path to save results if saveFile == TRUE # img_dev = "pdf" ### Image device if saveFile == TRUE # return = TRUE ### Whether to return list object ###### Initial values ###### ### Messaging - do_msg <- !silent + do_msg <- !silent ### Initialize Return List - return0 <- return; rm(return) - resultsList <- list() + return0 <- return; rm(return) + resultsList <- list() ### How to load code - loadProject <- "project" %in% (loadCode |> tolower()) - loadPackage <- "package" %in% (loadCode |> tolower()) - loadSource <- !loadProject & !loadPackage + loadProject <- "project" %in% (loadCode |> tolower()) + loadPackage <- "package" %in% (loadCode |> tolower()) + loadSource <- !loadProject & !loadPackage ###### Set Up Environment ###### ###### ** Set Paths ###### - # projectPath <- getwd() |> file.path("FrEDI") - projectPath <- fpath; rm(fpath) - codePath <- projectPath |> file.path("R") + # projectPath <- getwd() |> file.path("FrEDI") + projectPath <- fpath; rm(fpath) + codePath <- projectPath |> file.path("R") # projectPath |> list.files() |> print() # codePath |> list.files() |> print() + ### Output Paths - dowResultsPath <- outPath |> file.path("DoW") - fig7ResultsPath <- outPath |> file.path("fig7") - appxResultsPath <- outPath |> file.path("appendix_figures") + dowPath <- outPath |> file.path("DoW") + fig7Path <- outPath |> file.path("fig7") + appxPath <- outPath |> file.path("appendix_figures") # ### Check and create paths # outPath |> check_and_create_path() - # dowResultsPath |> check_and_create_path() - # fig7ResultsPath |> check_and_create_path() - # appxResultsPath |> check_and_create_path() + # dowPath |> check_and_create_path() + # fig7Path |> check_and_create_path() + # appxPath |> check_and_create_path() + + ### Output file names + rda_byType <- "integer_results_byType" + rda_totals <- "integer_results_totals" + + ### Plots by type + csv_appx_gcm <- "gcm_results_byDoW_byType" + csv_appx_slr <- "slr_results_byDoW_byType" + rda_appx_gcm <- "gcm_appendix_plots" + rda_appx_slr <- "slr_appendix_plots" + + ### Plots for totals + csv_fig7_gcm <- "gcm_results_byDoW_totals" + csv_fig7_slr <- "slr_results_byDoW_totals" + rda_fig7_gcm <- "gcm_fig7_plots" + rda_fig7_slr <- "slr_fig7_plots" ###### ** Load Code ###### ### Custom function to load code from a specified path @@ -111,7 +130,8 @@ create_DoW_results <- function( if(return0) resultsList[["sectorNames"]] <- c_sectorNames if(testing) c_sectorNames |> print(); newSectorNames |> print() - ###### ** Constants ###### + ###### Scenarios ###### + ###### ** Scenario Info ###### ### Numeric columns: Specify so that we can print out the associated data ### Number of digits to format c_popCol <- byState |> ifelse("state_pop", "reg_pop") @@ -129,6 +149,7 @@ create_DoW_results <- function( n_globalTemps <- c_globalTemps |> length() ### Labels c_globTempLabs <- c(1.5, 2) + ### Data frame of scenarios df_scenarios <- tibble(temp_C=c_conusTemps |> c(c_globalTemps)) |> mutate(tempType = c("conus" |> rep(n_conusTemps), "global" |> rep(n_globalTemps))) |> @@ -139,218 +160,254 @@ create_DoW_results <- function( if(testing) "Creating tibble of integer scenario information..." |> message() if(return0) resultsList[["df_scenarios"]] <- df_scenarios if(testing) df_scenarios |> glimpse() + ### Number of scenarios + cScenarios <- df_scenarios |> pull(scenario) |> unique() + nScenarios <- cScenarios |> length() ### Vector of scenarios - c_scen_con <- df_scenarios |> filter(tempType == "conus" ) |> get_column_values(col0="scenario") - c_scen_glo <- df_scenarios |> filter(tempType == "global") |> get_column_values(col0="scenario") + c_scen_con <- df_scenarios |> filter(tempType == "conus" ) |> pull(scenario) |> unique() + c_scen_glo <- df_scenarios |> filter(tempType == "global") |> pull(scenario) |> unique() # c_scen_con |> print(); c_scen_glo |> print(); df_scenarios[["scenario"]] |> print() # return(list(x=c_scen_con, y=c_scen_glo, z=df_scenarios)) - ###### Load Scenario Inputs ###### + ###### ** Inputs List ###### ### Message if(testing|do_msg) "Creating tibble of integer scenarios..." |> print() - ### Load scenario inputs - inputs_df_int <- list( - x = df_scenarios[["temp_C" ]], - y = df_scenarios[["tempType"]], - z = df_scenarios[["prefix" ]] - ) + # ### Load scenario inputs + # inputs_df_int <- list( + # x = df_scenarios[["temp_C" ]], + # y = df_scenarios[["tempType"]], + # z = df_scenarios[["prefix" ]] + # ) + # ### Create constant temp scenarios + # inputs_df_int <- inputs_df_int |> pmap(function(x, y, z){ + # create_constant_temp_scenario( + # temp0 = x, + # type0 = y, + # prefix0 = z ### Prefix for scenario + # ) + # }) |> bind_rows() ### Create constant temp scenarios - inputs_df_int <- inputs_df_int |> pmap(function(x, y, z){ + inputs_df_int <- df_scenarios |> nrow() |> seq_len() |> map(function(.i, df_i=df_scenarios[.i,]){ create_constant_temp_scenario( - temp0 = x, - type0 = y, - prefix0 = z ### Prefix for scenario + temp0 = df_i[["temp_C" ]], + type0 = df_i[["tempType"]], + scen0 = df_i[["scenario"]] ) - }) %>% (function(x){do.call(rbind, x)}) + }) |> bind_rows() ### Glimpse, message, & save if(return0) resultsList[["df_inputs"]] <- inputs_df_int if(testing) inputs_df_int |> glimpse() # return(list(x=c_scen_con, y=c_scen_glo, z=inputs_df_int)) - ###### Run Scenarios ###### - ###### Run scenarios - ###### ** Results By Type ###### + ###### GCM Scenarios ##### + ###### ** Run Scenarios and get results by type ###### + ###### Run scenarios to get results by type ### Run scenarios in FrEDI. Get model averages and national totals if(testing|do_msg) "Running integer scenarios..." |> message() + aggLvls0 <- c("modelaverage", "national") + if(totals) aggLvls0 <- aggLvls0 |> c("impactyear", "impacttype") df_int_byType <- inputs_df_int |> run_scenarios( col0 = "scenario", fredi = TRUE, sectors = sectors, - # sectors = FrEDI::get_sectorInfo(), - aggLevels = c("modelaverage", "national"), + # aggLevels = c("modelaverage", "national"), + aggLevels = aggLvls0, scenCols = c("scenario", "year", "temp_C_conus", "temp_C_global", "slr_cm"), - joinCols = c("year") + joinCols = c("year"), + return = TRUE, + save = FALSE, + outPath = dowPath ) + rm(aggLvls0) ### Glimpse results - if(return0) resultsList[["df_int_byType"]] <- df_int_byType + # if(return0) resultsList[["df_int_byType"]] <- df_int_byType if(testing) df_int_byType |> glimpse() ### Save results - if(saveFile){ - ### Save to RData - if(do_msg) paste0("Saving integer scenario results by type...") |> message() - df_int_byType |> - save_data(fpath = dowResultsPath, fname = "integer_results_byType", ftype = "rda") - - ### Save to CSV - # df_int_byType |> - # filter_years(years=c_years) |> - # format_values(cols0=c_numVars, digits=c_digits) |> - # save_data(fpath = dowResultsPath, fname = "integer_results_byType", ftype = "csv", row.names = F) - } ### End if(saveFile) - - ###### ** Result Totals ###### - if(testing|do_msg) "Aggregating integer scenario results..." |> message() - #### Aggregate Impact Types, Impact Years - df_int_totals <- df_int_byType |> run_scenarios( - col0 = "scenario", - fredi = FALSE, - aggLevels = c("impactyear", "impacttype"), - scenCols = c("scenario", "year", "temp_C_conus", "temp_C_global", "slr_cm"), - joinCols = c("year") - ) - ### Glimpse results - if(return0) resultsList[["df_int_totals"]] <- df_int_totals - if(testing) df_int_totals |> glimpse() - ### Save results - if(saveFile){ - ### Save to RData - if(do_msg) paste0("Saving aggregated integer scenario results...") |> message() - df_int_totals |> - save_data(fpath = dowResultsPath, fname = "integer_results_totals", ftype = "rda") - - ### Save to CSV - # df_int_totals |> - # filter_years(years=c_years) |> - # format_values(cols0=c_numVars, digits=c_digits) |> - # save_data(fpath = dowResultsPath, fname = "integer_results_totals", ftype = "csv", row.names = F) - } ### End if(saveFile) - # return(list(x=c_scen_con, y=c_scen_glo, z=df_int_totals)) - - ###### GCM Results & Figures ###### - ###### ** Figure 7: DoW by Sector ###### - ###### ** -- Data - ###### Summarize GCM sectors for degrees of warming - # codePath |> loadCustomFunctions() - if(testing|do_msg) "Summarizing GCM results by sector, degree of warming (DOW)..." |> message() - sum_gcm_totals <- df_int_totals |> sum_impacts_byDoW_years( - scenarios = c_scen_con, - bySector = FALSE, - sumCol = "annual_impacts", - impactYears = c("Interpolation"), - models = c("GCM"), - aggOnly = aggOnly, - years = gcmYears, - adjVal = 1/10**9, ### Factor to multiply by - adjCol = "impact_billions" - ) - ### Glimpse - if(return0) resultsList[["sum_gcm_totals"]] <- sum_gcm_totals - if(testing) sum_gcm_totals |> glimpse() - ### Save 2090 summary table - if(saveFile){ - if(do_msg) paste0("Saving summary of GCM results by sector, degree of warming...") |> message() - sum_gcm_totals |> - save_data(fpath = fig7ResultsPath, fname = "gcm_results_byDoW_totals", ftype = "csv", row.names = F) - } ### End if(saveFile) - # return(list(x=c_scen_con, y=c_scen_glo, z=df_int_totals, w=sum_gcm_totals)) - - ###### ** -- Plots - #### Create plots - ### Scale isn't the same across sectors - # codePath |> loadCustomFunctions() - if(testing|do_msg) "Plotting GCM results by sector, degree of warming (DOW)..." |> message() - plots_dow_gcm <- sum_gcm_totals |> plot_DoW( - types0 = c("GCM"), ### Model type: GCM or SLR - years = gcmYears, - xCol = "driverValue", - yCol = "annual_impacts", - thresh0 = breakChars - ) - ### Glimpse - if(testing) plots_dow_gcm[["GCM_2090"]] |> print() - if(return0) resultsList[["plots_dow_gcm"]] <- plots_dow_gcm - ### Save - # codePath |> loadCustomFunctions() - if(saveFile){ - if(do_msg) paste0("Saving plots of GCM results by sector, degree of warming...") |> message() - ### Save plots as Rdata - plots_dow_gcm |> save_data(fpath = fig7ResultsPath, fname = "gcm_fig7_plots", ftype = "rda") - - ### Save plots as image files - saved0 <- plots_dow_gcm |> save_fig7_images( - modelType = "GCM", - fpath = fig7ResultsPath, - device = img_dev, - units = imgUnits - ) - } ### End if(saveFile) + if(do_msg & saveFile) paste0("Saving integer scenario results by type...") |> message() + if(saveFile & (!totals)) df_int_byType |> save_data(fpath=dowPath, fname=rda_byType, ftype="rda") + if(saveFile & totals ) df_int_byType |> save_data(fpath=dowPath, fname=rda_totals, ftype="rda") + # for(scenario_i in cScenarios){ + # ### Run scenario + # df_i <- scenario_i |> run_scenario( + # df0 = df_scenarios, + # fredi = TRUE, + # sectors = sectors, + # aggLevels = c("modelaverage", "national"), + # scenCols = c("scenario", "year", "temp_C_conus", "temp_C_global", "slr_cm"), + # joinCols = c("year"), + # save = TRUE, + # return = FALSE, + # outPath = "." |> file.path("report_figures") + # ) ### End run_scenario(scenario_i) + # rm(scenario_i, df_i) + # } ### End for(row_i in df_scenarios |> nrow() |> seq_len()) ###### ** Appendix Figs: DoW By Type ###### # codePath |> loadCustomFunctions() - if(testing|do_msg) "Summarizing GCM results by sector, impact type, degree of warming (DOW)..." |> message() - sum_gcm_byType <- df_int_byType |> sum_impacts_byDoW_years( - scenarios = c_scen_con, - bySector = TRUE, - sumCol = "annual_impacts", - impactYears = c("NA", "2010", "2090"), - models = c("GCM"), - adjVal = 1/10**9, ### Factor to multiply by - adjCol = "impact_billions", - silent = TRUE - ) - ### Glimpse - if(testing) sum_gcm_byType |> glimpse() - if(return0) resultsList[["sum_gcm_byType"]] <- sum_gcm_byType - ### Save summary table - if(saveFile){ - if(do_msg) paste0("Saving summary of GCM results by sector, impact type, degree of warming...") |> message() - sum_gcm_byType |> - save_data(fpath = appxResultsPath, fname = "gcm_results_byDoW_byType", ftype = "csv", row.names = F) - } ### End if(saveFile) - - ### Create Plots - # codePath |> loadCustomFunctions() - if(testing|do_msg) "Plotting GCM results by sector, impact type, degree of warming (DOW)..." |> message() - plots_gcm_byType <- sum_gcm_byType |> - # filter(sector %in% c_sectorNames[c(10)]) |> - filter(!(sector %in% c("Roads"))) |> - plot_DoW_by_sector( - models = c("GCM"), - yCol = "annual_impacts" + if(!totals){ + if(testing|do_msg) "Summarizing GCM results by sector, impact type, degree of warming (DOW)..." |> message() + sum_gcm_byType <- df_int_byType |> sum_impacts_byDoW_years( + scenarios = c_scen_con, + bySector = TRUE, + sumCol = "annual_impacts", + impactYears = c("NA", "2010", "2090"), + models = c("GCM"), + adjVal = 1/10**9, ### Factor to multiply by + adjCol = "impact_billions", + silent = TRUE ) - ### Glimpse - if(testing) plots_gcm_byType$GCM$`Extreme Temperature_2010`[["2010"]] |> print() - if(return0) resultsList[["plots_gcm_byType"]] <- plots_gcm_byType - ### Save - if(saveFile){ - if(do_msg) paste0("Saving plots of GCM results by sector, impact type, degree of warming...") |> message() - ### Save plots as a data object - plots_gcm_byType |> save_data(fpath = appxResultsPath, fname = "gcm_appendix_plots", ftype = "rda") - - ### Save plots as image files - saved0 <- plots_gcm_byType |> save_appendix_figures( - df0 = sum_gcm_byType, - modelType = "GCM", ### Or SLR - fpath = appxResultsPath, - device = img_dev, - res = imgRes, - units = imgUnits - ) ### End save_appendix_figures - } ### End if(saveFile) - - + ### Glimpse + # if(return0) resultsList[["sum_gcm_byType"]] <- sum_gcm_byType + if(testing) sum_gcm_byType |> glimpse() + + ### Save summary table + if(do_msg & saveFile) paste0("Saving summary of GCM results by sector, impact type, degree of warming...") |> message() + if(saveFile) sum_gcm_byType |> save_data(fpath=appxPath, fname=csv_appx_gcm, ftype="csv", row.names=F) + + + ### Create Plots + # codePath |> loadCustomFunctions() + if(testing|do_msg) "Plotting GCM results by sector, impact type, degree of warming (DOW)..." |> message() + plots_gcm_byType <- sum_gcm_byType |> + # filter(sector %in% c_sectorNames[c(10)]) |> + filter(!(sector %in% c("Roads"))) |> + plot_DoW_by_sector( + models = c("GCM"), + yCol = "annual_impacts" + ) + ### Glimpse + # if(return0) resultsList[["plots_gcm_byType"]] <- plots_gcm_byType + if(testing) plots_gcm_byType$GCM$`Extreme Temperature_2010`[["2010"]] |> print() + + ### Save + if(do_msg & saveFile) paste0("Saving plots of GCM results by sector, impact type, degree of warming...") |> message() + if(saveFile){ + ### Save plots as a data object + plots_gcm_byType |> save_data(fpath=appxPath, fname=rda_appx_gcm, ftype="rda") + + ### Save plots as image files + saved0 <- plots_gcm_byType |> save_appendix_figures( + df0 = sum_gcm_byType, + modelType = "GCM", ### Or SLR + fpath = appxPath, + device = img_dev, + res = imgRes, + units = imgUnits + ) ### End save_appendix_figures + } ### End if(saveFile) + rm(sum_gcm_byType, plots_gcm_byType) + } ### End if(!totals) + + ###### ** GCM Totals ###### + if(totals){ + # if(testing|do_msg) "Aggregating integer scenario results..." |> message() + # #### Aggregate Impact Types, Impact Years + # # df_int_totals <- df_int_byType |> run_scenarios( + # # col0 = "scenario", + # # fredi = FALSE, + # # aggLevels = c("impactyear", "impacttype"), + # # scenCols = c("scenario", "year", "temp_C_conus", "temp_C_global", "slr_cm"), + # # joinCols = c("year") + # # ) + # group_totals <- c("sector", "variant", "impactType", "impactYear", "region", "state", "postal") |> + # c("model_type", "model") |> + # c("sectorprimary", "includeaggregate") |> + # c("scenario", "temp_C_conus", "temp_C_global", "slr_cm") + # agg_totals <- c("impactyear", "impacttype") + # df_int_totals <- tibble() + # for(scenario_i in cScenarios){ + # ### Message user + # "\n" |> paste0("Running scenario ", (cScenarios == scenario_i) |> which(), "/" , nScenarios, "...") |> message() + # ### Get scenario by itself and drop scenario + # df_i <- df_int_byType |> filter(scenario == scenario_i) + # df_int_byType <- df_int_byType |> filter(scenario != scenario_i) + # ### Aggregate scenario and add to dataframe + # df_i <- df_i |> aggregate_impacts(aggLevels=agg_totals, groupByCols=group_totals) + # df_int_totals <- df_int_totals |> rbind(df_i) + # rm(df_i, scenario_i) + # } ### End for(scenario_i in cScenarios) + # rm(agg_totals, group_totals) + # # rm(df_int_byType) + # ### Glimpse results + # # if(return0) resultsList[["df_int_totals"]] <- df_int_totals + # if(testing) df_int_totals |> glimpse() + # ### Save results + # if(do_msg & saveFile) paste0("Saving aggregated integer scenario results...") |> message() + # if(saveFile) df_int_totals |> save_data(fpath=dowPath, fname=rda_totals, ftype="rda") + # # return(list(x=c_scen_con, y=c_scen_glo, z=df_int_totals)) + df_int_totals <- df_int_byType + rm(df_int_byType) + + ###### ** -- Figure 7: DoW by Sector + ###### ** -- -- Data + ###### Summarize GCM sectors for degrees of warming + # codePath |> loadCustomFunctions() + if(testing|do_msg) "Summarizing GCM results by sector, degree of warming (DOW)..." |> message() + sum_gcm_totals <- df_int_totals |> sum_impacts_byDoW_years( + scenarios = c_scen_con, + bySector = FALSE, + sumCol = "annual_impacts", + impactYears = c("Interpolation"), + models = c("GCM"), + aggOnly = aggOnly, + years = gcmYears, + adjVal = 1/10**9, ### Factor to multiply by + adjCol = "impact_billions" + ) + rm(df_int_totals) + ### Glimpse + # if(return0) resultsList[["sum_gcm_totals"]] <- sum_gcm_totals + if(testing) sum_gcm_totals |> glimpse() + if(do_msg & saveFile) paste0("Saving summary of GCM results by sector, degree of warming...") |> message() + ### Save 2090 summary table + if(saveFile) sum_gcm_totals |> save_data(fpath=fig7Path, fname=csv_fig7_gcm, ftype="csv", row.names=F) + # return(list(x=c_scen_con, y=c_scen_glo, z=df_int_totals, w=sum_gcm_totals)) + + ###### ** -- -- Plots + #### Create plots + ### Scale isn't the same across sectors + # codePath |> loadCustomFunctions() + if(testing|do_msg) "Plotting GCM results by sector, degree of warming (DOW)..." |> message() + plots_dow_gcm <- sum_gcm_totals |> plot_DoW( + types0 = c("GCM"), ### Model type: GCM or SLR + years = gcmYears, + xCol = "driverValue", + yCol = "annual_impacts", + thresh0 = breakChars + ) + rm(sum_gcm_totals) + ### Glimpse + # if(return0) resultsList[["plots_dow_gcm"]] <- plots_dow_gcm + if(testing) plots_dow_gcm[["GCM_2090"]] |> print() + ### Save + # codePath |> loadCustomFunctions() + if(do_msg & saveFile) paste0("Saving plots of GCM results by sector, degree of warming...") |> message() + if(saveFile){ + ### Save plots as Rdata + plots_dow_gcm |> save_data(fpath=fig7Path, fname=rda_fig7_gcm, ftype="rda") + + ### Save plots as image files + saved0 <- plots_dow_gcm |> save_fig7_images( + modelType = "GCM", + fpath = fig7Path, + device = img_dev, + units = imgUnits + ) + } ### End if(saveFile) + rm(plots_dow_gcm) + } ### End if(totals) ###### SLR Results & Figures ###### - ###### ** Format SLR Data ###### - ###### ** -- Data + ###### ** -- Format SLR Data ###### + ###### ** -- -- Data ### Read in and format the impacts ### Note that the SLR sectors have no multipliers or impact types # codePath |> loadCustomFunctions() if(testing|do_msg) "Formatting SLR scenario model data..." |> message() ciraSLRData <- get_fig7_slrDataObj(drivers=T, impacts=T) ### Glimpse - if(return0) resultsList[["ciraSLRData"]] <- ciraSLRData + # if(return0) resultsList[["ciraSLRData"]] <- ciraSLRData if(testing) ciraSLRData[["slrImp"]] |> glimpse() if(testing) ciraSLRData[["slrCm" ]] |> glimpse() @@ -381,7 +438,7 @@ create_DoW_results <- function( scale_color_discrete("SLR Scenario") if(testing) plot_slr2 |> print() - ##### ** Plot Trajectories ##### + ##### ** -- Plot Trajectories ##### ### Plot the SLR trajectories # codePath |> loadCustomFunctions() if(testing|do_msg) "Plotting SLR scenarios..." |> message() @@ -392,11 +449,11 @@ create_DoW_results <- function( lgdTitle0 = "Sweet et al. SLR Scenario" ) ### Glimpse + # if(return0) resultsList[["p_slrScenarios"]] <- p_slrScenarios if(testing) p_slrScenarios |> print() - if(return0) resultsList[["p_slrScenarios"]] <- p_slrScenarios ### Save file + if(do_msg & saveFile) paste0("Saving plot of SLR scenarios...") |> message() if(saveFile){ - if(do_msg) paste0("Saving plot of SLR scenarios...") |> message() p_slrScenarios |> save_image( fpath = outPath, ### File path fname = "slrScenarios", @@ -410,109 +467,109 @@ create_DoW_results <- function( ) ### End save_image } ### End if(saveFile) - ###### ** Figure 7: DoW by Sector ###### + ###### ** -- Appendix Figs: DoW By Type ###### + # codePath |> loadCustomFunctions() + if(!totals){ + if(testing|do_msg) "Summarizing SLR results by sector, impact type, GMSL (cm)..." |> message() + sum_slr_byType <- get_fig7_slrImpacts( + slrDrivers = ciraSLRData[["slrCm" ]] |> filter(year >= 2010, year <= 2090), + slrImpacts = ciraSLRData[["slrImp"]] |> filter(year >= 2010, year <= 2090), + bySector = TRUE, + sumCol = "annual_impacts", + adjVal = 1/10**9, ### Factor to multiply by + adjCol = "impact_billions" + ) + ### Glimpse + # if(return0) resultsList[["sum_slr_byType"]] <- sum_slr_byType + if(testing) sum_slr_byType |> glimpse() + ### Save + if(do_msg & saveFile) paste0("Saving plot of SLR scenarios by year...") |> message() + if(saveFile) sum_slr_byType |> save_data(fpath=appxPath, fname=csv_appx_slr, ftype="csv", row.names=F) + + ### Create SLR plots + # codePath |> loadCustomFunctions() + if(testing|do_msg) "Plotting SLR results by sector, impact type, GMSL (cm)..." |> message() + plots_slr_byType <- sum_slr_byType |> plot_DoW_by_sector( + models = c("SLR"), + xCol = "year", + yCol = "annual_impacts" + ) + ### Glimpse + # if(return0) resultsList[["plots_slr_byType"]] <- plots_slr_byType + if(testing) plots_slr_byType$SLR$`Coastal Properties_all`[[1]] |> print() + ### Save + if(do_msg & saveFile) paste0("Saving plot of SLR scenarios by sector, impact type, GMSL (cm)...") |> message() + if(saveFile) { + ### Save plots as a data object + plots_slr_byType |> save_data(fpath=appxPath, fname=rda_appx_slr, ftype="rda") + + ### Save plots as image files + saved0 <- plots_slr_byType |> save_appendix_figures( + df0 = sum_slr_byType, + modelType = "SLR", ### Or SLR + fpath = appxPath, + device = img_dev, + res = imgRes, + units = imgUnits + ) ### End save_appendix_figures + } ### End if(saveFile) + } ### if(!totals) + + ###### ** -- Figure 7: DoW by Sector ###### ### SLR sectors separately: ### - Filter to 2090 and 2050 values ### - Calculate national totals ### - Combine CIRA impacts and SLR trajectories # codePath |> loadCustomFunctions() - if(testing|do_msg) "Summarizing SLR results by sector, year, GMSL (cm)..." |> message() - sum_slr_totals <- get_fig7_slrImpacts( - slrDrivers = ciraSLRData[["slrCm" ]] |> filter(year >= 2010, year <= 2090), - slrImpacts = ciraSLRData[["slrImp"]] |> filter(year >= 2010, year <= 2090), - bySector = FALSE, - aggOnly = aggOnly, - years = slrYears, - adjVal = 1/10**9, ### Factor to multiply by - adjCol = "impact_billions" - ) - ### Glimpse - if(return0) resultsList[["sum_slr_totals"]] <- sum_slr_totals - if(testing) sum_slr_totals |> glimpse() - # sum_gcm_totals |> glimpse() - ### Save - if(saveFile){ - if(do_msg) paste0("Saving summary of SLR results by sector, year, GMSL (cm)...") |> message() - sum_slr_totals |> - save_data(fpath = fig7ResultsPath, fname = "slr_results_byDoW_totals", ftype = "csv", row.names = F) - } ### End if(saveFile) - - ###### ** -- Plots - ### Create the plots - # codePath |> loadCustomFunctions() - if(testing|do_msg) "Plotting SLR results by sector, year, GMSL (cm)..." |> message() - plots_dow_slr <- sum_slr_totals |> plot_DoW( - types0 = c("SLR"), ### Model type: GCM or SLR - yCol = "annual_impacts", - nCol = 2, - thresh0 = breakChars - ) - ### Glimpse - if(return0) resultsList[["plots_dow_slr"]] <- plots_dow_slr - if(testing) plots_dow_slr[["SLR_all"]] |> print() - ### Save - if(saveFile){ - if(do_msg) paste0("Saving plots of SLR results by sector, year, GMSL (cm)...") |> message() - ### Save plots as a data object - plots_dow_slr |> save_data(fpath = fig7ResultsPath, fname = "slr_fig7_plots", ftype = "rda") - - ### Save plots as image files - plots_dow_slr |> save_fig7_images( - modelType = "SLR", ### Or SLR - fpath = fig7ResultsPath, - device = img_dev, - units = imgUnits + if(totals){ + if(testing|do_msg) "Summarizing SLR results by sector, year, GMSL (cm)..." |> message() + sum_slr_totals <- get_fig7_slrImpacts( + slrDrivers = ciraSLRData[["slrCm" ]] |> filter(year >= 2010, year <= 2090), + slrImpacts = ciraSLRData[["slrImp"]] |> filter(year >= 2010, year <= 2090), + bySector = FALSE, + aggOnly = aggOnly, + years = slrYears, + adjVal = 1/10**9, ### Factor to multiply by + adjCol = "impact_billions" ) - } ### End if(saveFile) + ### Glimpse + # if(return0) resultsList[["sum_slr_totals"]] <- sum_slr_totals + if(testing) sum_slr_totals |> glimpse() + # sum_gcm_totals |> glimpse() + ### Save + if(do_msg & saveFile) paste0("Saving summary of SLR results by sector, year, GMSL (cm)...") |> message() + if(saveFile) sum_slr_totals |> save_data(fpath=fig7Path, fname=csv_fig7_slr, ftype="csv", row.names=F) + + ###### ** -- Plots + ### Create the plots + # codePath |> loadCustomFunctions() + if(testing|do_msg) "Plotting SLR results by sector, year, GMSL (cm)..." |> message() + plots_dow_slr <- sum_slr_totals |> plot_DoW( + types0 = c("SLR"), ### Model type: GCM or SLR + yCol = "annual_impacts", + nCol = 2, + thresh0 = breakChars + ) + ### Glimpse + # if(return0) resultsList[["plots_dow_slr"]] <- plots_dow_slr + if(testing) plots_dow_slr[["SLR_all"]] |> print() + ### Save + if(do_msg) paste0("Saving plots of SLR results by sector, year, GMSL (cm)...") |> message() + if(saveFile & saveFile){ + ### Save plots as a data object + plots_dow_slr |> save_data(fpath=fig7Path, fname=rda_fig7_slr, ftype="rda") + + ### Save plots as image files + plots_dow_slr |> save_fig7_images( + modelType = "SLR", ### Or SLR + fpath = fig7Path, + device = img_dev, + units = imgUnits + ) + } ### End if(saveFile) + } ### if(totals) - ###### ** Appendix Figs: DoW By Type ###### - # codePath |> loadCustomFunctions() - if(testing|do_msg) "Summarizing SLR results by sector, impact type, GMSL (cm)..." |> message() - sum_slr_byType <- get_fig7_slrImpacts( - slrDrivers = ciraSLRData[["slrCm" ]] |> filter(year >= 2010, year <= 2090), - slrImpacts = ciraSLRData[["slrImp"]] |> filter(year >= 2010, year <= 2090), - bySector = TRUE, - sumCol = "annual_impacts", - adjVal = 1/10**9, ### Factor to multiply by - adjCol = "impact_billions" - ) - ### Glimpse - if(return0) resultsList[["sum_slr_byType"]] <- sum_slr_byType - if(testing) sum_slr_byType |> glimpse() - ### Save - if(saveFile){ - if(do_msg) paste0("Saving plot of SLR scenarios by year...") |> message() - sum_slr_byType |> - save_data(fpath = appxResultsPath, fname = "slr_results_byDoW_byType", ftype = "csv", row.names = F) - } ### End if(saveFile) - ### Create SLR plots - # codePath |> loadCustomFunctions() - if(testing|do_msg) "Plotting SLR results by sector, impact type, GMSL (cm)..." |> message() - plots_slr_byType <- sum_slr_byType |> plot_DoW_by_sector( - models = c("SLR"), - xCol = "year", - yCol = "annual_impacts" - ) - ### Glimpse - if(return0) resultsList[["plots_slr_byType"]] <- plots_slr_byType - if(testing) plots_slr_byType$SLR$`Coastal Properties_all`[[1]] |> print() - ### Save - if(saveFile){ - if(do_msg) paste0("Saving plot of SLR scenarios by sector, impact type, GMSL (cm)...") |> message() - ### Save plots as a data object - plots_slr_byType |> save_data(fpath = appxResultsPath, fname = "slr_appendix_plots", ftype = "rda") - - ### Save plots as image files - saved0 <- plots_slr_byType |> save_appendix_figures( - df0 = sum_slr_byType, - modelType = "SLR", ### Or SLR - fpath = appxResultsPath, - device = img_dev, - res = imgRes, - units = imgUnits - ) ### End save_appendix_figures - } ### End if(saveFile) ###### Return ###### return(resultsList) diff --git a/FrEDI/testing/configTests_utils.R b/FrEDI/testing/configTests_utils.R index 4bd596a3..540e32a6 100644 --- a/FrEDI/testing/configTests_utils.R +++ b/FrEDI/testing/configTests_utils.R @@ -19,12 +19,6 @@ has_nonNA_values <- function(x) { ### Function to check if column has at least one non NA value has_nonNA_values_df <- function(df0, groups0="sector", col0="annual_impacts") { - # ### Check whether values in x are NA - # x <- x |> is.na() - # ### Calculate number of rows - # y <- tibble(numRows = x |> nrow()) - # ### Number of NA values - # y <- y |> mutate(numNA = x |> colSums() |> nrow() |> is.null() |> if_else(., 0, 1)) ### Add counters df0 <- df0 |> mutate(numRows = 1) vals0 <- df0[[col0]] |> is.na() @@ -36,9 +30,6 @@ has_nonNA_values_df <- function(df0, groups0="sector", col0="annual_impacts") { y <- y |> mutate(allNA = (numRows == numNA)) ### Filter to values with allNA z <- y |> filter(allNA) - # ### Get number of rows |> - # z <- y |> nrow() - # # z <- 1 * (z > 0) ### Return return(z) } diff --git a/FrEDI/testing/utils_create_report_figures.R b/FrEDI/testing/utils_create_report_figures.R index e6ad3e36..a764777c 100644 --- a/FrEDI/testing/utils_create_report_figures.R +++ b/FrEDI/testing/utils_create_report_figures.R @@ -67,7 +67,7 @@ sum_with_na <- function( ### Multiply column df0[[col0]] <- df0[[col0]] * df0[["is_NA"]] - # df0 <- df0 |> rename_at(.vars=c("yCol"), ~c(col0)) + # df0 <- df0 |> rename_at(c("yCol"), ~c(col0)) ### Drop columns if(drop0){df0 <- df0 |> select(-c("is_NA"))} ### Return @@ -115,45 +115,45 @@ format_values <- function( ### Run CONUS scenarios create_constant_temp_scenario <- function( temp0, - type0 = "conus", - prefix0 = "Other_Integer" ### Prefix for scenario + type0 = "conus", + scen0 = "Other_Integer" |> paste(temp0 |> round(1), sep="_") ### Prefix for scenario ){ ### Temperature Type isConus <- "conus" %in% (type0 |> tolower()) ### Format scenario label - # pre0 <- (type0=="conus") |> ifelse("Other_Integer", "preI_global") - pre0 <- prefix0 - lab0 <- temp0 |> round(1) - scen0 <- pre0 |> paste(lab0, sep="_") + # pre0 <- prefix0 + # lab0 <- temp0 |> round(1) + # scen0 <- pre0 |> paste(lab0, sep="_") + lab0 <- scen0 |> str_extract("(\\d+)(\\.)(\\d+)") ### Get annual values 1995 - 2010: starting with zero in 1995 - xIn0 <- c(1995, 2010) - yIn0 <- c(0, temp0) - xOut0 <- seq(xIn0[1], xIn0[2]) - df0 <- approx(x = xIn0, y = yIn0, xout=xOut0) |> + xIn0 <- c(1995, 2010) + yIn0 <- c(0, temp0) + xOut0 <- seq(xIn0[1], xIn0[2]) + df0 <- approx(x=xIn0, y=yIn0, xout=xOut0) |> as_tibble() |> rename(year=x, temp_C=y) ### Extend values - df1 <- tibble(year = seq(2011, 2090, by=1)) - df1 <- df1 |> mutate(temp_C = temp0) - df0 <- df0 |> rbind(df1) - rm("df1") + df1 <- tibble(year = seq(2011, 2090, by=1)) + df1 <- df1 |> mutate(temp_C = temp0) + df0 <- df0 |> rbind(df1) + rm(df1) ### Get other temp types and rename if(isConus){ - df0 <- df0 |> mutate(temp_C_global = temp_C |> FrEDI::convertTemps(from="conus")) - df0 <- df0 |> mutate(temp_C_conus = temp_C) + df0 <- df0 |> mutate(temp_C_global = temp_C |> FrEDI::convertTemps(from="conus")) + df0 <- df0 |> mutate(temp_C_conus = temp_C) } ### End if(isConus) else { - df0 <- df0 |> mutate(temp_C_conus = temp_C |> FrEDI::convertTemps(from="global")) - df0 <- df0 |> mutate(temp_C_global = temp_C) + df0 <- df0 |> mutate(temp_C_conus = temp_C |> FrEDI::convertTemps(from="global")) + df0 <- df0 |> mutate(temp_C_global = temp_C) } ### End else(isConus) ### Drop temp_C - df0 <- df0 |> select(-c("temp_C")) + df0 <- df0 |> select(-c("temp_C")) ### Get SLR - ySlr0 <- FrEDI::temps2slr(temps = df0[["temp_C_global"]], years = df0[["year"]]) - df0 <- df0 |> left_join(ySlr0, by="year") - df0 <- df0 |> mutate(temp_lab = lab0) - df0 <- df0 |> mutate(scenario = scen0) + ySlr0 <- FrEDI::temps2slr(temps = df0[["temp_C_global"]], years = df0[["year"]]) + df0 <- df0 |> left_join(ySlr0, by="year") + df0 <- df0 |> mutate(temp_lab = lab0) + df0 <- df0 |> mutate(scenario = scen0) ### Return return(df0) } ### End create_constant_temp_scenario @@ -198,25 +198,25 @@ get_scenario_inputsList <- function( temp0 <- temp0 |> rename_at(vars("temp_C_conus"), ~c("temp_C")) } ### End if(doTemp0) list0[["tempInput"]] <- temp0 - rm("temp0") + rm(temp0) } ### End if(doTemp) if(doSlr){ slr0 <- df0 |> select(all_of(cSlr)) list0[["slrInput"]] <- slr0 - rm("slr0") + rm(slr0) } ### End if(doSlr) if(doGdp){ gdp0 <- df0 |> select(all_of(cGdp)) list0[["gdpInput"]] <- gdp0 - rm("gdp0") + rm(gdp0) } ### End if(doGdp) if(doPop){ pop0 <- df0 |> select(all_of(cPop)) list0[["popInput"]] <- pop0 - rm("pop0") + rm(pop0) } ### End if(doPop) ### Return @@ -231,10 +231,10 @@ run_fredi_scenario <- function( joinCols = c("year") ){ ### Filter to scenario - df1 <- df0 |> select(c(all_of(scenCols))); rm("df0") + df1 <- df0 |> select(c(all_of(scenCols))); rm(df0) list1 <- df1 |> get_scenario_inputsList() ### Run FrEDI - df2 <- FrEDI::run_fredi(inputsList = list1, sectorList=sectors, aggLevels = "none") + df2 <- FrEDI::run_fredi(inputsList=list1, sectorList=sectors, aggLevels="none") ### Join scenarios # df1 |> names() |> print(); df2 |> names() |> print(); df2 <- df2 |> left_join(df1, by=c(joinCols)) @@ -263,7 +263,7 @@ agg_fredi_scenario <- function( group0 <- group0 |> c("model_type", "model") group0 <- group0 |> c("sectorprimary", "includeaggregate") group0 <- group0 |> c(drop0) - df0 <- df0 |> FrEDI::aggregate_impacts(aggLevels = aggLevels, groupByCols = group0) + df0 <- df0 |> FrEDI::aggregate_impacts(aggLevels=aggLevels, groupByCols=group0) # df0 <- df0 |> FrEDI::aggregate_impacts(aggLevels = aggLevels) ### Return return(df0) @@ -278,75 +278,113 @@ run_scenario <- function( sectors = FrEDI::get_sectorInfo(), ### Which sectors scenCols = c("scenario", "year", "temp_C_conus", "temp_C_global", "slr_cm"), joinCols = c("year"), - aggLevels = c("modelaverage", "national") + aggLevels = c("modelaverage", "national"), + save = FALSE, + return = TRUE, + outPath = "." |> file.path("report_figures") ){ + ### Values & conditions + agg0 <- !("none" %in% aggLevels) + scenario0 <- scenario + rm(scenario) + # agg0 |> print() + + ### File names and info + fType0 <- "rda" + fName0 <- "integer_results_byType" |> paste0("_", scenario0) + # fName0 <- fName0 |> paste0(".", fType0) + ### Filter to scenario - scenario0 <- scenario - df_x0 <- df0 |> filter(scenario==scenario0) - rm("df0") + cScenarios <- df0 |> pull(scenario) |> unique() + nScenarios <- cScenarios |> length() + df0 <- df0 |> filter(scenario==scenario0) + # df0 |> nrow() |> print() + + ### Message user + "\n" |> paste0("Running scenario ", (cScenarios == scenario0) |> which(), "/" , nScenarios, "...") |> message() + ### Run FrEDI - if(fredi){ - df_x0 <- df_x0 |> run_fredi_scenario( - sectors = sectors, - scenCols = scenCols, - joinCols = joinCols - ) ### End run_fredi_scenario - } ### End if(fredi) - # "got here1" |> print(); df_x0 |> glimpse() + if(fredi) df0 <- df0 |> run_fredi_scenario(sectors=sectors, scenCols=scenCols, joinCols=joinCols) + # "got here1" |> print(); df0 |> glimpse() ### Aggregate FrEDI - agg0 <- !("none" %in% aggLevels) - # agg0 |> print() - if(agg0){ - # "got here1" |> print() - df_x0 <- df_x0 |> agg_fredi_scenario( - scenCols = scenCols, - joinCols = joinCols, - aggLevels = aggLevels - ) ### End run_fredi_scenario - } ### End if(agg0) - # "got here2" |> print(); df_x0 |> glimpse() + if(agg0 ) df0 <- df0 |> agg_fredi_scenario(scenCols=scenCols, joinCols=joinCols, aggLevels=aggLevels) + # "got here2" |> print(); df0 |> glimpse() ### Format other values mutate0 <- c("temp_C_conus", "temp_C_global", "slr_cm") - df_x0 <- df_x0 |> mutate_at(vars(mutate0), as.numeric) + df0 <- df0 |> mutate_at(vars(mutate0), as.numeric) + + ### Save results + if(save) { + ### Message user + "\t" |> paste0("Saving integer scenario results...") |> message() + ### Save results + df0 |> save_data(fpath=outPath, fname=fName0, ftype=fType0) + } ### End if(saveFile) ### Return - return(df_x0) + if(return) return(df0) } ### End function run_scenario ### Run list of scenarios run_scenarios <- function( - df0, ### Output of create_constant_temp_scenario + df0, ### Output of create_constant_temp_scenario col0 = "scenario", ### Scenario column fredi = TRUE, sectors = FrEDI::get_sectorInfo(), ### Which sectors aggLevels = c("modelaverage", "national"), scenCols = c("scenario", "year", "temp_C_conus", "temp_C_global", "slr_cm"), - joinCols = c("year") + joinCols = c("year"), + save = FALSE, + return = TRUE, + outPath = "." |> file.path("report_figures") ){ ### Unique scenarios scenarios0 <- df0[[col0]] |> unique() - nScenarios <- scenarios0 |> length() + # nScenarios <- scenarios0 |> length() ### Iterate over the scenarios - list0 <- scenarios0 |> map(function(.x){ - paste0("Running scenario ", which(scenarios0 == .x), "/" , nScenarios, "...") |> message() - df_x <- run_scenario( - .x, + # list0 <- scenarios0 |> map(function(.x){ + # paste0("Running scenario ", which(scenarios0 == .x), "/" , nScenarios, "...") |> message() + # df_x <- run_scenario( + # .x, + # df0 = df0, + # fredi = fredi, + # sectors = sectors, + # aggLevels = aggLevels, + # scenCols = scenCols, + # joinCols = joinCols + # ) ### End run_scenario(.x) + # return(df_x) + # }) ### End function(.x), walk + list0 <- list() + for(scenario_i in scenarios0) { + # ### Message user + # "Running scenario " |> paste0((scenarios0 == scenario_i) |> which(), "/" , nScenarios, "...") |> message() + ### Run scenario + df_i <- scenario_i |> run_scenario( df0 = df0, fredi = fredi, sectors = sectors, aggLevels = aggLevels, scenCols = scenCols, - joinCols = joinCols - ) ### End run_scenario(.x) - return(df_x) - }) ### End function(.x), walk + joinCols = joinCols, + save = save, + return = return, + outPath = outPath + ) ### End run_scenario(scenario_i) + ### Add scenario to list + list0[[scenario_i]] <- df_i + ### Drop values + rm(scenario_i, df_i) + } ### for(scenario_i in scenarios0) + rm(df0) + ### Bind values into a list - # df0 <- list0 %>% (function(x){do.call(rbind, x)}) df0 <- list0 |> bind_rows() + rm(list0) ### Return return(df0) @@ -368,52 +406,73 @@ sum_impacts_byDoW <- function( adjCol = "impact_billions", silent = FALSE ){ + ### Values + primary <- !bySector + scenarios0 <- scenarios + years0 <- impactYears + year0 <- year + rm(scenarios) + + do_gcm <- "gcm" %in% (models |> tolower()) + ### Filter to includeaggregate==1 - if(aggOnly){df0 <- df0 |> filter(includeaggregate==1)} ### Filter to sector primary - primary <- !bySector + ### Filter to appropriate year + if(aggOnly){df0 <- df0 |> filter(includeaggregate==1)} if(primary){df0 <- df0 |> filter(sectorprimary ==1)} + if(do_gcm ){df0 <- df0 |> filter(year == year0)} + ### Filter to scenarios - scenarios0 <- scenarios; rm("scenarios") - df0 <- df0 |> filter(scenario %in% scenarios0) ### Filter to appropriate models - df0 <- df0 |> filter(model_type %in% models) ### Filter to appropriate impact years - years0 <- impactYears + df0 <- df0 |> filter(scenario %in% scenarios0) + df0 <- df0 |> filter(model_type %in% models) df0 <- df0 |> filter(impactYear %in% years0) - # ### Filter to appropriate year - do_gcm <- "gcm" %in% tolower(models) - year0 <- year - if(do_gcm){df0 <- df0 |> filter(year == year0)} - ### Drop unnecessary columns - # df0 <- df0 |> select(-c("impactYear")) + ### Summarize by Degree of Warming - # df0 <- df0 |> summarize_DOW_data(year=year0, bySector = bySector) - list0 <- years0 %>% map(function(.z){ - df_z <- df0 |> summarize_DOW_data( + # list0 <- years0 %>% map(function(.z){ + # df_z <- df0 |> summarize_DOW_data( + # year = year0, + # bySector = bySector, + # sumCol = sumCol, + # groupVars = groupVars, + # impactYear = .z, + # silent = silent + # ) + # return(df_z) + # }) + list0 <- list() + for(year_i in years0) { + ### Summarize DOW data + df_i <- df0 |> summarize_DOW_data( year = year0, bySector = bySector, sumCol = sumCol, groupVars = groupVars, - impactYear = .z, + impactYear = year_i, silent = silent - ) - return(df_z) - }) + ) ### End summarize_DOW_data() + ### Add to list + list0[[year_i]] <- df_i + ### Drop values + rm(year_i, df_i) + } ### End for(year_i in years0) + rm(df0) + ### Bind together - # df0 <- list0 %>% (function(x){do.call(rbind, x)}) + ### Add summary year df0 <- list0 |> bind_rows() + df0 <- df0 |> mutate(summaryYear=year0) rm(list0) + ### Adjust values df0[[adjCol]] <- df0[["annual_impacts"]] * adjVal - ### Add summary year - df0 <- df0 |> mutate(summaryYear=year0) + ### Select columns # select0 <- c("sector", "region", "model_type", "model", "summaryYear", "driverValue", "annual_impacts", adjCol) |> unique() # df0 <- df0 |> relocate(c(all_of(select0))) + # df0 %>% glimpse() - ### Glimpse results - # df0 %>% glimpse ### Return return(df0) } ### End sum_impacts_byDoW @@ -433,41 +492,71 @@ sum_impacts_byDoW_years <- function( adjCol = "impact_billions", silent = FALSE ){ + ### Values + years0 <- years + nYears <- years0 |> length() + primary <- !bySector + ### Filter to includeaggregate==1 - ### Filter to includeaggregate==1 - # aggOnly <- TRUE - if(aggOnly){df0 <- df0 |> filter(includeaggregate==1)} ### Filter to sector primary - primary <- !bySector + if(aggOnly){df0 <- df0 |> filter(includeaggregate==1)} if(primary){df0 <- df0 |> filter(sectorprimary ==1)} - ### Run scenarios - nYears <- years |> length() + ### Run scenarios ### Get list - list0 <- years |> map(function(.x){ - paste0("Summarizing values for ", which(years == .x), "/" , nYears, " years...") |> message() - df_x <- sum_impacts_byDoW( - df0 = df0, + # list0 <- years |> map(function(.x){ + # "Summarizing values for " |> paste0((years == .x) |> which(), "/" , nYears, " years...") |> message() + # df_x <- sum_impacts_byDoW( + # df0 = df0, + # scenarios = scenarios, + # bySector = bySector, + # sumCol = sumCol, + # groupVars = groupVars, + # impactYears = impactYears, + # year = .x, + # models = models, + # aggOnly = aggOnly, + # adjVal = adjVal, + # adjCol = adjCol, + # silent = silent + # ) ### End sum_impactsByDegree + # return(df_x) + # }) ### End walk + list0 <- list() + for(year_i in years0) { + ### Message user + "Summarizing values for " |> paste0((years == year_i) |> which(), "/" , nYears, " years...") |> message() + + ### Summarize DOW data + df_i <- df0 |> sum_impacts_byDoW( scenarios = scenarios, bySector = bySector, sumCol = sumCol, groupVars = groupVars, impactYears = impactYears, - year = .x, + year = year_i, models = models, aggOnly = aggOnly, adjVal = adjVal, adjCol = adjCol, silent = silent - ) ### End sum_impactsByDegree - return(df_x) - }) ### End walk + ) ### End sum_impactsByDegree() + + ### Add to list + list0[[year_i]] <- df_i + + ### Drop values + rm(year_i, df_i) + } ### End for(year_i in years0) + rm(df0) + ### Bind values together - # df0 <- list0 %>% (function(x){do.call(rbind, x)}) - df0 <- list0 |> bind_rows() + df0 <- list0 |> bind_rows() rm(list0) + ### Convert to tibble - df0 <- df0 |> as_tibble() + df0 <- df0 |> as_tibble() + ### Return return(df0) } ### End sum_impacts_byDoW_years @@ -518,9 +607,9 @@ get_fig7_slrDataObj <- function( rename1 <- c("sector", "model_type") mutate0 <- c("sector", "sector_id") dfSectors <- dfSectors |> select(c(all_of(select0))) - dfSectors <- dfSectors |> rename_at(.vars=c(rename0), ~c(rename1)) + dfSectors <- dfSectors |> rename_at(c(rename0), ~c(rename1)) dfSectors <- dfSectors |> filter(tolower(model_type)=="slr") - dfSectors <- dfSectors |> mutate_at(.vars=c(mutate0), as.character) + dfSectors <- dfSectors |> mutate_at(c(mutate0), as.character) rm(select0, rename0, rename1, mutate0) ###### Variants Data ###### @@ -529,7 +618,7 @@ get_fig7_slrDataObj <- function( rename0 <- c("variant_label") rename1 <- c("variant") dfVariant <- dfVariant |> select(c(all_of(select0))) - dfVariant <- dfVariant |> rename_at(.vars=c(rename0), ~c(rename1)) + dfVariant <- dfVariant |> rename_at(c(rename0), ~c(rename1)) rm(select0, rename0, rename1) ###### Sector-Variant Data ###### @@ -543,7 +632,7 @@ get_fig7_slrDataObj <- function( rename0 <- c("driverValue") rename1 <- c("slr_cm") slrCm <- slrCm |> select(c(all_of(select0))) - slrCm <- slrCm |> rename_at(.vars=c(rename0), ~c(rename1)) + slrCm <- slrCm |> rename_at(c(rename0), ~c(rename1)) rm(select0, rename0, rename1) ### Add values for 0cm, 300 cm @@ -559,7 +648,7 @@ get_fig7_slrDataObj <- function( ### Arrange values arrange0 <- c("model", "year") - slrCm <- slrCm |> arrange_at(.vars=c(arrange0)) + slrCm <- slrCm |> arrange_at(c(arrange0)) rm(arrange0) ### Add to list @@ -572,14 +661,14 @@ get_fig7_slrDataObj <- function( rename0 <- c("sector" , "variant" , "scaled_impacts") rename1 <- c("sector_id", "variant_id", "annual_impacts") drop0 <- c("model_dot") - slrImp <- slrImp |> rename_at(.vars=c(rename0), ~c(rename1)) + slrImp <- slrImp |> rename_at(c(rename0), ~c(rename1)) slrImp <- slrImp |> select(-c(all_of(drop0))) rm(rename0, rename1, drop0) ### Adjust names exclude0 <- c("year", "annual_impacts") - mutate0 <- slrImp |> names() %>% (function(y1, y2=exclude0){y1[!(y1 %in% y2)]}) - slrImp <- slrImp |> mutate_at(.vars=c(mutate0), as.character) + mutate0 <- slrImp |> names() |> (function(y1, y2=exclude0){y1[!(y1 %in% y2)]})() + slrImp <- slrImp |> mutate_at(c(mutate0), as.character) slrImp <- slrImp |> mutate(model = model |> factor(levels=slrLevels, labels=slrLabels)) rm("exclude0", "mutate0") @@ -600,12 +689,12 @@ get_fig7_slrDataObj <- function( slrImp <- slrImp |> mutate(annual_impacts = annual_impacts |> replace_na(0)) ### Mutate specific values - slrImp <- slrImp %>% (function(y){ + slrImp <- slrImp |> (function(y){ yLo <- y |> filter(model=="30 cm" ) |> mutate(annual_impacts=0) |> mutate(model="0 cm") yHi <- y |> filter(model=="250 cm") |> mutate(model="300 cm") y <- yLo |> rbind(y) |> rbind(yHi) return(y) - }) + })() ### Mutate labels & levels slrImp <- slrImp |> mutate(model = model |> as.character()) @@ -613,7 +702,7 @@ get_fig7_slrDataObj <- function( ### Arrange values arrange0 <- c("sector", "variant", "impactType", "impactYear", "region", "model_type", "model", "year") - slrImp <- slrImp |> arrange_at(.vars=c(arrange0)) + slrImp <- slrImp |> arrange_at(c(arrange0)) rm(arrange0) ### Add to list @@ -638,6 +727,9 @@ get_fig7_slrImpacts <- function( adjVal = 1/10**9, ### Factor to multiply by adjCol = "impact_billions" ){ + ###### Values + primary <- !bySector + ###### Model Labels ###### ### SLR sectors separately: ### - Filter to 2090 and 2050 values @@ -647,18 +739,14 @@ get_fig7_slrImpacts <- function( modelHeights <- modelLabels |> map(function(.x){str_split(string=.x, pattern="\\s")[[1]][1]}) |> unlist() |> as.numeric() ###### Format data ###### - ### Add variables for plotting with plot_DOW_byModelType - # slrImpacts <- slrImpacts |> mutate(impactYear = "Interpolation") - - ### Filter to includeaggregate==1, - if(aggOnly){slrImpacts <- slrImpacts |> filter(includeaggregate==1)} - + ### Filter to includeaggregate==1 ### Filter to primary==1 - primary <- !bySector - if(aggOnly){slrImpacts <- slrImpacts |> filter(sectorprimary==1)} - ### Filter to appropriate categories and years + if(aggOnly){slrImpacts <- slrImpacts |> filter(includeaggregate==1)} + if(aggOnly){slrImpacts <- slrImpacts |> filter(sectorprimary==1)} if(!bySector){slrImpacts <- slrImpacts |> filter(year %in% years)} + + ### Filter to appropriate models slrImpacts <- slrImpacts |> filter(model %in% modelLabels) ### Filter to national totals or calculate national totals @@ -669,8 +757,8 @@ get_fig7_slrImpacts <- function( ### Change column names rename0 <- "model" rename1 <- "SLR_scenario" - slrDrivers <- slrDrivers |> rename_at(.vars=c(rename0), ~c(rename1)) - slrImpacts <- slrImpacts |> rename_at(.vars=c(rename0), ~c(rename1)) + slrDrivers <- slrDrivers |> rename_at(c(rename0), ~c(rename1)) + slrImpacts <- slrImpacts |> rename_at(c(rename0), ~c(rename1)) slrImpacts <- slrImpacts |> mutate(model = year |> factor()) rm(rename0, rename1) @@ -685,8 +773,7 @@ get_fig7_slrImpacts <- function( group0 <- c("sector", "variant", "impactYear", "region", "model_type", "SLR_scenario", "model", "year") count_impTypes <- slrTotals |> group_by_at(c(group0)) |> - summarize(n=n(), .groups="keep") |> - ungroup() + summarize(n=n(), .groups="drop") # n_impTypes <- count_impTypes[["n"]] |> max() ### Join counts with totals @@ -695,16 +782,14 @@ get_fig7_slrImpacts <- function( rm(join0, count_impTypes) ### Summarize - # sum0 <- c("annual_impacts", "is_NA") - # sum0 <- c(sumCol, "is_NA") slrTotals <- slrTotals |> sum_with_na( group0 = group0, ### Grouping columns - # col0 = "annual_impacts", col0 = sumCol, - threshCol = "n", ### Threshold to check against - drop0 = TRUE ### - ) %>% select(-c("n")) + threshCol = "n", ### Threshold to check against + drop0 = TRUE ### + ) |> select(-c("n")) + ### Add totals slrTotals <- slrTotals |> mutate(impactType = "All") # slrTotals |> names() |> print() } @@ -712,68 +797,54 @@ get_fig7_slrImpacts <- function( ###### National Totals ###### ### Calculate national totals group0 <- c("sector", "variant", "impactType", "impactYear", "model_type", "SLR_scenario", "model", "year") - # group0 <- c("sector", "variant", "impactType", "impactYear", "model_type", "model", "year") - # sum0 <- c("annual_impacts", "is_NA") slrTotals <- slrTotals |> mutate(threshold = n_regions) slrTotals <- slrTotals |> sum_with_na( - group0 = group0, ### Grouping columns - # col0 = "annual_impacts", + group0 = group0, ### Grouping columns col0 = sumCol, threshCol = "threshold", ### Threshold to check against drop0 = TRUE ### - ) %>% select(-c("threshold")) + ) |> select(-c("threshold")) slrTotals <- slrTotals |> mutate(region = "National Total") # slrTotals |> names() |> print() ###### #####Adjust Values ###### ### Adjust values - # slrTotals[[adjCol]] <- slrTotals[["annual_impacts"]] * adjVal slrTotals[[adjCol]] <- slrTotals[[sumCol]] * adjVal - # ### Add additional values & drop columns - # drop0 <- c("variant", "impactType", "impactYear") - # slrTotals <- slrTotals |> mutate(region = "National Total") - # # slrTotals <- slrTotals |> mutate(impactType = "All") - # slrTotals <- slrTotals |> select(-c(all_of(drop0))) - # rm(drop0) - ###### Format Results ###### ### Join with driver info rename0 <- c("slr_cm" , "year") rename1 <- c("driverValue", "summaryYear") join0 <- c("year", "SLR_scenario") - # join0 <- c("year", "model") - # select0 <- c("sector", "region", "model_type", "model", "summaryYear", "driverValue", "annual_impacts", adjCol) |> unique() - # select0 <- c("sector", "region", "model_type", "SLR_scenario", "model", "summaryYear", "driverValue", "annual_impacts", adjCol) |> unique() - select0 <- c("sector", "region", "model_type", "SLR_scenario", "model", "summaryYear", "driverValue", sumCol, adjCol) |> unique() + select0 <- c("sector", "region", "model_type", "SLR_scenario", "model", "summaryYear", "driverValue") |> c(sumCol, adjCol) |> unique() slrTotals <- slrTotals |> left_join(slrDrivers, by=c(join0)) - slrTotals <- slrTotals |> rename_at(.vars=c(rename0), ~c(rename1)) + slrTotals <- slrTotals |> rename_at(c(rename0), ~c(rename1)) slrTotals <- slrTotals |> relocate(c(all_of(select0))) rm(rename0, rename1, join0) ### Adjust column names if bySector if(bySector){ - slrTotals <- slrTotals |> mutate(model=SLR_scenario) - slrTotals <- slrTotals |> rename(year=summaryYear) - slrTotals <- slrTotals |> select(-c("SLR_scenario")) - } + slrTotals <- slrTotals |> mutate(model=SLR_scenario) + slrTotals <- slrTotals |> rename(year=summaryYear) + slrTotals <- slrTotals |> select(-c("SLR_scenario")) + } ### End if(bySector) - slrTotals |> glimpse() #|> print() + slrTotals |> glimpse() ### Return return(slrTotals) } ### End get_fig7_slrImpacts ### Plot impacts by degree of warming plot_DoW_by_modelYear <- function( - df0, ### Data (e.g., output from sum_impactsByDegree) - type0 ="GCM", ### Model type: GCM or SLR - year0 = 2010, - xCol = "driverValue", - yCol = "annual_impacts", - thresh0 = 18, - nCol = 4, - silent = T, + df0, ### Data (e.g., output from sum_impactsByDegree) + type0 ="GCM", ### Model type: GCM or SLR + year0 = 2010, + xCol = "driverValue", + yCol = "annual_impacts", + thresh0 = 18, + nCol = 4, + silent = T, options = list( title = NULL, xTitle = NULL, @@ -791,10 +862,11 @@ plot_DoW_by_modelYear <- function( do_slr <- "slr" == tolower(type0) ###### Filter Data ###### - ### Filter to model type - # df0 <- df0 |> filter(summaryYear==year0) + ### Filter to summary year if(do_gcm){df0 <- df0 |> filter(summaryYear==year0)} - df0 <- df0 |> filter(model_type ==type0) + + ### Filter to model type + df0 <- df0 |> filter(model_type == type0) ### Plot by model type plot0 <- df0 |> plot_DOW_byModelType( @@ -810,9 +882,69 @@ plot_DoW_by_modelYear <- function( return(plot0) } ### End plot_DoW_by_modelYear + +### Function to create a dataframe to iterate over, by model type +fun_create_df_types <- function( + types0 = c("GCM", "SLR"), ### Model types to get options for + years0 = c(2010, 2090), ### Result years to get impacts for + bySector = FALSE, ### Whether to get options by sector + df0 = FrEDI::get_sectorInfo(description=T) |> select(c("sector", "model_type")) ### If bySector=TRUE, dataframe to get sectors from + # df0 = tibble() |> mutate(sector="N/A", model_type=types0) ### If bySector=TRUE, dataframe to get sectors from +){ + ### Get sector info + select0 <- c("sector", "model_type") + df0 <- df0 |> select(all_of(select0)) |> unique() + rm(select0) + + ### Create tibble + df_types <- types0 |> map(function(.x){ + ### Condition + do_gcm <- "gcm" %in% (.x |> tolower()) + ### Years + if(do_gcm){yrs_x <- years0} else{yrs_x <- "all"} + ### Create tibble + df_x <- tibble(model_type=.x, year=yrs_x) + ### Mutate year + df_x <- df_x |> mutate(year = year |> as.character()) + ### Add label + df_x <- df_x |> mutate(label = model_type |> paste0("_", year)) + ### Return + return(df_x) + }) |> bind_rows() + # df_types |> glimpse() + + ### If bySector = TRUE, add sector info + if(bySector){ + df_types <- types0 |> map(function( + .x, + df_x=df_types |> filter(model_type==.x), + df_y=df0 |> filter(model_type==.x) + ){ + ### Add sector info + join0 <- c("model_type") + df_x <- df_x |> left_join(df_y, by=c("model_type")) + + ### Arrange + sort0 <- c("model_type", "sector", "year") + df_x <- df_x |> select(all_of(sort0)) + df_x <- df_x |> arrange_at(c(sort0)) + + ### Mutate label + df_x <- df_x |> mutate(label = sector |> paste0("_", year)) + + ### Return + return(df_x) + }) |> bind_rows() + } ### End if(bySector) + + ### Return + return(df_types) +} ### fun_create_df_types + + ### Plot DOW plot_DoW <- function( - df0, ### Data (e.g., output from sum_impactsByDegree) + df0, ### Data (e.g., output from sum_impactsByDegree) types0 = c("GCM", "SLR"), ### Model type: GCM or SLR years0 = c(2010, 2090), xCol = "driverValue", @@ -832,57 +964,45 @@ plot_DoW <- function( ) ){ ### Data frame to iterate over - # df_types <- types0 %>% - # map(function(.x){tibble(type=.x, year=years0, label=.x |> paste0("_", years0))}) %>% - # (function(y){do.call(rbind, y)}) - do_gcm <- "gcm" %in% tolower(types0) - do_slr <- "slr" %in% tolower(types0) + do_gcm <- "gcm" %in% (types0 |> tolower()) + do_slr <- "slr" %in% (types0 |> tolower()) + ### Initialize dataframe - df_types <- tibble() - if(do_gcm){ - df_gcm <- "GCM" %>% - # map(function(.x){tibble(type=.x, year=years0, label=.x |> paste0("_", years0))}) %>% - # (function(y){do.call(rbind, y)}) - map(function(.x){tibble(type=.x, year=years0, label=.x |> paste0("_", years0))}) |> - bind_rows() - df_types <- df_types |> rbind(df_gcm) - rm(df_gcm) - } ### if(do_gcm) - ### SLR data - if(do_slr){ - df_slr <- tibble(type="SLR", year="all", label="SLR" |> paste0("_", "all")) - df_types <- df_types |> rbind(df_slr) - rm(df_slr) - } ### if(do_slr) + df_types <- types0 |> fun_create_df_types(years0=years0) # "got here" |> print() # df_types |> glimpse() - ### Initialize list to iterate over - pList0 <- list(x1=df_types[["type"]], x2=df_types[["year"]]) - ### Initialize list - list0 <- pList0 %>% pmap(function(x1, x2){ - x1 |> paste0("_", x2) |> print() - plot_y <- plot_DoW_by_modelYear( - df0 = df0, ### Data (e.g., output from sum_impactsByDegree) - type0 = x1, ### Model type: GCM or SLR - year0 = x2, + + # ### Initialize list to iterate over + list0 <- list() + for(i in df_types |> nrow() |> seq_len()){ + ### Message user + x1_i <- df_types[["model_type"]][i] + x2_i <- df_types[["year" ]][i] + x_i <- df_types[["label" ]][i] + x_i |> print() + + ### Whether to do GCM + gcm_i <- "gcm" %in% (x1_i |> tolower()) + if(gcm_i) x2_i <- x2_i |> as.numeric() + + ### Plot by model year + plot_i <- df0 |> plot_DoW_by_modelYear( + type0 = x1_i, ### Model type: GCM or SLR + year0 = x2_i, ### Year xCol = xCol, yCol = yCol, thresh0 = thresh0, nCol = nCol, options = options, silent = silent - ) ### End plot_DoW_by_modelYear + ) ### End plot_DoW_by_modelYear() - # plot_y |> print() - ### Return - return(plot_y) - }) - - ### Add list names - # list0 |> print() - labels0 <- df_types[["label"]] - list0 <- list0 |> set_names(labels0) + ### Add to list + list0[[x_i]] <- plot_i + rm(i, x1_i, x2_i, x_i, plot_i) + } ### End for(i in df_types |> nrow() |> seq_len()) + rm(df0) ### Return return(list0) @@ -896,8 +1016,6 @@ plot_DoW_by_sector <- function( yCol = "impacts_billions", options = list( title = "Impacts by Degrees of Warming", - # subtitle = NULL, - # xTitle = expression("Degrees of Warming (°C)"), yTitle = "Impacts ($2015)", lgdTitle = "Model", lgdPos = "top", @@ -906,77 +1024,77 @@ plot_DoW_by_sector <- function( theme = NULL ) ){ + ### Values & Conditions + years0 <- c(2010, 2090) + ### Data frame to iterate over - do_gcm <- "gcm" %in% tolower(models) - do_slr <- "slr" %in% tolower(models) - ### Initialize dataframes - df_types <- tibble() - ### Other values - years <- c(2010, 2090) - ### For GCMs - if(do_gcm){ - df_gcm <- "GCM" |> map(function(.x, years0=years){ - # df0 |> glimpse() - df1 <- df0 |> filter(model_type=="GCM") - sectors0 <- df1[["sector"]] |> unique() - df_x <- sectors0 |> map(function(.y){tibble(type=.x, sector=.y, year=years, label=.y |> paste0("_", years))}) - df_x <- df_x |> bind_rows() - return(df_x) - }) - df_gcm <- df_gcm |> bind_rows() - df_types <- df_types |> rbind(df_gcm) - rm(df_gcm) - } ### End if(do_gcm) - ### For SLR - if(do_slr){ - sectors0 <- (df0 |> filter(model_type=="SLR"))[["sector"]] |> unique() - df_slr <- tibble(type="SLR", sector=sectors0, year="all", label=sectors0 |> paste0("_", "all")) - df_types <- df_types |> rbind(df_slr) - rm(df_slr, sectors0) - } ### End if(do_slr) + do_gcm <- "gcm" %in% (models |> tolower()) + do_slr <- "slr" %in% (models |> tolower()) + + ### Dataframe to iterate over + df_types <- models |> fun_create_df_types(years0=years0, bySector=TRUE, df0=df0) ### Get list - list0 <- models |> map(function(.x){ - paste0("Creating plots for model type ", .x, "...") |> message() - df_x <- df0 |> filter(model %in% c(.x)) - ### Sectors - types_x <- df_types |> filter(type==.x) - sectors_x <- types_x[["sector"]] - # df_types |> glimpse() - pList_x <- list(x1=types_x[["sector"]], x2=types_x[["year"]]) - - list_x <- pList_x %>% pmap(function(x1, x2){ - x1 |> paste0("_", x2) |> print() - df_y <- df0 |> filter(sector == x1) + list0 <- list() + for(model_i in models){ + ### Message user + "Creating plots for model type " |> paste0(model_i, "...") |> message() + + ### Filter tibbles + # df_i <- df0 |> filter(model_type %in% model_i) + types_i <- df_types |> filter(model_type %in% model_i) + + ### Iterate over rows in types_i + list_i <- list() + for(row_j in types_i |> nrow() |> seq_len()){ + ### Get values + x1_j <- types_i[["sector"]][row_j] + x2_j <- types_i[["year" ]][row_j] + x_j <- types_i[["label" ]][row_j] + x_j |> print() + + ### Get type and condition + type_j <- types_i[["model_type"]][row_j] + do_gcm_j <- "gcm" %in% (type_j |> tolower()) + + ### Filter to sector + df_j <- df0 |> filter(sector == x1_j) + ### If do_gcm, filter to appropriate years - if(do_gcm){ - c_yrs <- c("NA", x2) - df_y <- df_y |> filter(summaryYear == x2) - df_y <- df_y |> filter(impactYear %in% c_yrs) - #"look here" %>% print() - #df_y |> glimpse() - } ### End if(do_gcm) - - plot_y <- df_y |> plot_DOW_byImpactTypes( - sector = x1, - modelType = models, + if(do_gcm_j){ + yrs_j <- "NA" |> c(x2_j) + df_j <- df_j |> filter(summaryYear == x2_j) + df_j <- df_j |> filter(impactYear %in% yrs_j) + # df_j |> glimpse() + rm(yrs_j) + } ### End if(do_gcm_j) + + ### Plot j + plot_j <- df_j |> plot_DOW_byImpactTypes( + sector = x1_j, + modelType = type_j, yCol = yCol, xCol = xCol, silent = TRUE, options = options - ) - # plot_y |> names() |> print() - ### Return - return(plot_y) - }) - ### Add names - labels_x <- types_x[["label"]] - list_x <- list_x |> set_names(labels_x) - ### Return - return(list_x) - }) - ### Add names - list0 <- list0 |> set_names(models) + ) ### End plot_DOW_byImpactTypes() + # plot_j |> names() |> print() + + ### Add plot to list + list_i[[x_j]] <- plot_j + + ### Remove values + rm(row_j, type_j, do_gcm_j, x1_j, x2_j, x_j, df_j, plot_j) + } ### End for(row_j in types_i) + + ### Add list to list0 + list0[[model_i]] <- list_i + + ### Remove values + rm(model_i, types_i, list_i) + } ### End for(model_i in models) + + ### Return return(list0) } ### End plot_DoW_by_sector @@ -1009,11 +1127,6 @@ plot_slr_scenarios <- function( scale_x_continuous("Year") + scale_y_continuous("GMSL (cm)") - # plot0 <- plot0 + - # theme(panel.background = element_rect(fill="white")) + - # theme(panel.grid = element_line(color="lightgrey")) + - # theme(axis.line = element_line(color="darkgrey")) - plot0 <- plot0 + ggtitle(title0, subTitle0) + theme(plot.title = element_text(hjust = 0.5, size=14)) + @@ -1030,7 +1143,7 @@ create_default_tablePlot <- function(x=1){ # results0 |> glimpse() ### Filter to values used to report - results0 <- results0 |> + results0 <- results0 |> filter(model %in% c("Interpolation", "Average")) |> filter(includeaggregate == 1) |> filter(sectorprimary == 1) |> @@ -1045,19 +1158,19 @@ create_default_tablePlot <- function(x=1){ ### Summarize results over all years totals0 <- results0 |> - group_by_at(.vars=c("sector")) |> - summarize_at(.vars=c("annual_impacts"), sum, na.rm=T) |> + group_by_at(c("sector")) |> + summarize_at(c("annual_impacts"), sum, na.rm=T) |> ungroup() totals0 <- totals0|> - arrange_at(.vars=c("annual_impacts")) |> + arrange_at(c("annual_impacts")) |> mutate(order=row_number()) ### Factor results - results0 <- results0 |> mutate(sector_order = sector |> factor(levels=totals0[["sector"]])) - results0 <- results0 |> mutate(sector_factor = sector |> factor(levels=totals0[["sector"]])) + results0 <- results0 |> mutate(sector_order = sector |> factor(levels=totals0[["sector"]])) + results0 <- results0 |> mutate(sector_factor = sector |> factor(levels=totals0[["sector"]])) ### Arrange arrange0 <- c("sector_factor", "variant", "year") - results0 <- results0 |> arrange_at(.vars=c(arrange0)) + results0 <- results0 |> arrange_at(c(arrange0)) ### Create plot plot0 <- results0 |> @@ -1074,6 +1187,7 @@ create_default_tablePlot <- function(x=1){ returnList[["table" ]] <- table0 returnList[["totals"]] <- totals0 returnList[["plot" ]] <- plot0 + ### Return return(returnList) } ### End create_default_tablePlot diff --git a/FrEDI/testing/utils_plot_DOW_byImpactTypes.R b/FrEDI/testing/utils_plot_DOW_byImpactTypes.R index d61d4a6a..47a96a47 100644 --- a/FrEDI/testing/utils_plot_DOW_byImpactTypes.R +++ b/FrEDI/testing/utils_plot_DOW_byImpactTypes.R @@ -101,6 +101,7 @@ plot_DOW_byImpactTypes <- function( ) ###### Get Sector Info ###### + # df0 |> glimpse() infoList0 <- df0 |> get_sector_plotInfo(yCol=yCol, byType=TRUE, silent=silent) df_info <- infoList0[["sectorInfo"]] df_minMax <- infoList0[["minMax" ]] diff --git a/FrEDI/testing/utils_report_figures_scales.R b/FrEDI/testing/utils_report_figures_scales.R index a238a159..36d69526 100644 --- a/FrEDI/testing/utils_report_figures_scales.R +++ b/FrEDI/testing/utils_report_figures_scales.R @@ -279,22 +279,29 @@ fun_limitsByGroup <- function( if(print_msg){msg1 |> paste0("Grouping by columns ", paste(groupCols, collapse=", "), "...") |> message()} ### Summarize values by sector lim_bySector <- data |> - group_by_at(c(groupCols)) |> - summarise_at(.vars = c(sumCols), .funs = c(type), na.rm=T) |> - gather(key = "summary_type", value = "summary_value", -c(all_of(groupCols))) |> - ungroup() + group_by_at (c(groupCols)) |> + summarise_at(c(sumCols), .funs=c(type), na.rm=T) |> ungroup() + rm(data) + ### Pivot longer + # lim_bySector <- lim_bySector |> gather(key = "summary_type", value = "summary_value", -c(all_of(groupCols))) + lim_bySector <- lim_bySector |> pivot_longer( + cols = -all_of(groupCols), + names_to = "summary_type", + values_to = "summary_value" + ) ### pivot_longer # df_limBySector |> print() ###### Spread ###### ### Spread & calculate the spread - lim_bySector <- lim_bySector |> spread(key="summary_type", value="summary_value") + # lim_bySector <- lim_bySector |> spread(key="summary_type", value="summary_value") + lim_bySector <- lim_bySector |> pivot_wider(names_from="summary_type", values_from="summary_value") lim_bySector <- lim_bySector |> mutate(spread=max - min) ###### Arrange ###### ### Arrange the sectors & get their order # arrange0 <- groupCols |> c("max", "spread") arrange0 <- c("max", "spread") - lim_bySector <- lim_bySector |> arrange_at(.vars = c(arrange0), desc) + lim_bySector <- lim_bySector |> arrange_at(c(arrange0), desc) # lim_bySector |> print() ###### Get Group Orders ###### @@ -312,7 +319,7 @@ fun_limitsByGroup <- function( ### Arrange the sectors & get their order # arrange0 <- groupCols |> c("max", "spread") arrange0 <- "order" |> paste0("_", groupCols) - lim_bySector <- lim_bySector |> arrange_at(.vars = c(arrange0)) + lim_bySector <- lim_bySector |> arrange_at(c(arrange0)) lim_bySector <- lim_bySector |> mutate(order = row_number()) # lim_bySector |> print() diff --git a/FrEDI/testing/utils_save_report_objects.R b/FrEDI/testing/utils_save_report_objects.R index d9090e6e..95a6e0c3 100644 --- a/FrEDI/testing/utils_save_report_objects.R +++ b/FrEDI/testing/utils_save_report_objects.R @@ -21,7 +21,7 @@ check_and_create_path <- function( ###### save_data ###### ### Utility function to help save a data object save_data <- function( - obj0, ### Data object + obj0, ### Data object fpath = ".", ### File path fname = "data", ftype = "csv", ### CSV or RData