In LobsterScience/bio.lobster: Lobster Stock Assessment Tools for DFO Maritimes

knitr::opts_chunk$set(echo = TRUE)

The data in this document is current as of:

format(Sys.Date(),"%Y-%m-%d")

Missing Logs

require(bio.lobster)
require(bio.utilities)
require(ggplot2)
require(devtools)
require(dplyr)
require(tidyr)

la()

lobster.db('annual.landings.redo')
lobster.db('seasonal.landings.redo')
#lobster.db('logs.redo')



v = lobster.db('percent_reporting')
yrm = v$YEARMTH
vv = v %>% select(-YEARMTH) %>% tidyr::gather('Cat','PercMissing')
vv$YEARMTH = rep(yrm, times=ncol(v)-1)
i = grep('PERC',vv$Cat)
vv = vv[i,]
vv$yr = as.numeric(substr(vv$YEARMTH,1,4))
vv$mn = as.numeric(substr(vv$YEARMTH,5,6))
vv$yrmn = paste(month.abb[vv$mn],vv$yr,sep="-")
vv$lfa = gsub("PERCENT","",vv$Cat)
vr = c(paste('Oct',max(vv$yr)-1,sep="-"),
       paste('Nov',max(vv$yr)-1,sep="-"),
       paste('Dec',max(vv$yr)-1,sep="-"),
       paste('Jan',max(vv$yr)-1,sep="-"),
       paste('Feb',max(vv$yr)-1,sep="-"),
       paste('Mar',max(vv$yr)-1,sep="-"),
       paste('Apr',max(vv$yr)-1,sep="-"),
       paste('May',max(vv$yr)-1,sep="-"),
       paste('Jun',max(vv$yr)-1,sep="-"),
       paste('Jul',max(vv$yr)-1,sep="-"))


vv = subset(vv,yrmn %in% vr)
vv$Cats = factor(vv$yrmn,levels=vr)

g = ggplot(vv,aes(x=Cats,y=PercMissing))+geom_bar(stat='identity')+facet_wrap(~lfa)+
  theme(axis.text.x = element_text(angle = 90, hjust= 0,vjust=0.5))+ xlab("")+ylab('Percent Missing Logs (%)')
print(g)

\newpage

Seasonal Landings

  a = lobster.db('seasonal.landings')
      a$SYEAR = as.numeric(substring(a$SYEAR,6,9))
      a = subset(a,!is.na(SYEAR)& SYEAR>1995)
      sa1 = a %>% pivot_longer(cols=starts_with('LFA'),names_to="LFA",values_to='Landings')
      gg = ggplot(sa1,aes(x=SYEAR,y=Landings/1000,fill=factor(SYEAR)))+geom_bar(stat='identity')+
        facet_wrap(~LFA, scales='free_y' )+xlab('Season Year Ending')+ylab('Landings (kt)')
        last_bar_color <- "black"  # Change this to the color you want for the last bar
      bar_colors <- ifelse(sa1$SYEAR <max(sa1$SYEAR), last_bar_color, "orange")

gg+scale_fill_manual(values = bar_colors)+guides(fill=FALSE)

\newpage

Annual Landings

     a = lobster.db('annual.landings')
      a = subset(a,!is.na(YR)& YR>1995)
      sa = a %>% gather(key='LFA',value='Landings',-YR)
      sa = subset(sa,LFA<'LFA33')
      sa = subset(sa,LFA %ni% 'LFA31')
      sa = sa[order(sa$LFA,sa$YR),]
      gg = ggplot(sa,aes(x=YR,y=Landings/1000,fill=factor(YR)))+geom_bar(stat='identity')+
        facet_wrap(~LFA, scales='free_y' )+xlab('Season')+ylab('Landings (kt)')
      last_bar_color <- "black"  # Change this to the color you want for the last bar
      bar_colors <- ifelse(sa$YR <max(sa$YR), last_bar_color, "orange")

gg+scale_fill_manual(values = bar_colors)+guides(fill=FALSE)

\newpage

sl = lobster.db('slips')
inf = lobster.db('inflation')
i = which(sl$PRICE<2)
j = which(sl$PRICE>30)
i = c(i,j)
sl$PRICE[i] = NA
sl = subset(sl, SPECIES_CODE==700 & NIL_REPORT_FLAG=='N') #nil reports still have to be submitted

sl$DYR = lubridate::decimal_date(as.Date(sl$DATE_LANDED)) - lubridate::year(as.Date(sl$DATE_LANDED))
sl$WYR = ceiling(sl$DYR*52)
sl$DWYR = lubridate::year(as.Date(sl$DATE_LANDED)) + sl$WYR/52
sl$MWYR = lubridate::year(as.Date(sl$DATE_LANDED)) + ceiling(sl$DYR*12)/12
sl$YR = lubridate::year(as.Date(sl$DATE_LANDED))

price.data = aggregate(PRICE~DWYR+LFA, data=sl, FUN=function(x) c(mean(x,na.rm=T)))
price.data2 = aggregate(PRICE~MWYR+LFA, data=sl, FUN=function(x) c(mean(x,na.rm=T)))
price.data3 = aggregate(PRICE~YR+LFA, data=sl, FUN=function(x) c(mean(x,na.rm=T)))

sll = bio.utilities::fillNaDf2(sl, price.data, mergeCols=c('DWYR','LFA'),fillCols=c('PRICE'))
slll = bio.utilities::fillNaDf2(sll, price.data2, mergeCols=c('MWYR','LFA'),fillCols=c('PRICE'))
sllll = bio.utilities::fillNaDf2(slll, price.data3, mergeCols=c('YR','LFA'),fillCols=c('PRICE'))
s = sllll

