<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=utf-8">
</head>
<body bgcolor="#FFFFFF" text="#000000">
Dear FLR-Listers,<br>
<br>
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. <br>
<br>
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(). <br>
<br>
If anyone has any experience with such models, I would greatly
appreciate any advise.<br>
<br>
Cheers,<br>
Marc<br>
<br>
<b>Example script</b>:<br>
<br>
<small><font face="Courier New, Courier, monospace"># packages
----------------------------------------------------------------<br>
library(FLCore) # FLCore_2.5.20160107<br>
<br>
<br>
# load data
---------------------------------------------------------------<br>
<br>
data("ple4")<br>
<br>
<br>
# make srr obbject and add covariate
--------------------------------------<br>
<br>
ple4Sr <- as.FLSR(ple4) <br>
<br>
env1 <- c(-0.81, -1.73, -0.09, 0.42, -1.01, -1.06, -0.79,
-0.42, -0.74, <br>
-0.3, 0.25, 0.09, -0.18, -0.29, 0.13, 0.09, 0.48, 0.33, 0.41, <br>
0.4, -0.21, -0.64, -0.97, -0.02, -0.19, 0.28, -0.03, -0.19,
-0.47, <br>
-0.97, -0.88, 0.23, 0.82, 0.92, 0.17, 0.67, -0.07, 0.32, 0.9, <br>
-0.64, 0.97, 0.54, 1.18, 0.67, 0.44, 1.29, 1.54, 1.22, 0.47, <br>
1.04, 1.31, 1.06)<br>
<br>
ple4Sr@covar <- FLQuants(list(env1=FLQuant(env1,
dim=dim(ple4Sr@ssb), dimnames=dimnames(ple4Sr@ssb))))<br>
ple4Sr@covar$env1<br>
<br>
<br>
# attempt with existing SRModel fails<br>
model(ple4Sr) <- "ricker.c.a"<br>
# Error in do.call(value, list()) : could not find function
"ricker.c.a"<br>
<br>
<br>
<br>
# make new srr function
---------------------------------------------------<br>
<br>
# adapt ricker<br>
ricker <- function(){<br>
logl <- function(a, b, rec, ssb) loglAR1(log(rec), log(a
* <br>
ssb * exp(-b * ssb)))<br>
initial <- structure(function(rec, ssb) {<br>
res <- coefficients(lm(log(c(rec)/c(ssb)) ~ c(ssb)))<br>
return(FLPar(a = max(exp(res[1])), b = -max(res[2])))<br>
}, lower = rep(-Inf, 2), upper = rep(Inf, 2))<br>
model <- rec ~ a * ssb * exp(-b * ssb)<br>
return(list(logl = logl, model = model, initial = initial))<br>
}<br>
<br>
# to this (incl. env. control term - 'env1')<br>
ri.ec <- function(){<br>
logl <- function(a, b, e1, rec, ssb, env1)
loglAR1(log(rec), log(a * <br>
ssb * exp(-b * ssb) * exp(e1 * env1)))<br>
initial <- structure(function(rec, ssb, env1) {<br>
res <- coefficients(lm(log(c(rec)/c(ssb)) ~ c(ssb) +
c(env1)))<br>
return(FLPar(a = max(exp(res[1])), b = -max(res[2], env1
= max(res[3]))))<br>
}, lower = rep(-Inf, 3), upper = rep(Inf, 3))<br>
model <- rec ~ a * ssb * exp(-b * ssb) * exp(e1 * env1)<br>
return(list(logl = logl, model = model, initial = initial))<br>
}<br>
<br>
<br>
# fit SRR
-----------------------------------------------------------------<br>
model(ple4Sr) <- "ri.ec"<br>
ple4Sr <- fmle(ple4Sr) <br>
# Error in loglAR1(log(rec), log(a * ssb * exp(-b * ssb) *
exp(e1 * env1))) : <br>
# error in evaluating the argument 'hat' in selecting a method
for function 'loglAR1': Error: argument "e1" is missing, with no
default <br>
summary(ple4Sr)<br>
plot(ple4Sr)</font></small>
<pre class="moz-signature" cols="72">--
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: <a class="moz-txt-link-abbreviated" href="mailto:marc.taylor@thuenen.de">marc.taylor@thuenen.de</a>
Web: <a class="moz-txt-link-abbreviated" href="http://www.ti.bund.de">www.ti.bund.de</a></pre>
</body>
</html>