From bc8e2eb176d8bae7d8be4b04d5dd88436327ab85 Mon Sep 17 00:00:00 2001
From: Iago Mosqueira <iagomosqueira@users.noreply.github.com>
Date: Thu, 5 Dec 2024 20:03:40 +0100
Subject: [PATCH] Added segregDa SRR

---
 NAMESPACE    |  1 +
 R/SRmodels.R | 24 ++++++++++++++++++++++++
 2 files changed, 25 insertions(+)

diff --git a/NAMESPACE b/NAMESPACE
index 5844d266..bb0c9276 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -201,6 +201,7 @@ export(
   "sbind",
   "segreg",
   "segregAR1",
+  "segregDa",
   "setquant",
   "setunits",
   "shepherd",
diff --git a/R/SRmodels.R b/R/SRmodels.R
index 7ef4792f..4ac727d9 100644
--- a/R/SRmodels.R
+++ b/R/SRmodels.R
@@ -290,6 +290,26 @@ segreg <- function(){
 	return(list(logl=logl, model=model, initial=initial))
 } # }}}
 
+# segregDa  {{{
+
+#' @name SRModels
+#' @aliases segregDa
+segregDa <- function(){
+	logl <- function(a, b, d, rec, ssb){
+
+    loglAR1(log(rec), FLQuant(log(ifelse(c(ssb ^ d)<=b,a * c(ssb)^d, a * b)),
+      dimnames=dimnames(ssb)))}
+
+  model <- rec ~ ifelse(ssb ^ d <= b, a * ssb ^ d, a * b)
+
+  initial <- structure(function(rec, ssb){
+    return(FLPar(a=median(c(rec)/c(ssb),na.rm=TRUE), b=median(c(ssb),na.rm=TRUE), d=1))},
+    lower=rep(0, 0),
+    upper=rep(Inf, 2))
+
+	return(list(logl=logl, model=model, initial=initial))
+} # }}}
+
 # geomean {{{
 
 #' @name SRModels
@@ -827,6 +847,9 @@ SRModelName <- function(model){
     "ifelse(ssb<=b,a*ssb,a*b)" = "segreg",
     "FLQuant(ifelse(c(ssb)<=b,a*c(ssb),a*b),dimnames=dimnames(ssb))" = "segreg",
     "FLQuant(ifelse(c(ssb)<=c(b),c(a)*c(ssb),c(a)*c(b)),dimnames=dimnames(ssb))" = "segreg",
+    "ifelse(ssb^d<=b,a*ssb^d,a*b)" = "segregDa",
+    "FLQuant(ifelse(c(ssb^d)<=b,a*c(ssb^d),a*b),dimnames=dimnames(ssb))" = "segregDa",
+    "FLQuant(ifelse(c(ssb^d)<=c(b),c(a)*c(ssb^d),c(a)*c(b)),dimnames=dimnames(ssb))" = "segregDa",
       "a+ssb/ssb-1"                       = "mean",
       "FLQuant(a,dimnames=dimnames(rec))" = "mean",
       "a"                                 = "mean",
@@ -858,6 +881,7 @@ SRNameCode <- function(name)
     "bevholtSS3" = 23,
     "rickerD" = 31,
     "rickerSV" = 32,
+    "segregDa" = 41,
     "shepherdD" = 51,
     "shepherdSV" = 52,
     NA)