-
Notifications
You must be signed in to change notification settings - Fork 10
/
Using_information_on_life_history_relationships.Rmd
797 lines (574 loc) · 24.6 KB
/
Using_information_on_life_history_relationships.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
---
title: "Using information on Life History relationships"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output:
github_document:
mathjax: TRUE
pdf_document:
fig_width: 6
fig_height: 4
bibliography: bibliography.bib
tags: [FLife FLR]
license: Creative Commons Attribution-ShareAlike 4.0 International Public License
---
```{r knitr_init, echo=FALSE, results="hide"}
library(knitr)
## Global options
opts_chunk$set(cache =TRUE,
echo =!TRUE,
eval =TRUE,
prompt =FALSE,
comment =NA,
message =FALSE,
warning =FALSE,
tidy =FALSE,
fig.height=6,
fig.width =8)
iFig=0
```
```{r, pkgs, echo=FALSE, message=FALSE}
library(ggplot2)
library(FLife)
library(plyr)
theme_set(theme_bw())
options(digits=3)
```
[](#top)
[Quick Start](#Quick Start)
[Methods](#Methods)
[Simulation](#Simulation)
[Estimation](#Estimation)
[More Information](#More)
[References](#References)
Life history traits include growth rate; age and size at sexual maturity; the temporal pattern or schedule of reproduction; the number, size, and sex ratio of offspring; the distribution of intrinsic or extrinsic mortality rates (e.g., patterns of senescence); and patterns of dormancy and dispersal. These traits contribute directly to age-specific survival and reproductive functions.^[http://www.oxfordbibliographies.com/view/document/obo-9780199830060/obo-9780199830060-0016.xml] The **FLife** package has a variety of methods for modelling life history traits and functional forms for processes for use in fish stock assessment and for conducting Management Strategy Evaluation (MSE).
These relationships have many uses, for example in age-structured population models, functional relationships for these processes allow the calculation of the population growth rate and have been used to to develop priors in stock assesments and to parameterise ecological models.
The **FLife** package has methods for modelling functional forms, for simulating equilibrium `FLBRP` and dynamic stock objects `FLStock`.
[Back to Top](#top)
# Quick Start {#QuickStart}
This section provide a quick way to get running and overview of what functions are available, their potential use, and where to seek help. More details are given in later sections.
The simplest way to obtain **FLife** is to install it from the `FLR` repository via the R console:
```{r install,echo=TRUE,eval=FALSE}
install.packages("FLife", repos = "http://flr-project.org/R")
```
See help(install.packages) for more details.
After installing the **FLife** package, you need to load it
```{r lib,echo=TRUE}
library(FLife)
```
There is an example teleost dataset used for illustration and as a test dataset, alternatively you can load your own data.
```{r data,echo=TRUE}
data(teleost)
```
The dataset contains life history parameters for a range of bony fish species and families, i.e. von Bertalanffy growth parameters ($L_{\infty}, k, t_0$), length at 50\% mature ($L_{50}$), and the length weight relationship ($a, b$).
When loading a new dataset it is always a good idea to run a sanity check e.g.
```{r data-2,echo=TRUE}
is(teleost)
```
The `teleost` object can be used to create `vectors` or other `objects with values by age using **FLife** methods, e.g. to construct a growth curve for hutchen (*Hucho hucho*)
```{r data-3,echo=TRUE}
vonB(1:10,teleost[,"Hucho hucho"])
```
### Plotting
Plotting is done using **ggplot2** which provides a powerful alternative paradigm for creating both simple and complex plots in R using the *Grammar of Graphics* ^[Wilkinson, L. 1999. *The Grammar of Graphics*, Springer. [doi 10.1007/978-3-642-21551-3_13](http://dx.doi.org/10.1007/978-3-642-21551-3_13).] The idea of the grammar is to specify the individual building blocks of a plot and then to combine them to create the desired graphic^[<http://tutorials.iq.harvard.edu/R/Rgraphics/Rgraphics.html>].
The **ggplot** methods expects a `data.frame` for its first argument, `data` (this has been overloaded by **ggplotFL** to also accept FLR objects); then a geometric object `geom` that specifies the actual marks put on to a plot and an aesthetic that is "something you can see" have to be provided. Examples of geometic Objects (geom) include points (geom_point, for scatter plots, dot plots, etc), lines (geom_line, for time series, trend lines, etc) and boxplot (geom_boxplot, for, well, boxplots!). Aesthetic mappings are set with the aes() function and, examples include, position (i.e., on the x and y axes), color ("outside" color), fill ("inside" color), shape (of points), linetype and size.
```{r, echo=TRUE, fig.cap="Von Bertalanffy growth curves."}
age=FLQuant(1:20,dimnames=list(age=1:20))
len=vonB(age,teleost)
ggplot(as.data.frame(len))+
geom_line(aes(age,data,col=iter))+
theme(legend.position="none")
```
[Back to Top](#top)
# Methods {#Methods}
## Life History Parameters
```{r, fig.height=8,fig.cap="Relationship between life history parameters in the teleost dataset."}
library(GGally)
habitat=ifelse(attributes(teleost)$habitat=="demersal","Demersal","Other")
my_smooth <- function(data,mapping,...){
ggplot(data=data,mapping=mapping)+
geom_point(...,size=.5)+
geom_smooth(...,method="lm",se=FALSE)}
my_density <- function(data,mapping,...){
ggplot(data=data,mapping=mapping)+
geom_density(...,lwd=1)}
ggpairs(cbind(transform(model.frame(teleost)[,-c(7)],linf=log(linf),k=log(k),l50=log(l50)),
"habitat"=habitat),
mapping = ggplot2::aes(color=habitat),
lower = list(continuous = wrap(my_smooth)),
diag=list(continuous=wrap(my_density,alpha=0.2)),
title = "")+
theme(legend.position ="none",
panel.grid.major =element_blank(),
axis.ticks =element_blank(),
axis.text.x =element_blank(),
axis.text.y =element_blank(),
panel.border =element_rect(linetype = 1, colour="black", fill=NA))
```
### Growth
Consider the von Bertalanffy growth equation
$$ L_t = L_\infty (1 - e^{(-kt-t_0)})$$
where $L_t$ is length at time t, $L_\infty$ the asymptotic maximum length, $k$ the growth coefficient, and $t_0$ the time at which an individual would, if it possible, be of zero length.
As $L_\infty$ increases $k$ declines. in other words at a given length a large species will grow faster than a small species. for example @gislason2008coexistence proposed the relationship
$$k=3.15L_{\infty}^{-0.64}$$
There also appears to be empirical relationship between $t_0$ and $L_{\infty}$ and $k$ i.e.
$$log(-t_0) = -0.3922 - 0.2752 log(L_{\infty}) - 1.038 log(k)$$
Therefore for a value of $L_{\infty}$ or even $L_{max}$ the maximum size observered as
$L_{\infty}=0.95L_{max}$ then all the growth parameters can be recovered.
### Maturity
There is also a relationship between $L_{50}$ the length at which 50% of individuals are mature
$$l_{50}=0.72L_{\infty}^{0.93}$$
and even between the length weight relationship
$$W=aL^b$$
### Natural Mortality
For larger species securing sufficient food to maintain a fast growth rate may entail exposure to a higher natural mortality @gislason2008does. While many small demersal species seem to be partly protected against predation by hiding, cryptic behaviour, being flat or by possessing spines have the lowest rates of natural mortality @griffiths2007natural. Hence, at a given length individuals belonging to species with a high $L_{\infty}$ may generally be exposed to a higher M than individuals belonging to species with a low $L_{\infty}$.
$$ log(M) = 0.55-1.61log(L) + 1.44log(L_{\infty}) + log(k)$$
## Functional forms
In **FLIfe** there are methods for creating growth curves, maturity ogives and natural mortality vectors, selection patterns, and other ogives. All these methods are used to create `FLQuant` objects.
### Growth
gompertz, richards, vonB
```{r growth}
age=FLQuant(0:10,dimnames=list(age=0:10))
lenV=vonB(age,FLPar(linf=120,k=0.1,t0=-0.1))
lenR=richards(age,params=FLPar(linf=100,k=.4,b=.1,m=2))
lenG=gompertz(age,FLPar(linf=100,a=2,k=.4))
ggplot(as.data.frame(FLQuants(Gompertz=lenG,Richards=lenR,"Von Bertalanffy"=lenV)))+
geom_line(aes(age,data,col=qname))
```
### Ogives
dnormal, knife, logistic, sigmoid
```{r, echo=TRUE,eval=FALSE}
dnormal( age,FLPar(a1=4,sl=2,sr=5000))
knife( age,FLPar(a1=4))
logistic(age,FLPar(a50=4,ato95=1,asym=1.0))
sigmoid( age,FLPar(a50=4,ato95=1))
```
### Natural Mortality
Many estimators have been propose for M, based on growth and reproduction, see @kenchington2014natural.
### Natural Mortality
Many estimators have been propose for M, based on growth and reproduction, see @kenchington2014natural.
#### Age at maturity $a_{50}$
Rikhter and Efanov
$$M=\frac{1.521}{a_{50}^{0.72}}-0.155$$
Jensen
$$M=\frac{1.65}{a_{50}}$$
#### Growth
Jensen
$$M=1.5k$$
Griffiths and Harrod
$$M=1.406W_{\infty}^{-0.096}k^{0.78}$$
where $W_{\infty}=\alpha L_{\infty}^{\beta}$
Djabali
$$M=1.0661L_{\infty}^{-0.1172}k^{0.5092}$$
#### Growth and length at maturity $L_{50}$
Roff
$$M=3kL_{\infty}\frac{(1-\frac{L_{50}}{L_{\infty}})}{L_{50}}$$
Rikhter and Efanov
$$M=\frac{\beta k}{e^{k(a_{50}-t_0)}-1}$$
where $a_{50}=t_0+\frac{log(1-\frac{L_{50}}{L_{\infty}})}{-k}$
#### Varing by length
Gislason
$$M_L=1.73L^{-1.61}L_{\infty}^{1.44}k$$
Charnov
$$M_L=k\frac{L_{\infty}}{L}^{1.5}$$
#### Varying by weight
Peterson and Wroblewsk
$$M_W=1.28W^{-0.25}$$
Lorenzen
$$M_W=3W^{-0.288}$$
#### Senescence
### Conversions
ages, len2wt, wt2len
```{r ages,eval=FALSE}
data(ple4)
ages(m(ple4))
```
```{r wt2len,eval=FALSE}
wt2len(stock.wt(ple4),FLPar(a=0.0001,b=3))
```
Generation of missing life history relationships
```{r, echo=TRUE}
par=lhPar(FLPar(linf=100))
par
```
There are relationships between the life history parameters and size, growth, maturation, natural mortality and productivity, as seen in the following.
### Simulation
lhPar, lhEql
## Function Forms
## Population dynamics
### Ecological
leslie, r
#### life history traits
```{r}
data(teleost)
teleost
```
```{r lh, eval=FALSE}
library(glmnet)
t.=cbind(model.frame(teleost)[,-7],as.data.frame(attributes(teleost)[5:9]))
x=model.matrix(~order+genus+family+habitat,t.[,-1])
y=log(as.matrix(t.[,"k"])
fit=glmnet::cv.glmnet(x, y)
plot(fit)
lmb=fit$lambda.1se
coeffs=coef(fit, s="lambda.1se")
fit = glmnet(x, y)
plot(fit, xvar = "lambda", label = TRUE)
```
```
#### Natural Mortality
```{r m-gislason}
m=gislason(FLQuant(1:15,dimnames=list(age=1:15)),teleost)
ggplot(as.data.frame(m))+
geom_line(aes(age,data,col=factor(iter)))+
theme(legend.position="none")+
scale_x_continuous(limits=c(0,15))
```
#### Stock recruitment
```{r}
```
#### Fishery
```{r}
```
### Reference points
lopt, loptAge
### Density Dependence
matdd, mdd
### Parameter estination
moment, powh
### Stationarity
rod
### Random variables
rnoise
### Refetrence points
```{r, echo=TRUE}
library(FLBRP)
data(ple4)
refs(ple4)
```
# Simulation {#Simulation}
## Simulation of equilibrium values and reference points
```{r, echo=TRUE, fig.cap="Age-vectors of growthm natural mortality, maturity and selection pattern"}
library(FLBRP)
eql=lhEql(par)
ggplot(FLQuants(eql,"m","catch.sel","mat","catch.wt"))+
geom_line(aes(age,data))+
facet_wrap(~qname,scale="free")+
scale_x_continuous(limits=c(0,15))
```
```{r, fig.cap="Equilibrium curves and reference points."}
plot(eql)
```
```{r}
lhRef(par)
```
Creation of FLBRP objects
```{r fig2}
data(teleost)
#teleost=with(teleost,l50linf=l50/linf)
teleost=rbind(teleost,l50linf=teleost["l50"]/teleost["linf"])
dimnames(teleost)[[1]][7]="l50linf"
alb=FLPar(unlist(teleost[,"Thunnus alalunga",
c("linf","k","t0","l50","a","b")]))
alb=lhPar(rbind(alb,FLPar(m1=0.15,m2=-0.288,s=0.75)))
```
## Stock recruitment relationships
```{r fig3,fig.cap="Stock recruitment relationships for a steepness of 0.75 and vigin biomass of 1000"}
library(reshape)
srr=FLBRPs("Beverton and Holt" =lhEql(alb,sr="bevholt"),
"Ricker" =lhEql(alb,sr="ricker"),
"Cushing" =lhEql(alb,sr="cushing"),
"Shepherd" =lhEql(rbind(alb,FLPar(c=1.5)),sr="shepherd"),
"Segmented \nRegression"=lhEql(alb,sr="segreg"))
srr=
ldply(srr,function(x) {
refpts(x)=refpts(x)["msy"]
fbar(x)=seq(0,1,length.out=501)
res=brp(x)
subset(model.frame(FLQuants(res,"ssb","rec","catch"),drop=TRUE),ssb>=0)})
ggplot(melt(srr[,-5],id=c("year","ssb",".id")))+
geom_vline(aes(xintercept=200))+
geom_line(aes(ssb,value,col=.id))+
theme_bw()+theme(legend.position="bottom")+
scale_colour_manual("Stock Recruit \n Relationship",
values=c("red","green","yellow","blue","pink"))+
xlab("Spawning Stock Biomass")+ylab("Recruits")
i=0
```
```{r fig4,fig.cap="Production curves, Yield v SSB, for a steepness of 0.75 and vigin biomass of 1000."}
ggplot(melt(srr[,-4],id=c("year","ssb",".id")))+
geom_path(aes(ssb,value,col=.id))+
theme_bw()+theme(legend.position="bottom")+
scale_colour_manual("Stock Recruit \n Relationship",
values=c("red","green","yellow","blue","pink"))+
xlab("Spawning Stock Biomass")+ylab("Yield")
```
```{r fig5,eval=!TRUE,fig.height=3,fig.width=6}
par=lhPar(teleost[c("linf","k","t0","l50","a","b")])
mGislason=function(length,params)
0.55*(length^-1.66)%*%(params["linf"]^1.44)%*%params["k"]
ref=mdply(seq(dim(par)[2]),function(i,par) lhRef(par[,i],m=mGislason),par=par)
dat=ref[dimnames(ref[!is.na(ref[,"rc"]),])[[1]],]
pc=princomp(dat[-122,c("r","rc","lopt","sk")],
cor=TRUE,use="pairwise.complete.obs")
gg=ggbiplot(pc, obs.scale=1, var.scale=1,
ellipse=TRUE, ellipse.prob=.5, circle=FALSE,
groups=factor(family[-122,"what"]) )+
kobe:::theme_ms(12,legend.position="bottom")
gg=gg+geom_point(aes(xvar,yvar),data=gg$data[130,],size=3)
#gg$layers[[2]]=NULL
#gg$layers[[2]]$mapping$colour=NULL
#gg$layers[[3]]$mapping$colour=NULL
gg+theme(legend.position="none")
```
```{r,eval=FALSE}
#alb["t0"]=-alb["t0"]
## Beverton and Holt recruitment
bh =lhEql(alb,m=lorenzen)
refpts(bh)=refpts(bh)["msy",]
p=plot(bh)+theme_bw()+theme(legend.position="bottom")+
scale_colour_manual("",values="red",label="MSY")
```
## Density Dependence
Modelling density dependence in natural mortality and fecundity.
```{r, echo=TRUE, m-density-dependence,fig.cap="Density Dependence in M"}
library(FLBRP)
library(FLife)
data(teleost)
par=teleost[,"Hucho hucho"]
par=lhPar(par)
hutchen=lhEql(par)
scale=stock.n(hutchen)[,25]%*%stock.wt(hutchen)
scale=(stock.n(hutchen)%*%stock.wt(hutchen)%-%scale)%/%scale
m=mdd(stock.wt(hutchen),par=FLPar(m1=.2,m2=-0.288),scale,k=.5)
ggplot(as.data.frame(m))+
geom_line(aes(age,data,col=factor(year)))+
theme(legend.position="none")+
scale_x_continuous(limits=c(0,15))
```
```{r, echo=TRUE, Maturity-density-dependence,fig.cap="Density Dependence in M"}
scale=stock.n(hutchen)[,25]%*%stock.wt(hutchen)
scale=(stock.n(hutchen)%*%stock.wt(hutchen)%-%scale)%/%scale
mat=matdd(ages(scale),par,scale,k=.5)
ggplot(as.data.frame(mat))+
geom_line(aes(age,data,col=factor(year)))+
theme(legend.position="none")+
scale_x_continuous(limits=c(0,15))
```
```{r DD, eval=FALSE}
```
```{r fig6,fig.height=5,fig.width=6,eval=FALSE}
```
## Noise
Methods to simulate random noise with autocorrelation, e.g. by age or cohort
```{r fig9}
data(ple4)
res=rnoise(4,m(ple4)[1:8,ac(1980:2008)],burn=10,b=0.9,what="age")
ggplot()+
geom_point(aes(year,age,size= data),
data=subset(as.data.frame(res),data>0))+
geom_point(aes(year,age,size=-data),
data=subset(as.data.frame(res),data<=0),colour="red")+
scale_size_area(max_size=4, guide="none")+
facet_wrap(~iter)+theme_bw()
```
```{r fig10}
res=rnoise(4,m(ple4)[1:8,ac(1980:2008)],burn=10,b=0.9,what="cohort")
ggplot()+
geom_point(aes(year,age,size= data),
data=subset(as.data.frame(res),
data>0))+
geom_point(aes(year,age,size=-data),
data=subset(as.data.frame(res),
data<=0),colour="red")+
scale_size_area(max_size=4, guide="none")+
facet_wrap(~iter)+theme_bw()
```
```{r fig11, fig.height=6,fig.width=10,eval=FALSE}
k =1
sr ="cushing"
s =0.7
alb =teleost[c("linf","k","t0","l50","a","b"),"Thunnus alalunga"]
alb =lhPar(rbind(alb,FLPar(m1=0.3,m2=-0.288,s=s)))
eq =lhEql(alb,m=lorenzen,sr=sr)
fbar(eq)=FLQuant(rep(1,1001)*refpts(eq)["msy","harvest"])
f =fbar(eq)[,-1]
f =propagate(fbar(eq)[,-1],3)
f[,,,,,2]=0
f[,,,,,3]=f[,,,,,1]*4
stkr=as(eq,"FLStock")
stkr=fwd(stkr,f=f,sr=eq)
ref =stock.n(eq)[,1]
scale=rnoise(1,stock.wt(stkr),sd=0.3,b=0.9,what="cohort")
stkm=stkr
m( stkm)=mdd(iter(stock.wt(stkm),1),alb,scale,k)
stkm=fwd(stkm,f=f,sr=eq)
scale=rnoise(1,stock.wt(stkm),sd=0.3,b=0.9,what="cohort")
stkf=stkr
mat(stkf)=matdd(ages(stock.wt(stkf)),alb,scale,k,TRUE)
stkf=fwd(stkf,f=f,sr=eq)
stkr=fwd(stkr,f=f,sr=eq,sr.residuals=rlnorm(1,iter(f,1)*0,.3))
dat =as.data.frame(FLQuants("SRR"=ssb(stkr),
"M"=ssb(stkm),
"Fecundity"=ssb(stkf)))
fishMat=ddply(subset(dat,year>50),.(iter,qname), transform, val=data/mean(data))
k =1
sr ="cushing"
s =0.7
alb =FLPar(unlist(teleost[teleost$species=="Thunnus alalunga",
c("linf","k","t0","l50","a","b")]))
alb =lhPar(rbind(alb,FLPar(m1=0.3,m2=-0.288,s=s)))
alb[c("a1","sr")]=c(0,5000)
eq =lhEql(alb,m=lorenzen,sr=sr)
fbar(eq)=FLQuant(rep(1,1001)*refpts(eq)["msy","harvest"])
f =fbar(eq)[,-1]
f =propagate(fbar(eq)[,-1],3)
f[,,,,,2]=0
f[,,,,,3]=f[,,,,,1]*4
stkr=as(eq,"FLStock")
stkr=fwd(stkr,f=f,sr=eq)
ref =stock.n(eq)[,1]
scale=rnoise(1,stock.wt(stkr),sd=0.3,b=0.9,what="cohort")
stkm=stkr
m( stkm)=mdd(iter(stock.wt(stkm),1),alb,scale,k)
stkm=fwd(stkm,f=f,sr=eq)
scale=rnoise(1,stock.wt(stkm),sd=0.3,b=0.9,what="cohort")
stkf=stkr
mat(stkf)=matdd(ages(stock.wt(stkf)),alb,scale,k,TRUE)
stkf=fwd(stkf,f=f,sr=eq)
stkr=fwd(stkr,f=f,sr=eq,sr.residuals=rlnorm(1,iter(f,1)*0,.3))
dat =as.data.frame(FLQuants("SRR"=ssb(stkr),
"M"=ssb(stkm),
"Fecundity"=ssb(stkf)))
fishJuv=ddply(subset(dat,year>50),.(iter,qname), transform, val=data/mean(data))
dat=rbind(cbind("Selection"="Juvenile",fishJuv),
cbind("Selection"="Mature", fishMat))
dat=transform(dat,F=factor(paste("F times",c(0,1,3))[iter]))
ggplot(dat)+
geom_line(aes(year,val,col=qname))+
theme_bw()+
theme(legend.position="bottom")+
facet_grid(F~Selection,scale="free_y")+
scale_x_continuous(limits=c(500,700))+
xlab("Time (year)")+ylab("")
```
```{r fig12,fig.width=6,fig.height=6,eval=FALSE,fig.cap="Year effects"}
dat=rbind(cbind("Selection"="Juvenile",fishJuv),
cbind("Selection"="Mature", fishMat))
dat=transform(dat,F=factor(paste("F times",c(0,1,3))[iter]))
dat=ddply(dat,.(Selection,qname,F), with,
# as.data.frame(spectrum(data, spans = c(7,13), log = "dB", ci = 0.8,plot=FALSE)[c("freq","spec")]))
as.data.frame(spectrum(data, log = "dB", ci = 0.8,plot=FALSE)[c("freq","spec")]))
dat=ddply(subset(dat,freq>0.05),.(F,Selection,qname),transform,val=spec/max(spec))
ggplot(dat,aes(freq,val,col=qname))+
geom_smooth(se=FALSE)+
facet_grid(F~Selection,scale="free_y")+
theme_bw()+
theme(legend.position="bottom")
```
```{r fig13, fig.width=10,fig.height=4,eval=FALSE,fig.cap="Cohort Effects"}
library(FLAssess)
stk =iter(stkm[,101:250],1)
m(stk)=iter(m(stkr),1)[,101:250]
vpa =stk+VPA(stk)
p=plot(FLStocks("Actual"=stk,"Model Estimate"=vpa))
p$data=subset(p$data,qname%in%c("SSB","Rec"))
names(p$data)[8]="data"
p$data=ddply(p$data,.(qname), transform, val=data/mean(data))
ggplot(subset(p$data,year>50))+
geom_line(aes(year,val,col=qname))+
facet_grid(qname~stock,scale="free")+
theme_bw()+
theme(legend.position="none")+
xlab("Year")+ylab("")
```
## MSE using empirical HCR
```{r fig14, fig.width=6,fig.height=8,fig.cap="MSE using empirical HCR"}
library(FLife)
library(FLash)
library(FLBRP)
par=lhPar(FLPar(linf=100))
eql=lhEql(par)
mou=as(eql,"FLStock")
mou=FLash::fwd(mou,f=fbar(eql)[,-1]/4,sr=eql)
srDev=rlnorm(100,FLQuant(rep(0,136)),0.3)
om=FLife:::mseSBT1(mou,eql,srDev,
start=dims(mou)$maxyear,end=dims(mou)$maxyear+20,interval=3,
k1=1.5,k2=3.0,gamma=1,nyrs=5,
uDev =0.2)
ggplot()+
geom_line(aes(year,data,col=iter),
data=as.data.frame(FLQuants(iter(om[,ac(95:120)],5:7),c("Rec"=rec,"SSB"=ssb,
"Catch"=catch,"Harvest"=fbar)),drop=T))+
facet_grid(qname~.,scale="free")+
theme_bw()+xlab("")+ylab("")+
theme(legend.position="bottom")
```
[Back to Top](#top)
# Estimation {#Estimation}
Life history parameters can also be used to estimate quantities of use in stock assessment
@beverton1956review developed a method to estimate life history and population parameters length data. e.g.
\begin{equation}Z=K\frac{L_{\infty}-\overline{L}}{\overline{L}-L^\prime} \end{equation}
Based on which @powell1979estimation developed a method, extended by @wetherall1987estimating, to estimate growth and mortality parameters. This assumes that the right hand tail of a length frequency distribution was determined by the asymptotic length $L_{\infty}$ and the ratio between Z and the growth rate k.
The Beverton and Holt methods assumes good estimates for K and $L_{\infty}$, while the Powell-Wetherall method only requires an estimate of K, since $L_{\infty}$ is estimated by the method as well as Z/K.These method therefore provide estimates for each distribution of Z/K, if K is unknown and Z if K is known.
%As well as assuming that growth follows the von Bertalanffy growth function, it is also assumed that the population is in a steady state with constant exponential mortality, no changes in selection pattern of the fishery and constant recruitment. In the Powell-Wetherall method $L^\prime$ can take any value between the smallest and largest sizes. Equation 1 then provides a series of estimates of Z and since
\begin{equation}\overline{L}-L^\prime=a+bL^{\prime} \end{equation}
a and b can be estimated by a regression analysis where
\begin{equation}b=\frac{-K}{Z+K} \end{equation}
\begin{equation}a=-bL_{\infty} \end{equation}
Therefore plotting $\overline{L}-L^\prime$ against $L^\prime$ therefore provides an estimate of $L_{\infty}$ and Z/K
Plotting $\overline{L}-L^\prime$ against $L^\prime$ provides an estimate of $L_{\infty}$ and Z/k, since $L_{\infty}=-a/b$ and $Z/k=\frac{-1-b}{b}$. If k is known then it also provides an estimate of Z (\textbf{Figure} \ref{fig:15}).
```{r}
data(ple4)
ctc=as.data.frame(catch.n(ple4))
dat=cc(age=ctc$age,n=ctc$data)
head(dat)
```
```{r}
library(plyr)
library(dplyr)
data(cas)
pw=ddply(subset(cas), .(year),
function(cas) powh(cas$len,cas$n)$data)
pw=transform(pw, lustrum=(year%/%5)*5,
yr =year-(year%/%5)*5,
weight=ifelse(len>=100&len<=200,1,0))
ggplot(pw)+
geom_line(aes(len,diff,colour=factor(yr),group=year))+
scale_x_continuous(limits=c(0,300)) +
xlab("Length (cm)")+
ylab("Difference between Length and Mean Size")+
geom_smooth(aes(len,diff,weight=weight),
method="lm",col="red",size=1.25,alpha=.1)+
theme_bw()+theme(legend.position="none")
```
### Catch curve analysis
```{r, echo=TRUE}
data(ple4)
ctc=as.data.frame(catch.n(ple4))
ctc=ddply(ctc,.(year), with, cc(age=age,n=data))
ctc=ddply(transform(ctc,decade=factor(10*(year%/%10))),.(decade,age),with,data.frame(sel=mean(sel)))
ggplot(ctc)+
geom_line(aes(age,sel,colour=decade))
```
[Back to Top](#top)
# More Information {#More}
* You can submit bug reports, questions or suggestions on `FLife` at the `FLife` issue page ^[<https://github.com/flr/FLife/issues>], or on the *FLR* mailing list.
* Or send a pull request to <https://github.com/flr/FLife/>
* For more information on the FLR Project for Quantitative Fisheries Science in R, visit the FLR webpage ^[<http://flr-project.org>].
* The latest version of `FLife` can always be installed using the `devtools` package, by calling
```{r, devtools, echo=TRUE, eval=FALSE}
library(devtools)
install_github("flr/FLife")
```
## Software Versions
* `r version$version.string`
* FLCore: `r packageVersion('FLCore')`
* FLPKG: `r # packageVersion('FLPKG')`
* **Compiled**: `r date()`
* **Git Hash**: `r system("git log --pretty=format:'%h' -n 1", intern=TRUE)`
## Author information
**Laurence KELL**. [email protected]
## Acknowledgements
This vignette and many of the methods documented in it were developed under the MyDas project funded by the Irish exchequer and EMFF 2014-2020. The overall aim of MyDas is to develop and test a range of assessment models and methods to establish Maximum Sustainable Yield (MSY) reference points (or proxy MSY reference points) across the spectrum of data-limited stocks.
# References {#References}
[Back to Top](#top)