<html>
<head>
<meta content="text/html; charset=windows-1252"
http-equiv="Content-Type">
</head>
<body bgcolor="#FFFFFF" text="#000000">
see, which is in FLCore <br>
<br>
<br>
<tt>rickerCa <- function() {</tt><tt><br>
</tt><tt> logl <- function(a, b, c, rec, ssb, covar)</tt><tt><br>
</tt><tt> loglAR1(log(rec), log(a * (1 - c * covar) * ssb *
exp(-b * ssb)))</tt><tt><br>
</tt><tt> </tt><tt><br>
</tt><tt> initial <- structure(function(rec, ssb) {</tt><tt><br>
</tt><tt> # The function to provide initial values</tt><tt><br>
</tt><tt> res <-coefficients(lm(c(log(rec/ssb))~c(ssb)))</tt><tt><br>
</tt><tt> return(FLPar(a=max(exp(res[1])), b=-max(res[2]),
c=1))},</tt><tt><br>
</tt><tt> </tt><tt><br>
</tt><tt> # lower and upper limits for optim()</tt><tt><br>
</tt><tt> lower=rep(-Inf, 3),</tt><tt><br>
</tt><tt> upper=rep( Inf, 3))</tt><tt><br>
</tt><tt> </tt><tt><br>
</tt><tt> model <- rec ~ a * (1 - c * covar) * ssb * exp(-b *
ssb)</tt><tt><br>
</tt><tt> return(list(logl=logl, model=model, initial=initial))</tt><tt><br>
</tt><tt>}</tt><tt><br>
</tt><br>
<br>
There is an example using it somewhere, I will see if I can find it.<br>
<br>
Laurie<br>
<br>
<div class="moz-cite-prefix">On 07/04/16 09:37, Marc Taylor wrote:<br>
</div>
<blockquote cite="mid:57060E1C.5040105@thuenen.de" type="cite">
<meta http-equiv="content-type" content="text/html;
charset=windows-1252">
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 moz-do-not-send="true" class="moz-txt-link-abbreviated" href="mailto:marc.taylor@thuenen.de">marc.taylor@thuenen.de</a>
Web: <a moz-do-not-send="true" class="moz-txt-link-abbreviated" href="http://www.ti.bund.de">www.ti.bund.de</a></pre>
<br>
<fieldset class="mimeAttachmentHeader"></fieldset>
<br>
<pre wrap="">_______________________________________________
flr-list mailing list
<a class="moz-txt-link-abbreviated" href="mailto:flr-list@flr-project.org">flr-list@flr-project.org</a>
<a class="moz-txt-link-freetext" href="https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/flr-list">https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/flr-list</a>
</pre>
</blockquote>
<br>
</body>
</html>