Fishieries Lab 1

library(FSA)
Warning: package 'FSA' was built under R version 4.4.3
## FSA v0.10.1. See citation('FSA') if used in publication.
## Run fishR() for related website and fishR('IFAR') for related book.
library(readxl)
Warning: package 'readxl' was built under R version 4.4.2
library(FSA)
library(magrittr)
Warning: package 'magrittr' was built under R version 4.4.1
library(dplyr)
Warning: package 'dplyr' was built under R version 4.4.2

Attaching package: 'dplyr'
The following objects are masked from 'package:stats':

    filter, lag
The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union
library(tidyr)
Warning: package 'tidyr' was built under R version 4.4.1

Attaching package: 'tidyr'
The following object is masked from 'package:magrittr':

    extract
library(plotrix)
Warning: package 'plotrix' was built under R version 4.4.3
library(nlstools)
Warning: package 'nlstools' was built under R version 4.4.3

'nlstools' has been loaded.
IMPORTANT NOTICE: Most nonlinear regression models and data set examples
related to predictive microbiolgy have been moved to the package 'nlsMicrobio'
rm(list=ls()) 
getwd()
[1] "C:/Users/Kyle/Documents/fish class"
attribdata<-read_excel("Rainy fish attributes.xlsx", sheet=1, col_names = TRUE)
st <- filter(attribdata,species=="sturgeon")
head(st)
# A tibble: 6 × 12
  Effort  SITE Index_gear_item start_date end_date   species  fish_number
   <dbl> <dbl>           <dbl> <chr>      <chr>      <chr>          <dbl>
1    101     1               2 2018/06/21 2018/06/22 sturgeon           1
2    103     3               2 2018/06/21 2018/06/22 sturgeon           1
3    103     3               2 2018/06/21 2018/06/22 sturgeon           2
4    103     3               2 2018/06/21 2018/06/22 sturgeon           3
5    104     5               1 2018/06/21 2018/06/22 sturgeon           1
6    104     5               1 2018/06/21 2018/06/22 sturgeon           2
# ℹ 5 more variables: fork_length <dbl>, total_length <dbl>, round_wt <dbl>,
#   age <dbl>, sex <chr>
new_st <- na.omit(st)
st_sum <- new_st %>%
summarize(n=n(),val.n=validn(total_length),
mean_tl=round(mean(total_length,na.rm=TRUE),1),
sd_tl=round(sd(total_length,na.rm=TRUE),2),
mean_wt=round(mean(round_wt,na.rm=TRUE),1),
sd_wt=round(sd(round_wt,na.rm=TRUE),2),
mean_age=round(mean(age,na.rm=TRUE),1),
sd_age=round(sd(age,na.rm=TRUE),2))%>%
as.data.frame()
  head(st_sum)
   n val.n mean_tl  sd_tl mean_wt   sd_wt mean_age sd_age
1 31    31   570.1 200.54  1189.7 1117.89        6   4.03
plot(round_wt~total_length, data=st,
     ylim=c(0,max(new_st$round_wt)),xlim=c(100,max(new_st$total_length)),
ylab="round_wt",xlab="total_length",pch=19)

 hist(~age,data=st,xlab="age", ylab ="frequency",
ylim=c(0,500),xlim=c(0,40))

hist(~total_length,data=st,xlab="total length", ylab ="frequency",
ylim=c(0,500),xlim=c(0,1500))

sumBT <- st %>% group_by(age) %>%
summarize(n=validn(total_length),mnlen=mean(total_length,na.rm=TRUE),
selen=se(total_length,na.rm=TRUE)) %>%
as.data.frame()
 head(sumBT,n=10)
   age  n    mnlen     selen
1    0  2 251.0000 57.000000
2    1 75 324.3733  3.850016
3    2 67 410.7313  5.578419
4    3 84 453.5714  4.401836
5    4 71 514.6479  5.900315
6    5 23 541.0870 14.715069
7    6 32 630.4062 10.281998
8    7 29 641.8621 12.649181
9    8 39 694.3590 11.532182
10   9 11 837.6364 36.775306
 conf.level <- 0.95
tcrit <- qt(0.5+conf.level/2,df=sumBT$n-1)
Warning in qt(0.5 + conf.level/2, df = sumBT$n - 1): NaNs produced
sumBT %<>% mutate(LCI=mnlen-tcrit*selen,UCI=mnlen+tcrit*selen)
 headtail(sumBT,n=10)
   age   n     mnlen      selen       LCI       UCI
