Commit 4d0a1132 authored by luroth's avatar luroth
Browse files

spline fitting optimized

parent ab2467ff
# Working directory with temperature data
path_home <- 'E:/Scripts/htfp_data_processing'
path_simulation <- 'E:/Simulation/Runs'
path_simulation <- 'E:/Simulation/Runs_Posterior'
setwd(path_home)
......@@ -16,6 +16,7 @@ library(zoo)
library(plyr)
library(stringr)
library(SpATS)
library(fs)
library(foreach)
library(dplyr)
......@@ -27,9 +28,10 @@ source("R/Model/Dose_response.R")
source("R/Model/FitSpATS.R")
source("R/Model/Graphs.R")
# Missing from euler: 1, 3, 8
start_run <- 1
max_runs <- 1
number_of_cpus <- 5
max_runs <- 500
number_of_cpus <- 29
sigma_error <- 10
......@@ -103,15 +105,15 @@ df_designs <- df_designs %>% mutate(plot.discrete_x = plot.row * if_else(plot.re
df_genotypes <- read_csv('Simulation/genotypes.csv')
df_temp <- read_csv('Simulation/covariate_temp.csv')
run <- 1
for(run in start_run:max_runs) {
# run <- 1
# for(run in start_run:max_runs) {
# cl <- parallel::makeCluster(number_of_cpus)
# doParallel::registerDoParallel(cl)
# foreach(run = start_run:max_runs, .verbose = TRUE,
# .packages = c("readr", "tidyr", "purrr", "ggplot2", "lubridate", "gridExtra", "plyr", "stringr", "SpATS", "dplyr", "scam", "MASS")
# ) %dopar% {
cl <- parallel::makeCluster(number_of_cpus)
doParallel::registerDoParallel(cl)
foreach(run = start_run:max_runs, .verbose = TRUE,
.packages = c("fs", "readr", "tidyr", "purrr", "ggplot2", "lubridate", "gridExtra", "plyr", "stringr", "SpATS", "dplyr", "scam", "MASS")
) %dopar% {
# Validation data
......@@ -156,6 +158,7 @@ for(run in start_run:max_runs) {
if(length(files)==0) {
#try({
fs::file_touch(paste0(path_simulation, "/", run, "/", set, "_MILESTONE_start_plot.txt"))
df_values_for_fit_orig_ <- df_values_for_fit_orig_ %>%
filter(format(timestamp, "%m%d") %in% measurement_dates_set)
......@@ -170,6 +173,7 @@ for(run in start_run:max_runs) {
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))
file_touch(paste0(path_simulation, "/", run, "/", set, "_MILESTONE_reverse_SpATS.txt"))
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_)
......@@ -203,6 +207,8 @@ for(run in start_run:max_runs) {
df_spline_model <- df_spline_model %>% dplyr::select(-data)
file_touch(paste0(path_simulation, "/", run, "/", set, "_MILESTONE_fit_spline.txt"))
# Predict value with spline model
time_interval <- 60*60*12
prediction_timepoints <- df_values_for_fit %>%
......@@ -223,6 +229,8 @@ for(run in start_run:max_runs) {
predict_deriv = predict_scam_spline(.$spline_model[[1]], list(x=.$prediction_timepoint[[1]]), deriv = T),
timestamp = .$prediction_timepoint[[1]]))
file_touch(paste0(path_simulation, "/", run, "/", set, "_MILESTONE_predict_spline.txt"))
if (run == 1 & set == "set3d") {
df_spline_predicts_export <- df_spline_predicts %>%
filter(!startsWith(plot.UID, "BLUE_")) %>%
......@@ -235,6 +243,8 @@ for(run in start_run:max_runs) {
df_growth_phase_predicts <- df_spline_predicts %>% ungroup() %>% group_by(plot.UID) %>%
mutate(growth_phase_params = map(spline_predicts, find_start_stop_growth_phase_posterior))
file_touch(paste0(path_simulation, "/", run, "/", set, "_MILESTONE_extract_traits.txt"))
# Extract predicted values
df_growth_phase_predicts <- df_growth_phase_predicts %>%
unnest(growth_phase_params)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment