diff --git a/.github/workflows/build_fredi.yml b/.github/workflows/build_fredi.yml index 5bf3fb54..f402c655 100644 --- a/.github/workflows/build_fredi.yml +++ b/.github/workflows/build_fredi.yml @@ -19,22 +19,25 @@ on: options: - no - yes -# update_results: + update_scenarios: + type: choice + description: Update scenarios? + required: true + options: + - no + - yes + +# - "GDP" +# - "Population" +# - "Temp/SLR" +# - "O3/CH4/NOx" +# date_results: # type: choice # description: Update default results? # required: true # options: # - no # - yes - update_scenarios: - type: multi-choice - description: Update scenarios? - required: true - options: - - GDP - - Population - - Temps & SLR - - O3, CH4, & NOx jobs: compile_data: @@ -64,115 +67,127 @@ jobs: - name: Update Scenarios run: | Rscript -e ' + require(tidyverse) + require(devtools) + require(ggpubr) + require(openxlsx) ###### Conditionals ###### ### Which scenarios/documentation to update - do_docs <- "yes" %in% "${{ inputs.update_scenarios}}" - do_gdp <- "GDP" %in% "${{ inputs.update_scenarios}}" - do_pop <- "Pop" %in% "${{ inputs.update_scenarios}}" - do_temp <- "Temps & SLR" %in% "${{ inputs.update_scenarios}}" - do_o3 <- "${{ inputs.update_scenarios}}" |> str_detect(pattern="O3") |> any() + do_docs <- "true" %in% "${{ inputs.update_docs}}" + do_data <- "true" %in% "${{ inputs.update_scenarios}}" + do_gdp <- do_data + do_pop <- do_data + do_temp <- do_data + do_o3 <- do_data + # do_gdp <- "GDP" %in% "${{ inputs.update_scenarios}}" + # do_pop <- "Pop" %in% "${{ inputs.update_scenarios}}" + # do_temp <- "Temps & SLR" %in% "${{ inputs.update_scenarios}}" + # do_o3 <- "${{ inputs.update_scenarios}}" |> str_detect(pattern="O3") |> any() + c(do_docs, do_data) |> print() ###### File Paths ###### ### - Main repo path, FrEDI project path ### - Data path, scenario csv path rPath0 <- "." - pPath0 <- rPath0 |> file.path("FrEDI") dPath0 <- rPath0 |> file.path("data" ) cPath0 <- rPath0 |> file.path("inst", "extdata", "scenarios") - ###### Update Scenarios ###### - ### GDP - if(do_gdp) { - gdpDefault <- "gdp_default" |> get_frediDataObj("scenarioData") - fGdp <- "gdpDefault" - dGdp <- dPath0 |> paste0(fGdp, ".rda") - cGdp <- cPath0 |> paste0(fGdp, ".csv") - gdpDefault |> save(file=dGdp) - gdpDefault |> write.csv(filename=cGdp, row.names=F) - rm(fGdp, dGdp, cGdp, gdpDefault) - } ### End if(do_gdp) - - ### Population - if(do_pop) { - popDefault <- "pop_default" |> get_frediDataObj("scenarioData") - fPop <- "popDefault" - dPop <- dPath0 |> paste0(fPop, ".rda") - cPop <- cPath0 |> paste0(fPop, ".csv") - popDefault |> save(file=dPop) - popDefault |> write.csv(filename=cPop, row.names=F) - rm(fPop, dPop, cPop, popDefault) - } ### End if(do_pop) - - ### Temperature & CSV - if(do_temp) { - gcamScenarios <- "gcam_scenarios" |> get_frediDataObj("scenarioData") - fTemps <- "gcamScenarios" - dTemps <- dPath0 |> paste0(fTemps, ".rda") - cTemps <- cPath0 |> paste0(fTemps, ".csv") - gcamScenarios |> save(file=dTemps) - gcamScenarios |> write.csv(filename=cTemps, row.names=F) - rm(fTemps, dTemps, cTemps, gcamScenarios) - } ### End if(do_temp) - - ### O3, CH4, and NOx - if(do_o3) { - ### Ozone - select0 <- c("region", "state", "postal", "model", "year", "O3_pptv") - o3Default <- "o3_default" |> get_frediDataObj(listSub="scenarioData", listName="listMethane") - o3Default <- o3Default |> select(all_of(select0)) - rm(select0) - - # ### Adjust the default scenario - # co_mods <- "co_models" |> get_frediDataObj(listSub="package", listName="listMethane") - # co_mods <- co_mods |> select(model, model_label) - # o3Default <- o3Default |> left_join(co_mods, by=c("model")) - # o3Default <- o3Default |> select(-model) - # o3Default <- o3Default |> rename(model=model_label) - # o3Default <- o3Default |> relocate(c("model")) - - ### Save ozone - fO3 <- "o3Default" - dO3 <- dPath0 |> paste0(fO3, ".rda") - cO3 <- cPath0 |> paste0(fO3, ".csv") - o3Default |> save(file=dO3) - o3Default |> write.csv(filename=cO3, row.names=F) - rm(fO3, dO3, cO3, o3Default) - - ### CH4 - ch4Default <- "ch4_default" |> get_frediDataObj(listSub="scenarioData", listName="listMethane") - fCH4 <- "ch4Default" - dCH4 <- dPath0 |> paste0(fCH4, ".rda") - cCH4 <- cPath0 |> paste0(fCH4, ".csv") - ch4Default |> save(file=dCH4) - ch4Default |> write.csv(filename=cCH4, row.names=F) - rm(fCH4, dCH4, cCH4, ch4Default) - - ### NOx - noxDefault <- "nox_default" |> get_frediDataObj(listSub="scenarioData", listName="listMethane") - fNOx <- "noxDefault" - dNOx <- dPath0 |> paste0(fNOx, ".rda") - cNOx <- cPath0 |> paste0(fNOx, ".csv") - noxDefault |> save(file=dNOx) - noxDefault |> write.csv(filename=cNOx, row.names=F) - rm(fNOx, dNOx, cNOx, noxDefault) - } ### End if(do_o3) + # ###### Update Scenarios ###### + # ### GDP + # if(do_gdp) { + # gdpDefault <- "gdp_default" |> get_frediDataObj("scenarioData") + # fGdp <- "gdpDefault" + # dGdp <- dPath0 |> paste0(fGdp, ".rda") + # cGdp <- cPath0 |> paste0(fGdp, ".csv") + # gdpDefault |> save(file=dGdp) + # gdpDefault |> write.csv(filename=cGdp, row.names=F) + # rm(fGdp, dGdp, cGdp, gdpDefault) + # } ### End if(do_gdp) + # + # ### Population + # if(do_pop) { + # popDefault <- "pop_default" |> get_frediDataObj("scenarioData") + # fPop <- "popDefault" + # dPop <- dPath0 |> paste0(fPop, ".rda") + # cPop <- cPath0 |> paste0(fPop, ".csv") + # popDefault |> save(file=dPop) + # popDefault |> write.csv(filename=cPop, row.names=F) + # rm(fPop, dPop, cPop, popDefault) + # } ### End if(do_pop) + # + # ### Temperature & CSV + # if(do_temp) { + # gcamScenarios <- "gcam_scenarios" |> get_frediDataObj("scenarioData") + # fTemps <- "gcamScenarios" + # dTemps <- dPath0 |> paste0(fTemps, ".rda") + # cTemps <- cPath0 |> paste0(fTemps, ".csv") + # gcamScenarios |> save(file=dTemps) + # gcamScenarios |> write.csv(filename=cTemps, row.names=F) + # rm(fTemps, dTemps, cTemps, gcamScenarios) + # } ### End if(do_temp) + # + # ### O3, CH4, and NOx + # if(do_o3) { + # ### Ozone + # select0 <- c("region", "state", "postal", "model", "year", "O3_pptv") + # o3Default <- "o3_default" |> get_frediDataObj(listSub="scenarioData", listName="listMethane") + # o3Default <- o3Default |> select(all_of(select0)) + # rm(select0) + # + # # ### Adjust the default scenario + # # co_mods <- "co_models" |> get_frediDataObj(listSub="package", listName="listMethane") + # # co_mods <- co_mods |> select(model, model_label) + # # o3Default <- o3Default |> left_join(co_mods, by=c("model")) + # # o3Default <- o3Default |> select(-model) + # # o3Default <- o3Default |> rename(model=model_label) + # # o3Default <- o3Default |> relocate(c("model")) + # + # ### Save ozone + # fO3 <- "o3Default" + # dO3 <- dPath0 |> paste0(fO3, ".rda") + # cO3 <- cPath0 |> paste0(fO3, ".csv") + # o3Default |> save(file=dO3) + # o3Default |> write.csv(filename=cO3, row.names=F) + # rm(fO3, dO3, cO3, o3Default) + # + # ### CH4 + # ch4Default <- "ch4_default" |> get_frediDataObj(listSub="scenarioData", listName="listMethane") + # fCH4 <- "ch4Default" + # dCH4 <- dPath0 |> paste0(fCH4, ".rda") + # cCH4 <- cPath0 |> paste0(fCH4, ".csv") + # ch4Default |> save(file=dCH4) + # ch4Default |> write.csv(filename=cCH4, row.names=F) + # rm(fCH4, dCH4, cCH4, ch4Default) + # + # ### NOx + # noxDefault <- "nox_default" |> get_frediDataObj(listSub="scenarioData", listName="listMethane") + # fNOx <- "noxDefault" + # dNOx <- dPath0 |> paste0(fNOx, ".rda") + # cNOx <- cPath0 |> paste0(fNOx, ".csv") + # noxDefault |> save(file=dNOx) + # noxDefault |> write.csv(filename=cNOx, row.names=F) + # rm(fNOx, dNOx, cNOx, noxDefault) + # } ### End if(do_o3) ###### Update Documentation ###### ###### - Build Manual ###### - Add and build vignettes ###### - Generate Documentation + "got here1" |> print() if(do_docs) { - roxygen2::roxygenise(pPath0) - devtools::document(pkg = pPath0) - # devtools::build_manual(pkg = pPath0) - # devtools::build_vignettes(pkg = pPath0) + roxygen2::roxygenise(rPath0) + "got here2" |> print() + devtools::document(pkg = rPath0) + "got here3" |> print() + # devtools::build_manual(pkg = rPath0) + # devtools::build_vignettes(pkg = rPath0) } ### End if(do_docs) ###### Build Package ###### ###### - Build Package but do not include vignettes - # devtools::build(pkg=pPath0, path=rPath0) + # devtools::build(pkg=rPath0, path=rPath0) ' @@ -180,12 +195,12 @@ jobs: run: | Rscript -e ' ### Main repo path, FrEDI project path, scripts path + "got here4" |> print() rPath0 <- "."; - pPath0 <- rPath0 |> file.path("FrEDI") - oPath0 <- pPath0 |> file.path("data", "defaultResults.rda") # ###### Create Default Results ###### - # pPath0 |> devtools::load_all() + # oPath0 <- rPath0 |> file.path("data", "defaultResults.rda") + # rPath0 |> devtools::load_all() # defaultResults <- run_fredi() # save(defaultResults, file=oPath0) @@ -193,24 +208,24 @@ jobs: ###### - Build Manual ###### - Add and build vignettes ###### - Generate Documentation - roxygen2::roxygenise(pPath0) - devtools::document(pkg = pPath0) - # devtools::build_manual(pkg = pPath0) - # devtools::build_vignettes(pkg = pPath0) + roxygen2::roxygenise(rPath0) + devtools::document(pkg = rPath0) + # devtools::build_manual(pkg = rPath0) + # devtools::build_vignettes(pkg = rPath0) ###### Build Package ###### ###### - Build Package but do not include vignettes - # devtools::build(pkg=pPath0, path=rPath0) + # devtools::build(pkg=rPath0, path=rPath0) ' - ### git add FrEDI/data/defaultResults.rda + ### git add data/defaultResults.rda - name: Commit results run: | git config --local core.autocrlf false git config --local user.email "${{ github.actor }}@users.noreply.github.com" git config --local user.name "${{ github.actor }}" - git add FrEDI/man/*.Rd + git add man/*.Rd git pull origin ${{ github.head_ref }} --autostash --rebase -X ours git commit -am "Updated package documentation" git push diff --git a/pkgdown.yaml b/.github/workflows/deploy_github_pages.yml similarity index 83% rename from pkgdown.yaml rename to .github/workflows/deploy_github_pages.yml index 63cbb18a..8edb39d4 100644 --- a/pkgdown.yaml +++ b/.github/workflows/deploy_github_pages.yml @@ -1,13 +1,21 @@ # Workflow derived from https://github.com/r-lib/actions/tree/master/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +name: 6. Deploy github.io + on: - push: - branches: [main, master] - release: - types: [published] + # push: + # branches: + # - main + # - master + # release: + # types: [published] workflow_dispatch: + branches: + - main + - master + release: + types: [published] -name: pkgdown jobs: pkgdown: diff --git a/.github/workflows/test_fredi.yml b/.github/workflows/test_fredi.yml index edcc3894..d763dde4 100644 --- a/.github/workflows/test_fredi.yml +++ b/.github/workflows/test_fredi.yml @@ -35,7 +35,7 @@ jobs: - name: Send input status run: | - echo "${{ inputs.ref_branch }} ${{ inputs.agg_types }}" + echo "$${{ github.ref_name }} ${{ inputs.ref_branch }} ${{ inputs.agg_types }}" - name: Setup R @@ -78,17 +78,21 @@ jobs: urlRepo <- "https://github.com/USEPA/FrEDI" newBranch <- "${{ github.ref_name }}" refBranch <- "${{ inputs.ref_branch }}" + c(newBranch, refBranch) |> print() aggTypes <- "${{ inputs.agg_types }}" == "true" - if(aggTypes) cAggLvls <- "all" - else cAggLvls <- c("national", "modelaverage", "impactyear") + if(aggTypes) { + cAggLvls <- "all" + } else { + cAggLvls <- c("national", "modelaverage", "impactyear") + } ### End if(aggTypes) ###### Run FrEDI for Reference Branch ###### ### Install FrEDI from ref branch ### Load library ### Run FrEDI - devtools::install_github(repo=urlRepo, ref=refBranch, dependencies=F, upgrade="never", force=T, type="source") + devtools::install_github(repo=urlRepo, ref=refBranch, subdir="FrEDI", dependencies=F, upgrade="never", force=T, type="source") library(FrEDI) - dfRef <- run_fredi(allLevels=cAggLvls) + dfRef <- run_fredi(aggLevels=cAggLvls) dfRef |> save(file=oFileRef) ### Detach FrEDI package @@ -98,8 +102,9 @@ jobs: ### Install FrEDI from new branch devtools::install_github(repo=urlRepo, ref=newBranch, dependencies=F, upgrade="never", force=T, type="source") library(FrEDI) - dfNew <- run_fredi(allLevels=cAggLvls) + dfNew <- run_fredi(aggLevels=cAggLvls) dfNew |> save(file=oFileNew) + "got here4" |> print() ###### Test results ###### ### Load testing scripts @@ -107,7 +112,8 @@ jobs: for(file_i in tFiles0){file_i |> source(); rm(file_i)} ### Get test results dfTests <- general_fredi_test(newOutputs=dfNew, refOutputs=dfRef, outPath=oPath0) - ' + "got here5" |> print() + ' - name: Upload Tests uses: actions/upload-artifact@v4 diff --git a/.github/workflows/update_github_pages.yml b/.github/workflows/update_github_pages.yml index 3416056f..060a66ee 100644 --- a/.github/workflows/update_github_pages.yml +++ b/.github/workflows/update_github_pages.yml @@ -49,6 +49,7 @@ jobs: any::devtools any::zoo any::pkgdown + any::kableExtra - name: Build documentation run: | @@ -58,8 +59,10 @@ jobs: require(pkgdown) rPath0 <- "."; docPath0 <- rPath0 |> file.path("docs") - build_site_github_pages(lazy=TRUE, dest_dir=docPath0, clean=FALSE) - ' + # pkgdown::build_site_github_pages(lazy=TRUE, dest_dir=docPath0, clean=FALSE, new_process=FALSE) + pkgdown::build_site_github_pages(lazy=TRUE, clean=TRUE, new_process=TRUE) + ' + - name: Commit results run: | git config --local core.autocrlf false diff --git a/DESCRIPTION b/DESCRIPTION index 31fb3803..5419dacf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FrEDI Title: The Framework for Evaluating Damages and Impacts (FrEDI) -Version: 4.1.1 +Version: 4.2.0 Authors@R: c(person("Corinne", "Hartin", email = "hartin.corinne@epa.gov", role = c("aut","cre"), @@ -38,10 +38,11 @@ Description: This R package models damages and impacts from climate change in th using the Framework for Evaluating Damages and Impacts (FrEDI) developed as part of the Climate Change Impacts and Risk Analysis (CIRA) project at the U.S. Environmental Protection Agency. The package contains functions that implement FrEDI for projecting impacts from climate change and sea level rise for a selected set of - sectors. Version 3 and above includes a module for estimating impacts on socially vulnerable populations for - select sectors. Versions > 3.3.0 extend calculations out to 2300 to facilitate the calculation of Net Present Values - (NPV) but only contains default values through 2090--users must provide their own inputs through 2300. Versions 4.0.1 and - above calculate values at the state-level. + sectors. Versions 3+ include a module for estimating impacts on socially vulnerable populations for + select sectors. Versions 3.3+ extend calculations out to 2300 to facilitate the calculation of Net Present Values + (NPV) but only contain default values through 2090--users must provide their own custom input scenarios for results past 2090. + Versions 4.0.1+ calculate values at the state-level. Versions 4.2+ include a module for estimating excess mortality from changes + to ozone concentrations or methane concentrations and, optionally, NOx emissions. License: file LICENSE Encoding: UTF-8 Depends: R (>= 4.2.0), diff --git a/NAMESPACE b/NAMESPACE index 35fa7133..c12622f1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,9 +2,11 @@ export(aggregate_impacts) export(convertTemps) +export(get_matches) export(get_sectorInfo) export(get_sv_sectorInfo) export(import_inputs) export(run_fredi) +export(run_fredi_methane) export(run_fredi_sv) export(temps2slr) diff --git a/R/aggregate_impacts.R b/R/aggregate_impacts.R index e1933766..abf2b17c 100644 --- a/R/aggregate_impacts.R +++ b/R/aggregate_impacts.R @@ -429,7 +429,8 @@ aggregate_impacts <- function( ###### ** Model Averages ###### ### Average values across models - modTypes0 <- df_agg[["model_type"]] + # modTypes0 <- df_agg[["model_type"]] + modTypes0 <- df_agg |> pull(model_type) |> unique() |> tolower() has_modTypes <- modTypes0 |> length() has_gcm <- has_modTypes |> ifelse("gcm" %in% modTypes0, FALSE) if(aveModels & has_gcm){ @@ -438,7 +439,7 @@ aggregate_impacts <- function( ### Ungroup first df_agg <- df_agg |> ungroup() ### Group by columns - group0 <- groupByCols |> get_matches(y=c("model", yearCol0), matches=F) + group0 <- groupByCols |> get_matches(y="model" |> c(yearCol0), matches=F) group0 <- group0 |> c("year") ### Separate model types df_gcm <- df_agg |> filter(model_type |> tolower() == "gcm") diff --git a/R/import_inputs.R b/R/import_inputs.R index 2f222f0f..f1a3419c 100644 --- a/R/import_inputs.R +++ b/R/import_inputs.R @@ -176,15 +176,26 @@ import_inputs <- function( ### Figure out which inputs are not null, and filter to that list ### inputsList Names inNames <- inputsList |> names() - inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() - ### Filter to values that are not NULL - inputsList <- inputsList[inWhich] - inNames <- inputsList |> names() - rm(inWhich) - ### Check which input names are in the user-provided list - inWhich <- inNames %in% inNames0 - inNames <- inNames[inWhich] - rm(inWhich) + inLength <- inputsList |> length() + hasNames <- inNames |> length() + if(hasNames) { + # inWhich <- inNames |> map(function(name0, list0=inputsList){(!(list0[[name0]] |> is.null())) |> which()}) |> unlist() |> unique() + inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() + ### Filter to values that are not NULL + inputsList <- inputsList[inWhich] + inNames <- inputsList |> names() + rm(inWhich) + ### Check which input names are in the user-provided list + inWhich <- inNames %in% inNames0 + inNames <- inNames[inWhich] + inputsList <- inputsList[inNames] + rm(inWhich) + # inNames |> print() + } else if (inLength) { + paste0(msg1) |> paste0("Error! `inputsList` argument requires a list with named elements.") |> message() + msgN |> paste0(msg1) |> paste0("Exiting...") |> message() + return() + } ### End if(!hasInputs) diff --git a/R/run_fredi.R b/R/run_fredi.R index 480808e7..cf751fad 100644 --- a/R/run_fredi.R +++ b/R/run_fredi.R @@ -176,7 +176,7 @@ ###### run_fredi ###### ### This function creates a data frame of sector impacts for default values or scenario inputs. run_fredi <- function( - inputsList = list(temp=NULL, slr=NULL, gdp=NULL, pop=NULL), ### List of inputs + inputsList = list(temp=NULL, slr=NULL, gdp=NULL, pop=NULL), ### List of inputs sectorList = NULL, ### Vector of sectors to get results for aggLevels = c("national", "modelaverage", "impactyear", "impacttype"), ### Aggregation levels elasticity = 1, ### Override value for elasticity for economic values @@ -201,6 +201,9 @@ run_fredi <- function( ###### Set up the environment ###### ### Level of messaging (default is to message the user) msgUser <- !silent + msgN <- "\n" + msg0 <- "" + msg1 <- msg0 |> paste0("\t") ### Model years and NPD (FrEDI past 2100) minYear <- minYear0 @@ -294,17 +297,20 @@ run_fredi <- function( dfSectors <- co_sectors |> filter((sector_label |> tolower()) %in% (sectorList |> tolower())) sectorIds <- dfSectors |> pull(sector_id) sectorLbls <- dfSectors |> pull(sector_label) + sectors0 <- co_sectors |> pull(sector_label) |> unique() ### Check sectors # sectorList |> print(); sectorLbls |> print() naSectors0 <- sectorList |> get_matches(y=sectorLbls, matches=F, type="values") ### Message the user if(naSectors0 |> length()){ - naSectors0 <- "\"" |> paste0(naSectors0 |> paste(collapse= "\", \""), "\"") - msgSectors0 <- "\"" |> paste0(sectorLbls |> paste(collapse= "\", \""), "\"") + naSectors0 <- "'" |> paste0(naSectors0 |> paste(collapse="', '")) |> paste0("'") + msgSectors0 <- "'" |> paste0(sectors0 |> paste(collapse="', '")) |> paste0("'") 1 |> get_msgPrefix(newline=T) |> paste0("Warning! Error in `sectorList`:") |> message() - 2 |> get_msgPrefix() |> paste0("Impacts are not available for sectors: ", naSectors0) |> message() - 2 |> get_msgPrefix(newline=T) |> paste0("Available sectors: ", msgSectors0) |> message() + 2 |> get_msgPrefix() |> paste0("Impacts are not available for sectors: ") |> message() + 3 |> get_msgPrefix() |> paste0(naSectors0) |> message() + 2 |> get_msgPrefix(newline=T) |> paste0("Availabler sectors: ") |> message() + 3 |> get_msgPrefix()|> paste0(msgSectors0) |> message() return() } ### End if(length(missing_sectors)>=1) ### Update in list @@ -367,22 +373,32 @@ run_fredi <- function( ### Figure out which inputs are not null, and filter to that list ### inputsList Names inNames <- inputsList |> names() - # inNames |> print() - # inputsList |> map(glimpse) - # inWhich <- inNames |> map(function(name0, list0=inputsList){(!(list0[[name0]] |> is.null())) |> which()}) |> unlist() |> unique() - inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() - ### Filter to values that are not NULL - inputsList <- inputsList[inWhich] - inNames <- inputsList |> names() - rm(inWhich) - ### Check which input names are in the user-provided list - inWhich <- inNames %in% inNames0 - inNames <- inNames[inWhich] - inputsList <- inputsList[inNames] - hasAnyInputs <- inNames |> length() - rm(inWhich) - # inNames |> print() - + inLength <- inputsList |> length() + hasNames <- inNames |> length() + if(hasNames) { + # inNames <- inputsList |> names() + # inNames |> print() + # inputsList |> map(glimpse) + # inWhich <- inNames |> map(function(name0, list0=inputsList){(!(list0[[name0]] |> is.null())) |> which()}) |> unlist() |> unique() + inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() + ### Filter to values that are not NULL + inputsList <- inputsList[inWhich] + inNames <- inputsList |> names() + rm(inWhich) + ### Check which input names are in the user-provided list + inWhich <- inNames %in% inNames0 + inNames <- inNames[inWhich] + inputsList <- inputsList[inNames] + hasAnyInputs <- inNames |> length() + rm(inWhich) + # inNames |> print() + } else if (inLength) { + paste0(msg1) |> paste0("Error! `inputsList` argument requires a list with named elements.") |> message() + msgN |> paste0(msg1) |> paste0("Exiting...") |> message() + return() + } else { + hasAnyInputs <- FALSE + } ### End if(!hasInputs) ###### ** Check Inputs ###### @@ -552,7 +568,7 @@ run_fredi <- function( - ###### Format Results ###### + ###### Refactor Data ###### ### Add in model info paste0("Formatting results", "...") |> message() @@ -630,10 +646,11 @@ run_fredi <- function( # return(df_results) - ###### ** Aggregation ###### + ###### Aggregation ###### ### For regular use (i.e., not impactYears), simplify the data: groupCols0 if(doAgg) { - # doAgg |> print() + paste0("Aggregating impacts", "...") |> message() + # aggLevels |> length(); doAgg |> print() group0 <- groupCols0 df_results <- df_results |> aggregate_impacts( aggLevels = aggLevels, @@ -643,7 +660,7 @@ run_fredi <- function( } ### End if(doAgg) - + ###### Format Results ###### ###### ** Arrange Columns ###### ### Convert levels to character ### Order the rows, then order the columns diff --git a/R/run_fredi_methane.R b/R/run_fredi_methane.R index 936026cc..e708ed65 100644 --- a/R/run_fredi_methane.R +++ b/R/run_fredi_methane.R @@ -295,19 +295,32 @@ run_fredi_methane <- function( ### Figure out which inputs are not null, and filter to that list ### inputsList Names inNames <- inputsList |> names() - # inNames |> print(); inputsList |> map(glimpse) - inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() - ### Filter to values that are not NULL - inputsList <- inputsList[inWhich] - inNames <- inputsList |> names() - rm(inWhich) - ### Check which input names are in the user-provided list - inWhich <- inNames %in% inNames0 - inNames <- inNames[inWhich] - inputsList <- inputsList[inNames] - hasAnyInputs <- inNames |> length() - rm(inWhich) - # inNames |> print() + inLength <- inputsList |> length() + hasNames <- inNames |> length() + if(hasNames) { + # inNames <- inputsList |> names() + # inNames |> print() + # inputsList |> map(glimpse) + # inWhich <- inNames |> map(function(name0, list0=inputsList){(!(list0[[name0]] |> is.null())) |> which()}) |> unlist() |> unique() + inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() + ### Filter to values that are not NULL + inputsList <- inputsList[inWhich] + inNames <- inputsList |> names() + rm(inWhich) + ### Check which input names are in the user-provided list + inWhich <- inNames %in% inNames0 + inNames <- inNames[inWhich] + inputsList <- inputsList[inNames] + hasAnyInputs <- inNames |> length() + rm(inWhich) + # inNames |> print() + } else if (inLength) { + paste0(msg1) |> paste0("Error! `inputsList` argument requires a list with named elements.") |> message() + msgN |> paste0(msg1) |> paste0("Exiting...") |> message() + return() + } else { + hasAnyInputs <- FALSE + } ### End if(!hasInputs) ### Need scenario for CH4 & NOX or O3: diff --git a/R/run_fredi_sv.R b/R/run_fredi_sv.R index 4b5268ac..39396247 100644 --- a/R/run_fredi_sv.R +++ b/R/run_fredi_sv.R @@ -49,7 +49,7 @@ #' #' @examples #' ### Run SV Module with defaults without specifying sector -#' df_sv <- run_fredi_sv() +#' # df_sv <- run_fredi_sv() #' #' ### Return a character vector with the names of all of the sectors in the FrEDI SV Module: #' get_sv_sectorInfo() @@ -70,13 +70,13 @@ #' data(popDefault) #' #' ### Run SV Module for "Extreme Temperature" with custom population and temperature scenarios -#' df_sv <- run_fredi_sv(sector = "Extreme Temperature", inputsList = list(pop=popDefault, temp=gcamScenarios) +#' df_sv <- run_fredi_sv(sector = "Extreme Temperature", inputsList=list(pop=popDefault, temp=gcamScenarios) #' #' ### Run SV Module for "Coastal Properties" with custom population and SLR scenarios -#' df_sv <- run_fredi_sv(sector = "Coastal Properties", inputsList = list(pop=popDefault, slr=gcamScenarios) +#' df_sv <- run_fredi_sv(sector = "Coastal Properties", inputsList=list(pop=popDefault, slr=gcamScenarios) #' #' ### Run SV Module for "Coastal Properties" with custom population and temperature scenarios -#' df_sv <- run_fredi_sv(sector = "Coastal Properties", inputsList = list(pop=popDefault, temp=gcamScenarios) +#' df_sv <- run_fredi_sv(sector = "Coastal Properties", inputsList=list(pop=popDefault, temp=gcamScenarios) #' #' #' @@ -106,10 +106,10 @@ run_fredi_sv <- function( .testing = FALSE ){ ###### Set up the environment ###### - pkgPath <- NULL - pkgPath <- (pkgPath |> is.null()) |> ifelse(system.file(package="FrEDI"), pkgPath); - rDataType <- "rds" - impactsPath <- pkgPath |> file.path("extdata", "sv", "impactLists") + pkgPath <- NULL + pkgPath <- (pkgPath |> is.null()) |> ifelse(system.file(package="FrEDI"), pkgPath); + rDataType <- "rds" + impactsPath <- pkgPath |> file.path("extdata", "sv", "impactLists") ###### ** Load Data Objects ###### ### Get FrEDI data objects @@ -128,20 +128,20 @@ run_fredi_sv <- function( ### Group types c_svGroupTypes <- svDataList$c_svGroupTypes - minYear <- minYear0 - maxYear <- maxYear0 - yearsBy5 <- minYear |> seq(maxYear, by=5) + minYear <- minYear0 + maxYear <- maxYear0 + yearsBy5 <- minYear |> seq(maxYear, by=5) ### Testing - save <- .testing |> ifelse(FALSE, save) + save <- .testing |> ifelse(FALSE, save) ### Level of messaging (default is to message the user) - silent <- (silent |> is.null()) |> ifelse(T, silent) - msgUser <- !silent - msg0 <- "" - msg1 <- msg0 |> paste0("\t") - msg2 <- msg1 |> paste0("\t") - msg3 <- msg2 |> paste0("\t") + silent <- (silent |> is.null()) |> ifelse(T, silent) + msgUser <- !silent + msg0 <- "" + msg1 <- msg0 |> paste0("\t") + msg2 <- msg1 |> paste0("\t") + msg3 <- msg2 |> paste0("\t") ###### ** State Columns ###### byState <- TRUE @@ -239,23 +239,38 @@ run_fredi_sv <- function( idCols0 <- list(valCols0=valCols0, df0=inputDefs[inNames0]) |> pmap(function(valCols0, df0){ df0 |> names() |> get_matches(y=valCols0, matches=F) }) |> set_names(inNames0) - valCols0 |> print(); idCols0 |> print() + # valCols0 |> print(); idCols0 |> print() ###### ** Valid Inputs & Input Info ###### ### Figure out which inputs are not null, and filter to that list ### inputsList Names inNames <- inputsList |> names() - inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() - ### Filter to values that are not NULL - inputsList <- inputsList[inWhich] - inNames <- inputsList |> names() - rm(inWhich) - ### Check which input names are in the user-provided list - inWhich <- inNames %in% inNames0 - inNames <- inNames[inWhich] - inputsList <- inputsList[inNames] - hasAnyInputs <- inNames |> length() - rm(inWhich) + inLength <- inputsList |> length() + hasNames <- inNames |> length() + if(hasNames) { + # inNames <- inputsList |> names() + # inNames |> print() + # inputsList |> map(glimpse) + # inWhich <- inNames |> map(function(name0, list0=inputsList){(!(list0[[name0]] |> is.null())) |> which()}) |> unlist() |> unique() + inWhich <- inNames |> map(function(name0, list0=inputsList){!(list0[[name0]] |> is.null())}) |> unlist() |> which() + ### Filter to values that are not NULL + inputsList <- inputsList[inWhich] + inNames <- inputsList |> names() + rm(inWhich) + ### Check which input names are in the user-provided list + inWhich <- inNames %in% inNames0 + inNames <- inNames[inWhich] + inputsList <- inputsList[inNames] + hasAnyInputs <- inNames |> length() + rm(inWhich) + # inNames |> print() + } else if (inLength) { + paste0(msg1) |> paste0("Error! `inputsList` argument requires a list with named elements.") |> message() + msgN |> paste0(msg1) |> paste0("Exiting...") |> message() + return() + } else { + hasAnyInputs <- FALSE + } ### End if(!hasInputs) ###### ** Check Inputs ###### diff --git a/R/utils.R b/R/utils.R index 4d3835a6..faefe824 100644 --- a/R/utils.R +++ b/R/utils.R @@ -29,7 +29,7 @@ get_msgPrefix <- function(level=1, newline=FALSE){ ### Message new line msgN0 <- newline |> ifelse("\n", "") ### Message indents - msgX0 <- "\t" |> rep(level) + msgX0 <- "\t" |> rep(level) |> paste(collapse="") ### Message prefix msg0 <- msgN0 |> paste0(msgX0) ### Return @@ -42,6 +42,7 @@ get_returnListStatus <- function(cond0=TRUE){ } ### Function to make it easier to subset a vector +#' @export get_matches <- function( x, ### Vector to subset y, ### Vector to check x against diff --git a/docs/404.html b/docs/404.html index 4b577f4f..c44b91ba 100644 --- a/docs/404.html +++ b/docs/404.html @@ -24,7 +24,7 @@ FrEDI - 4.1.1 + 4.2.0 - - - - - -
-
-
-

