temp commits

R/build_schedule.R

@@ -109,6 +109,7 @@ build_schedule <- function(p, env = make_environment(parameters = p),
     attr(p, "net_reproduction_ratios") <- net_reproduction_ratios
   }
 
+  # This gives the wrong message if integration succeeds.
   if(i == ctrl$schedule_nsteps)
     plant_log_debug("Maximum number of iterations reached", routine="schedule")
   else

init_script.R

@@ -0,0 +1,152 @@
+devtools::load_all()
+library(tidyverse)
+library(patchwork)
+
+env <- make_environment("FF16")
+ctrl <- scm_base_control()
+p0 <- scm_base_parameters("FF16")
+
+names <- c("height", "mortality", "fecundity", "area_heartwood",
+           "mass_heartwood", "offspring_produced_survival_weighted",
+           "log_density")
+
+p1 <- expand_parameters(trait_matrix(c(0.0825), "lma"), p0, FF16_hyperpar,FALSE)
+s = p1$strategies[[1]]
+
+
+# log-normal
+ln_init <- function(mean_height = 6, log_sd = 0.8,
+                    density = 1,
+                    min_h = 0.3920458,
+                    max_h = 10,
+                    n = 100) {
+
+    log_mu <- log(mean_height)
+
+    init_height <- seq(min_h, max_h, len = n)
+    init_density <- dlnorm(init_height, log_mu, log_sd)
+
+    # normalise to user density
+    area_density <-   trapezium(init_height, init_density)
+    init_density_scaled <- init_density / area_density * density
+
+    # sense check initial leaf area
+    la = (init_height / s$a_l1)^(1.0 / s$a_l2)
+    leaf_area <- trapezium(init_height, init_density_scaled * la)
+
+    # fit splines
+    init_log_normal <- c(init_height, 
+                         rep(0, n),
+                         rep(0, n),
+                         rep(0, n), 
+                         rep(0, n),
+                         rep(0, n),
+                         log(init_density_scaled)) %>%
+      matrix(., ncol = n, byrow = T)
+
+    rownames(init_log_normal) <- names
+
+    splines <- init_spline(list(init_log_normal), size_idx = 1)
+
+
+    return(list(leaf_area = leaf_area,
+                splines = splines))
+}
+
+init_df <- data.frame(mu = c(10, 10, 10, 2, 2, 2),
+                 sd = c(0.1, 0.1, 0.1, 0.4, 0.4, 0.4),
+                 density = c(0.3, 0.2, 0.1, 0.3, 0.2, 0.1)) %>%
+  mutate(init = pmap(list(mu, sd, density), ~ ln_init(..1, ..2, density = ..3))) %>%
+  unnest_wider(init)
+
+init_df
+
+
+# set crude starting point
+nth_element <- function(vec, interval){
+  vec[seq(1, length(vec), interval)]
+}
+
+times <- p1$cohort_schedule_times_default
+times_half <- nth_element(times, 2)
+
+p1$cohort_schedule_times[[1]] <- times
+
+
+#p1$strategies[[1]]$recruitment_decay <- 0
+p1$strategies[[1]]$a_d0 = 0
+
+plant_log_console()
+
+res <- map(init_df$splines, ~ build_schedule(p1, env, ctrl, splines = .x))
+
+out <- map(res, ~ run_scm_collect(.$parameters, env, ctrl))
+
+results <- map(out, tidy_patch)
+
+fn <- function(init_df, tidy_species, build_schedule_results) {
+  scen = sprintf("Mode: %f, density: %f, leaf_area: %f", init$mu, init$density, init$leaf_area)
+
+  n_nodes = length(res[[1]]$parameters$cohort_schedule_times[[1]])
+  diag = sprintf("Complete: %f, # steps: %f, # nodes: %f")
+
+  tidy_species %>%
+    tidyr::drop_na() %>%
+    plot_size_distribution() +
+    coord_cartesian(expand = F) + 
+    ggdark::dark_theme_classic()
+}
+
+p <- pmap(c(init_df, results, res), ~ fn(..1, ..2$species, ..3))
+
+wrap_plots(p) + 
+  plot_layout(guides = 'collect')
+
+# disable darkmode
+ggdark::invert_geom_defaults() 
+
+
+
+fn2 <- function(tidy_results) {
+  tidy_results %>%
+    FF16_expand_state() %>%
+    {.$species} %>%
+    integrate_over_size_distribution()
+}
+
+fn3 <- function(totals) {
+  totals %>% 
+    select(time, area_leaf, individuals) %>%
+    gather(metric, value, -time) %>%
+    filter(time < 100) %>%
+    ggplot(., aes(time, value)) +
+      geom_line() +
+      coord_cartesian(expand = F) +
+      theme_classic() +
+      facet_wrap(~ metric, scales = "free")
+}
+
+totals <- map(results, fn2)
+p <- map(totals, fn3)
+
+wrap_plots(p) + 
+  plot_layout(guides = 'collect')
+
+v <- c("mass_heartwood", "mass_sapwood", "mass_bark", "mass_leaf")
+
+fn4 <- function(totals) {
+  totals %>% 
+    select(time, species, one_of(v)) %>%
+    pivot_longer(cols=starts_with("mass"), names_to = "tissue") %>%
+    mutate(across(tissue, factor, levels = v)) %>%
+    ggplot(., aes(time, value, fill=tissue)) +
+      geom_area() +
+      labs(x = "Patch age (yr)", y = "Above ground mass (kg/m2)") +
+      theme_classic() + 
+      coord_cartesian(expand = F)
+}
+
+p <- map(totals, fn4)
+
+wrap_plots(p) + 
+  plot_layout(guides = 'collect')