Commit dac1cd47 authored by luroth's avatar luroth
Browse files

van Eeuwjick et al processing added

parent eb0eb17e
library(scam) library(scam)
`vcov.scam` <- function (object, freq = FALSE, dispersion = NULL,
parametrized = TRUE, ...) {
if (freq) {
vc <- if (parametrized) {
object$Ve.t
} else {
object$Ve
}
} else {
vc <- if (parametrized) {
object$Vp.t
} else {
object$Vp
}
}
if (!is.null(dispersion)) {
vc <- dispersion * vc/object$sig2
}
name <- names(object$edf)
dimnames(vc) <- list(name, name)
vc
}
`coef.scam` <- function(object, parametrized = TRUE, ...) {
coefs <- if (parametrized) {
object$coefficients.t
} else {
object$coefficients
}
coefs
}
fit_scam_spline <- function(x, y, k = NA, bs = "mpi", label = NULL, optimizer = "bfgs") { fit_scam_spline <- function(x, y, k = NA, bs = "mpi", label = NULL, optimizer = "bfgs") {
if (!is.null(label)) { print(label) } if (!is.null(label)) { print(label) }
if (is.na(k)) k <- round(length(x) * 3 / 4) if (is.na(k)) k <- round(length(x) * 3 / 4)
...@@ -16,6 +48,23 @@ fit_scam_spline <- function(x, y, k = NA, bs = "mpi", label = NULL, optimizer = ...@@ -16,6 +48,23 @@ fit_scam_spline <- function(x, y, k = NA, bs = "mpi", label = NULL, optimizer =
return(spline) return(spline)
} }
fit_scam_spline_weights <- function(x, y, w, k = NA, bs = "mpi", label = NULL, optimizer = "bfgs") {
w <- 1 / (w^2)
if (!is.null(label)) { print(label) }
if (is.na(k)) k <- round(length(x) * 3 / 4)
if (k > 20) k <- 20
spline <- NULL
try(
system.time(spline <- scam(y ~ s(as.numeric(x), k = k, bs = bs), optimizer = optimizer, weights=w))
)
if (is.null(spline)) {
print("decreasing k")
spline <- scam(y ~ s(as.numeric(x), k = k - 1, bs = bs), weights=w)
}
return(spline)
}
predict_scam_spline <- function(spline, x_, deriv = NULL, se = FALSE) predict_scam_spline <- function(spline, x_, deriv = NULL, se = FALSE)
{ {
...@@ -37,9 +86,40 @@ predict_scam_spline <- function(spline, x_, deriv = NULL, se = FALSE) ...@@ -37,9 +86,40 @@ predict_scam_spline <- function(spline, x_, deriv = NULL, se = FALSE)
return(predicts) return(predicts)
} }
predict_scam_spline_posteriors <- function(spline, x_)
{
# Design matrix
lp <- predict.scam(spline, newdata = x_, type = "lpmatrix")
# Estimated coefficients
coef <- coef.scam(spline)
# install.packages("gratia")
vc <- vcov.scam(spline)
if (!all( eigen(vc)$values >0 )) {
predicts <- predict.scam(spline, newdata = x_, se.fit = FALSE)
return(list(predicts))
}
# Sample from the distrubitions of the coefficients
set.seed(35)
sim <- MASS::mvrnorm(1000, mu = c(coef), Sigma = unname(vc))
# For each realisation, obtain the "fitted" curve
predicts_ <- lp %*% t(sim)
predicts <- lapply(seq_len(ncol(predicts_)), function(i) predicts_[,i])
predicts_r <- sapply (predicts, function (x) {length (x) <- nrow(predicts_); return (x)})
predicts_rr <- lapply(seq_len(nrow(predicts_r)), function(i) predicts_r[i,])
return(predicts_rr)
}
# Finds start/stop of growth phase, final value and key percentiles # Finds start/stop of growth phase, final value and key percentiles
find_start_stop_growth_phase <- function(df, text = NA, threshold_start = 1 / 4, threshold_stop = 1 / 4, delta_days = 40, final_height_agg = 24) { find_start_stop_growth_phase <- function(df, text = NA, threshold_start = 1 / 4, threshold_stop = 1 / 4, delta_days = 40, final_height_agg = 24) {
if (!is.na(text)) print(text) if (!is.na(text)) print(text)
# Extract maximum growth phase # Extract maximum growth phase
max_growth <- max(df$predict_deriv) max_growth <- max(df$predict_deriv)
if (max_growth == 0) { if (max_growth == 0) {
...@@ -133,3 +213,26 @@ find_start_stop_growth_phase <- function(df, text = NA, threshold_start = 1 / 4, ...@@ -133,3 +213,26 @@ find_start_stop_growth_phase <- function(df, text = NA, threshold_start = 1 / 4,
predict_p95 = p95_final_value, predict_p95 = p95_final_value,
predict_p95_se = p95_final_value_se)) predict_p95_se = p95_final_value_se))
} }
find_start_stop_growth_phase_posterior <- function(df, text = NA, threshold_start = 1 / 4, threshold_stop = 1 / 4, delta_days = 40, final_height_agg = 10) {
f <- function(pred) {return(c(0, diff(pred)))}
predict <- find_start_stop_growth_phase(df, text, threshold_start, threshold_stop, delta_days, final_height_agg)
df_posterior_1 <- sapply (df$predict_posteriors, function (x) {length (x) <- length(df$predict_posteriors[[1]]); return (x)})
df_posterior_1 <- lapply(seq_len(nrow(df_posterior_1)), function(i) df_posterior_1[i,])
df_posterior_2 <- lapply(df_posterior_1, f)
df_posterior <- mapply(function(X, Y) {tibble(predict = X, predict_deriv=Y, timestamp = df$timestamp, predict_se = df$predict_se)}, X=df_posterior_1, Y=df_posterior_2, SIMPLIFY = F)
predict_posterior <- lapply(df_posterior, find_start_stop_growth_phase, NA, threshold_start, threshold_stop, delta_days, final_height_agg)
df_predict_posterior <- bind_rows(predict_posterior)
df_predict_posterior_se <- df_predict_posterior %>% dplyr::select(-ends_with("se")) %>%
summarise_each(funs(mean,sd,sepost=sd(.)/sqrt(n()))) %>%
dplyr::select(ends_with("sepost"))
predict <- bind_cols(predict, df_predict_posterior_se)
return(predict)
}
\ No newline at end of file
...@@ -27,8 +27,8 @@ source("R/Model/Dose_response.R") ...@@ -27,8 +27,8 @@ source("R/Model/Dose_response.R")
source("R/Model/FitSpATS.R") source("R/Model/FitSpATS.R")
source("R/Model/Graphs.R") source("R/Model/Graphs.R")
start_run <- 11 start_run <- 1
max_runs <- 500 max_runs <- 1
number_of_cpus <- 35 number_of_cpus <- 35
sigma_error <- 10 sigma_error <- 10
......
# Working directory with temperature data # Working directory with temperature data
path_home <- 'C:/Users/luroth/PycharmProjects/htfp_wheat_canopy_height_processing' path_home <- 'E:/Scripts/htfp_data_processing'
path_simulation <- 'E:/Simulation/Runs' path_simulation <- 'E:/Simulation/Runs'
setwd(path_home) setwd(path_home)
...@@ -27,9 +27,9 @@ source("R/Model/Dose_response.R") ...@@ -27,9 +27,9 @@ source("R/Model/Dose_response.R")
source("R/Model/FitSpATS.R") source("R/Model/FitSpATS.R")
source("R/Model/Graphs.R") source("R/Model/Graphs.R")
start_run <- 11 start_run <- 2
max_runs <- 500 max_runs <- 500
number_of_cpus <- 35 number_of_cpus <- 30
sigma_error <- 10 sigma_error <- 10
...@@ -88,8 +88,8 @@ measurement_dates_freq_14d <- c( ...@@ -88,8 +88,8 @@ measurement_dates_freq_14d <- c(
measurement_dates_sets <- list( measurement_dates_sets <- list(
#"1 d" = measurement_dates_freq_1d,
"3 d" = measurement_dates_freq_3d "3 d" = measurement_dates_freq_3d
#"1 d" = measurement_dates_freq_1d,
#"5 d" = measurement_dates_freq_5d, #"5 d" = measurement_dates_freq_5d,
#"7 d" = measurement_dates_freq_7d, #"7 d" = measurement_dates_freq_7d,
#"14 d" = measurement_dates_freq_14d #"14 d" = measurement_dates_freq_14d
...@@ -103,14 +103,14 @@ df_designs <- df_designs %>% mutate(plot.discrete_x = plot.row * if_else(plot.re ...@@ -103,14 +103,14 @@ df_designs <- df_designs %>% mutate(plot.discrete_x = plot.row * if_else(plot.re
df_genotypes <- read_csv('Simulation/genotypes.csv') df_genotypes <- read_csv('Simulation/genotypes.csv')
df_temp <- read_csv('Simulation/covariate_temp.csv') df_temp <- read_csv('Simulation/covariate_temp.csv')
#run <- 1 run <- 1
#for(run in start_run:max_runs) { # for(run in start_run:max_runs) {
cl <- parallel::makeCluster(number_of_cpus) cl <- parallel::makeCluster(number_of_cpus)
doParallel::registerDoParallel(cl) doParallel::registerDoParallel(cl)
foreach(run = start_run:max_runs, .verbose = TRUE, foreach(run = start_run:max_runs, .verbose = TRUE,
.packages = c("readr", "tidyr", "purrr", "ggplot2", "lubridate", "gridExtra", "plyr", "stringr", "SpATS", "dplyr", "scam") .packages = c("readr", "tidyr", "purrr", "ggplot2", "lubridate", "gridExtra", "plyr", "stringr", "SpATS", "dplyr", "scam", "MASS")
) %dopar% { ) %dopar% {
...@@ -141,7 +141,21 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -141,7 +141,21 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
### Merge design and plot information ### Merge design and plot information
df_values_for_fit_orig <- inner_join(inner_join(df_trait_values, df_designs, by="plot.UID"), df_genotypes, by="genotype.id") df_values_for_fit_orig_ <- inner_join(inner_join(df_trait_values, df_designs, by="plot.UID"), df_genotypes, by="genotype.id")
# Initial correction to test van Eeujwick 2018:
df_BLUEs_for_fit_orig_ <- df_values_for_fit_orig_ %>%
mutate(se=1, year_site.UID_ = year_site.UID) %>%
group_by(year_site.UID_, timestamp) %>%
nest() %>%
mutate(BLUEs = map(data, fit_SpATS, paste(year_site.UID_, timestamp), use_weights =FALSE, use_checks=TRUE))
df_BLUEs_for_fit_orig_ <- df_BLUEs_for_fit_orig_ %>% unnest(BLUEs)
df_BLUEs_for_fit_orig_ <- df_BLUEs_for_fit_orig_ %>%
mutate(year_site.UID = paste0(year_site.UID_, "_corrected"),
value = BLUE, value_se = BLUE_SE, plot.UID = paste0("BLUE_", genotype.id, year_site.UID))
df_values_for_fit_orig_$value_se <- 1
df_values_for_fit_orig <- bind_rows(df_values_for_fit_orig_, df_BLUEs_for_fit_orig_)
i <- length(measurement_dates_sets) i <- length(measurement_dates_sets)
i <- 1 i <- 1
...@@ -184,9 +198,9 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -184,9 +198,9 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
group_by(plot.UID, year_site.UID) %>% group_by(plot.UID, year_site.UID) %>%
nest() %>% nest() %>%
mutate(spline_model = map(data, mutate(spline_model = map(data,
~fit_scam_spline(.$timestamp, .$value))) ~fit_scam_spline_weights(.$timestamp, .$value, .$value_se)))
df_spline_model <- df_spline_model %>% select(-data) df_spline_model <- df_spline_model %>% dplyr::select(-data)
# Predict value with spline model # Predict value with spline model
time_interval <- 60*60*12 time_interval <- 60*60*12
...@@ -208,7 +222,9 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -208,7 +222,9 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
timestamp = .$prediction_timepoint[[1]])) timestamp = .$prediction_timepoint[[1]]))
if (run == 1 & set == "set3d") { if (run == 1 & set == "set3d") {
df_spline_predicts_export <- df_spline_predicts %>% unnest(spline_predicts) df_spline_predicts_export <- df_spline_predicts %>%
filter(!startsWith(plot.UID, "BLUE_")) %>%
unnest(spline_predicts)
write_csv(df_spline_predicts_export, paste0(path_simulation, "/", run, "/", set, "_spline_predict.csv")) write_csv(df_spline_predicts_export, paste0(path_simulation, "/", run, "/", set, "_spline_predict.csv"))
} }
...@@ -223,7 +239,7 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -223,7 +239,7 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
measurements <- df_values_for_fit %>% filter(plot.UID %in% plot_ids) measurements <- df_values_for_fit %>% filter(plot.UID %in% plot_ids)
predicts <- df_growth_phase_predicts %>% filter(plot.UID %in% plot_ids) %>% unnest(spline_predicts) predicts <- df_growth_phase_predicts %>% filter(plot.UID %in% plot_ids) %>% unnest(spline_predicts)
predicts <- inner_join(predicts, df_designs %>% select(plot.UID, genotype.id), by="plot.UID") predicts <- inner_join(predicts, df_designs %>% dplyr::select(plot.UID, genotype.id), by="plot.UID")
predicts <- inner_join(predicts, df_genotypes, by="genotype.id") predicts <- inner_join(predicts, df_genotypes, by="genotype.id")
# Add predicted parameters to plots to perform two-stage processing # Add predicted parameters to plots to perform two-stage processing
...@@ -233,16 +249,16 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -233,16 +249,16 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
predict_final_height_se = predict_final_value_se, predict_final_height_se = predict_final_value_se,
predict_start_growth = yday(predict_start_growth), predict_start_growth = yday(predict_start_growth),
predict_stop_growth = yday(predict_stop_growth)) %>% predict_stop_growth = yday(predict_stop_growth)) %>%
select(plot.UID, dplyr::select(plot.UID,
predict_final_height, predict_final_height_se, predict_final_height, predict_final_height_se,
predict_start_growth, predict_start_growth_se, predict_start_growth, predict_start_growth_se,
predict_stop_growth, predict_stop_growth_se) predict_stop_growth, predict_stop_growth_se)
df_growth_phase_predicts_values <- df_growth_phase_predicts_ %>% df_growth_phase_predicts_values <- df_growth_phase_predicts_ %>%
select(plot.UID, predict_start_growth, predict_stop_growth, predict_final_height) %>% dplyr::select(plot.UID, predict_start_growth, predict_stop_growth, predict_final_height) %>%
pivot_longer( pivot_longer(
cols= c(predict_final_height, predict_start_growth, predict_stop_growth), names_to = "parameter", values_to = "predict") cols= c(predict_final_height, predict_start_growth, predict_stop_growth), names_to = "parameter", values_to = "predict")
df_growth_phase_predicts_se <- df_growth_phase_predicts_ %>% df_growth_phase_predicts_se <- df_growth_phase_predicts_ %>%
select(plot.UID, predict_final_height_se, dplyr::select(plot.UID, predict_final_height_se,
predict_start_growth_se, predict_stop_growth_se) %>% predict_start_growth_se, predict_stop_growth_se) %>%
pivot_longer( pivot_longer(
cols= c( cols= c(
...@@ -251,27 +267,34 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -251,27 +267,34 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
df_growth_phase_predicts_ <- inner_join(df_growth_phase_predicts_values, df_growth_phase_predicts_se, by=c("plot.UID", "parameter")) df_growth_phase_predicts_ <- inner_join(df_growth_phase_predicts_values, df_growth_phase_predicts_se, by=c("plot.UID", "parameter"))
df_growth_phase_predicts_BLUE <- df_growth_phase_predicts_ %>%
filter(endsWith(plot.UID, "_corrected"))
df_growth_phase_predicts_ <- df_growth_phase_predicts_ %>%
filter(!endsWith(plot.UID, "_corrected"))
# Comparison with true values # Comparison with true values
df_genotype_predicts <- df_growth_phase_predicts_ %>% ungroup() %>% df_genotype_predicts <- df_growth_phase_predicts_ %>% ungroup() %>%
select(plot.UID, parameter, predict, se) %>% dplyr::select(plot.UID, parameter, predict, se) %>%
mutate(parameter = str_remove(parameter, "predict_")) %>% mutate(parameter = str_remove(parameter, "predict_")) %>%
inner_join(df_genotypes_yearsite_true, by=c("plot.UID", "parameter")) inner_join(df_genotypes_yearsite_true, by=c("plot.UID", "parameter"))
## Percentile predictions ## Percentile predictions
# Add predicted parameters to plots to perform two-stage processing # Add predicted parameters to plots to perform two-stage processing
df_growth_phase_predicts_ <- df_growth_phase_predicts %>% df_growth_phase_predicts_ <- df_growth_phase_predicts %>%
mutate( mutate(
predict_p15 = yday(predict_p15), predict_p15 = yday(predict_p15),
predict_p95 = yday(predict_p95)) %>% predict_p95 = yday(predict_p95)) %>%
select(plot.UID, dplyr::select(plot.UID,
predict_p15, predict_p15_se, predict_p15, predict_p15_se,
predict_p95, predict_p95_se) predict_p95, predict_p95_se)
df_growth_phase_predicts_values <- df_growth_phase_predicts_ %>% df_growth_phase_predicts_values <- df_growth_phase_predicts_ %>%
select(plot.UID, predict_p15, predict_p95) %>% dplyr::select(plot.UID, predict_p15, predict_p95) %>%
pivot_longer( pivot_longer(
cols= c(predict_p15, predict_p95), names_to = "parameter", values_to = "predict") cols= c(predict_p15, predict_p95), names_to = "parameter", values_to = "predict")
df_growth_phase_predicts_se <- df_growth_phase_predicts_ %>% df_growth_phase_predicts_se <- df_growth_phase_predicts_ %>%
select(plot.UID, dplyr::select(plot.UID,
predict_p15_se, predict_p95_se) %>% predict_p15_se, predict_p95_se) %>%
pivot_longer( pivot_longer(
cols= c( cols= c(
...@@ -280,9 +303,14 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -280,9 +303,14 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
df_growth_phase_predicts_ <- inner_join(df_growth_phase_predicts_values, df_growth_phase_predicts_se, by=c("plot.UID", "parameter")) df_growth_phase_predicts_ <- inner_join(df_growth_phase_predicts_values, df_growth_phase_predicts_se, by=c("plot.UID", "parameter"))
df_percentile_predicts_BLUE <- df_growth_phase_predicts_ %>%
filter(endsWith(plot.UID, "_corrected"))
df_growth_phase_predicts_ <- df_growth_phase_predicts_ %>%
filter(!endsWith(plot.UID, "_corrected"))
# Comparison with true values # Comparison with true values
df_genotype_predicts_percentile <- df_growth_phase_predicts_ %>% ungroup() %>% df_genotype_predicts_percentile <- df_growth_phase_predicts_ %>% ungroup() %>%
select(plot.UID, parameter, predict, se) %>% dplyr::select(plot.UID, parameter, predict, se) %>%
mutate(parameter = str_remove(parameter, "predict_")) %>% mutate(parameter = str_remove(parameter, "predict_")) %>%
mutate(parameter = case_when( mutate(parameter = case_when(
parameter == "p15" ~ "start_growth", parameter == "p15" ~ "start_growth",
...@@ -291,164 +319,164 @@ foreach(run = start_run:max_runs, .verbose = TRUE, ...@@ -291,164 +319,164 @@ foreach(run = start_run:max_runs, .verbose = TRUE,
)) %>% )) %>%
inner_join(df_genotypes_yearsite_true, by=c("plot.UID", "parameter")) inner_join(df_genotypes_yearsite_true, by=c("plot.UID", "parameter"))
######################################## # ########################################
## Fit growth response curves # ## Fit growth response curves
print("Fit growth curves") # print("Fit growth curves")
#
# Filter measurement data for growth period # # Filter measurement data for growth period
df_growth_fit <- inner_join(df_values_original, df_growth_phase_predicts, by="plot.UID") # df_growth_fit <- inner_join(df_values_original, df_growth_phase_predicts, by="plot.UID")
#
# Filter for growth period # # Filter for growth period
df_growth_fit <- df_growth_fit %>% # df_growth_fit <- df_growth_fit %>%
filter(timestamp >= predict_start_growth) %>% # filter(timestamp >= predict_start_growth) %>%
filter(timestamp <= predict_stop_growth) # filter(timestamp <= predict_stop_growth)
#
## Add temperature course to PH measurements # ## Add temperature course to PH measurements
# Generate temperature course lookup table # # Generate temperature course lookup table
df_covar_course_lookup <- df_growth_fit %>% ungroup() %>% # df_covar_course_lookup <- df_growth_fit %>% ungroup() %>%
select(timestamp, lag_timestamp) %>% unique() %>% # dplyr::select(timestamp, lag_timestamp) %>% unique() %>%
mutate(temp_course_id = seq(n())) # mutate(temp_course_id = seq(n()))
df_growth_fit <- inner_join(df_growth_fit, df_covar_course_lookup, by=c("timestamp", "lag_timestamp")) # df_growth_fit <- inner_join(df_growth_fit, df_covar_course_lookup, by=c("timestamp", "lag_timestamp"))
# Fill with values # # Fill with values
extract_covar <- function(df, from, to) { # extract_covar <- function(df, from, to) {
df_ <- df %>% filter(timestamp > from, timestamp <= to) # df_ <- df %>% filter(timestamp > from, timestamp <= to)
return(df_) # return(df_)
} # }
df_temp_course_lookup <- df_covar_course_lookup %>% group_by(temp_course_id) %>% # df_temp_course_lookup <- df_covar_course_lookup %>% group_by(temp_course_id) %>%
nest() %>% # nest() %>%
mutate(temperature_course = # mutate(temperature_course =
map(data, ~ extract_covar(df_temp, .$lag_timestamp, .$timestamp))) %>% # map(data, ~ extract_covar(df_temp, .$lag_timestamp, .$timestamp))) %>%
unnest(data) %>% # unnest(data) %>%
select(-timestamp, -lag_timestamp) # dplyr::select(-timestamp, -lag_timestamp)
#
df_temp_course_lookup <- df_temp_course_lookup %>% # df_temp_course_lookup <- df_temp_course_lookup %>%
group_by(temp_course_id) %>% # group_by(temp_course_id) %>%
mutate(mean_temp = map_dbl(temperature_course, ~mean(.$value))) # mutate(mean_temp = map_dbl(temperature_course, ~mean(.$value)))
#
# Join temperature course to PH measurements # # Join temperature course to PH measurements
df_growth_fit <- inner_join(df_growth_fit, df_temp_course_lookup, by="temp_course_id") # df_growth_fit <- inner_join(df_growth_fit, df_temp_course_lookup, by="temp_course_id")
remove(df_temp_course_lookup) # remove(df_temp_course_lookup)
#
df_growth_fit <- df_growth_fit %>% mutate(temps = map(temperature_course, function (df) df$value)) # df_growth_fit <- df_growth_fit %>% mutate(temps = map(temperature_course, function (df) df$value))
#
# Calcualte growth rate # # Calcualte growth rate
df_growth_fit_ <- df_growth_fit %>% # df_growth_fit_ <- df_growth_fit %>%
group_by(plot.UID) %>% # group_by(plot.UID) %>%
mutate(time_diff = difftime(timestamp, lag_timestamp, units = "hours")) # mutate(time_diff = difftime(timestamp, lag_timestamp, units = "hours"))
df_growth_fit_ <- df_growth_fit_ %>% mutate(value_rate = value_delta / as.numeric(time_diff)) # df_growth_fit_ <- df_growth_fit_ %>% mutate(value_rate = value_delta / as.numeric(time_diff))
df_growth_fit_ <- df_growth_fit_ %>% mutate(value_delta = value_rate, temps = mean_temp) # df_growth_fit_ <- df_growth_fit_ %>% mutate(value_delta = value_rate, temps = mean_temp)
#
# Simple lm # # Simple lm
models_simple_lm <- df_growth_fit_ %>% # models_simple_lm <- df_growth_fit_ %>%
group_by(year_site.UID, plot.UID, method.id, trait.label) %>% # group_by(year_site.UID, plot.UID, method.id, trait.label) %>%
nest() %>% # nest() %>%
mutate(model = map(data, ~lm(value_rate ~ mean_temp + 1, data = .))) # mutate(model = map(data, ~lm(value_rate ~ mean_temp + 1, data = .)))
#
models_simple_lm <- models_simple_lm %>% # models_simple_lm <- models_simple_lm %>%
mutate(coefs = map(model, ~coef(.)), # mutate(coefs = map(model, ~coef(.)),
coefs_se = map(model, ~coef(summary(.))[, "Std. Error"])) # coefs_se = map(model, ~coef(summary(.))[, "Std. Error"]))
#
# Extract parameters # # Extract parameters
params_simple_lm <- models_simple_lm %>% # params_simple_lm <- models_simple_lm %>%
unnest_wider(coefs) %>% # unnest_wider(coefs) %>%
rename(lm_intercept = "(Intercept)", lm_slope = mean_temp) %>% # rename(lm_intercept = "(Intercept)", lm_slope = mean_temp) %>%
unnest_wider(coefs_se) %>% # unnest_wider(coefs_se) %>%
rename(lm_intercept_se = "(Intercept)", lm_slope_se = mean_temp) %>% # rename(lm_intercept_se = "(Intercept)", lm_slope_se = mean_temp) %>%
mutate(lm_intercept = - lm_intercept / lm_slope) # mutate(lm_intercept = - lm_intercept / lm_slope)
#
# Convert to long format # # Convert to long format
params_simple_lm_long <- params_simple_lm %>% # params_simple_lm_long <- params_simple_lm %>%
pivot_longer(c(lm_intercept, lm_slope), names_to = "parameter", values_to = "value") %>% # pivot_longer(c(lm_intercept, lm_slope), names_to = "parameter", values_to = "value") %>%
select(-data) %>% # dplyr::select(-data) %>%
mutate(se = if_else(parameter == "lm_intercept", lm_intercept_se, lm_slope_se)) %>% # mutate(se = if_else(parameter == "lm_intercept", lm_intercept_se, lm_slope_se)) %>%
select(-lm_intercept_se, -lm_slope_se) # dplyr::select(-lm_intercept_se, -lm_slope_se)
#
## Simple bplm # ## Simple bplm
#
print("Simple bplm") # print("Simple bplm")
models_simple_bplm <- df_growth_fit_ %>% # models_simple_bplm <- df_growth_fit_ %>%
group_by(year_site.UID, plot.UID) %>% # group_by(year_site.UID, plot.UID) %>%
do(model = bplm_fit(., fixed_par = c(sigma_error = sigma_error))) # do(model = bplm_fit(., fixed_par = c(sigma_error = sigma_error)))
#
params_simple_bplm_long <- models_simple_bplm %>% unnest(cols = c(model)) # params_simple_bplm_long <- models_simple_bplm %>% unnest(cols = c(model))
#
print("Simple asym") # print("Simple asym")
models_simple_asym <- df_growth_fit_ %>% # models_simple_asym <- df_growth_fit_ %>%
group_by(year_site.UID, plot.UID) %>% # group_by(year_site.UID, plot.UID) %>%
do(model