1    0   2  251.0000  57.000000 -473.2537  975.2537
2    1  75  324.3733   3.850016  316.7020  332.0447
3    2  67  410.7313   5.578419  399.5937  421.8690
4    3  84  453.5714   4.401836  444.8164  462.3265
5    4  71  514.6479   5.900315  502.8801  526.4157
6    5  23  541.0870  14.715069  510.5698  571.6041
7    6  32  630.4062  10.281998  609.4360  651.3765
8    7  29  641.8621  12.649181  615.9514  667.7727
9    8  39  694.3590  11.532182  671.0133  717.7047
10   9  11  837.6364  36.775306  755.6959  919.5769
24  23   4 1141.5000  66.661458  929.3535 1353.6465
25  24   3 1347.0000   6.928203 1317.1903 1376.8097
26  25   4 1292.7500 134.153752  865.8129 1719.6871
27  26   8 1286.1250  32.130002 1210.1496 1362.1004
28  27   4 1296.5000  15.375847 1247.5672 1345.4328
29  28   1 1254.0000         NA        NA        NA
30  29   1 1065.0000         NA        NA        NA
31  31   1 1183.0000         NA        NA        NA
32  32   1 1386.0000         NA        NA        NA
33  NA 148  435.3919  12.127834  411.4245  459.3593
plotCI(sumBT$age,sumBT$mnlen,
li=sumBT$LCI,ui=sumBT$UCI,pch=19,cex=0.7,
xlab="Age (yrs)",ylab="total Length (mm")

males <- new_st %>%
filter(sex %in% c("Male")) 

lm1 <- lm(log(round_wt) ~ log(total_length), data = males)

males %<>% mutate(lwresid=residuals(lm1))
headtail(males,n=10)
    Effort  SITE Index_gear_item start_date   end_date  species fish_number
1      104   5.0               1 2018/06/21 2018/06/22 sturgeon          25
2      105   6.0               1 2018/06/21 2018/06/22 sturgeon          24
3      106   7.0               1 2018/06/21 2018/06/22 sturgeon          10
4      106   7.0               1 2018/06/21 2018/06/22 sturgeon          11
5      111  11.0               1 2018/06/22 2018/06/23 sturgeon           8
6      112  12.0               1 2018/06/22 2018/06/23 sturgeon          20
7      112  12.0               1 2018/06/22 2018/06/23 sturgeon          21
8      123  23.0               1 2018/06/24 2018/06/25 sturgeon           9
9      417 142.0               1 2018/08/10 2018/08/11 sturgeon           3
10     419 145.0               1 2018/08/10 2018/08/11 sturgeon           2
91     417 142.0               1 2018/08/10 2018/08/11 sturgeon           3
101    419 145.0               1 2018/08/10 2018/08/11 sturgeon           2
11     514 202.0               1 2018/08/24 2018/08/25 sturgeon           4
12     540 209.0               1 2018/08/28 2018/08/29 sturgeon           2
13     602   5.5               3 2018/09/11 2018/09/12 sturgeon          16
14     605   7.0               1 2018/09/11 2018/09/12 sturgeon          80
15     605   7.0               1 2018/09/11 2018/09/12 sturgeon          81
16     609  11.0               1 2018/09/12 2018/09/13 sturgeon          18
17     610  11.5               3 2018/09/12 2018/09/13 sturgeon          60
18     611  12.0               1 2018/09/12 2018/09/13 sturgeon          22
    fork_length total_length round_wt age  sex      lwresid
1           538          610     1087   8 Male  0.039154538
2           339          378      234   4 Male -0.005990892
3           604          677     1618   8 Male  0.112306498
4           432          491      515   4 Male -0.031862821
5           360          407      322   4 Male  0.082984803
6           454          514      602   6 Male -0.018372483
7           243          274       88   2 Male  0.018313474
8           349          401      292   3 Male  0.031449700
9           729          821     2853  13 Male  0.078760894
10          809          922     3699  14 Male -0.022951971
91          729          821     2853  13 Male  0.078760894
101         809          922     3699  14 Male -0.022951971
11          601          684     1539   6 Male  0.030206042
12          376          430      309   2 Male -0.129461149
13          575          649     1219   7 Male -0.039282034
14          610          691     1338   8 Male -0.141467086
15          618          698     1599   6 Male  0.005338830
16          723          810     2369   8 Male -0.065124981
17          628          717     1720   8 Male -0.005372992
18          662          752     2133   8 Male  0.061371633

Mortality

frqage<-st %>% group_by(age) %>%
  summarize(n=validn(total_length)) %>%
  as.data.frame()
new_frqage <- na.omit(frqage)

thcr <- chapmanRobson(n~age,data=new_frqage,ages2use=2:30)
Warning: Some 'ages2use' not in observed ages.
cbind(summary(thcr),confint(thcr))
    Estimate Std. Error    95% LCI    95% UCI
S 83.8158872 0.70972392 82.4248538 85.2069205
Z  0.1764763 0.01977275  0.1377224  0.2152302
plot(thcr)

tmp <- filter(new_frqage,age>=1) %>% mutate(lnct=log(n))
lm1 <- lm(lnct~age,data=tmp)
coef(lm1)
(Intercept)         age 
  3.8843550  -0.1252543 
 tmp %<>% mutate(wts=predict(lm1))
 lm2 <- lm(lnct~age,data=tmp,weights=age)
 coef(lm2)
