data-raw/mike_wright_temperature_regression/create_estimated_timeseries.r

In CVPIA-OSC/DSMtemperature: Modeled Temperature Data for the CVPIA SIT Model

### use outputs of regression estimating water temperature in a stream using
### equilibrium temperature and river mile to generate time series of
### temperatures for each affected stream

# load needed libraries
library(tidyverse)
library(lubridate)
library(purrr)

# Add year 2000 to data
# Need to create an eq_temp.csv that includes 2000
eq_temp <- read_excel("data-raw/mike_wright_temperature_regression/source/GerberEQTEMP-61to17.xlsx") %>%
  select("date" = `Months...12`, "monthly_mean_temp_f_air" = `EQTEMP...13`) %>% drop_na()

# inputs: regression parameters and reach lengths (/2 for river mile, assuming
# reach begins at confluence) for each river, monthly equilibrium air temps.

# air temperatures to be converted to water temperatures using
# the parameters in regression_parameters.csv, as assigned in
# regression_assignments.csv eq_temp was generated in GerberEQTEMP-61to17.xlsx
# from a 6-hourly time series in F to a monthly (average) time series, still in
# F since regression was calibrated using F

# Replaced with eq_temps containing 20000
#  eq_temp <- read_csv('data-raw/mike_wright_temperature_regression/eq_temp.csv')

# regression assignments will allow us to identify which parameters each river
# should use. these assignments were taken from an email dated 04/26/19, which
# was sent to Mike Urkov among others

# regression parameters were generated by Kirk Nelson;
# Final_21streamResults.xlsx contains the parameters and analysis of
# stream-by-stream comparisons

watershed_parameters <- left_join(read_csv('data-raw/mike_wright_temperature_regression/regression_assignments.csv'),
                                  read_csv('data-raw/mike_wright_temperature_regression/regression_parameters.csv'))

# add river mile information  to watershed_parameters, automatically using
# watershed as the key; this puts river miles (which must be divided by two) in
# the same tbl_df as parameters
# rearing lengths will be used and the miles for the creek will be divided by
# two to obtain the river mile used in the calculations
watershed_parameters_river_miles <- watershed_parameters %>%
  left_join(DSMhabitat::watershed_lengths) %>%
  filter(lifestage == 'rearing', species == 'fr') %>%
  mutate(miles = miles / 2)


# function for creating a juv_temp formatted long df of monthly temperatures
# from study period (Oct79-Dec99) for a given watershed

water_temps <- function(watershed_) {

	# filter watershed_parameters_river_miles to keep only the single row which has this watershed's information
	params <- filter(watershed_parameters_river_miles, watershed == watershed_)

	# for each date in eq_temp, generate a water temperature estimate in C using the monthly_mean_temp_f_air values in F from eq_temp and mm, bm, mb, bb, and miles from params
		#### NOTE that currently, the method takes input equilibrium temperatures in F and outputs water temperature estimates in C!
	water_temp_estimates <- eq_temp %>%
	  mutate(monthly_mean_temp_c = (params$mm * monthly_mean_temp_f_air + params$bm) * params$miles +
	           (params$mb * monthly_mean_temp_f_air + params$bb),
	         watershed = watershed_) %>%
	  select(date, watershed, monthly_mean_temp_c)

	return(water_temp_estimates)

}

# map function across all of the watersheds in watershed_parameters_river_miles and combine in tbl_df
watersheds <- unique(watershed_parameters_river_miles$watershed)

juv_temp_regression <- map_df(watersheds, water_temps)

# save regression temp estimates
write_rds(juv_temp_regression, 'data-raw/mike_wright_temperature_regression/juv_temp_regression.rds')


# ------------------------------------------------------------------------------
# comparison plots with old surrogate method

# antelope creek----
# previously cow creek was used as a surrogate
antelope_new <- juv_temp_regression %>%
  filter(watershed == 'Antelope Creek') %>%
  mutate(method = 'regression')

antelope_old <- DSMtemperature::juv_temp %>%
  filter(watershed == 'Cow Creek') %>%
  mutate(method = 'cow creek surrogate')

bind_rows(antelope_new, antelope_old) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = method)) +
  geom_line()

# bear creek-----
# previously cow creek was used as a surrogate
bear_new <- juv_temp_regression %>%
  filter(watershed == 'Bear Creek') %>%
  mutate(method = 'regression')

bear_old <- DSMtemperature::juv_temp %>%
  filter(watershed == 'Cow Creek') %>%
  mutate(method = 'cow creek surrogate')

bind_rows(bear_new, bear_old) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = method)) +
  geom_line()

# elder creek ----
# previously thomes creek was used as a surrogate
elder_new <- juv_temp_regression %>%
  filter(watershed == 'Elder Creek') %>%
  mutate(method = 'regression')

elder_old <- DSMtemperature::juv_temp %>%
  filter(watershed == 'Thomes Creek') %>%
  mutate(method = 'thomes creek surrogate')

bind_rows(elder_new, elder_old) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = method)) +
  geom_line()

# paynes creek ------
# previously cow creek was used as a surrogate
paynes_new <- juv_temp_regression %>%
  filter(watershed == 'Paynes Creek') %>%
  mutate(method = 'regression')

paynes_old <- DSMtemperature::juv_temp %>%
  filter(watershed == 'Cow Creek') %>%
  mutate(method = 'cow creek surrogate')

bind_rows(paynes_new, paynes_old) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = method)) +
  geom_line()

# Bear River-----
# previously yuba river was used as a surrogate
bear_river_new <- juv_temp_regression %>%
  filter(watershed == 'Bear River') %>%
  mutate(method = 'regression')

bear_river_old <- DSMtemperature::juv_temp %>%
  filter(watershed == 'Yuba River') %>%
  mutate(method = 'yuba river surrogate')

bind_rows(bear_river_new, bear_river_old) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = method)) +
  geom_line()


# Feather River-----
# previously american river was used as a surrogate
feather_river_new <- juv_temp_regression %>%
  filter(watershed == 'Feather River') %>%
  mutate(method = 'regression')

feather_river_old <- DSMtemperature::juv_temp %>%
  filter(watershed == 'American River') %>%
  mutate(method = 'american river surrogate')

bind_rows(feather_river_new, feather_river_old) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = method)) +
  geom_line()

# Calaveras River-----
# previously mokelumne river was used as a surrogate
calaveras_river_new <- juv_temp_regression %>%
  filter(watershed == 'Calaveras River') %>%
  mutate(method = 'regression')

calaveras_river_old <- DSMtemperature::juv_temp %>%
  filter(watershed == 'Mokelumne River') %>%
  mutate(method = 'mokelumne river surrogate')

bind_rows(calaveras_river_new, calaveras_river_old) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = method)) +
  geom_line()

# all
juv_temp_regression %>%
  filter(str_detect(watershed, 'River')) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = watershed)) +
  geom_line()

juv_temp_regression %>%
  filter(str_detect(watershed, 'Creek')) %>%
  ggplot(aes(date, monthly_mean_temp_c, color = watershed)) +
  geom_line()