s$mn = lubridate::month(s$DATE_LANDED)
i= which(s$LFA %in% c('33','34','35','36', '38')) 
j = which(s$mn %in% c(10,11,12))
k = intersect(i,j)
s$SYEAR = s$YR
s$SYEAR[k] = s$SYEAR[k]+1
s$Value = s$PRICE * s$SLIP_WEIGHT_LBS

ss = aggregate(Value~LFA+SYEAR,data=s,FUN=sum)
ss$Value = ss$Value/1000
ss$LFA = paste('LFA',ss$LFA,sep="")
ss1 = merge(sa,ss,by.x=c('YR','LFA'),by.y=c('SYEAR','LFA'))

ss2 = merge(sa1,ss,by.x=c('SYEAR','LFA'),by.y=c('SYEAR','LFA'))
ss1 = ss1[order(ss1$LFA,ss1$YR),]

ss2 = ss2[order(ss2$LFA,ss2$SYEAR),]

gg = ggplot(ss1,aes(x=YR,y=Value,fill=factor(YR)))+geom_bar(stat='identity')+
        facet_wrap(~LFA, scales='free_y' )+xlab('Season')+ylab("Value ('000s)")
      last_bar_color <- "black"  # Change this to the color you want for the last bar
      bar_colors1 <- ifelse(ss1$YR <max(ss1$YR), last_bar_color, "orange")

gg2= ggplot(ss2,aes(x=SYEAR,y=Value,fill=factor(SYEAR)))+geom_bar(stat='identity')+
        facet_wrap(~LFA, scales='free_y' )+xlab('Season')+ylab("Value ('000s)")
      last_bar_color <- "black"  # Change this to the color you want for the last bar
      bar_colors2 <- ifelse(ss2$SYEAR <max(ss2$SYEAR), last_bar_color, "orange")

gg+scale_fill_manual(values = bar_colors1)+guides(fill=FALSE)

\newpage

gg2+scale_fill_manual(values = bar_colors2)+guides(fill=FALSE)

\newpage

CPUE

       a = lobster.db('process.logs')
      a = subset(a,SYEAR %in% 2004:2023) 

      aa = split(a,f=list(a$LFA,a$SYEAR))
      cpue.lst<-list()
      m=0
      #by time
      for(i in 1:length(aa)){
        tmp<-aa[[i]]
        tmp = tmp[,c('DATE_FISHED','WEIGHT_KG','NUM_OF_TRAPS')]
        names(tmp)<-c('time','catch','effort')
        tmp$date<-as.Date(tmp$time)
        first.day<-min(tmp$date)
        tmp$time<-julian(tmp$date,origin=first.day-1)
        tmp$time = ceiling(tmp$time/7) #convert to week of season
        if(nrow(tmp)>5){
          m=m+1
        g<-as.data.frame(biasCorrCPUE(tmp,by.time=F))
        g$lfa=unique(aa[[i]]$LFA)
        g$yr = unique(aa[[i]]$SYEAR)
        g = t(g)[,2]
        cpue.lst[[m]] <- g
      }
      }
      cc =as.data.frame(do.call(rbind,cpue.lst))
      cc$CPUE = as.numeric(cc$`biasCorrCPUE(tmp, by.time = F)`)
      cc = cc[order(cc$lfa,cc$yr),]
      cc$yr = as.numeric(cc$yr)
      cc$fyr = as.factor(cc$yr)
      point_colors <- ifelse(cc$yr <max(cc$yr), last_bar_color, "orange")
      cc1 = cc

  ggplot(cc,aes(x=yr,y=CPUE))+geom_point()+
        geom_smooth(se=FALSE)+geom_point(data=cc1,aes(x=yr,y=CPUE,colour=fyr))+facet_wrap(~lfa,scales='free_y')+
      scale_colour_manual(values = point_colors)+theme(legend.position = 'none')

\newpage

  wv = subset(vv,select=c(Cats,Cat,PercMissing)) %>% pivot_wider(names_from = Cat, values_from = PercMissing)
names(wv)[2:ncol(wv)]=sub("PERCENT","",names(wv)[2:ncol(wv)]) 
names(wv)[1] = 'MnYr' 
wv = wv[order(wv$MnYr),]
options(knitr.kable.NA = "--")
  wv %>% 
  knitr::kable(format='pipe',caption='Percent of Missing logbooks')

\newpage

require(kableExtra)
sa = sa %>% pivot_wider(names_from = LFA, values_from = Landings)
options(knitr.kable.NA = "--")
  sa %>% 
  knitr::kable(format='latex',booktabs=T, caption='Annual Commercial Landings. The last row is preliminary (indicated in orange)') %>%
  row_spec(nrow(sa),color='orange')

\newpage

sa1 = sa1 %>% pivot_wider(names_from = LFA, values_from = Landings)
sa1 = sa1[order(sa1$SYEAR),]

  sa1 %>% 
  knitr::kable(format='latex',booktabs=T, caption='Seasonal Commercial Landings. The last row is preliminary (indicated in orange') %>%
  row_spec(nrow(sa1),color='orange')

\newpage

cc$CPUE = round(cc$CPUE,2)
cc = subset(cc,select=c(lfa,yr,CPUE)) %>% pivot_wider(names_from = lfa, values_from = CPUE)


  cc %>% 
  knitr::kable(format='latex',booktabs=T, caption='Raw Commercial Catch Per Unit Effort by Year and LFA. The last row is preliminary (indicated in orange') %>%
  row_spec(nrow(cc),color='orange')