R/zchunk_LA119.solar-korea.R

Defines functions module_gcam.korea_LA119.Solar

#' module_gcam.korea_LA119.Solar
#'
#' Compute scalars by state to vary capacity factors by state.
#'
#' @param command API command to execute
#' @param ... other optional parameters, depending on command
#' @return Depends on \code{command}: either a vector of required inputs,
#' a vector of output names, or (if \code{command} is "MAKE") all
#' the generated outputs: \code{L119.CapFacScaler_PV_korea}, \code{L119.CapFacScaler_CSP_korea}. The corresponding file in the
#' original data system was \code{LA119.Solar.R} (gcam-korea level1).
#' @details This chunk computes scalars by state to vary capacity factors for central station PV and CSP technologies by state.
#' @importFrom assertthat assert_that
#' @importFrom dplyr filter mutate select
#' @importFrom tidyr gather spread
#' @author M. Roh
module_gcam.korea_LA119.Solar <- function(command, ...) {
  if(command == driver.DECLARE_INPUTS) {
    return(c(FILE = "gcam-korea/states_subregions",
             FILE = "gcam-korea/korea_re_capacity_factors"))
  } else if(command == driver.DECLARE_OUTPUTS) {
    return(c("L119.CapFacScaler_PV_korea",
             "L119.CapFacScaler_CSP_korea"))
  } else if(command == driver.MAKE) {

    fuel <- value <- State <- . <- value.x <- value.y <- sector <- scaler <-
        state <- state_name <- NULL     # silence package check.

    all_data <- list(...)[[1]]

    # Load required inputs
    states_subregions <- get_data(all_data, "gcam-korea/states_subregions")
    korea_re_capacity_factors <- get_data(all_data, "gcam-korea/korea_re_capacity_factors")

    # ===================================================
    # Create scalers to scale capacity factors read in the assumptions file in the energy folder.
    # These scalers will then be used to create capacity factors by state.
    # The idea is to vary capacity factors for solar technologies by state depending on the varying solar irradiance by state.

    # removing read-in value for the average
    korea_re_capacity_factors %>%
      gather(fuel, value, -State) %>%
      filter(State != "Average") ->
      korea_re_capacity_factorss_longform

    # Calculate average capacity factor by fuel (not including the 0 capacity factors)
    korea_re_capacity_factorss_longform %>%
      group_by(fuel) %>%
      summarise_at(vars(value), funs(mean(.[. != 0]))) -> # Average does not include 0 capacity factors
      Capacityfactor_average

    #minyoung: chnage NaN to 0
    Capacityfactor_average$value[is.nan(Capacityfactor_average$value)]<-0

    # Creating scalers by state by dividing capacity factor by the average
    # Using state name abbreviations instead of full names
    korea_re_capacity_factorss_longform %>%
      left_join_error_no_match(Capacityfactor_average, by = "fuel") %>%
      mutate(scaler = value.x / value.y, sector = "electricity generation") %>%
      select(State, sector, fuel, scaler) %>%
      left_join_error_no_match(
      select(states_subregions, state, state_name), by = c("State" = "state_name")) %>%
      select(state, sector, fuel, scaler, -State) -> # Removing full state name
      Capacityfactors_scaled

    #minyoung: chnage NaN to 0
    Capacityfactors_scaled$scaler[is.nan(Capacityfactors_scaled$scaler)]<-0

    # Creating solar PV table by using Urban_Utility_scale_PV fuel values
    Capacityfactors_scaled %>%
      filter(fuel == "Urban_Utility_scale_PV") %>%
      mutate(fuel = "solar PV") ->
      L119.CapFacScaler_PV_korea

    # Creating solar CSP table by using CSP fuel values
    Capacityfactors_scaled %>%
      filter(fuel == "CSP") %>%
      mutate(fuel = "solar CSP") %>%
      # Null CSP capacity factor implies that CSP is not suitable in the state.
      # Set capacity factor to small number (0.001) to prevent divide by 0 error in GCAM.
      mutate(scaler = if_else(scaler > 0, scaler, 0.001)) ->
      L119.CapFacScaler_CSP_korea

    # ===================================================
    L119.CapFacScaler_PV_korea %>%
      add_title("Scalar to vary PV capacity factors by state") %>%
      add_units("Unitless") %>%
      add_comments("The scalars are generated by dividing data on capacity factors by state by national average capacity factor from rNREL") %>%
      add_legacy_name("L119.CapFacScaler_PV_korea") %>%
      add_precursors("gcam-korea/states_subregions", "gcam-korea/korea_re_capacity_factors") ->
      L119.CapFacScaler_PV_korea

    L119.CapFacScaler_CSP_korea %>%
      add_title("Scalar to vary CSP capacity factors by state") %>%
      add_units("Unitless") %>%
      add_comments("The scalars are generated by dividing data on capacity factors by state by national average capacity factor from NREL") %>%
      add_legacy_name("L119.CapFacScaler_CSP_korea") %>%
      add_precursors("gcam-korea/states_subregions", "gcam-korea/korea_re_capacity_factors") ->
      L119.CapFacScaler_CSP_korea

    return_data(L119.CapFacScaler_PV_korea, L119.CapFacScaler_CSP_korea)
  } else {
    stop("Unknown command")
  }
}
rohmin9122/gcam-korea-release documentation built on Nov. 26, 2020, 8:11 a.m.