R/plot.frqit.r
In PacificCommunity/ofp-sam-diags4MFCL: R Functions for Presenting MULTIFAN-CL Results and Diagnostics
Defines functions
plot.frqit
Documented in
plot.frqit
#' Plot a frqit::frq object
#'
#' @param Frq.list A list of two Frq objects (for plotting difference) or a single Frq object. The reference model should be listed first.
#' @param Frq.names A vector of character strings naming the models for plotting purposes. If not supplied, model names will be taken from the names in the rep.list (if available) or generated automatically.
#' @param fdesc A data.frame with 7 columns (num,gear_long,method,code,gear,flag,region) and n rows, where n is the number of defined fisheries.
#' @param save.dir Path to the directory where the outputs will be saved
#' @param save.name Name stem for the output, useful when saving many model outputs in the same directory
#' @export
#' @import frqit
#' @import magrittr
#' @importFrom data.table as.data.table
#' @importFrom data.table melt
#' @importFrom data.table rbindlist
#' @importFrom data.table dcast
#' @importFrom data.table setnames
#' @importFrom ggthemes theme_few
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 ggplot
#' @importFrom ggplot2 xlab
#' @importFrom ggplot2 xlim
#' @importFrom ggplot2 ylab
#' @importFrom ggplot2 ggtitle
#' @importFrom ggplot2 facet_wrap
#' @importFrom ggplot2 ggsave
#' @importFrom ggplot2 geom_line
#' @importFrom ggplot2 scale_fill_manual
#' @importFrom ggplot2 geom_text
#' @importFrom ggplot2 geom_point
#' @importFrom ggplot2 geom_bar
#' @importFrom ggplot2 geom_tile
#' @importFrom ggplot2 geom_hline
#' @importFrom ggplot2 scale_color_viridis_c
#' @importFrom ggplot2 scale_fill_gradientn
plot.frqit = function(Frq.list,Frq.names=NULL,fdesc=NULL, save.dir,save.name)
{
# Check and sanitise input Frq arguments and names
frq.list = check.frqit.args(frq=Frq.list, frq.names=Frq.names)
frq.names = names(frq.list)
rainbow.cols = c("#f44336","#e91e63","#9c27b0","#673ab7","#3f51b5","#2196f3","#03a9f4","#00bcd4","#009688","#4caf50","#8bc34a","#cddc39","#ffeb3b","#ffc107","#ff9800")
tmp.fn = function(x,y){return(median(rep(x,round(ifelse(is.na(y),0,y))),na.rm=TRUE))}
if(length(frq.list)>2)
{
dt.list = as.list(rep(NA,length(frq.list)))
names(dt.list) = names(frq.list)
stop("plot.frq is not defined for plotting more than 2 frqit objects")
} else if (length(frq.list)==2){
catch.dt.list = as.list(rep(NA,length(frq.list)))
names(catch.dt.list) = names(frq.list)
ln.dt.list = as.list(rep(NA,length(frq.list)))
names(ln.dt.list) = names(frq.list)
wt.dt.list = as.list(rep(NA,length(frq.list)))
names(wt.dt.list) = names(frq.list)
# exctract data from each frq
for(i in 1:length(frq.list))
{
catch.dt.list[[i]] = data.table::as.data.table(cateffpen(frq.list[[i]])) %>% .[,model:=frq.names[i]]
ln.dt.list[[i]] = data.table::as.data.table(lnfrq(frq.list[[i]])) %>% .[,model:=frq.names[i]]
wt.dt.list[[i]] = data.table::as.data.table(wtfrq(frq.list[[i]])) %>% .[,model:=frq.names[i]]
}
g.catch_diff = data.table::rbindlist(catch.dt.list) %>%
.[,ts:=year+month/12] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Model comparison - Catch") +
ggplot2::geom_line(ggplot2::aes(x=ts,y=catch,color=model),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.effort_diff = data.table::rbindlist(catch.dt.list) %>%
.[,ts:=year+month/12] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Effort") +
ggplot2::ggtitle("Model comparison - Effort") +
ggplot2::geom_line(ggplot2::aes(x=ts,y=effort,color=model),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.penalty_diff = data.table::rbindlist(catch.dt.list) %>%
.[,ts:=year+month/12] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Penalty") +
ggplot2::ggtitle("Model comparison - Penalty") +
ggplot2::geom_line(ggplot2::aes(x=ts,y=penalty,color=model),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.ln_diff = data.table::rbindlist(ln.dt.list) %>% .[,ts:=year+month/12] %>% data.table::melt(.,id.vars=c("ts","year","month","week","fishery","model"),variable.name = "Length",value.name="N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Model comparison - Length composition") +
ggplot2::geom_point(ggplot2::aes(x=ts,y=Length,color=model,size=N),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.wt_diff = data.table::rbindlist(wt.dt.list) %>% .[,ts:=year+month/12] %>% data.table::melt(.,id.vars=c("ts","year","month","week","fishery","model"),variable.name = "Weight",value.name="N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Model comparison - Weight composition") +
ggplot2::geom_point(ggplot2::aes(x=ts,y=Weight,color=model,size=N),alpha=0.5,shape=1) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
# write.out
if(!missing(save.dir))
{
if(missing(save.name))
{
stop("How can you save the output if you haven't specified the directory? Please specify save.dir.")
} else {
if (! dir.exists(save.dir))dir.create(save.dir,recursive=TRUE)
ggplot2::ggsave(paste0(save.name,".catch_diff.png"),plot=g.catch_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".effort_diff.png"),plot=g.effort_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".penalty_diff.png"),plot=g.penalty_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_diff.png"),plot=g.ln_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_diff.png"),plot=g.wt_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
}
}
return(list(catch_diff=g.catch_diff,effort_diff=g.effort_diff,penalty_diff=g.penalty_diff,ln_diff=g.ln_diff,wt_diff=g.wt_diff))
} else {
tmp.frq = frq.list[[1]]
tmp.name = names(frq.list)[1]
# define defaults
if(is.null(fdesc))
{
fdesc = data.frame(num=1:n_fisheries(tmp.frq),gear_long=NA,method=NA,code=NA,gear=NA,flag=NA,region=c(aperm(region_fish(tmp.frq),c(3,1,2,4,5,6))))
fdesc$code = paste0(fdesc$num,".",fdesc$region)
fdesc$name = fdesc$code
} else {
fdesc$name = paste0(fdesc$num,": ",fdesc$code)
}
#____________________________________________________________________________________________________________
# Plot catch
n.fishery = max(fdesc$num)
fishery.data = data_flags(tmp.frq)[1,]
fishery.reg = fdesc$region
cep.dt = data.table::as.data.table(cateffpen(tmp.frq))
g.catch = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
.[,Text:=ifelse(fishery.data[fishery]==0,"N","MT")] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Catch by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=catch,fill=Region),stat="identity") +
ggplot2::scale_fill_manual("Region",values=colorRampPalette(rainbow.cols)(length(unique(fishery.reg)))) +
ggplot2::geom_text(data=data.frame(Fishery=factor(fdesc$name,levels=fdesc$name),ts=min(cep.dt$year+(cep.dt$month/12)+(cep.dt$week/48)),catch=cep.dt[,.(catch=0.9*max(catch)),by=fishery][order(fishery)]$catch,text=ifelse(fishery.data==0,"N","MT")),ggplot2::aes(x=ts,y=catch,label=text),hjust=0,vjust=1)
#____________________________________________________________________________________________________________
# Plot effort
n.fishery = max(fdesc$num)
fishery.data = data_flags(tmp.frq)[1,]
fishery.reg = fdesc$region
cep.dt = data.table::as.data.table(cateffpen(tmp.frq))
g.effort = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Relative Effort") +
ggplot2::ggtitle("Effort by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=effort,fill=Region),stat="identity") +
ggplot2::scale_fill_manual("Region",values=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
#____________________________________________________________________________________________________________
# Plot cpue & penalty weight
cep.dt = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,cpue :=catch/effort] %>% .[,cpue:=ifelse(cpue<0,NA,cpue)]
g.cpue = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
.[,cpue :=catch/effort] %>% .[,cpue:=ifelse(cpue<0,NA,cpue)] %>% merge(.,cep.dt[,.(mean_cpue=mean(cpue,na.rm=TRUE)),by=fishery],by="fishery") %>%
.[,cpue := cpue/mean_cpue] %>% .[,penalty:=ifelse(penalty<0,NA,penalty)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) + ggplot2::ylim(0,NA) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=1) +
ggplot2::xlab("Year") +
ggplot2::ylab("CPUE") +
ggplot2::ggtitle("CPUE by fishery")
if(length(unique(ifelse(cep.dt$penalty<0,NA,cep.dt$penalty)))>1)
{
g.cpue = g.cpue + ggplot2::geom_point(ggplot2::aes(x=ts,y=cpue,fill=penalty),size=2,shape=21) +
ggplot2::scale_fill_viridis_c("Penalty weight")
g.pen = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
.[,penalty:=ifelse(penalty<0,NA,penalty)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) + ggplot2::ylim(0,NA) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=1) +
ggplot2::xlab("Year") +
ggplot2::ylab("CPUE") +
ggplot2::ggtitle("CPUE by fishery") +
ggplot2::geom_point(ggplot2::aes(x=ts,y=penalty,fill=penalty),size=2,shape=21) +
ggplot2::scale_fill_viridis_c("Penalty weight")
# write.out
if(!missing(save.dir))
{
if(missing(save.name))
{
stop("How can you save the output if you haven't specified the directory? Please specify save.dir.")
} else {
if (! dir.exists(save.dir))dir.create(save.dir,recursive=TRUE)
ggplot2::ggsave(paste0(save.name,".png"),plot=g.pen, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
}
}
} else{
g.cpue = g.cpue + ggplot2::geom_point(ggplot2::aes(x=ts,y=cpue),fill="gray70",size=2,shape=21)
g.pen = NULL
}
#____________________________________________________________________________________________________________
# Plot ln data
ln.dt = data.table::as.data.table(lnfrq(tmp.frq))
g.ln_hist_time = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Temporal length composition availability by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=N,fill=Length),stat="identity") +
ggplot2::scale_fill_gradientn("Length",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
ln.dt = data.table::as.data.table(lnfrq(tmp.frq))
g.ln_hist = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>% .[order(fishery,ts,Length)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Length") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Length histogram by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=Length,y=N,fill=ts),stat="identity") +
ggplot2::scale_fill_gradientn("Year",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
ln.dt = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>% .[order(fishery,ts,Length)]
g.ln_heat = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>% .[order(fishery,ts,Length)] %>%
merge(.,ln.dt[,.(maxN=sum(N)),by=.(fishery,ts)],by=c("fishery","ts")) %>% .[,N:=N/maxN] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Length") +
ggplot2::ggtitle("Mean length by fishery") +
ggplot2::geom_tile(ggplot2::aes(x=ts,y=Length,color=N),stat="identity") +
# ggplot2::geom_line(data=ln.dt[,.(num=sum(Length*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),color="hotpink") +
# ggplot2::geom_point(data=ln.dt[,.(num=sum(Length*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),fill="hotpink",shape=21,size=1) +
ggplot2::geom_line(data=ln.dt[,.(med=tmp.fn(Length,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),color="hotpink") +
ggplot2::geom_point(data=ln.dt[,.(med=tmp.fn(Length,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),fill="hotpink",shape=21,size=1) +
ggplot2::scale_color_viridis_c("Proportion of observations",trans="logit")
#____________________________________________________________________________________________________________
# Plot wt data
wt.dt = data.table::as.data.table(wtfrq(tmp.frq))
g.wt_hist_time = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Temporal weight composition availability by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=N,fill=Weight),stat="identity") +
ggplot2::scale_fill_gradientn("Weight",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
wt.dt = data.table::as.data.table(wtfrq(tmp.frq))
g.wt_hist = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>% .[order(fishery,ts,Weight)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Weight") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Weight histogram by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=Weight,y=N,fill=ts),stat="identity") +
ggplot2::scale_fill_gradientn("Year",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
wt.dt = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>% .[order(fishery,ts,Weight)]
g.wt_heat = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>% .[order(fishery,ts,Weight)] %>%
merge(.,wt.dt[,.(maxN=sum(N)),by=.(fishery,ts)],by=c("fishery","ts")) %>% .[,N:=N/maxN] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Weight") +
ggplot2::ggtitle("Mean weight by fishery") +
ggplot2::geom_tile(ggplot2::aes(x=ts,y=Weight,color=N),stat="identity") +
# ggplot2::geom_line(data=wt.dt[,.(num=sum(Weight*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),color="hotpink") +
# ggplot2::geom_point(data=wt.dt[,.(num=sum(Weight*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),fill="hotpink",shape=21,size=1) +
ggplot2::geom_line(data=wt.dt[,.(med=tmp.fn(Weight,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),color="hotpink") +
ggplot2::geom_point(data=wt.dt[,.(med=tmp.fn(Weight,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),fill="hotpink",shape=21,size=1) +
ggplot2::scale_color_viridis_c("Proportion of observations",trans="logit")
# write.out
if(!missing(save.dir))
{
if(missing(save.name))
{
stop("How can you save the output if you haven't specified the directory? Please specify save.dir.")
} else {
if (! dir.exists(save.dir))dir.create(save.dir,recursive=TRUE)
ggplot2::ggsave(paste0(save.name,".catch.png"),plot=g.catch, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".effort.png"),plot=g.effort, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".cpue.png"),plot=g.cpue, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_hist_time.png"),plot=g.ln_hist_time, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_hist.png"),plot=g.ln_hist, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_heat.png"),plot=g.ln_heat, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_hist_time.png"),plot=g.wt_hist_time, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_hist.png"),plot=g.wt_hist, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_heat.png"),plot=g.wt_heat, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
}
}
return(list(catch=g.catch,effort=g.effort,cpue=g.cpue,pen=g.pen,ln_hist_time=g.ln_hist_time,ln_hist=g.ln_hist,ln_heat=g.ln_heat,
wt_hist_time=g.wt_hist_time,wt_hist=g.wt_hist,wt_heat=g.wt_heat))
}
}
PacificCommunity/ofp-sam-diags4MFCL documentation built on Oct. 11, 2023, 1:32 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions plot.frqit
Documented in plot.frqit
#' Plot a frqit::frq object
#'
#' @param Frq.list A list of two Frq objects (for plotting difference) or a single Frq object. The reference model should be listed first.
#' @param Frq.names A vector of character strings naming the models for plotting purposes. If not supplied, model names will be taken from the names in the rep.list (if available) or generated automatically.
#' @param fdesc A data.frame with 7 columns (num,gear_long,method,code,gear,flag,region) and n rows, where n is the number of defined fisheries.
#' @param save.dir Path to the directory where the outputs will be saved
#' @param save.name Name stem for the output, useful when saving many model outputs in the same directory
#' @export
#' @import frqit
#' @import magrittr
#' @importFrom data.table as.data.table
#' @importFrom data.table melt
#' @importFrom data.table rbindlist
#' @importFrom data.table dcast
#' @importFrom data.table setnames
#' @importFrom ggthemes theme_few
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 ggplot
#' @importFrom ggplot2 xlab
#' @importFrom ggplot2 xlim
#' @importFrom ggplot2 ylab
#' @importFrom ggplot2 ggtitle
#' @importFrom ggplot2 facet_wrap
#' @importFrom ggplot2 ggsave
#' @importFrom ggplot2 geom_line
#' @importFrom ggplot2 scale_fill_manual
#' @importFrom ggplot2 geom_text
#' @importFrom ggplot2 geom_point
#' @importFrom ggplot2 geom_bar
#' @importFrom ggplot2 geom_tile
#' @importFrom ggplot2 geom_hline
#' @importFrom ggplot2 scale_color_viridis_c
#' @importFrom ggplot2 scale_fill_gradientn
plot.frqit = function(Frq.list,Frq.names=NULL,fdesc=NULL, save.dir,save.name)
{
# Check and sanitise input Frq arguments and names
frq.list = check.frqit.args(frq=Frq.list, frq.names=Frq.names)
frq.names = names(frq.list)
rainbow.cols = c("#f44336","#e91e63","#9c27b0","#673ab7","#3f51b5","#2196f3","#03a9f4","#00bcd4","#009688","#4caf50","#8bc34a","#cddc39","#ffeb3b","#ffc107","#ff9800")
tmp.fn = function(x,y){return(median(rep(x,round(ifelse(is.na(y),0,y))),na.rm=TRUE))}
if(length(frq.list)>2)
{
dt.list = as.list(rep(NA,length(frq.list)))
names(dt.list) = names(frq.list)
stop("plot.frq is not defined for plotting more than 2 frqit objects")
} else if (length(frq.list)==2){
catch.dt.list = as.list(rep(NA,length(frq.list)))
names(catch.dt.list) = names(frq.list)
ln.dt.list = as.list(rep(NA,length(frq.list)))
names(ln.dt.list) = names(frq.list)
wt.dt.list = as.list(rep(NA,length(frq.list)))
names(wt.dt.list) = names(frq.list)
# exctract data from each frq
for(i in 1:length(frq.list))
{
catch.dt.list[[i]] = data.table::as.data.table(cateffpen(frq.list[[i]])) %>% .[,model:=frq.names[i]]
ln.dt.list[[i]] = data.table::as.data.table(lnfrq(frq.list[[i]])) %>% .[,model:=frq.names[i]]
wt.dt.list[[i]] = data.table::as.data.table(wtfrq(frq.list[[i]])) %>% .[,model:=frq.names[i]]
}
g.catch_diff = data.table::rbindlist(catch.dt.list) %>%
.[,ts:=year+month/12] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Model comparison - Catch") +
ggplot2::geom_line(ggplot2::aes(x=ts,y=catch,color=model),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.effort_diff = data.table::rbindlist(catch.dt.list) %>%
.[,ts:=year+month/12] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Effort") +
ggplot2::ggtitle("Model comparison - Effort") +
ggplot2::geom_line(ggplot2::aes(x=ts,y=effort,color=model),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.penalty_diff = data.table::rbindlist(catch.dt.list) %>%
.[,ts:=year+month/12] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Penalty") +
ggplot2::ggtitle("Model comparison - Penalty") +
ggplot2::geom_line(ggplot2::aes(x=ts,y=penalty,color=model),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.ln_diff = data.table::rbindlist(ln.dt.list) %>% .[,ts:=year+month/12] %>% data.table::melt(.,id.vars=c("ts","year","month","week","fishery","model"),variable.name = "Length",value.name="N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Model comparison - Length composition") +
ggplot2::geom_point(ggplot2::aes(x=ts,y=Length,color=model,size=N),alpha=0.5) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
g.wt_diff = data.table::rbindlist(wt.dt.list) %>% .[,ts:=year+month/12] %>% data.table::melt(.,id.vars=c("ts","year","month","week","fishery","model"),variable.name = "Weight",value.name="N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() +
ggplot2::facet_wrap(~fishery,scales="free_y",drop=FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Model comparison - Weight composition") +
ggplot2::geom_point(ggplot2::aes(x=ts,y=Weight,color=model,size=N),alpha=0.5,shape=1) +
ggplot2::scale_color_manual("Model",values=c("blue","red"))
# write.out
if(!missing(save.dir))
{
if(missing(save.name))
{
stop("How can you save the output if you haven't specified the directory? Please specify save.dir.")
} else {
if (! dir.exists(save.dir))dir.create(save.dir,recursive=TRUE)
ggplot2::ggsave(paste0(save.name,".catch_diff.png"),plot=g.catch_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".effort_diff.png"),plot=g.effort_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".penalty_diff.png"),plot=g.penalty_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_diff.png"),plot=g.ln_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_diff.png"),plot=g.wt_diff, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
}
}
return(list(catch_diff=g.catch_diff,effort_diff=g.effort_diff,penalty_diff=g.penalty_diff,ln_diff=g.ln_diff,wt_diff=g.wt_diff))
} else {
tmp.frq = frq.list[[1]]
tmp.name = names(frq.list)[1]
# define defaults
if(is.null(fdesc))
{
fdesc = data.frame(num=1:n_fisheries(tmp.frq),gear_long=NA,method=NA,code=NA,gear=NA,flag=NA,region=c(aperm(region_fish(tmp.frq),c(3,1,2,4,5,6))))
fdesc$code = paste0(fdesc$num,".",fdesc$region)
fdesc$name = fdesc$code
} else {
fdesc$name = paste0(fdesc$num,": ",fdesc$code)
}
#____________________________________________________________________________________________________________
# Plot catch
n.fishery = max(fdesc$num)
fishery.data = data_flags(tmp.frq)[1,]
fishery.reg = fdesc$region
cep.dt = data.table::as.data.table(cateffpen(tmp.frq))
g.catch = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
.[,Text:=ifelse(fishery.data[fishery]==0,"N","MT")] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Catch") +
ggplot2::ggtitle("Catch by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=catch,fill=Region),stat="identity") +
ggplot2::scale_fill_manual("Region",values=colorRampPalette(rainbow.cols)(length(unique(fishery.reg)))) +
ggplot2::geom_text(data=data.frame(Fishery=factor(fdesc$name,levels=fdesc$name),ts=min(cep.dt$year+(cep.dt$month/12)+(cep.dt$week/48)),catch=cep.dt[,.(catch=0.9*max(catch)),by=fishery][order(fishery)]$catch,text=ifelse(fishery.data==0,"N","MT")),ggplot2::aes(x=ts,y=catch,label=text),hjust=0,vjust=1)
#____________________________________________________________________________________________________________
# Plot effort
n.fishery = max(fdesc$num)
fishery.data = data_flags(tmp.frq)[1,]
fishery.reg = fdesc$region
cep.dt = data.table::as.data.table(cateffpen(tmp.frq))
g.effort = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Relative Effort") +
ggplot2::ggtitle("Effort by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=effort,fill=Region),stat="identity") +
ggplot2::scale_fill_manual("Region",values=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
#____________________________________________________________________________________________________________
# Plot cpue & penalty weight
cep.dt = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,cpue :=catch/effort] %>% .[,cpue:=ifelse(cpue<0,NA,cpue)]
g.cpue = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
.[,cpue :=catch/effort] %>% .[,cpue:=ifelse(cpue<0,NA,cpue)] %>% merge(.,cep.dt[,.(mean_cpue=mean(cpue,na.rm=TRUE)),by=fishery],by="fishery") %>%
.[,cpue := cpue/mean_cpue] %>% .[,penalty:=ifelse(penalty<0,NA,penalty)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) + ggplot2::ylim(0,NA) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=1) +
ggplot2::xlab("Year") +
ggplot2::ylab("CPUE") +
ggplot2::ggtitle("CPUE by fishery")
if(length(unique(ifelse(cep.dt$penalty<0,NA,cep.dt$penalty)))>1)
{
g.cpue = g.cpue + ggplot2::geom_point(ggplot2::aes(x=ts,y=cpue,fill=penalty),size=2,shape=21) +
ggplot2::scale_fill_viridis_c("Penalty weight")
g.pen = data.table::as.data.table(cateffpen(tmp.frq)) %>% .[,ts:=year+(month/12)+(week/48)] %>% .[,Region:=fishery.reg[fishery]] %>%
.[,Region := factor(as.character(Region),levels=as.character(sort(unique(Region))))] %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>%
.[,penalty:=ifelse(penalty<0,NA,penalty)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop=FALSE) + ggplot2::ylim(0,NA) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=1) +
ggplot2::xlab("Year") +
ggplot2::ylab("CPUE") +
ggplot2::ggtitle("CPUE by fishery") +
ggplot2::geom_point(ggplot2::aes(x=ts,y=penalty,fill=penalty),size=2,shape=21) +
ggplot2::scale_fill_viridis_c("Penalty weight")
# write.out
if(!missing(save.dir))
{
if(missing(save.name))
{
stop("How can you save the output if you haven't specified the directory? Please specify save.dir.")
} else {
if (! dir.exists(save.dir))dir.create(save.dir,recursive=TRUE)
ggplot2::ggsave(paste0(save.name,".png"),plot=g.pen, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
}
}
} else{
g.cpue = g.cpue + ggplot2::geom_point(ggplot2::aes(x=ts,y=cpue),fill="gray70",size=2,shape=21)
g.pen = NULL
}
#____________________________________________________________________________________________________________
# Plot ln data
ln.dt = data.table::as.data.table(lnfrq(tmp.frq))
g.ln_hist_time = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Temporal length composition availability by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=N,fill=Length),stat="identity") +
ggplot2::scale_fill_gradientn("Length",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
ln.dt = data.table::as.data.table(lnfrq(tmp.frq))
g.ln_hist = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>% .[order(fishery,ts,Length)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Length") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Length histogram by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=Length,y=N,fill=ts),stat="identity") +
ggplot2::scale_fill_gradientn("Year",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
ln.dt = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>% .[order(fishery,ts,Length)]
g.ln_heat = data.table::as.data.table(lnfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Length",value.name = "N") %>%
.[,Length:=as.numeric(as.character(Length))] %>% .[N>0] %>% .[order(fishery,ts,Length)] %>%
merge(.,ln.dt[,.(maxN=sum(N)),by=.(fishery,ts)],by=c("fishery","ts")) %>% .[,N:=N/maxN] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Length") +
ggplot2::ggtitle("Mean length by fishery") +
ggplot2::geom_tile(ggplot2::aes(x=ts,y=Length,color=N),stat="identity") +
# ggplot2::geom_line(data=ln.dt[,.(num=sum(Length*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),color="hotpink") +
# ggplot2::geom_point(data=ln.dt[,.(num=sum(Length*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),fill="hotpink",shape=21,size=1) +
ggplot2::geom_line(data=ln.dt[,.(med=tmp.fn(Length,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),color="hotpink") +
ggplot2::geom_point(data=ln.dt[,.(med=tmp.fn(Length,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),fill="hotpink",shape=21,size=1) +
ggplot2::scale_color_viridis_c("Proportion of observations",trans="logit")
#____________________________________________________________________________________________________________
# Plot wt data
wt.dt = data.table::as.data.table(wtfrq(tmp.frq))
g.wt_hist_time = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Temporal weight composition availability by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=ts,y=N,fill=Weight),stat="identity") +
ggplot2::scale_fill_gradientn("Weight",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
wt.dt = data.table::as.data.table(wtfrq(tmp.frq))
g.wt_hist = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>% .[order(fishery,ts,Weight)] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Weight") +
ggplot2::ylab("Observations") +
ggplot2::ggtitle("Weight histogram by fishery") +
ggplot2::geom_bar(ggplot2::aes(x=Weight,y=N,fill=ts),stat="identity") +
ggplot2::scale_fill_gradientn("Year",colors=colorRampPalette(rainbow.cols)(length(unique(fishery.reg))))
wt.dt = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>% .[order(fishery,ts,Weight)]
g.wt_heat = data.table::as.data.table(wtfrq(tmp.frq)) %>% .[,Fishery := factor(fdesc$name[fishery],levels=fdesc$name)] %>% .[,ts:=year+(month/12)+(week/48)] %>%
data.table::melt(.,id.vars=c("ts","year","month","week","fishery","Fishery"),variable.name = "Weight",value.name = "N") %>%
.[,Weight:=as.numeric(as.character(Weight))] %>% .[N>0] %>% .[order(fishery,ts,Weight)] %>%
merge(.,wt.dt[,.(maxN=sum(N)),by=.(fishery,ts)],by=c("fishery","ts")) %>% .[,N:=N/maxN] %>%
ggplot2::ggplot() + ggthemes::theme_few() + ggplot2::facet_wrap(~Fishery,scales="free_y",drop = FALSE) +
ggplot2::xlim(tail(range(tmp.frq),n=2)[1],tail(range(tmp.frq),n=2)[2]+1) +
ggplot2::geom_hline(yintercept=0) +
ggplot2::xlab("Year") +
ggplot2::ylab("Weight") +
ggplot2::ggtitle("Mean weight by fishery") +
ggplot2::geom_tile(ggplot2::aes(x=ts,y=Weight,color=N),stat="identity") +
# ggplot2::geom_line(data=wt.dt[,.(num=sum(Weight*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),color="hotpink") +
# ggplot2::geom_point(data=wt.dt[,.(num=sum(Weight*N),denom=sum(N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=num/denom),fill="hotpink",shape=21,size=1) +
ggplot2::geom_line(data=wt.dt[,.(med=tmp.fn(Weight,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),color="hotpink") +
ggplot2::geom_point(data=wt.dt[,.(med=tmp.fn(Weight,N)),by=.(ts,Fishery)],ggplot2::aes(x=ts,y=med),fill="hotpink",shape=21,size=1) +
ggplot2::scale_color_viridis_c("Proportion of observations",trans="logit")
# write.out
if(!missing(save.dir))
{
if(missing(save.name))
{
stop("How can you save the output if you haven't specified the directory? Please specify save.dir.")
} else {
if (! dir.exists(save.dir))dir.create(save.dir,recursive=TRUE)
ggplot2::ggsave(paste0(save.name,".catch.png"),plot=g.catch, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".effort.png"),plot=g.effort, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".cpue.png"),plot=g.cpue, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_hist_time.png"),plot=g.ln_hist_time, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_hist.png"),plot=g.ln_hist, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".ln_heat.png"),plot=g.ln_heat, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_hist_time.png"),plot=g.wt_hist_time, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_hist.png"),plot=g.wt_hist, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
ggplot2::ggsave(paste0(save.name,".wt_heat.png"),plot=g.wt_heat, device = "png", path = save.dir,scale = 1, width = 16, height = 9, units = c("in"))
}
}
return(list(catch=g.catch,effort=g.effort,cpue=g.cpue,pen=g.pen,ln_hist_time=g.ln_hist_time,ln_hist=g.ln_hist,ln_heat=g.ln_heat,
wt_hist_time=g.wt_hist_time,wt_hist=g.wt_hist,wt_heat=g.wt_heat))
}
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.