Update process_temperature

Author: mengqi-z

Diff for: R/hdcd.R

@@ -143,14 +143,42 @@ hdcd <- function(ncdf = NULL,
       print('.........................................')
       print(paste0('Running hdcd for file: ', ncdf_i))
 
-      ncdf_list <- helios::process_temperature(ncdf = ncdf_i,
+      ncdf_grid <- helios::process_temperature(ncdf = ncdf_i,
                                                model = model,
                                                ncdf_var = ncdf_var,
                                                time_periods = time_periods,
-                                               spatial = spatial)
-      ncdf_pivot <- ncdf_list$ncdf_pivot
-      years <- ncdf_list$ncdf_years
-      index_subset <- ncdf_list$index_subset
+                                               spatial = spatial,
+                                               reference_temp_F = reference_temp_F)
+
+
+      # get the actual datetime from the ncdf
+      ncdf_times <- names(ncdf_grid)[
+        !names(ncdf_grid) %in% c('lat', 'lon', 'region', 'subRegion', 'ID')]
+
+      indices <- as.integer(grepl(paste0(time_periods, collapse = '|'), ncdf_times))
+      index_subset <- c(1:length(ncdf_times)) * indices
+      index_subset <- index_subset[!index_subset %in% 0]
+      years <- unique(substr(ncdf_times, 1, 4))
+
+      if (model == 'wrf') {
+
+        ncdf_pivot <- ncdf_grid %>%
+          tidyr::pivot_longer(cols = dplyr::all_of(ncdf_times), names_to = 'datetime') %>%
+          dplyr::mutate(datetime = as.POSIXct(datetime,
+                                              format = '%Y-%m-%d_%H:%M:%S',
+                                              tz = 'UTC')) %>%
+          dplyr::mutate(year = lubridate::year(datetime))
+
+      } else if (model == 'cmip') {
+
+        ncdf_pivot <- ncdf_grid %>%
+          tidyr::pivot_longer(cols = dplyr::all_of(ncdf_times), names_to = 'datetime') %>%
+          dplyr::mutate(datetime = as.POSIXct(datetime,
+                                              format = '%Y-%m-%d',
+                                              tz = 'UTC')) %>%
+          dplyr::mutate(year = lubridate::year(datetime))
+
+      }
 
 
       #......................
@@ -183,8 +211,7 @@ hdcd <- function(ncdf = NULL,
           dplyr::left_join(population_j_weighted %>%
                              dplyr::select(-value, -subRegion_total_value),
                            by = c('ID', 'region', 'subRegion', 'lat', 'lon', 'year')) %>%
-          dplyr::mutate(value = (((value - 273.15) * 9/5) + 32) - reference_temp_F,
-                        value = dplyr::if_else(is.na(pop_weight), value, value * pop_weight))
+          dplyr::mutate(value = dplyr::if_else(is.na(pop_weight), value, value * pop_weight))
 
         # aggregated to region, but leave the datetime for later segment, monthly, annual aggregation
         hdcd_region_i <- ncdf_hdcd_pop_weighted %>%

Diff for: R/process_temperature.R

@@ -7,6 +7,7 @@
 #' @param model Default = NULL. String for climate model that generates the ncdf file. Options: 'wrf' or 'cmip'.
 #' @param spatial Default = NULL. String for spatial aggregation boundaries. Options: check helios::spatial_options. 'gcam_us49', 'gcam_regions32', 'gcam_regions31_us52', 'gcam_countries', 'gcam_basins'.
 #' @param time_periods Default = NULL. Integer vector for selected time periods to process. If not specified, set to GCAM periods seq(2020, 2100, 5).
+#' @param reference_temp_F Default = 65. Integer for comfort temperature in degree F. 65 degree F is the comfort baseline temperature typically used by NOAA. The comfort temperature can vary by regions.
 #' @importFrom magrittr %>%
 #' @importFrom data.table :=
 #' @export
@@ -15,7 +16,8 @@ process_temperature <- function(ncdf = NULL,
                                 ncdf_var = NULL,
                                 model = NULL,
                                 spatial = NULL,
-                                time_periods = NULL){
+                                time_periods = NULL,
+                                reference_temp_F = 65){
 
   # read ncdf file
   ncdf_grid <- helios::read_ncdf(ncdf = ncdf,
@@ -27,37 +29,13 @@ process_temperature <- function(ncdf = NULL,
   ncdf_grid <- helios::find_mapping_grid(data = ncdf_grid,
                                          spatial = spatial)
 
-  # get the actual datetime from the ncdf
-  ncdf_times <- names(ncdf_grid)[
-    !names(ncdf_grid) %in% c('lat', 'lon', 'region', 'subRegion', 'ID')]
+  # calculate heating and cooling degrees
+  ncdf_grid <- ncdf_grid %>%
+    dplyr::mutate(across(c(-lat, -lon, -region, -subRegion, -ID),
+                         ~ round((((. - 273.15) * 9/5) + 32) - reference_temp_F, 2)))
 
-  indices <- as.integer(grepl(paste0(time_periods, collapse = '|'), ncdf_times))
-  index_subset <- c(1:length(ncdf_times)) * indices
-  index_subset <- index_subset[!index_subset %in% 0]
-  years <- unique(substr(ncdf_times, 1, 4))
 
-  if (model == 'wrf') {
 
-    ncdf_pivot <- ncdf_grid %>%
-      tidyr::pivot_longer(cols = dplyr::all_of(ncdf_times), names_to = 'datetime') %>%
-      dplyr::mutate(datetime = as.POSIXct(datetime,
-                                          format = '%Y-%m-%d_%H:%M:%S',
-                                          tz = 'UTC')) %>%
-      dplyr::mutate(year = lubridate::year(datetime))
-
-  } else if (model == 'cmip') {
-
-    ncdf_pivot <- ncdf_grid %>%
-      tidyr::pivot_longer(cols = dplyr::all_of(ncdf_times), names_to = 'datetime') %>%
-      dplyr::mutate(datetime = as.POSIXct(datetime,
-                                          format = '%Y-%m-%d',
-                                          tz = 'UTC')) %>%
-      dplyr::mutate(year = lubridate::year(datetime))
-
-  }
-
-  return(list(ncdf_pivot = ncdf_pivot,
-              ncdf_years = years,
-              index_subset = index_subset))
+  return(ncdf_grid)
 
 }

Diff for: inst/extras/dev_tests.R

@@ -28,7 +28,7 @@ ncdf_grid <- helios::read_ncdf(ncdf = path_to_climate_ncdf,
 
 pop <- helios::read_population(path_to_population, time_periods = 2020)
 
-ncdf_pivot <- helios::process_temperature(ncdf = path_to_climate_ncdf,
+ncdf_grid <- helios::process_temperature(ncdf = path_to_climate_ncdf,
                                           model = 'wrf',
                                           ncdf_var = 'T2',
                                           time_periods = 2020,