[FLR-list] fitting a custom SRModel with a covariate

[Marc Taylor]

Dear FLR-Listers,

I was hoping someone might help me figure out a way to create a custom 
SRModel that uses a covariate in addition to ssb and rec.

 From the documentation of SRModels (i.e. ?SRModels), reference is made 
to several models that would be of interest to me (e.g. 'ricker.c.a', 
'ricker.c.b', etc.), but these do not appear to be presently included in 
FLCore.  I made an attempt (below) to define a custom model, but am 
getting errors when fitting with fmle().

If anyone has any experience with such models, I would greatly 
appreciate any advise.

Cheers,
Marc

*Example script*:

# packages ----------------------------------------------------------------
library(FLCore) # FLCore_2.5.20160107


# load data ---------------------------------------------------------------

data("ple4")


# make srr obbject and add covariate --------------------------------------

ple4Sr <- as.FLSR(ple4)

env1 <- c(-0.81, -1.73, -0.09, 0.42, -1.01, -1.06, -0.79, -0.42, -0.74,
-0.3, 0.25, 0.09, -0.18, -0.29, 0.13, 0.09, 0.48, 0.33, 0.41,
0.4, -0.21, -0.64, -0.97, -0.02, -0.19, 0.28, -0.03, -0.19, -0.47,
-0.97, -0.88, 0.23, 0.82, 0.92, 0.17, 0.67, -0.07, 0.32, 0.9,
-0.64, 0.97, 0.54, 1.18, 0.67, 0.44, 1.29, 1.54, 1.22, 0.47,
1.04, 1.31, 1.06)

ple4Sr at covar <- FLQuants(list(env1=FLQuant(env1, dim=dim(ple4Sr at ssb), 
dimnames=dimnames(ple4Sr at ssb))))
ple4Sr at covar$env1


# attempt with existing SRModel fails
model(ple4Sr) <- "ricker.c.a"
# Error in do.call(value, list()) : could not find function "ricker.c.a"



# make new srr function ---------------------------------------------------

# adapt ricker
ricker <- function(){
     logl <- function(a, b, rec, ssb) loglAR1(log(rec), log(a *
         ssb * exp(-b * ssb)))
     initial <- structure(function(rec, ssb) {
         res <- coefficients(lm(log(c(rec)/c(ssb)) ~ c(ssb)))
         return(FLPar(a = max(exp(res[1])), b = -max(res[2])))
     }, lower = rep(-Inf, 2), upper = rep(Inf, 2))
     model <- rec ~ a * ssb * exp(-b * ssb)
     return(list(logl = logl, model = model, initial = initial))
}

# to this (incl. env. control term - 'env1')
ri.ec <- function(){
     logl <- function(a, b, e1, rec, ssb, env1) loglAR1(log(rec), log(a *
         ssb * exp(-b * ssb) * exp(e1 * env1)))
     initial <- structure(function(rec, ssb, env1) {
         res <- coefficients(lm(log(c(rec)/c(ssb)) ~ c(ssb) + c(env1)))
         return(FLPar(a = max(exp(res[1])), b = -max(res[2], env1 = 
max(res[3]))))
     }, lower = rep(-Inf, 3), upper = rep(Inf, 3))
     model <- rec ~ a * ssb * exp(-b * ssb) * exp(e1 * env1)
     return(list(logl = logl, model = model, initial = initial))
}


# fit SRR -----------------------------------------------------------------
model(ple4Sr) <- "ri.ec"
ple4Sr <- fmle(ple4Sr)
# Error in loglAR1(log(rec), log(a * ssb * exp(-b * ssb) * exp(e1 * 
env1))) :
#   error in evaluating the argument 'hat' in selecting a method for 
function 'loglAR1': Error: argument "e1" is missing, with no default
summary(ple4Sr)
plot(ple4Sr)

-- 
Achtung: Das Thünen-Institut hat die Domain gewechselt. Bitte ändern Sie meine Mailadresse in Ihrem Adressbuch!
Notice: Thünen Institute has changed its domain. Please change my email address in your address book!

Dr. Marc Taylor
Marine Lebende Resourcen / Marine Living Resources
Thünen-Institut für Seefischerei / Thünen Institute of Sea Fisheries
Palmaille 9
22767 Hamburg, Germany

Tel:  +49 40 38905-143
Mail: marc.taylor at thuenen.de
Web:  www.ti.bund.de

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.r-forge.r-project.org/pipermail/flr-list/attachments/20160407/dbbd956f/attachment.html>