<html>
<head>
<meta content="text/html; charset=windows-1252"
http-equiv="Content-Type">
</head>
<body bgcolor="#FFFFFF" text="#000000">
Thanks Laurie. I would greatly appreciate the example if you are
able to find it.<br>
<br>
Cheers,<br>
Marc<br>
<br>
<br>
<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>
<div class="moz-cite-prefix">On 4/7/2016 9:49 AM, laurie wrote:<br>
</div>
<blockquote cite="mid:5706110A.9000602@gmail.com" type="cite">
<meta content="text/html; charset=windows-1252"
http-equiv="Content-Type">
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 moz-do-not-send="true" class="moz-txt-link-abbreviated" href="mailto:flr-list@flr-project.org">flr-list@flr-project.org</a>
<a moz-do-not-send="true" 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>
<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>