Merge pull request #111 from earthlab/temp_conversion

Temp conversion

.gitignore

@@ -14,5 +14,5 @@ doc
 Meta
 acadia_national_park/
 shapefiles/
-
+joss/
 docs/

R/compare_periods.R

@@ -84,27 +84,29 @@ compare_periods <- function(
   # Combine into one data frame
   cdf <- rbind(df1, df2)
 
+  # Add periods in case that's helpful
+  if ( length(unique(reference_period)) == 1 ) {
+    ref_print = as.character(reference_period[1])
+  } else {
+    ref_print = paste(reference_period[1], reference_period[2], sep = " - ")
+  }
+  if ( length(unique(target_period)) == 1 ) {
+    target_print = as.character(target_period[1])
+  } else {
+    target_print = paste(target_period[1], target_period[2], sep = " - ")
+  }
+  cdf["reference_period"] <- ref_print
+  cdf["target_period"] <- target_print
+
   # Rearrange columns
-  cdf <- cdf[c("model", "rcp", "variable", "units", "value_reference", "value_target",
-               "difference" )]
+  cdf <- cdf[c("model", "rcp", "parameter", "units", "reference_period", "target_period",
+               "reference_value", "target_value", "difference" )]
 
   return(cdf)
 }
 
-
-# convert file reference object temperature from kelvin to celsius if necessary
-convert_temperature <- function(file_df, column) {
-  temperature_rows <- grep("air_temperature", file_df$parameter_long)
-  temperature_kelvin <- unlist(file_df[[column]][temperature_rows])
-  temperature_c <- temperature_kelvin - 273.15
-  file_df[[column]][temperature_rows] <- temperature_c
-  file_df$units[temperature_rows] <- "C"
-  return(file_df)
-}
-
-
-# Get the difference in values for one variable
-df_difference <- function(df, variable, agg_fun, target_period, reference_period, month_map) {
+# Get the difference in values for one parameter
+df_difference <- function(df, parameter, agg_fun, target_period, reference_period, month_map) {
 
   # Match the aggregation function string to a function 
   tryCatch({
@@ -116,35 +118,35 @@ df_difference <- function(df, variable, agg_fun, target_period, reference_period
 
   # Reference Period
   df_ref <- df %>%
-    dplyr::select(.data$rcp, .data$model, .data$year, .data$month, variable) %>%
-    dplyr::filter(.data$month %in% month_map[[variable]]) %>%
+    dplyr::select(.data$rcp, .data$model, .data$year, .data$month, parameter) %>%
+    dplyr::filter(.data$month %in% month_map[[parameter]]) %>%
     dplyr::filter(.data$year >= reference_period[1],
                   .data$year <= reference_period[2]) %>%
     dplyr::group_by(.data$rcp, .data$model) %>%
-    dplyr::summarise("value" = fun(!!as.name(variable)))
+    dplyr::summarise("value" = fun(!!as.name(parameter)))
 
   # Target Period
   df_tar <- df %>%
-    dplyr::select(.data$rcp, .data$model, .data$year, .data$month, variable) %>%
-    dplyr::filter(.data$month %in% month_map[[variable]]) %>%
+    dplyr::select(.data$rcp, .data$model, .data$year, .data$month, parameter) %>%
+    dplyr::filter(.data$month %in% month_map[[parameter]]) %>%
     dplyr::filter(.data$year >= target_period[1],
                   .data$year <= target_period[2]) %>%
     dplyr::group_by(.data$rcp, .data$model) %>%
-    dplyr::summarise("value" = fun(!!as.name(variable)))
-  
+    dplyr::summarise("value" = fun(!!as.name(parameter)))
+
   # Join
-  df = dplyr::left_join(df_ref, df_tar, by = c("rcp", "model"),
-                        suffix = c("_reference", "_target"))
-  
+  df <- dplyr::left_join(df_ref, df_tar, by = c("rcp", "model"))
+  names(df) <- c("rcp", "model", "reference_value", "target_value")                     
+
   # Find the difference in values between target and reference periods
-  df = df %>% dplyr::mutate(difference = .data$value_target - .data$value_reference)
+  df = df %>% dplyr::mutate(difference = .data$target_value - .data$reference_value)
 
   # Add variable name
-  df$variable <- variable
+  df$parameter <- parameter
 
   # Add in units
   arg_ref <- Argument_Reference()
-  internal_var <- as.character(arg_ref$variables[ variable])
+  internal_var <- as.character(arg_ref$variables[parameter])
   units = as.character(arg_ref$units[internal_var])
   df$units <- units
 

R/cst_df.R

@@ -1,4 +1,6 @@
-#' Generate a climate data frame
+#' Generate a climate data frame of spatial averages from the file
+#' reference object generated by cstdata. Averages represent all
+#' grid cells within or touching the area of interest provided to cstdata.
 #'
 #' @param file_reference A file reference data frame generated by `cstdata()`
 #' @param ncores Number of cores to use (int)
@@ -19,15 +21,18 @@
 #' 
 #' @export
 cst_df <- function(file_reference, ncores = 1) {
+
+  # Create long form data frame
   message("Computing spatial averages...")
   cl <- parallel::makeCluster(ncores)
   on.exit(parallel::stopCluster(cl))
-  df <- pbapply::pbapply(file_reference, 
-                         MARGIN = 1, 
-                         FUN = r_to_df, 
+  df <- pbapply::pbapply(file_reference,
+                         MARGIN = 1,
+                         FUN = r_to_df,
                          cl = cl) %>%
     dplyr::bind_rows()
-
+
+  # Conver to wide form
   message("Generating climate data.frame...")
   wide_df <- split(df, df$date) %>%
     pbapply::pblapply(FUN = tidyr::pivot_wider, 
@@ -57,3 +62,4 @@ r_to_df <- function(df_row) {
     area_name = df_row["area_name"]
   )
 }
+

tests/testthat/test-compare_periods.R

@@ -27,16 +27,6 @@ test_that("Months can be formatted from integers", {
   expect_identical(month_string, c("Jan", "Feb", "Mar"))
 })
 
-test_that("Temperature conversion succeeds", {
-  test_df <- data.frame(parameter_long = "air_temperature", 
-                        units = "K", 
-                        value = 273.15, 
-                        stringsAsFactors = FALSE)
-  out_df <- convert_temperature(test_df, "value")
-  expect_equal(out_df$value, 0)
-  expect_equal(out_df$units, "C")
-})
-
 test_that("Invalid filter params raise errors", {
   expect_error(compare_periods(df, var1 = "foo", var2 = "bar"), 
                regexp = "The requested variables are not present")
@@ -104,4 +94,3 @@ test_that("Providing invalid scenario raises errors.", {
                                   scenarios = "rcp9000"),
     regexp = "The requested scenarios are not present")
 })
-