(Intercept)         age 
  3.3398442  -0.0995269 
confint(lm2)
                 2.5 %      97.5 %
(Intercept)  2.5794726  4.10021573
age         -0.1333432 -0.06571057
tmp_cc <- tmp %>%
  filter(age %in% 2:20,
    is.finite(lnct),
    is.finite(age))
thcc <- catchCurve(lnct~age,data=tmp_cc,ages2use=2:20,weighted=TRUE)
cbind(summary(thcc),confint(thcc))
   Estimate Std. Error  t value     Pr(>|t|)    95% LCI    95% UCI
Z 0.0996404 0.01430981 6.963082 2.288385e-06 0.06944933  0.1298315
A 9.4837144         NA       NA           NA 6.70926018 12.1756567
plot(thcc, pos.est="bottomleft")

##male conditions

males <- new_st %>%
  filter(sex %in% c("Male"))

tmp <- filter(males,age>=1) %>% mutate(lnct=log(Effort))
lm1 <- lm(lnct~age,data=tmp)
coef(lm1)
(Intercept)         age 
  4.9163139   0.1020683 
 tmp %<>% mutate(wts=predict(lm1))
 lm2 <- lm(lnct~age,data=tmp,weights=age)
 coef(lm2)
(Intercept)         age 
 5.07844708  0.08219823 
confint(lm2)
                  2.5 %    97.5 %
(Intercept)  4.08868206 6.0682121
age         -0.03013108 0.1945275
tmp_cc <- tmp %>%
  filter(age %in% 1:30,
    is.finite(lnct),
    is.finite(age))
thcc <- catchCurve(lnct~age,data=tmp_cc,ages2use=1:30,weighted=TRUE)
Warning: Some 'ages2use' not in observed ages.
cbind(summary(thcc),confint(thcc))
     Estimate  Std. Error   t value   Pr(>|t|)     95% LCI       95% UCI
Z -0.02231056 0.009086426 -2.455372 0.04942892 -0.04454424 -7.687622e-05
A -2.25613007          NA        NA         NA -4.55512326 -7.687918e-03
plot(thcc, pos.est="bottomleft")

##female conditions

females <- new_st %>%
  filter(sex %in% c("Female"))

tmp <- filter(females,age>=1) %>% mutate(lnct=log(Effort))
lm1 <- lm(lnct~age,data=tmp)
coef(lm1)
(Intercept)         age 
   4.180360    0.141428 
 tmp %<>% mutate(wts=predict(lm1))
 lm2 <- lm(lnct~age,data=tmp,weights=age)
 coef(lm2)
(Intercept)         age 
  4.1095564   0.1472659 
confint(lm2)
                 2.5 %    97.5 %
(Intercept) 2.82230583 5.3968069
age         0.04677209 0.2477597
tmp_cc <- tmp %>%
  filter(age %in% 1:10,
    is.finite(lnct),
    is.finite(age))
thcc <- catchCurve(lnct~age,data=tmp_cc,ages2use=1:10,weighted=TRUE)
Warning: Some 'ages2use' not in observed ages.
cbind(summary(thcc),confint(thcc))
Warning in qt(a, object$df.residual): NaNs produced
   Estimate Std. Error t value Pr(>|t|) 95% LCI 95% UCI
Z 0.0199299        NaN     NaN      NaN     NaN     NaN
A 1.9732610         NA      NA       NA     NaN     NaN
plot(thcc, pos.est="bottomleft")

##Von Bertalanffy Growth Curve

( svTyp <- findGrowthStarts(total_length~age,data=st) )
         Linf             K            t0 
1465.75279075    0.06415392   -2.77911879 
findGrowthStarts(total_length~age,data=st)
         Linf             K            t0 
1465.75279075    0.06415392   -2.77911879 
 svTyp1 <- list(Linf=1193,K=0.13,t0=-2.0)

  vbTyp <- function(age,Linf,K,t0) Linf*(1-exp(-K*(age-t0)))
  vbTyp(3,Linf=1200,K=0.13,t0=-2.0)
[1] 573.5451
   fitTyp <- nls(total_length~vbTyp(age,Linf,K,t0),data=st,start=svTyp)

x <- seq(0,42,length.out=199) 
pTyp <- vbTyp(x,
              Linf = coef(fitTyp)["Linf"],
              K    = coef(fitTyp)["K"],
              t0   = coef(fitTyp)["t0"])
xlmts <- range(c(x,st$age))
ylmts <- range(c(pTyp,st$total_length))
plot(total_length~age,data=st,xlab="Age",ylab="Total Length (mm)",
pch=19,col=rgb(0,0,0,1/3))
 lines(pTyp~x,lwd=2)

plotCI(sumBT$age,sumBT$mnlen,
li=sumBT$LCI,ui=sumBT$UCI,pch=19,cex=0.7,)