Population scenario to use as an input to run_fredi() and run_fredi_sv()

- Source: R/data.R -
popScenario.Rd
-
- -
-

A dataframe containing a population scenario to be passed as an input to run_fredi() and run_fredi_sv().

-
- -
-

Usage

- 
popScenario
-
- -
-

Format

-

A data frame with 14,259 rows and 5 columns:

year
-

Year

- -
region
-

Region of U.S. ("Midwest", "Northeast", "Northern Plains", "Northwest", "Southeast", "Southern Plains", and "Southwest")

- -
state
-

One of 48 contiguous U.S. states or the District of Columbia

- -
postal
-

Postal code abbreviation associated with the state

- -
state_pop
-

State population for associated region and year

- - -
-
-

Source

-

https://epa.gov/cira/FrEDI/

-
-
-

Details

-

This dataframe contains population projections at the state level from the Integrated Climate and Land Use Scenarios version 2 (ICLUSv2) model (Bierwagen et al, 2010; EPA 2017) under the Median variant projection of United Nations (2015).

-

Bierwagen, B., D. M. Theobald, C. R. Pyke, A. Choate, P. Groth, J. V. Thomas, and P. Morefield. 2010. “National housing and impervious surface scenarios for integrated climate impact assessments.” Proc. Natl. Acad. Sci. 107 (49): 20887–20892. https://doi.org/10.1073/pnas.1002096107.

-

EPA. 2017. Multi-Model Framework for Quantitative Sectoral Impacts Analysis: A technical report for the Fourth National Climate Assessment. U.S. Environmental Protection Agency, EPA 430-R-17-001.

-

United Nations. 2015. World population prospects: The 2015 revision. New York: United Nations, Department of Economic and Social Affairs, Population Division.

-
- -
- - -
- - - - - - - diff --git a/docs/reference/run_fredi.html b/docs/reference/run_fredi.html index 09824b88..c5388b5f 100644 --- a/docs/reference/run_fredi.html +++ b/docs/reference/run_fredi.html @@ -12,7 +12,7 @@ FrEDI - 4.1.0 + 4.2.0