Skip to content

Commit

Permalink
Merge pull request #192 from USEPA/fredi_methane_dev_kmn
Browse files Browse the repository at this point in the history 
Improvements to input methods and initial documentation for methane functions
  • Loading branch information
@knoiva-indecon
knoiva-indecon authored Sep 10, 2024
2 parents 25ffa2c + fae7f14 commit 4708091
Show file tree
Hide file tree
Showing 14 changed files with 1,274 additions and 988 deletions.
131 changes: 93 additions & 38 deletions .github/workflows/build_fredi.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,21 +19,22 @@ on:
options:
- no
- yes
update_results:
type: choice
description: Update default results?
required: true
options:
- no
- yes
# update_results:
# type: choice
# description: Update default results?
# required: true
# options:
# - no
# - yes
update_scenarios:
type: multi-choice
description: Update scenarios?
required: true
options:
- Temps & SLR
- Population
- GDP
- Population
- Temps & SLR
- O3, CH4, & NOx

jobs:
compile_data:
Expand Down Expand Up @@ -64,10 +65,13 @@ jobs:
run: |
Rscript -e '
###### Conditionals ######
### Which scenarios to update
do_temp <- "Temps & SLR" %in% "${{ inputs.update_scenarios}}"
### 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()
###### File Paths ######
Expand All @@ -80,42 +84,93 @@ jobs:
###### 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 <- "scenarios_gcam" |> get_frediDataObj("frediData")
gcamScenarios <- gcamScenarios |> mutate(temp_C_conus = temp_C_global |> convertTemps(from="global"))
gcamScenarios <- gcamScenarios |> (function(df0){
scenarios0 <- gcamScenarios |> pull(scenario) |> unique()
dfSlr0 <- scenarios0 |> map(function(x0, df0=df0){
df0 <- df0 |> filter(scenario == x0)
df0 <- temps2slr(temps = df0 |> pull(temp_C_global), years = df0 |> pull(year))
return(df0)
}) |> bind_rows(.id = "scenario")
df0 <- df0 |> left_join(dfSlr0, by=c("year"))
return(df0)
})()
arrange0 <- c("scenario", "year", "temp_C_conus", "temp_C_global", "slr_cm")
gcamScenarios <- gcamScenarios |> arrange_at(c(arrnage0))
fTemps <- "Hector_GCAM_v5.3_scenarios"
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)
pPath0 |> devtools::load_all()
defaultResults <- run_fredi()
save(defaultResults, file=oPath0)
### 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
roxygen2::roxygenise(pPath0)
devtools::document(pkg = pPath0)
# devtools::build_manual(pkg = pPath0)
# devtools::build_vignettes(pkg = pPath0)
if(do_docs) {
roxygen2::roxygenise(pPath0)
devtools::document(pkg = pPath0)
# devtools::build_manual(pkg = pPath0)
# devtools::build_vignettes(pkg = pPath0)
} ### End if(do_docs)
###### Build Package ######
###### - Build Package but do not include vignettes
Expand All @@ -132,10 +187,10 @@ jobs:
pPath0 <- rPath0 |> file.path("FrEDI")
oPath0 <- pPath0 |> file.path("data", "defaultResults.rda")
###### Create Default Results ######
pPath0 |> devtools::load_all()
defaultResults <- run_fredi()
save(defaultResults, file=oPath0)
# ###### Create Default Results ######
# pPath0 |> devtools::load_all()
# defaultResults <- run_fredi()
# save(defaultResults, file=oPath0)
###### Update Documentation ######
###### - Build Manual
Expand Down
21 changes: 13 additions & 8 deletions FrEDI/R/aggregate_impacts.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -264,7 +264,7 @@ aggregate_impacts <- function(

###### Format Columns ######
### Make sure all summary values are numeric
mutate0 <- c("sectorprimary", "includeaggregate")
mutate0 <- c("sectorprimary", "includeaggregate") |> get_matches(y=data |> names())
chrCols0 <- groupByCols |> get_matches(y=mutate0, matches=F)
numCols0 <- summaryCols |> c(mutate0)
numCols0 <- numCols0 |> c("gdp_usd", "national_pop", "gdp_percap")
Expand Down Expand Up @@ -429,7 +429,10 @@ aggregate_impacts <- function(

###### ** Model Averages ######
### Average values across models
if(aveModels){
modTypes0 <- df_agg[["model_type"]]
has_modTypes <- modTypes0 |> length()
has_gcm <- has_modTypes |> ifelse("gcm" %in% modTypes0, FALSE)
if(aveModels & has_gcm){
modelAveMsg <- "Calculating model averages..."
if(msgUser){msg0 (1) |> paste0(modelAveMsg) |> message()}
### Ungroup first
Expand Down Expand Up @@ -559,27 +562,28 @@ aggregate_impacts <- function(
### Join base scenario with driver scenario
# baseScenario |> glimpse(); driverScenario |> glimpse()
join0 <- c(yearCol0)
arrange0 <- c("model_type") |> c(join0)
arrange0 <- c("model_type") |> get_matches(y=driverScenario |> names()) |> c(join0) |> unique()
df_base <- baseScenario |> left_join(driverScenario, by=c(join0), relationship="many-to-many")
df_base <- df_base |> arrange_at(c(arrange0))
rm(join0, arrange0, driverScenario, baseScenario)

### Join base scenario with population scenario
# df_base |> glimpse(); regionalPop |> glimpse()
join0 <- c(yearCol0)
arrange0 <- c("model_type") |> c("region") |> c(stateCols0) |> c(yearCol0)
arrange0 <- c("model_type") |> get_matches(y=df_base |> names()) |> c("region") |> c(stateCols0) |> c(yearCol0)
df_base <- df_base |> left_join(regionalPop, by=c(join0))
df_base <- df_base |> arrange_at(c(arrange0))
rm(join0, arrange0, regionalPop)

### Join base scenario with aggregated info
### Order the data frame and ungroup
namesB0 <- df_base |> names() |> get_matches(y=c(yearCol0), matches=F)
join0 <- c("model_type") |> c("region") |> c(stateCols0) |> c(yearCol0)
join0 <- c("model_type") |> get_matches(y=df_base |> names()) |> c("region") |> c(stateCols0) |> c(yearCol0)
arrange0 <- c("sector", "variant", "impactType", "impactYear") |>
c("region", stateCols0) |>
c("model_type", "model") |>
c(yearCol0)
c(yearCol0) |>
get_matches(y=df_agg |> names())
df_agg <- df_agg |> ungroup()
df_agg <- df_agg |> left_join(df_base, by=c(join0))
df_agg <- df_agg |> relocate(all_of(namesB0), .after=all_of(arrange0))
Expand All @@ -603,8 +607,9 @@ aggregate_impacts <- function(
df_agg <- df_agg |> select(any_of(standardCols))

###### Return ######
### Return object
# if(msgUser) message("\n", "Finished...")
### Message, clear unused memory, return
# paste0("\n", "Finished", ".") |> message()
gc()
return(df_agg)
}

Loading

0 comments on commit 4708091

Please sign in to comment.