Correction on ddwAgeLFD - Density dependence growth function

R/OM_1a2_DensityDependent_weight_functions.R

@@ -84,24 +84,33 @@ ddwAgeCa <- function(biol, stknm, year, season, ctrl, covars, ...) {
 # - OUTPUT: list(wt = wage, wt.chg = wt.chg) - vector with estimated weight at age values and relative change
 #-------------------------------------------------------------------------------
 
-# Weights-at-age based on SSB (linear model for estimating LW b parameter) and A LFD
+# Weights-at-age based on total biomass and a length frequency distribution
 
 ddwAgeLFD <- function(biol, stknm, year, season, ctrl, covars, ...) {
 
-  lfd       <- ctrl[['LFD']]
-  a         <- ctrl[['a.lw']]
-  lbins     <- as.numeric(colNames(lfd))
+  lfd         <- ctrl[['LFD']]
+  a           <- ctrl[['a.lw']]
+  dd_mod      <- ctrl[['LFD_model']]
+  excluded.a  <- ctrl[['exc.a']]
 
-  B <- quantSums((biol@wt*biol@n)[,year-1])[drop=T] #! DG needs to consider season dimension
+  mx.lfd = matrix(lfd, dim(biol@n)[1], dim(biol@n)[6])
 
-  condF <- predict(LW_lm, data.frame(biomass = B))  #! DG requires: biols.ctrl[[stknm]][['ddw.ctrl']][['LW_lm']]
+  B <- quantSums((biol@wt*biol@n)[,year-1,,season,])[drop=T] 
 
-  wy <- a*(lbins)^condF
+  condb <- predict(dd_mod, data.frame(biomass = B))  
+  condb_matrix <- matrix(condb, dim(biol@n)[1], dim(biol@n)[6], byrow = TRUE)
 
-  wt. <- rowSums(sweep(lfd, 2, wy, "*"))  #! DG needs to consider also season dimension
-  wt  <- biol@wt[,year,,season,]
+  wage <- a * mx.lfd^condb_matrix/1000 # in tonnes
 
-  return(list(wt = wt., wt.chg = wt./wt))
+  if(!is.null(excluded.a)){
+    excluded.a.pos <- which(biol@range[["min"]]:biol@range[["max"]] %in% excluded.a)  
+    wage[excluded.a.pos,] <- biol@wt[excluded.a.pos,year,,season,drop=TRUE]
+  }
+
+  # wt change
+  wt.ref <- biol@wt[,year,,season,drop=TRUE]
+  wt.chg <- wage/wt.ref
+
+  return(list(wt = wage, wt.chg = wt.chg))
 
 }
-

R/OM_1a_Population_Growth_Functions.R

@@ -368,9 +368,11 @@ ASPG_DDW <- function(biols, SRs, fleets, stknm, year, season, ctrl, covars, ...)
   ddw.model <- ctrl[[stknm]][['ddw.model']]
   ddw.ctrl  <- ctrl[[stknm]][['ddw.ctrl']]
 
-  if (ddw.model == "ddwAgeCa") # for in-year ssb calculation (nage required)
-    biol <- ASPG(biols, SRs, fleets, year, season, stknm, biols.ctrl,...)$biol
+  biol <- biols[[stknm]]
 
+  if (ddw.model == "ddwAgeCa") # for in-year ssb or total biomass calculation (nage required)
+    biol <- ASPG(biols, SRs, fleets, year, season, stknm, biols.ctrl,...)$biol
+
   wts <- eval(call(ddw.model, biol = biol, stknm = stknm, year = year, season = season, 
                   ctrl = ddw.ctrl, covars = covars))
 
@@ -386,4 +388,3 @@ ASPG_DDW <- function(biols, SRs, fleets, stknm, year, season, ctrl, covars, ...)
 
   return(res)
 }
-

README.md

@@ -1,5 +1,5 @@
 # FLBEIA
-- Version: 1.16.1.17
+- Version: 1.16.1.18
 - Date: 2024-07-09
 - Author: Dorleta GARCIA <dgarcia@azti.es>; FLBEIA Team <flbeia@azti.es>
 - Maintainer: Dorleta GARCIA, AZTI & FLBEIA Team