allow "s=0" in init_calib

R/calibrate_params.R

@@ -131,8 +131,9 @@ init_calib  <- function(s, f, lam0){
   # Combine vital rates
   inits_vr <- c(s_init,f_init)
   inits_vr <- c(tail(inits_vr, nac), head(inits_vr, nac))
-  inits <- inits_vr[inits_vr != 0]
-  inits
+
+  # remove fecundities = 0 (but not survivals = 0, in case there is any)
+  inits <- inits_vr[-which(inits_vr == 0 & (substr(names(inits_vr),1,1) == "f"))]
 
   return(inits)
 } # End function

junk.R

+##
+survivals <- c(0.5, 0.7, 0)
+fecundities <- c(0, 0.2, 0.55)
+lam0 = 1.08
+inits <- init_calib(s = survivals, f = fecundities, lam0 = lam0)
+inits
 
-S = 0.05
-rbinom(3, size = 1, prob = S-trunc(S))
 
-which(is.na(N), arr.ind = TRUE)
+s = survivals
+f = fecundities
+##
 
-N[,,2,498]
 
 
 
+A00 <- build_Leslie(s=s, f=f)
 
-s = c(0.5, 0.75, 0.9)
-f = c(0, 0.2, 0.4)
-lambda(build_Leslie(s,f))
+# Difference to apply on lambda
+diff_rel_lam <- (lam0 - lambda(A00))/lambda(A00)
+d <- match_lam_delta(diff_rel_lam = diff_rel_lam, s=s, f=f)
 
-nac = 3
-N1 = c(0,0,0)
-h = 0.03
-s_corr_factor = f_corr_factor = 1.2
+el <- elements_Leslie(s=s, f=f)
+vr0 = el$vital_rates
+vr1 = vr0*(1+d)
 
-# Survivors using the "s_realized" from reference scenarios
-S <- N1*(1-h)*s*s_corr_factor
+nac = length(s)
 
-# Active rounding
-S <- round(trunc(S) + rbinom(nac, size = 1, prob = S-trunc(S)))
+# Define s_init and f_init
+s_init <- head(vr1, nac)
+f_init <- tail(vr1, nac)
 
-N2 <- c(rep(0, nac-1), tail(S,1)) + c(0, head(S,-1))
+# Apply correction to respect relative order of survivals and fecundities
+s_init <- apply(cbind(s_init, s_init * (s/s[1]) / (s_init/s_init[1])), 1 , max, na.rm = TRUE)
+f_init <- f_init * (f/max(f[f!=0])) / (f_init/max(f_init[f_init!=0]))
+f_init[is.nan(f_init)] <- 0
 
-# Births
-B <- sum(f*f_corr_factor*N2)
+# Calibrate survivals
+#s_init <- (s_init %>% sapply(., max, 0.05)) %>% sapply(., min, 0.97)
+s_init <- cbind(
+  (s_init %>% sapply(., max, 0.05)) %>% sapply(., min, 0.97),
+  s*1.1) %>%
+  apply(., 1, min)
 
-# Active rounding
-B <- round(trunc(B) + rbinom(1, size = 1, prob = B-trunc(B)))
 
-N2[1] <- B
-N2
+# Calibrate fecundities
+f_init <- f_init %>% sapply(., max, 0.001)
+f_init[f == 0] <- 0
+
+# Combine vital rates
+inits_vr <- c(s_init,f_init)
+inits_vr <- c(tail(inits_vr, nac), head(inits_vr, nac))
+
+# remove fecundities = 0 (but not survivals = 0, in case there is any)
+inits <- inits_vr[-which(inits_vr == 0 & (substr(names(inits_vr),1,1) == "f"))]
+inits
+
+## old one
+inits_vr[inits_vr != 0]