#' mfcl
#'
#' Runs MFCL with defined inputs
#'
#' @param frq An object of class MFCLFrq.
#' @param par An object of class MFCLPar.
#' @param outpar The name of the output par file.
#' @param switch Optional numeric vector of additional flag settings.
#' @param spp Character string with 3 letter species code - optional but required to produce the .cfg file if missing.
#' @param ... Additional argument list that might not ever be used.
#'
#' @return Creates a text file at the specified location.
#'
#' @seealso \code{\link{read.MFCLFrq}} and \code{\link{read.MFCLPar}}
#'
#' @export
#' @docType methods
#' @rdname mfcl-methods
check.mfcl.cfg <- function(dir=".", spp){
if(!file.exists(paste(dir, 'mfcl.cfg', sep="/")) & is.null(spp))
stop("mfcl.cfg file unavailable: spp arg in mfcl call is not defined!")
if(!file.exists(paste(dir, 'mfcl.cfg', sep="/")) & !is.null(spp)){
cfg <- switch(toupper(spp),
SKJ = paste("96000000" , "\n", "850000000", "\n", "180000000", sep=""),
BET = paste("100000000", "\n", "850000000", "\n", "550000000", sep=""),
YFT = paste("100000000", "\n", "850000000", "\n", "550000000", sep=""),
ALB = paste("36000000", "\n", "450000000", "\n", "200000000", sep=""),
BSH = paste("36000000", "\n", "450000000", "\n", "200000000", sep=""))
cat(cfg, file=paste(dir,"mfcl.cfg",sep="/"))
}
}
setGeneric('mfcl', function(frq, par, ...) standardGeneric('mfcl'))
#' @rdname mfcl-methods
#' @aliases mfcl
setMethod("mfcl", signature(frq="MFCLFrq", par="MFCLPar"),
function(frq, par, outpar="out.par", tag=NULL, makepar=F, newflags=NULL, spp=NULL, ...){
check.mfcl.cfg(dir=getwd(), spp=spp)
if(is.null(outpar))
outpar <- "out.par"
path <- system.file("extdata",package="FLR4MFCL")
write(frq, "xx.frq")
write(par, "xx.par")
if(!is.null(tag))
write(tag, "xx.tag")
if(!is.null(newflags))
newflags <- paste(" -switch", paste(newflags, collapse=" "))
makepararg <- ifelse(makepar, " -makepar", "")
system(paste(path, "/mfclo64 xx.frq xx.par ", outpar, newflags, makepararg, sep=""))
#file.remove("xx.frq","xx.par","xx.tag")
#system(paste(path, "/mfclo64 --version", sep=""))
})
#' @rdname mfcl-methods
#' @aliases mfcl
setMethod("mfcl", signature(frq="MFCLFrq", par="MFCLIni"),
function(frq, par, outpar="out.par", tag=NULL, makepar=F, newflags=NULL, ...){
if(is.null(outpar))
outpar <- "00.par"
path <- system.file("extdata",package="FLR4MFCL")
write(frq, "xx.frq")
write(par, "xx.ini")
if(!is.null(tag))
write(tag, "xx.tag")
if(!is.null(newflags))
newflags <- paste(" -switch", paste(newflags, collapse=" "))
makepararg <- ifelse(makepar, " -makepar", "")
system(paste(path, "/mfclo64 xx.frq xx.ini ", outpar, newflags, makepararg, sep=""))
#file.remove("xx.frq","xx.par","xx.tag")
#system(paste(path, "/mfclo64 --version", sep=""))
})
#' setMFCLversion
#'
#' Sets the version of MFCL to be activated within the package.
#' Currently only the 2015 development version of MFCL is available.
#' The available versions can be obtained from the function availableMFCLversions.
#'
#' @param version Character string specifying the MFCL version.
#'
#' @return Returns Nothing: just sets the MFCL version to the one specified.
#'
#' @examples
#' setMFCLversion("2015_devvsn_1.1.4.3_linux")
#'
#' @export
setMFCLversion <- function(version="2015_devvsn_1.1.4.3_linux"){
opsys <- rev(unlist(strsplit(packageDescription("FLR4MFCL")$Built, split=" ")))[1]
oldpath <- getwd()
path <- system.file("extdata",package="FLR4MFCL")
from <- paste(path, "/", version, sep="")
to <- switch(opsys,
"unix" = paste(path, "/mfclo64", sep=""),
"linux" = paste(path, "/mfclo64", sep=""),
"windows" = paste(path, "/mfclo64.exe", sep=""))
file.copy(from=from, to=to, overwrite=TRUE)
if(opsys=="linux")
system(paste("chmod 777 ", path, "/mfclo64", sep=""))
setwd(oldpath)
}
#' availableMFCLversions
#'
#' Returns the available versions of MFCL within the package.
#' Currently only the 2015 development version of MFCL is available.
#'
#' @return Returns a list of available MFCL versions.
#'
#' @examples
#' availableMFCLversions()
#'
#' @export
availableMFCLversions <- function(){
res <- dir(system.file("extdata",package="FLR4MFCL"))
res2<- res[grep("mfcl", res)]
return(res2[!is.element(res2,c('mfclo64','mfclo64.exe'))])
}
#' getMFCLversion
#'
#' Returns the version of MFCL to be used for this session
#'
#' @param file name of a file to get the MFCL version from.
#'
#' @details
#' The value of \code{file} should be either (1) a path to an MFCL executable
#' such as \file{mfclo64}, or (2) a path to an MFCL \verb{rep} file such as
#' \file{plot-10.par.rep}.
#'
#' The default value of \code{file} looks for \verb{mfclo64} inside the FLR4MFCL
#' package installation directory.
#'
#' @return the mfcl version
#'
#' @examples
#' repfile <- system.file(package="FLR4MFCL", "extdata/plot-07.par.rep")
#' getMFCLversion(repfile)
#'
#' @importFrom tools file_ext
#'
#' @export
getMFCLversion <- function(file)
{
if(missing(file)) {
file <- file.path(system.file(package="FLR4MFCL"), "extdata/mfclo64")
}
if(!file.exists(file)){
warning("file '", file, "' does not exist")
return(invisible(NULL)) # exit with warning, consistent with old function
}
# Read rep file or run executable
if(file_ext(file) == "rep") {
ver <- readLines(file)
ver <- grep("MULTIFAN-CL version number", ver, value=TRUE)
ver <- gsub(".*: ", "", ver)
} else {
ver <- system(paste(file, "--version"), intern=TRUE)
ver <- grep("Version number", ver, value=TRUE)
ver <- gsub(".*: ", "", ver)
}
ver
}
#' gradients
#'
#' Returns a data.frame of parameters and their gradients in reverse order.
#'
#' @param grads text string of input file name for sorted gradients.
#' @param parnames text string of input file name for parameter names.
#'
#' @return data.frame of parameter gradients.
#'
#' @examples
#' \dontrun{
#' gradients()
#' }
#'
#' @export
gradients <- function(grads="sorted_gradient.rpt", parnames="xinit.rpt"){
trim.leading <- function(x) sub("^\\s+", "", x)
kk <- strsplit(readLines(parnames), split="[[:blank:]]+")
parnum <- as.numeric(unlist(lapply(kk, el, 1)))
parname<- unlist(lapply(kk, el, 2))
df1 <- data.frame(parnum=parnum, parname=parname)
kk <- strsplit(trim.leading(readLines(grads)), split="[[:blank:]]+")
parnum <- as.numeric(unlist(lapply(kk, el, 1)))
gradient<- as.numeric(unlist(lapply(kk, el, 2)))
df2 <- data.frame(parnum=parnum, gradient=gradient)
df3 <- merge(df1, df2)
return(df3[rev(order(df3$gradient)),])
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.