new calibration of grow

exploration/GR3D_Rdescription/GR3Dfunction.R

@@ -54,7 +54,7 @@ vonBertalanffyIncrement = function(nStep, L0, Linf, K, timeStepDuration, sigma,
   return(L)
 }
 
-vonBertalanffyWithNextIncrement = function(L, L0, Linf, K, timeStepDuration, sigma, tempEffect ){
+vonBertalanffyWithNextIncrement = function(L,  Linf, K, timeStepDuration, sigma, tempEffect ){
   if (sigma == 0) {
     mu = log((Linf - L) * (1 - exp(-K * timeStepDuration)))
     increment = exp(mu)
@@ -67,6 +67,112 @@ vonBertalanffyWithNextIncrement = function(L, L0, Linf, K, timeStepDuration, sig
   return(L)
 }
 
+# generate a cohort of length trajectories
+computeMultipleLengthTrajectories = function(temperaturePattern, Nind = 10, growPar){
+  ages = temperaturePattern$age
+  
+  res <- expand_grid(ind = seq.int(Nind),  age = ages) %>% 
+    inner_join(temperaturePattern, by = 'age') %>% 
+    arrange(age, ind) %>% 
+    mutate(temperatureEffect = temperatureEffect(temperature, 
+                                                 growPar$tempMinGrow, 
+                                                 growPar$tempOptGrow, 
+                                                 growPar$tempMaxGrow), 
+           L = if_else(age == 0, growPar$lengthAtHatching, 0))
+  
+  for (i in 2:length(ages)) {
+    previousAge  = ages[i - 1]
+    currentAge = ages[i]
+    tempEffect = res %>% filter(age == currentAge) %>% select(temperatureEffect) %>% unlist(use.names = FALSE)
+    previousL <- res %>% filter(age == previousAge) %>% select(L) %>% unlist(use.names = FALSE)
+    
+    currentL <- vonBertalanffyWithNextIncrement(L = previousL, 
+                                                Linf = growPar$Linf, 
+                                                K = growPar$kOpt,
+                                                timeStepDuration = currentAge - previousAge, 
+                                                sigma = growPar$sigmaDeltaLVonBert, 
+                                                tempEffect = tempEffect)
+    res = res %>% mutate(L =replace(L, age == ages[i], currentL) ) 
+  }
+  return(res)
+}
+
+computeMultipleLengthTrajectoriesWithRandomSeed = function(temperaturePattern, 
+                                                           Nind = 10, 
+                                                           growPar, 
+                                                           RNGseed =1){
+  set.seed(RNGseed)
+  ages = temperaturePattern %>% 
+    distinct(age) %>% 
+    unlist(use.names = FALSE)
+  
+  res <- expand_grid(ind = seq.int(Nind),  age = ages) %>% 
+    mutate(random = rnorm(Nind * length(ages)))  %>% 
+    inner_join(temperaturePattern, by = 'age') %>% 
+    arrange(age, ind) %>% 
+    mutate(temperatureEffect = temperatureEffect(temperature, 
+                                                 growPar$tempMinGrow, 
+                                                 growPar$tempOptGrow, 
+                                                 growPar$tempMaxGrow), 
+           L = if_else(age == 0, growPar$lengthAtHatching, 0))
+  
+  for (i in 2:length(ages)) {
+    previousAge  = ages[i - 1]
+    currentAge = ages[i]
+    tempEffect <-  res %>% filter(age == currentAge) %>% 
+      select(temperatureEffect) %>% unlist(use.names = FALSE)
+    
+    previousL <- res %>% filter(age == previousAge) %>% 
+      select(L) %>% unlist(use.names = FALSE)
+    rnd <- res %>% filter(age == currentAge) %>% select(random) %>% unlist(use.names = FALSE)
+    currentL <- vonBertalanffyWithRandomVector(L = previousL, 
+                                               Linf = growPar$Linf, 
+                                               K = growPar$kOpt,
+                                               timeStepDuration = currentAge - previousAge, 
+                                               randomVector = rnd,
+                                               sigma = growPar$sigmaDeltaLVonBert, 
+                                               tempEffect = tempEffect)
+    res = res %>% mutate(L = replace(L, age == ages[i], currentL) ) 
+  }
+  return(res)
+}
+
+#computeMultipleLengthTrajectoriesWithRandomSeed(temperaturePattern, Nind = 10, 
+#growPar = growParUnisex,
+# RNGseed = 1)
+
+vonBertalanffyWithRandomVector = function(L, Linf, K, timeStepDuration, randomVector, sigma, tempEffect ){
+  if (sigma == 0) {
+    mu = if_else(L < Linf, log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))),-Inf)
+    #mu =  log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration)))
+    increment = exp(mu)
+  }
+  else {
+    mu = if_else(L < Linf, log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) - (sigma * sigma) / 2, -Inf)
+    #      mu = log((Linf - L) * (1 - exp(-K * tempEffect * timeStepDuration))) - (sigma * sigma) / 2
+    increment = exp(randomVector * sigma + mu)
+  }
+  L = pmin(Linf, L + increment) 
+  return(L)
+}
+
+
+computeOgive = function(lengthTrajectories, lengthAtMaturity) {
+  ogive <-
+    lengthTrajectories %>% 
+    group_by(age) %>% 
+    summarise(nTotal=n()) %>% 
+    left_join(lengthTrajectories %>%  group_by(age) %>% 
+                filter(L > lengthAtMaturity) %>% 
+                summarise(mature = n(), .groups = 'drop'), 
+              by = 'age') %>% 
+    replace_na(list(mature = 0)) %>% 
+    mutate(p =  mature/nTotal) %>% 
+    select(age, p)
+  
+  return(ogive)
+} 
+
 # -------------------------------------------------------
 # Dispersal      
 # see see (Chapman et al., 2007; Holloway et al., 2016)