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.
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
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
Warning: package 'tidyr' was built under R version 4.4.1
Attaching package: 'tidyr'
The following object is masked from 'package:magrittr':
extract
Warning: package 'plotrix' was built under R version 4.4.3
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'
[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>
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
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
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
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
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 )
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 ,)