Nothing
##################################################################################################
## ##
## BALD is an R-package. ##
## It is a Bayesian time series model of loss development. ##
## Features include skewed Student-t distribution with time-varying scale parameters, ##
## an expert prior for the calendar year effect, ##
## and accommodation for structural breaks in the consumption path of development years. ##
## It is an update for the older package lossDev as it has been stopped supported. ##
## ##
## Copyright (c) 2018 Frank A. Schmid, ##
## ##
## This file is part of BALD. ##
## ##
## lossDev is free software: you can redistribute it and/or modify ##
## it under the terms of the GNU General Public License as published by ##
## the Free Software Foundation, either version 3 of the License, or ##
## (at your option) any later version. ##
## ##
## This program is distributed in the hope that it will be useful, ##
## but WITHOUT ANY WARRANTY; without even the implied warranty of ##
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ##
## GNU General Public License for more details. ##
## ##
## You should have received a copy of the GNU General Public License ##
## along with this program. If not, see <https://www.gnu.org/licenses/>. ##
## ##
##################################################################################################
## This file contains the functions needed for package startup.
## Values assigned by .onLoad are also included here.
#' @import methods
NULL
##' The Packages Mutable State.
##'
##'
##' @name mutableState
##' @keywords internal
mutableState <- new.env(parent=emptyenv())
##' Current Name of the Package. Intended for internal use only.
##'
##' Set by \code{.onLoad}.
##'
##'
##' @return The current name of the package including version number if the package was installed as such. (i.e. \samp{BALD})
myPkgName <- function() return(get('myPkgName', envir=mutableState, inherits=FALSE))
##' Installation Library of the Package. Intended for internal use only.
##'
##' @return The installation library path.
##' Set by \code{.onLoad}.
##'
##'
myLibPath <- function() return(get('myLibPath', envir=mutableState, inherits=FALSE))
##' Intialize the Namespace. Intended for internal use only.
##'
##' Currently only sets correct functions for \code{myPkgName} and \code{myLibPath} and loads the \acronym{JAGS} module.
##
##'
##' @param libname The library where the R package is installed.
##' @param pkgname The name of the R package.
##' @name dot-onLoad-lossDev
##' @aliases .onLoad
##' @seealso \code{\link{.onLoad}}
##' @import rjags
.onLoad <- function(libname, pkgname)
{
##Create functions to return the required values. Lexical scoping ensures the correct values are returned.
myPkgName <- pkgname
myLibPath <- libname
##Assign the values to the package namespace and lock the bindings for safty.
assign('myPkgName', myPkgName, envir=mutableState)
lockBinding('myPkgName', env=mutableState)
assign('myLibPath', myLibPath, envir=mutableState)
lockBinding('myLibPath', env=mutableState)
##Load the JAGS module.
rarch <- .Platform$r_arch
fp <- ifelse(nzchar(rarch),
file.path(myLibPath(), myPkgName(), 'libs', rarch),
file.path(myLibPath(), myPkgName(), 'libs'))
#dyn.load(normalizePath(fp))
#load.module('BALD', normalizePath(fp))
wd <- getwd()
on.exit(setwd(wd))
db.folder <- tempfile()
dir.create(db.folder)
setwd(db.folder)
mutableState$CounterForCreatedCodas <- 0
mutableState$lossDevOptions <- list()
mutableState$lossDevOptions[['logsplinePenaltyFunction']] <- function(x) log(length(x))
}
##' A Safe Version of \code{setGeneric}. Intended for internal use only.
##'
##' \code{setGeneric} will overwrite existing generic functions. This will result in the loss of all methods already associated with that generic.
##' \code{setGenericVerif} only sets the generic if it is not already a generic.
##' If a generic by the name of \code{name} already exists, a warning is issued and NULL is returned. Otherwise \code{setGeneric} is called and its value returned.
##'
##' @param name The character string name of the generic function.
##' @param \dots Additional arguments to pass to \code{setGeneric}.
##' @return \code{setGenericVerif} really exists for its side effect; but returns the value returned by \code{setGeneric} or NULL.
##' @seealso \code{\link{setGeneric}}
setGenericVerif <- function(name, ...)
{
if(!isGeneric(name))
return(setGeneric(name, ...))
else
{
warning('Tried to overwrite an exisiting generic function')
return(NULL)
}
}
##' Options for \pkg{BALD}.
##'
##' Currently the only options are \code{keepCodaOnDisk} and \code{logsplinePenaltyFunction}.
##'
##' \describe{
##' \item{\code{logsplinePenaltyFunction}}{
##' When drawing kernal density plots using the \pkg{logspline}, it maybe desirable to specify a penalty to smooth the density (See \code{?logspline}).
##' This value must be a function which takes one paramter (a vector of the sampled data points) and returns one value -- the penalty.
##' The default returns the the log of the number of draws.
##' }
##'
##' }
##' @param \dots named values to set. If empty, only the current list of option settings is returned.
##' @return The current (or altered) list of option settings is returned.
##' @export
##' @examples
##' library(BALD)
##' #define the log of sample size function
##' logsamplesize <- function(x) {
##' log(length(x))
##' }
##' #assign the log of sample size function as penalty function
##' lossDevOptions(logsplinePenaltyFunction = logsamplesize)
lossDevOptions <- function(...)
{
args <- list(...)
n <- names(args)
if(length(n) == 0)
return(mutableState$lossDevOptions)
if(length(n) != 1)
stop('You must specify only one option at a time')
if(n != 'logsplinePenaltyFunction')
stop('The only current options are "logsplinePenaltyFunction"')
if(n == 'logsplinePenaltyFunction') {
f <- args[[n]]
if(!is.function(f) && is.numeric(f(c(1, 2, 3))) && length(f(c(1, 2, 3))) != 1 )
stop('"logsplinePenaltyFunction" must be a function. Reverting to previous setting.')
}
mutableState$lossDevOptions[[n]] <- args[[n]]
return(mutableState$lossDevOptions)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.