#'
#'@title Get estimated/predicted fishery-related quantities from several model runs
#'
#'@description Function to get estimated/predicted fishery-related quantities from
#'several model runs.
#'
#'@param obj - object that can be converted into a list of tcsam2013.resLst objects
#'@param type - fishery-related quantity to retrieve
#'@param pdfType - type of error distribution for observations
#'@param ci - confidence interval for error bars on observations
#'@param verbose - flag (T/F) to print debug info
#'
#'@details Potential values for 'type' are:
#'\itemize{
#' \item {'bio.retm' - retained catch mortality (1000's t)}
#' \item {'bio.dscm' - discard catch mortality (1000's t) for males in directed fishery}
#' \item {'bio.totm' - total catch mortality (1000's t)}
#' \item {'prNatZ.ret' - annual retained catch proportions-at-size}
#' \item {'prNatZ.tot' - annual total catch proportions-at-size}
#' \item {'PRs.ret' - pearsons residuals for retained catch proportions-at-size}
#' \item {'PRs.tot' - pearsons residuals for total catch proportions-at-size}
#' \item {'mnPrNatZ.ret' - mean proportions-at-size for retained catch data}
#' \item {'mnPrNatZ.tot' - mean proportions-at-size for total catch data}
#' \item {'sel_cxz' - fishery selectivity and retention functions, by time period and sex}
#' \item {'sel_yxz' - fishery selectivity functions, by year and sex}
#' \item {'ret_yxz' - fishery retention functions, by year and sex}
#' \item {'zscores.tot' - annual z-scores for fits to total catch biomass}
#' \item {'zscores.ret' - annual z-scores for fits to retained catch biomass}
#' \item {'effSS.tot' - effective (and input) sample sizes for total catch size comps}
#' \item {'effSS.ret' - effective (and input) sample sizes for retained catch size comps}
#' \item {'qFsh_xy' - annual fishery catchabilities}
#' \item {'maxFc_xy' - annual max capture rates}
#' \item {'max rates' - max fishing mortality, retained mortality, and capture rates}
#' \item {'mean rates' - mean fishing mortality, retained mortality, and capture rates}
#'}
#'Requires sqldf package.
#'
#'@return dataframe in canonical format
#'
#'@export
#'
getMDFR.FisheryQuantities<-function(obj,
type=c("bio.retm","bio.dscm","bio.totm",
"prNatZ.ret","prNatZ.tot",
"PRs.ret","PRs.tot",
"mnPrNatZ.ret","mnPrNatZ.tot",
"sel_cxz","sel_yxz","ret_yxz",
"zscores.tot","zscores.ret",
"effSS.ret","effSS.tot",
"qFsh_xy","maxFc_xy",
"max rates","mean rates"),
ci=0.80,
pdfType=c("norm2","normal","lognormal"),
verbose=FALSE){
options(stringsAsFactors=FALSE);
lst<-convertToListOfResults(obj);
cases<-names(lst);
#set up time info
tinfo<-getTimeInfo(obj);
years <-tinfo$years;
years.m1 <-tinfo$years.m1;
#----------------------------------
# observed and predicted retained catch mortality from fisheries (1000's t)
#----------------------------------
if (type[1]=="bio.retm"){
dfr<-NULL;
for (fsh in c('TCF')){
nmo<-gsub("&&fsh",fsh,"fsh.obs.ret.bio.&&fsh",fixed=TRUE);
nmp<-gsub("&&fsh",fsh,"fsh.mod.ret.bio.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.ret.bio.yrs.&&fsh",fixed=TRUE);
for (case in cases){
#observed
idx <- years.m1[[case]] %in% (lst[[case]]$rep)[[nmy]];
val <-(lst[[case]]$rep)[[paste0(nmo,".M")]];
dfrp<-data.frame(case=case,type='observed',fleet=fsh,
y=(years.m1[[case]])[idx],x='male',m='all',s='all',val=val[idx]);
dfr<-rbind(dfr,dfrp);
#predicted
val <-(lst[[case]]$rep)[[paste0(nmp,".M")]];
dfrp<-data.frame(case=case,type='predicted',fleet=fsh,
y=(years.m1[[case]]),x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'retained';
return(dfrp);
}
#----------------------------------
# observed and predicted total catch mortality from fisheries (1000's t)
#----------------------------------
if (type[1]=="bio.totm"){
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmo<-gsub("&&fsh",fsh,"fsh.obs.totm.bio.&&fsh",fixed=TRUE);
nmp<-gsub("&&fsh",fsh,"fsh.mod.totm.bio.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.totm.bio.yrs.&&fsh",fixed=TRUE);
for (case in cases){
if (fsh!='GTF'){
#observed females
val <-(lst[[case]]$rep)[[paste0(nmo,".F")]];
dfrp<-data.frame(case=case,type='observed',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='female',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#observed males
val <-(lst[[case]]$rep)[[paste0(nmo,".M")]];
dfrp<-data.frame(case=case,type='observed',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#predicted females
val <-(lst[[case]]$rep)[[paste0(nmp,".F")]];
dfrp<-data.frame(case=case,type='predicted',fleet=fsh,
y=(years.m1[[case]]),x='female',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#predicted males
val <-(lst[[case]]$rep)[[paste0(nmp,".M")]];
dfrp<-data.frame(case=case,type='predicted',fleet=fsh,
y=(years.m1[[case]]),x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
} else {
#observed for GTF is males+females
val <-(lst[[case]]$rep)[[paste0(nmo,"")]];
dfrp<-data.frame(case=case,type='observed',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='all',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#predicted
val <-(lst[[case]]$rep)[[paste0(nmp,"")]];
dfrp<-data.frame(case=case,type='predicted',fleet=fsh,
y=(years.m1[[case]]),x='all',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
}
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-"total mortality";
return(dfrp);
}
#----------------------------------
# observed and predicted discard catch mortality from fisheries (1000's t)
#----------------------------------
if (type[1]=="bio.dscm"){
dfr<-NULL;
for (fsh in c('TCF')){
nmo<-gsub("&&fsh",fsh,"fsh.obs.dscm.bio.&&fsh",fixed=TRUE);
nmp<-gsub("&&fsh",fsh,"fsh.mod.dscm.bio.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.totm.bio.yrs.&&fsh",fixed=TRUE);
for (case in cases){
#observed
val <-(lst[[case]]$rep)[[paste0(nmo,".M")]];
dfrp<-data.frame(case=case,type='observed',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#predicted
val <-(lst[[case]]$rep)[[paste0(nmp,".M")]];
dfrp<-data.frame(case=case,type='predicted',fleet=fsh,
y=(years.m1[[case]]),x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'discard mortality';
return(dfrp);
}
#----------------------------------
# observed and predicted fishery total catch size comps
#----------------------------------
if (type[1]=="prNatZ.tot"){
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmo<-gsub("&&fsh",fsh,"fsh.obs.tot.PrNatZ.&&fsh",fixed=TRUE);
nmp<-gsub("&&fsh",fsh,"fsh.mod.tot.PrNatZ.&&fsh",fixed=TRUE);
nmc<-gsub("&&fsh",fsh,"fsh.mod.cap.PrNatZ.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.tot.PrNatZ.yrs.&&fsh",fixed=TRUE);
for (case in cases){
for (x in c('female','male')){
#observed
vals_yz<-(lst[[case]]$rep)[[paste0(nmo,".",toupper(substr(x,1,1)))]];
obsy<-as.character((lst[[case]]$rep)[[nmy]]);
dimnames(vals_yz)<-list(y=obsy,
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(vals_yz,value.name='val');
dfrp<-cbind(case=case,type='observed',fleet=fsh,
x=x,m="all",s="all",dfrp);
dfr<-rbind(dfr,dfrp[,c("case","type","fleet","y","x","m","s","z","val")]);
#predicted
nmm<-paste0(nmp,".",toupper(substr(x,1,1)));
if (lst[[case]]$rep$mod.optFMFit>0) nmm<-paste0(nmc,".",toupper(substr(x,1,1)))
vals_yz<-(lst[[case]]$rep)[[nmm]];
dimnames(vals_yz)<-list(y=as.character(years.m1[[case]]),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(vals_yz,value.name='val');
dfrp<-cbind(case=case,type='predicted',fleet=fsh,
x=x,m="all",s="all",dfrp[dfrp$y %in% obsy,]);
dfr<-rbind(dfr,dfrp[,c("case","type","fleet","y","x","m","s","z","val")]);
rm(obsy);
}#--x
}#--cases
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'total catch size comps';
return(dfrp);
}
#----------------------------------
# observed and predicted fishery retained catch size comps
#----------------------------------
if (type[1]=="prNatZ.ret"){
dfr<-NULL;
for (fsh in c('TCF')){
nmo<-gsub("&&fsh",fsh,"fsh.obs.ret.PrNatZ.&&fsh",fixed=TRUE);
nmp<-gsub("&&fsh",fsh,"fsh.mod.ret.PrNatZ.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.ret.PrNatZ.yrs.&&fsh",fixed=TRUE);
for (case in cases){
for (x in c('male')){
#observed
vals_yz<-(lst[[case]]$rep)[[paste0(nmo,".",toupper(substr(x,1,1)))]];
obsy<-as.character((lst[[case]]$rep)[[nmy]]);
dimnames(vals_yz)<-list(y=obsy,
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(vals_yz,value.name='val');
dfrp<-cbind(case=case,type='observed',fleet=fsh,
x=x,m="all",s="all",dfrp);
dfr<-rbind(dfr,dfrp[,c("case","type","fleet","y","x","m","s","z","val")]);
#predicted
vals_yz<-(lst[[case]]$rep)[[paste0(nmp,".",toupper(substr(x,1,1)))]];
dimnames(vals_yz)<-list(y=as.character(years.m1[[case]]),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(vals_yz,value.name='val');
dfrp<-cbind(case=case,type='predicted',fleet=fsh,
x=x,m="all",s="all",dfrp[dfrp$y %in% obsy,]);
dfr<-rbind(dfr,dfrp[,c("case","type","fleet","y","x","m","s","z","val")]);
rm(obsy);
}#--x
}#--cases
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'retained catch size comps';
return(dfrp);
}
#----------------------------------
# mean total catch size comps from fisheries
#----------------------------------
if (type[1]=="mnPrNatZ.tot"){
#--take mean only over years w/ non-zero observations
dfrp<-getMDFR.FisheryQuantities(obj,type="prNatZ.tot");
dfrpp<-reshape2::dcast(dfrp[dfrp$type=='observed',],formula="case+fleet+y~.",fun.aggregate=sum,value.var='val');
names(dfrpp)[4]<-'val';
qry<-'select p."case",p.type,p.fleet,p.y,p.x,p.m,p.s,p.z,p.val
from dfrp p, dfrpp pp
where p."case"=pp."case" and p.fleet=pp.fleet and p.y=pp.y and pp.val>0;';
dfrp<-sqldf::sqldf(qry);
#--
dfrp1<-reshape2::dcast(dfrp,formula="case+type+fleet+x+m+z~.",fun.aggregate=mean,value.var='val');
names(dfrp1)[7]<-'val';
dfrp2<-reshape2::dcast(dfrp,formula="case+type+fleet+x+m+z~.",fun.aggregate=sd,value.var='val');
names(dfrp2)[7]<-'stdv';
dfrp3<-reshape2::dcast(dfrp,formula="case+type+fleet+x+m+z~.",fun.aggregate=length,value.var='val');
names(dfrp3)[7]<-'N';
cis<-calcCIs(dfrp1$val,sdvs=dfrp2$stdv/sqrt(dfrp3$N),pdfType='normal',ci=0.80)
dfrp<-cbind(dfrp1,lci=cis$lci,uci=cis$uci);
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfrp);
dfrp$process<-'fishery';
dfrp$category<-'total catch mean size comps';
return(dfrp);
}
#----------------------------------
# mean retained catch size comps from fisheries
#----------------------------------
if (type[1]=="mnPrNatZ.ret"){
#--take mean only over years w/ non-zero observations
dfrp<-getMDFR.FisheryQuantities(obj,type="prNatZ.ret");
dfrpp<-reshape2::dcast(dfrp[dfrp$type=='observed',],formula="case+fleet+y~.",fun.aggregate=sum,value.var='val');
names(dfrpp)[4]<-'val';
qry<-'select p."case",p.type,p.fleet,p.y,p.x,p.m,p.s,p.z,p.val
from dfrp p, dfrpp pp
where p."case"=pp."case" and p.fleet=pp.fleet and p.y=pp.y and pp.val>0;';
dfrp<-sqldf::sqldf(qry);
#--
dfrp1<-reshape2::dcast(dfrp,formula="case+type+fleet+x+m+z~.",fun.aggregate=mean,value.var='val');
names(dfrp1)[7]<-'val';
dfrp2<-reshape2::dcast(dfrp,formula="case+type+fleet+x+m+z~.",fun.aggregate=sd,value.var='val');
names(dfrp2)[7]<-'stdv';
dfrp3<-reshape2::dcast(dfrp,formula="case+type+fleet+x+m+z~.",fun.aggregate=length,value.var='val');
names(dfrp3)[7]<-'N';
cis<-calcCIs(dfrp1$val,sdvs=dfrp2$stdv/sqrt(dfrp3$N),pdfType='normal',ci=0.80)
dfrp<-cbind(dfrp1,lci=cis$lci,uci=cis$uci);
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfrp);
dfrp$process<-'fishery';
dfrp$category<-'retained catch mean size comps';
return(dfrp);
}
#----------------------------------
# Pearson's residuals for total catch size comps from fisheries
#----------------------------------
if (type[1]=="PRs.tot"){
dfrp1<-getMDFR.FisheryQuantities(obj,type="prNatZ.tot")
dfrp1<-reshape2::dcast(dfrp1,formula="case+fleet+y+x+m+s+z~type",fun.aggregate=sum,value.var='val')
dfrp1$val<-(dfrp1$observed-dfrp1$predicted)/sqrt((dfrp1$predicted+1.0e-5)*(1-dfrp1$predicted));
dfrp2<-getMDFR.FisheryQuantities(obj,type="effSS.tot");
#--TCF, SCF, RKF fit proportions by sex
fsh<-c('TCF','SCF','RKF');
dfrpp1<-dfrp1[dfrp1$fleet %in% fsh,];
dfrpp2<-dfrp2[dfrp2$fleet %in% fsh,];
qry<-'select
p."case", "Pearsons Residuals" as type, p.fleet,
p.y, p.x, p.m, p.s, p.z, sqrt(s.val)*p.val as val
from
dfrpp2 s, dfrpp1 p
where
s."case"=p."case" and
s.fleet=p.fleet and
s.y=p.y and
s.x=p.x and
s.type="input";';
dfrppp1<-sqldf::sqldf(qry);
#--GTF fits proportions extended over sex
fsh<-c('GTF');
dfrpp1<-dfrp1[dfrp1$fleet %in% fsh,];
dfrpp2<-dfrp2[dfrp2$fleet %in% fsh,];
qry<-'select
p."case", "Pearsons Residuals" as type, p.fleet,
p.y, p.x, p.m, p.s, p.z, sqrt(s.val)*p.val as val
from
dfrpp2 s, dfrpp1 p
where
s."case"=p."case" and
s.fleet=p.fleet and
s.y=p.y and
s.type="input";'
dfrppp2<-sqldf::sqldf(qry);
dfrp<-rbind(dfrppp1,dfrppp2);
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfrp);
dfrp$process<-'fishery';
dfrp$category<-'total catch size comps';
return(dfrp);
}
#----------------------------------
# Pearson's residuals for retained catch size comps from fisheries
#----------------------------------
if (type[1]=="PRs.ret"){
dfrp1<-getMDFR.FisheryQuantities(obj,type="prNatZ.ret")
dfrp1<-reshape2::dcast(dfrp1,formula="case+fleet+y+x+m+s+z~type",fun.aggregate=sum,value.var='val')
dfrp1$val<-(dfrp1$observed-dfrp1$predicted)/sqrt((dfrp1$predicted+1.0e-5)*(1-dfrp1$predicted));
dfrp2<-getMDFR.FisheryQuantities(obj,type="effSS.ret");
qry<-'select
p."case","Pearsons Residuals" as type,p.fleet,
p.y, p.x, p.m, p.s, p.z, sqrt(s.val)*p.val as val
from
dfrp2 s, dfrp1 p
where
s."case"=p."case" and
s.fleet=p.fleet and
s.y=p.y and
s.x=p.x and
s.type="input";'
dfrp<-sqldf::sqldf(qry);
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfrp);
dfrp$process<-'fishery';
dfrp$category<-'retained catch size comps';
return(dfrp);
}
#----------------------------------
#selectivity/retention functions by time period
#----------------------------------
if (type[1]=="sel_cxz"){
dfr<-NULL;
cols.out<-c("case","type","fleet","pc","x","m","s","z","val");
for (fsh in c('TCF','SCF','RKF','GTF')){
nm<-gsub("&&fsh",fsh,"fsh.mod.sel.&&fsh",fixed=TRUE);
for (case in cases){
if (fsh!='TCF'){
#females
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".F")]];
dimnames(sel_cz)<-list(pc=c('1','2','3'),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='female',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
#males
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".M")]];
dimnames(sel_cz)<-list(pc=c('1','2','3'),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='male',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
} else {
#TCF
#--female selectivity
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".F")]];
sel_cz<-array(sel_cz,dim=c(1,length(sel_cz)));
dimnames(sel_cz)<-list(pc=c('1'),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='female',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
#--male selectivity
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".M")]];
dimnames(sel_cz)<-list(pc=as.character(years.m1[[case]]),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='male',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
#--retained selectivity (male only)
sel_cz<-(lst[[case]]$rep)[["fsh.mod.selr.TCF.M"]];
dimnames(sel_cz)<-list(pc=as.character(years.m1[[case]]),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='ret-sel',fleet=fsh,
x='male',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
#--retention functions
ret_cz<-(lst[[case]]$rep)[["fsh.mod.ret.TCF.M"]];
dimnames(ret_cz)<-list(pc=as.character(years.m1[[case]]),
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(ret_cz,value.name='val');
dfrp<-cbind(case=case,type='retention',fleet='TCF',
x='male',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
}
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'selectivity functions';
return(dfrp);
}
#----------------------------------
#selectivity functions by year
#----------------------------------
if (type[1]=="sel_yxz"){
dfr<-NULL;
cols.out<-c("case","type","fleet","y","x","m","s","z","val");
for (fsh in c('TCF','SCF','RKF','GTF')){
nm<-gsub("&&fsh",fsh,"fsh.mod.sel.&&fsh",fixed=TRUE);
for (case in cases){
if (fsh!='TCF'){
#females
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".FEMALE")]];
dimnames(sel_cz)<-list(y=years.m1[[case]],
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='female',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
#males
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".MALE")]];
dimnames(sel_cz)<-list(y=years.m1[[case]],
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='male',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
} else {
#TCF
#--female selectivity
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".FEMALE")]];
dimnames(sel_cz)<-list(y=years.m1[[case]],
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='female',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
#--male selectivity
sel_cz<-(lst[[case]]$rep)[[paste0(nm,".MALE")]];
dimnames(sel_cz)<-list(y=years.m1[[case]],
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(sel_cz,value.name='val');
dfrp<-cbind(case=case,type='selectivity',fleet=fsh,
x='male',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
}
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'selectivity functions';
return(dfrp);
}
#----------------------------------
#retention functions by year
#----------------------------------
if (type[1]=="ret_yxz"){
dfr<-NULL;
cols.out<-c("case","type","fleet","y","x","m","s","z","val");
for (fsh in c('TCF')){
nm<-gsub("&&fsh",fsh,"fsh.mod.sel.&&fsh",fixed=TRUE);
for (case in cases){
#--retention functions
ret_cz<-(lst[[case]]$rep)[["fsh.mod.ret.TCF.MALE"]];
dimnames(ret_cz)<-list(y=years.m1[[case]],
z=as.character(lst[[case]]$rep$mod.zBs));
dfrp<-reshape2::melt(ret_cz,value.name='val');
dfrp<-cbind(case=case,type='retention',fleet='TCF',
x='male',m='all',s='all',dfrp);
dfr<-rbind(dfr,dfrp[,cols.out]);
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'retention functions';
return(dfrp);
}
#----------------------------------
# z-scores for total catch biomass
#----------------------------------
if (type[1]=="zscores.tot"){
if (verbose) cat("Getting total catch biomass z-scores.\n")
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmv<-gsub("&&fsh",fsh,"fsh.bio.zscr.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.totm.bio.yrs.&&fsh",fixed=TRUE);
for (case in cases){
if (fsh!='GTF'){
idx<-years[[case]] %in% (lst[[case]]$rep)[[nmy]];#select only years with observations
#females
val <-(lst[[case]]$rep)[[paste0(nmv,".F")]][idx];
dfrf<-data.frame(case=case,category='total',fleet=fsh,
y=years[[case]][idx],x='female',m='all',s='all',val=val,stringsAsFactors=FALSE);
#males
val <-(lst[[case]]$rep)[[paste0(nmv,".M")]][idx];
dfrm<-data.frame(case=case,category='total',fleet=fsh,
y=years[[case]][idx],x='male',m='all',s='all',val=val,stringsAsFactors=FALSE);
dfr<-rbind(dfr,dfrf,dfrm);
} else {
idx<-years[[case]] %in% (lst[[case]]$rep)[[nmy]];#select only years with observations
val <-(lst[[case]]$rep)[[nmv]][idx];
dfrp<-data.frame(case=case,category='total',fleet=fsh,
y=years[[case]][idx],x='all',m='all',s='all',val=val,stringsAsFactors=FALSE);
dfr<-rbind(dfr,dfrp);
}
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$type<-'z-score';
return(dfrp);
}
#----------------------------------
# z-scores for retained catch biomass
#----------------------------------
if (type[1]=="zscores.ret"){
if (verbose) cat("Getting retained catch biomass z-scores.\n")
dfr<-NULL;
for (case in cases){
idx<-years[[case]] %in% as.numeric((lst[[case]]$rep)[["fsh.obs.ret.bio.yrs.TCF"]]);#select only years with observations
val <-(lst[[case]]$rep)[["fsh.ret.zscr.TCF"]][idx];
dfrp<-data.frame(case=case,category='retained',fleet='TCF',
y=years[[case]][idx],x='male',m='all',s='all',val=val,stringsAsFactors=FALSE);
dfr<-rbind(dfr,dfrp);
}#--case
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$type<-'z-score';
return(dfrp);
}
#----------------------------------
# total catch sample sizes
#----------------------------------
if (type[1]=="effSS.tot"){
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmi<-gsub("&&fsh",fsh,"fsh.inpSS.tot.&&fsh",fixed=TRUE);
nme<-gsub("&&fsh",fsh,"fsh.effSS.McI.tot.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.tot.PrNatZ.yrs.&&fsh",fixed=TRUE);
for (case in cases){
if (fsh!='GTF'){
#input sample sizes
#--females
val <-(lst[[case]]$rep)[[paste0(nmi,".F")]];
dfrp<-data.frame(case=case,type='input',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='female',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#--males
val <-(lst[[case]]$rep)[[paste0(nmi,".M")]];
dfrp<-data.frame(case=case,type='input',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#effective sample sizes (McAllister-Ianelli)
idx<-years[[case]] %in% (lst[[case]]$rep)[[nmy]];#select only years with observations
#--females
val <-(lst[[case]]$rep)[[paste0(nme,".F")]][idx];
dfrp<-data.frame(case=case,type='McAllister-Ianelli',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='female',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#--males
val <-(lst[[case]]$rep)[[paste0(nme,".M")]][idx];
dfrp<-data.frame(case=case,type='McAllister-Ianelli',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
} else {
#input sample sizes
val <-(lst[[case]]$rep)[[nmi]];
dfrp<-data.frame(case=case,type='input',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='all',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#effective sample sizes (McAllister-Ianelli)
idx<-years[[case]] %in% (lst[[case]]$rep)[[nmy]];#select only years with observations
val <-(lst[[case]]$rep)[[nme]][idx];
dfrp<-data.frame(case=case,type='McAllister-Ianelli',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='all',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
}
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'total catch sample sizes';
return(dfrp);
}
#----------------------------------
# retained catch sample sizes
#----------------------------------
if (type[1]=="effSS.ret"){
dfr<-NULL;
for (fsh in c('TCF')){
nmi<-gsub("&&fsh",fsh,"fsh.inpSS.ret.&&fsh",fixed=TRUE);
nme<-gsub("&&fsh",fsh,"fsh.effSS.McI.ret.&&fsh",fixed=TRUE);
nmy<-gsub("&&fsh",fsh,"fsh.obs.ret.PrNatZ.yrs.&&fsh",fixed=TRUE);
for (case in cases){
#input sample sizes
val <-(lst[[case]]$rep)[[nmi]];
dfrp<-data.frame(case=case,type='input',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
#effective sample sizes (McAllister-Ianelli)
idx<-years[[case]] %in% (lst[[case]]$rep)[[nmy]];#select only years with observations
val <-(lst[[case]]$rep)[[nme]][idx];
dfrp<-data.frame(case=case,type='McAllister-Ianelli',fleet=fsh,
y=(lst[[case]]$rep)[[nmy]],x='male',m='all',s='all',val=val);
dfr<-rbind(dfr,dfrp);
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'retained catch sample sizes';
return(dfrp);
}
#----------------------------------
# fishery catchabilities
#----------------------------------
if (type[1]=="qFsh_xy"){
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmcr<-gsub("&&fsh",fsh,"fsh.mod.fcr.fully.selected.&&fsh",fixed=TRUE);
for (case in cases){
#fishery catchability rates
vals<-(lst[[case]]$rep)[[nmcr]];
if (!is.null(vals)){
##males
dfrp<-data.frame(case=case,type="capture",fleet=fsh,
y=years.m1[[case]],x="male",m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
##females
nmpr<-gsub("&&fsh",fsh," pAvgLnF_&&fshF",fixed=TRUE);
pLnF_F<-(lst[[case]]$prs)$value[(lst[[case]]$prs)$name==nmpr];
dfrp<-data.frame(case=case,type="capture",fleet=fsh,
y=years.m1[[case]],x="female",m="all",s="all",val=vals*exp(pLnF_F));
dfr<-rbind(dfr,dfrp);
rm(pLnF_F);
}
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'catchability';
return(dfrp);
}
#----------------------------------
# max fishery capture rates
#----------------------------------
if (type[1]=="qFsh_xy"){
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmcr<-gsub("&&fsh",fsh,"fsh.fcr.max.&&fsh",fixed=TRUE);
for (case in cases){
for (x in c('male','female')){
#fishery capture rates
vals<-(lst[[case]]$rep)[[paste0(nmcr,".",toupper(substr(x,1,1)))]];
if (!is.null(vals)){
dfrp<-data.frame(case=case,type="capture",fleet=fsh,
y=years.m1[[case]],x=x,m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
}
}#--x
}#--case
}#--fsh
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'max capture rate';
return(dfrp);
}
#----------------------------------
# max fishing mortality rates
#----------------------------------
if (type[1]=="max rates"){
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmmr<-gsub("&&fsh",fsh,"fsh.fmr.max.&&fsh",fixed=TRUE);
nmcr<-gsub("&&fsh",fsh,"fsh.fcr.max.&&fsh",fixed=TRUE);
for (case in cases){
for (x in c('male','female')){
#fishing mortality rates
vals<-(lst[[case]]$rep)[[paste0(nmmr,".",toupper(substr(x,1,1)))]];
if (!is.null(vals)){
dfrp<-data.frame(case=case,type="total mortality",fleet=fsh,
y=years.m1[[case]],x=x,m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
}
#fishery capture rates
vals<-(lst[[case]]$rep)[[paste0(nmcr,".",toupper(substr(x,1,1)))]];
if (!is.null(vals)){
dfrp<-data.frame(case=case,type="capture",fleet=fsh,
y=years.m1[[case]],x=x,m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
}
}#--x
}#--case
}#--fsh
#retained mortality
for (case in cases){
for (x in c('male')){
#retained mortality rates in TCF
vals<-(lst[[case]]$rep)[["fsh.rmr.max"]];
dfrp<-data.frame(case=case,type='retained mortality',fleet="TCF",
y=years.m1[[case]],x=x,m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
}#--x
}#--case
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'max fishing mortality rates';
return(dfrp);
}
#----------------------------------
# mean fishing mortality rates
#----------------------------------
if (type[1]=="mean rates"){
dfr<-NULL;
for (fsh in c('TCF','SCF','RKF','GTF')){
nmmr<-gsub("&&fsh",fsh,"fsh.fmr.mean.&&fsh",fixed=TRUE);
nmcr<-gsub("&&fsh",fsh,"fsh.fcr.mean.&&fsh",fixed=TRUE);
for (case in cases){
for (x in c('male','female')){
#fishing mortality rates
vals<-(lst[[case]]$rep)[[paste0(nmmr,".",toupper(substr(x,1,1)))]];
if (!is.null(vals)){
dfrp<-data.frame(case=case,type="total mortality",fleet=fsh,
y=years.m1[[case]],x=x,m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
}
#fishery capture rates
vals<-(lst[[case]]$rep)[[paste0(nmcr,".",toupper(substr(x,1,1)))]];
if (!is.null(vals)){
dfrp<-data.frame(case=case,type="capture",fleet=fsh,
y=years.m1[[case]],x=x,m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
}
}#--x
}#--case
}#--fsh
#retained mortality
for (case in cases){
for (x in c('male')){
#retained mortality rates in TCF
vals<-(lst[[case]]$rep)[["fsh.rmr.mean"]];
dfrp<-data.frame(case=case,type='retained mortality',fleet="TCF",
y=years.m1[[case]],x=x,m="all",s="all",val=vals);
dfr<-rbind(dfr,dfrp);
}#--x
}#--case
dfrp<-rCompTCMs::getMDFR.CanonicalFormat(dfr);
dfrp$process<-'fishery';
dfrp$category<-'mean fishing mortality rates';
return(dfrp);
}
cat("Requested type '",type,"' not found!\n",sep="");
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.