R/read.MFCLIni.r

In robscott3/FLR4MFCL: R Functions for Taming MULTIFAN-CL

#FLR4MFCL - R4MFCL built with FLR classes
#Copyright (C) 2018  Rob Scott

#' read.MFCLIni
#'
#' Reads information from the ini file and creates an MFCLIni object.
#'
#' @param inifile \verb{ini} filename.
#' @param nseasons number of seasons.
#'
#' @return An object of class MFCLIni.
#'
#' @examples
#' \dontrun{
#' read.MFCLIni("C:/R4MFCL/test_data/skj_ref_case/skj.ini")
#' read.MFCLIni("/home/robertsc/skj/HCR/run0/skj.ini")
#' }
#'
#' @export

read.MFCLIni <- function(inifile, nseasons=4) {

  trim.leading  <- function(x) sub("^\\s+", "", x)
  trim.trailing <- function(x) sub("\\s+$", "", x)
  splitter      <- function(ff, tt, ll=1, inst=1) unlist(strsplit(trim.leading(ff[grep(tt, ff)[inst]+ll]),split="[[:blank:]]+"))

  slotcopy <- function(from, to){
    for(slotname in slotNames(from)){
      slot(to, slotname) <- slot(from, slotname)
    }
    return(to)
  }

  res <- new("MFCLIni")

  par <- readLines(inifile)
  par <- par[nchar(par)>=1]                                          # remove blank lines
  if(any(grepl("# ", par) & nchar(par)<3))
    par <- par[-seq(1,length(par))[grepl("# ", par) & nchar(par)<3]]   # remove single hashes with no text "# "

  ## Read in the version number because this specifies if it is single species, mulitple species or includes maturity at length
  slot(res,'ini_version') <- as.numeric(splitter(par, "# ini version number"))
  if ( slot(res,'ini_version') == 1002) stop("Sorry FLR4MFCL is not compatable with multispecies models at the moment")
  nages    <- as.numeric(splitter(par, "# number of age classes"))
  nagestest <- length(splitter(par, "# maturity at age"))
  if (nages != nagestest) warning("The number of age classes and length of maturity at age don't match up")
  nregions <- length(splitter(par, "# recruitment distribution by region"))

  dims_age        <- dimnames(FLQuant(quant="age"))
  dims_age$age    <- as.character(0:((nages/nseasons)-1))
  dims_age$season <- as.character(1:nseasons)

  if(any(grep("# tag fish rep", par)))
    res <- slotcopy(read.MFCLTagRep(parfile, par), res)
  
  if(slot(res, 'ini_version') >= 1004)
    tag_shed_rate(res) <- as.numeric(splitter(par, "tag shed rate"))  # Annoyingly this is called "tag shed rate" in the ini and "tagmort" in the par

  slot(res, 'm')          <- as.numeric(splitter(par, '# natural mortality'))
  slot(res, "mat")      <- FLQuant(aperm(array(as.numeric(splitter(par, "# maturity at age")),
                                               dim=c(nseasons,nages/nseasons,1,1,1)),c(2,3,4,1,5)), dimnames=dims_age)
  if ( slot(res,'ini_version') > 1002) slot(res, "mat_at_length") <- as.numeric(splitter(par,"# maturity at length"))
  slot(res, 'move_map')   <- as.numeric(splitter(par, '# movement map'))
#  slot(res, 'diff_coffs') <- as.array(matrix(as.numeric(splitter(par, '# diffusion coffs', 1:(max(c(nregions-1,1))))),nrow=max(c(nregions-1,1)), byrow=T))
#  slot(res, 'diff_coffs') <- as.array(matrix(as.numeric(splitter(par, '# diffusion coffs', 1:(max(c(length(slot(res,'move_map'))),1)))),nrow=max(c(nregions-1,1)), byrow=T))
  slot(res, 'diff_coffs') <- as.array(matrix(as.numeric(splitter(par, '# diffusion coffs', 1:(max(c(length(slot(res,'move_map'))),1)))),
                                             nrow=length(slot(res,"move_map")), byrow=T))

  # RDS 05/2020 - dodgy hack - shortening text string to match on because the "_" is missing in some ini files
  if ( slot(res,'ini_version') > 1001) 
    #slot(res,"region_flags") <- matrix(as.numeric(splitter(par,"# region_flags")),ncol=nregions,nrow=10,byrow=TRUE)
    slot(res,"region_flags") <- matrix(as.numeric(splitter(par,"# region")),ncol=nregions,nrow=10,byrow=TRUE)
  
  slot(res, 'age_pars')   <- as.array(matrix(as.numeric(splitter(par, '# age_pars', 1:10)), nrow=10, byrow=T))
  slot(res, 'rec_dist')   <- as.numeric(splitter(par, '# recruitment distribution'))
  slot(res, 'growth')     <- t(array(as.numeric(splitter(par, '# The von Bertalanffy', c(3,5,7))),
                                     dim=c(3,3), dimnames=list(c("est","min","max"),c("Lmin","Lmax","k"))))
  slot(res, 'lw_params')  <- as.numeric(splitter(par, '# Length-weight'))
  
  # RDS 05/2020 - dodgy hack - shortening text string to match on because the the text changes in some ini files
  slot(res, 'sv')         <- as.numeric(splitter(par, 'sv')) # used to be '# sv'
  
  slot(res, 'sd_length_at_age')   <- as.numeric(splitter(par, '# Generic SD'))
  slot(res, 'sd_length_dep')      <- as.numeric(splitter(par, '# Length-dependent SD'))
  slot(res, 'n_mean_constraints')   <- as.numeric(splitter(par, '# The number of mean constraints'))

  slot(res, 'dimensions') <- c(agecls   =nages,
                               years    =NA,
                               seasons   =dim(slot(res, 'mat'))[4],
                               regions  =nregions,
                               fisheries=dim(slot(res, 'tag_fish_rep_rate'))[2],
                               taggrps  =dim(slot(res, 'tag_fish_rep_rate'))[1]-1)
  return(res)
}