partage/GeneralizedAsymmetricLaplace
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Ajout de deux fonctions

Browse source
This commit is contained in:
François Pelletier 2014-01-02 23:43:57 -05:00
parent 4c249b7bfc
commit 336a7f6180
8 changed files with 146 additions and 173 deletions
Download patch file Download diff file Expand all files Collapse all files

5
R/characteristicfunction.R → R/cfGAL.R
View file

@ -9,12 +9,11 @@
#' @param u Transform variate
#' @param param Parameter vector
#' @param type Choose between "mu" or "kappa" parametrization
#' @param log Boolean for log-parameters
#' @param log Logical for log-parameters
#' @return Characteristic function value at point u for given parameter vector
#'
#' @author Francois Pelletier
characteristicfn <- function(u,param,type="mu",log=FALSE)
cfGAL <- function(u,param,type="mu",log=FALSE)
{
if(log)
{

41
R/changetypeGAL.R Normal file
View file

@ -0,0 +1,41 @@
# Change type of parametrization of GAL distribution
#
# Author: Francois Pelletier
#
# LGPL 3.0
###############################################################################
#' Change type of parametrization of GAL distribution
#' @param param Parameter vector
#' @param type Choose between "mu" or "kappa" parametrization
#' @param target Choose between "mu" or "kappa" parametrization
#' @param log Logical for log-parameters
#' @return The converted parameter vector
#'
#' @author Francois Pelletier
changetypeGAL <- function(param,type="mu",target="kappa",log=FALSE)
{
if(log)
{
if(type=="mu" && target=="kappa")
{
c(param[1],param[2],log((sqrt(4*exp(param[2])^2+exp(param[3])^2)-exp(param[3]))/(2*exp(param[2]))),param[4])
}
else if(type=="kappa" && target=="mu")
{
c(param[1],param[2],log(exp(param[2])*(1/exp(param[3])-exp(param[3]))/sqrt(2)),param[4])
}
}
else
{
if(type=="mu" && target=="kappa")
{
c(param[1],param[2],(sqrt(4*param[2]^2+param[3]^2)-param[3])/(2*param[2]),param[4])
}
else if(type=="kappa" && target=="mu")
{
c(param[1],param[2],param[2]*(1/param[3]-param[3])/sqrt(2),param[4])
}
}
}

45
R/dGAL.r Normal file
View file

@ -0,0 +1,45 @@
#' Density function for the GAL distribution
#' @param x vector of quantiles
#' @param param Parameter vector
#' @param type Choose between "mu" or "kappa" parametrization
#' @param log Logical for log-parameters
#' @return density at quantile x
#'
#' @author Francois Pelletier
dGAL <- function(x,param,type="mu",log=FALSE)
{
if(log)
{
if(type=="mu")
{
dGAL(x,changetypeGAL(param=param,log=log),type="kappa",log=log)
}
else if(type=="kappa")
{
num1 <- sqrt(2)*exp(sqrt(2)/(2*exp(param[2]))*(1/exp(param[3])-exp(param[3]))*(x-exp(param[1])))
denom1 <- sqrt(pi)*exp(param[2])^(exp(param[4])+1/2)*gamma(exp(param[4]))
num2 <- sqrt(2)*abs(x-exp(param[1]))
denom2 <- exp(param[3])+1/exp(param[3])
expo1 <- exp(param[4])-1/2
besselarg <- sqrt(2)/(2*exp(param[2]))*(1/exp(param[3])+exp(param[3]))*abs(x-exp(param[1]))
num1/denom1 * (num2/denom2)^expo1 * besselK(besselarg,expo1)
}
}
else
{
if(type=="mu")
{
dGAL(x,changetypeGAL(param=param,log=log),type="kappa",log=log)
}
else if(type=="kappa")
{
num1 <- sqrt(2)*exp(sqrt(2)/(2*param[2])*(1/param[3]-param[3])*(x-param[1]))
denom1 <- sqrt(pi)*param[2]^(param[4]+1/2)*gamma(param[4])
num2 <- sqrt(2)*abs(x-param[1])
denom2 <- param[3]+1/param[3]
expo1 <- param[4]-1/2
besselarg <- sqrt(2)/(2*param[2])*(1/param[3]+param[3])*abs(x-param[1])
num1/denom1 * (num2/denom2)^expo1 * besselK(besselarg,expo1)
}
}
}