#FLR4MFCL - R4MFCL built with FLR classes
#Copyright (C) 2018 Rob Scott
## #' @rdname FLQuant
## #' @aliases FLQuant,MFCLLenFreq-method
setMethod("FLQuant", signature(object="MFCLLenFreq"),
function(object, data='catch', ...) {
quant <- switch(data, "catch" = "all",
"effort"= "all",
"length"= "length",
"weight"= "weight")
if(data=='catch' | data=='effort'){
dd <- cbind(quant, realisations(object)[,c('year','fishery','month')], 'unique', 1, realisations(object)[,data])
colnames(dd) <- colnames(as.data.frame(FLQuant()))
return(as.FLQuant(dd))
}
if(data=="length" | data=='weight'){
dd <- cbind(freq(object)[,c(quant,'year','fishery','month')], 'unique', 1, freq(object)[,'freq'])
colnames(dd) <- c(quant, colnames(as.data.frame(FLQuant()))[-1])
return(as.FLQuant(dd))
}
}
) # }}}
setMethod("FLQuant", signature(object="MFCLLenFreq2"),
function(object, data='catch', ...) {
quant <- switch(data, "catch" = "all",
"effort"= "all",
"length"= "length",
"weight"= "weight")
if(data=='catch' | data=='effort'){
dd <- cbind(quant, realisations(object)[,c('year','fishery','month')], 'unique', 1, realisations(object)[,data])
colnames(dd) <- colnames(as.data.frame(FLQuant()))
return(as.FLQuant(dd))
}
if(data=="length"){
## if(data=="length" | data=='weight'){
## dd <- cbind(freq(object)[,c(quant,'year','fishery','month')], 'unique', 1, freq(object)[,'freq'])
## colnames(dd) <- c(quant, colnames(as.data.frame(FLQuant()))[-1])
lnfrq <- lnfrq(object)
nobs=dim(lnfrq)[1]
nLbins <- lf_range(object)['LFIntervals']; Lwidth <- lf_range(res)["LFWidth"]; Lfirst <- lf_range(res)["LFFirst"]
frqlen <- seq(Lfirst, Lwidth*nLbins+Lfirst-Lwidth, by=Lwidth)
dd <- cbind(rep(frqlen,nobs),rep(lnfrq$year,each=nLbins),rep(lnfrq$fishery,each=nLbins),rep(lnfrq$month,each=nLbins),'unique',1,unlist(lnfrq[,-4:-1]))
colnames(dd) <- c(quant, colnames(as.data.frame(FLQuant()))[-1])
return(as.FLQuant(dd))
}
if(data=='weight'){
wtfrq <- wtfrq(object)
nWbins <- lf_range(res)['WFIntervals']; Wwidth <- lf_range(res)["WFWidth"]; Wfirst <- lf_range(res)["WFFirst"]
frqwt <- seq(Wfirst, Wwidth*nWbins+Wfirst-Wwidth, by=Wwidth)
dd <- cbind(rep(frqwt,nobs),rep(wtfrq$year,each=nWbins),rep(wtfrq$fishery,each=nWbins),rep(wtfrq$month,each=nWbins),'unique',1,unlist(wtfrq[,-4:-1]))
return(as.FLQuant(dd))
}
}
) # }}}
#' qts
#'
#' Returns a quarterly time series from a seasonally structured FLQuant.
#'
#' @param quant An FLQuant object.
#'
#' @return An object of class FLQuant.
#'
#' @examples
#' data(ple4)
#' qts(stock.n(ple4))
#'
#' @export
qts <- function(quant){
if(!is.FLQuant(quant))
stop('quant must be an object of class FLQuant')
ssns <- dim(quant)[4]
if(ssns<=1){
warning("object has only 1 season: nothing changed")
return(quant)
}
#q2 <- aperm(quant, c(4,2,1,3,5,6))
q2 <- aperm(quant, c(1,4,2,3,5,6)) ## RDS 16/03/2021
#q3 <- array(c(q2), dim=c(dim(q2)[3], dim(q2)[1]*dim(q2)[2], dim(q2)[4], 1, dim(q2)[5:6]))
q3 <- array(c(q2), dim=c(dim(q2)[1], dim(q2)[2]*dim(q2)[3], dim(q2)[4], 1, dim(q2)[5:6])) ## RDS 16/03/2021
# dirty hack to force the first dimension to be age - not ideal but OK for now I think
names(dimnames(quant))[1] <- "age"
dimnames(q3) <- list(age = dimnames(quant)$age,
year= as.character(rep(as.numeric(dimnames(quant)$year),each=ssns)+(1/(2*ssns))*seq(1, by=2, length.out=ssns)),
unit= dimnames(quant)$unit,
season="all",
area= dimnames(quant)$area,
iter= dimnames(quant)$iter)
return(as.FLQuant(q3))
}
# testing qts
#aa <- array(rep(1:30, 4)+rep(c(0.125,0.375,0.625,0.875), each=30), dim=c(5,6,1,4,1))
#tt <- FLQuant(aa, dimnames=list(age=1:5, year=1:6, unit='unique', season=1:4, area='all'))
#qts(tt)
#' ats
#'
#' Converts a quarterly time series object into a 6 dimensional, seasonally structured FLQuant (i.e. the opposite of qts).
#'
#' @param quant An FLQuant object.
#'
#' @return An object of class FLQuant.
#'
#' @export
ats <- function(quant){
if(!is.FLQuant(quant))
stop('quant must be an object of class FLQuant')
ssns <- unique(as.numeric(unlist(dimnames(quant)['year']))-floor(as.numeric(unlist(dimnames(quant)['year']))))
if(length(ssns)<=1){
warning("object has only 1 season: nothing changed")
return(quant)
}
qdf <- as.data.frame(quant)
for(ss in 1:length(ssns))
qdf$new.season[qdf$year-floor(qdf$year)==ssns[ss]] <- factor(ss, levels=as.character(1:length(ssns)))
qdf$season <- qdf$new.season
qdf$year <- floor(qdf$year)
return(as.FLQuant(qdf[,c(1:7)]))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.