Ajout des return() et update du namespace avec roxygen
This commit is contained in:
François Pelletier
parent
a4cf4175df
commit
a7a238dd9b
33 changed files with 183 additions and 165 deletions
56
NAMESPACE
56
NAMESPACE
|
|
@ -1,29 +1,27 @@
|
|||
export(cfGAL,
|
||||
cfLM,
|
||||
cgfEsscherGAL,
|
||||
cgfGAL,
|
||||
changetypeGAL,
|
||||
cmGAL,
|
||||
dchangetypeGAL,
|
||||
dGAL,
|
||||
diffcgfEsscherGAL,
|
||||
diffcgfGAL,
|
||||
dmGAL,
|
||||
dnormapproxEsscherLM,
|
||||
dsaddleapproxGAL,
|
||||
dscaleGAL,
|
||||
kurtosisGAL,
|
||||
mean.variance.GMM.gradient,
|
||||
mGAL,
|
||||
mgfGAL,
|
||||
pnormapproxEsscherLM,
|
||||
psaddleapproxEsscherGAL,
|
||||
psaddleapproxGAL,
|
||||
rGAL,
|
||||
riskneutralparGAL,
|
||||
saddlepointEsscherGAL,
|
||||
saddlepointGAL,
|
||||
scaleGAL,
|
||||
skewnessGAL,
|
||||
startparamGAL,
|
||||
testparGAL)
|
||||
export(cfGAL)
|
||||
export(cfLM)
|
||||
export(cgfEsscherGAL)
|
||||
export(cgfGAL)
|
||||
export(changetypeGAL)
|
||||
export(cmGAL)
|
||||
export(dGAL)
|
||||
export(dchangetypeGAL)
|
||||
export(diffcgfEsscherGAL)
|
||||
export(diffcgfGAL)
|
||||
export(dmGAL)
|
||||
export(dnormapproxEsscherLM)
|
||||
export(dsaddleapproxGAL)
|
||||
export(dscaleGAL)
|
||||
export(mGAL)
|
||||
export(mean.variance.GMM.gradient.GAL)
|
||||
export(mgfGAL)
|
||||
export(pnormapproxEsscherLM)
|
||||
export(psaddleapproxEsscherGAL)
|
||||
export(psaddleapproxGAL)
|
||||
export(rGAL)
|
||||
export(riskneutralparGAL)
|
||||
export(saddlepointEsscherGAL)
|
||||
export(saddlepointGAL)
|
||||
export(scaleGAL)
|
||||
export(startparamGAL)
|
||||
export(testparGAL)
|
||||
|
|
|
|||
14
R/cfGAL.R
14
R/cfGAL.R
|
|
@ -11,7 +11,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return Characteristic function value at point u for given parameter vector
|
||||
#'
|
||||
#' @export cfGAL
|
||||
#' @author Francois Pelletier
|
||||
cfGAL <- function(u,param,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -20,24 +20,24 @@ cfGAL <- function(u,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
exp(1i*exp(param[1])*u)*(1+(exp(param[2])^2*u^2)/2-1i*exp(param[3])*u)^(-exp(param[4]))
|
||||
return(exp(1i*exp(param[1])*u)*(1+(exp(param[2])^2*u^2)/2-1i*exp(param[3])*u)^(-exp(param[4])))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
exp(1i*exp(param[1])*u)*(1+(exp(param[2])^2*u^2)/2-(1/2*1i)*
|
||||
exp(param[2])*sqrt(2)*(1/exp(param[3])-exp(param[3]))*u)^(-exp(param[4]))
|
||||
return(exp(1i*exp(param[1])*u)*(1+(exp(param[2])^2*u^2)/2-(1/2*1i)*
|
||||
exp(param[2])*sqrt(2)*(1/exp(param[3])-exp(param[3]))*u)^(-exp(param[4])))
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
exp(1i*param[1]*u)*(1+(param[2]^2*u^2)/2-1i*param[3]*u)^(-param[4])
|
||||
return(exp(1i*param[1]*u)*(1+(param[2]^2*u^2)/2-1i*param[3]*u)^(-param[4]))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
exp(1i*param[1]*u)*(1+(param[2]^2*u^2)/2-(1/2*1i)*
|
||||
param[2]*sqrt(2)*(1/param[3]-param[3])*u)^(-param[4])
|
||||
return(exp(1i*param[1]*u)*(1+(param[2]^2*u^2)/2-(1/2*1i)*
|
||||
param[2]*sqrt(2)*(1/param[3]-param[3])*u)^(-param[4]))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
14
R/cfLM.R
14
R/cfLM.R
|
|
@ -13,7 +13,7 @@
|
|||
#' @param log Logical for log-parameters
|
||||
#' @param start Starting value of the process
|
||||
#' @return Characteristic function value at point u for given parameter vector
|
||||
#'
|
||||
#' @export cfLM
|
||||
#' @author Francois Pelletier
|
||||
cfLM <- function(u,time,param,type="mu",log=FALSE,start=0)
|
||||
{
|
||||
|
|
@ -22,24 +22,24 @@ cfLM <- function(u,time,param,type="mu",log=FALSE,start=0)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
exp(1i*(start+exp(param[1])*time)*u)*(1+(exp(param[2])^2*u^2)/2-1i*exp(param[3])*u)^(-exp(param[4])*time)
|
||||
return(exp(1i*(start+exp(param[1])*time)*u)*(1+(exp(param[2])^2*u^2)/2-1i*exp(param[3])*u)^(-exp(param[4])*time))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
exp(1i*(start+exp(param[1])*time)*u)*(1+(exp(param[2])^2*u^2)/2-(1/2*1i)*
|
||||
exp(param[2])*sqrt(2)*(1/exp(param[3])-exp(param[3]))*u)^(-exp(param[4])*time)
|
||||
return(exp(1i*(start+exp(param[1])*time)*u)*(1+(exp(param[2])^2*u^2)/2-(1/2*1i)*
|
||||
exp(param[2])*sqrt(2)*(1/exp(param[3])-exp(param[3]))*u)^(-exp(param[4])*time))
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
exp(1i*(start+param[1]*time)*u)*(1+(param[2]^2*u^2)/2-1i*param[3]*u)^(-param[4]*time)
|
||||
return(exp(1i*(start+param[1]*time)*u)*(1+(param[2]^2*u^2)/2-1i*param[3]*u)^(-param[4]*time))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
exp(1i*(start+param[1]*time)*u)*(1+(param[2]^2*u^2)/2-(1/2*1i)*
|
||||
param[2]*sqrt(2)*(1/param[3]-param[3])*u)^(-param[4]*time)
|
||||
return(exp(1i*(start+param[1]*time)*u)*(1+(param[2]^2*u^2)/2-(1/2*1i)*
|
||||
param[2]*sqrt(2)*(1/param[3]-param[3])*u)^(-param[4]*time))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,14 +15,14 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return Cumulant generating function value at point u for given parameter vector
|
||||
#'
|
||||
#' @export cgfEsscherGAL
|
||||
#' @author Francois Pelletier
|
||||
cgfEsscherGAL <- function(u,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
log((exp(param[1]*(u+1))/(1-(1/2)*param[2]^2*(u+1)^2-param[3]*(u+1))^param[4])^eval.time/
|
||||
(exp(param[1])/(1-(1/2)*param[2]^2-param[3])^param[4])^eval.time)
|
||||
return(log((exp(param[1]*(u+1))/(1-(1/2)*param[2]^2*(u+1)^2-param[3]*(u+1))^param[4])^eval.time/
|
||||
(exp(param[1])/(1-(1/2)*param[2]^2-param[3])^param[4])^eval.time))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
|
|
|
|||
10
R/cgfGAL.R
10
R/cgfGAL.R
|
|
@ -12,7 +12,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return Cumulant generating function value at point u for given parameter vector
|
||||
#'
|
||||
#' @export cgfGAL
|
||||
#' @author Francois Pelletier
|
||||
cgfGAL <- function(u,param,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -21,22 +21,22 @@ cgfGAL <- function(u,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
log(exp(exp(param[1])*u)*(1-(1/2)*exp(param[2])^2*u^2-exp(param[3])*u)^(-exp(param[4])))
|
||||
return(log(exp(exp(param[1])*u)*(1-(1/2)*exp(param[2])^2*u^2-exp(param[3])*u)^(-exp(param[4]))))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
log(exp(exp(param[1])*u)*((exp(param[2])^2*u^2)/2+(exp(param[3])*exp(param[2])*u)/sqrt(2)-(exp(param[2])*u)/(sqrt(2)*exp(param[3]))+1)^(-exp(param[4])))
|
||||
return(log(exp(exp(param[1])*u)*((exp(param[2])^2*u^2)/2+(exp(param[3])*exp(param[2])*u)/sqrt(2)-(exp(param[2])*u)/(sqrt(2)*exp(param[3]))+1)^(-exp(param[4]))))
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
log(exp(param[1]*u)*(1-(1/2)*param[2]^2*u^2-param[3]*u)^(-param[4]))
|
||||
return(log(exp(param[1]*u)*(1-(1/2)*param[2]^2*u^2-param[3]*u)^(-param[4])))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
log(exp(param[1]*u)*((param[2]^2*u^2)/2+(param[3]*param[2]*u)/sqrt(2)-(param[2]*u)/(sqrt(2)*param[3])+1)^(-param[4]))
|
||||
return(log(exp(param[1]*u)*((param[2]^2*u^2)/2+(param[3]*param[2]*u)/sqrt(2)-(param[2]*u)/(sqrt(2)*param[3])+1)^(-param[4])))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
#' @param target Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return The converted parameter vector
|
||||
#'
|
||||
#' @export changetypeGAL
|
||||
#' @author Francois Pelletier
|
||||
changetypeGAL <- function(param,type="mu",target="kappa",log=FALSE)
|
||||
{
|
||||
|
|
@ -20,22 +20,22 @@ changetypeGAL <- function(param,type="mu",target="kappa",log=FALSE)
|
|||
{
|
||||
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])
|
||||
return(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])
|
||||
return(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])
|
||||
return(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])
|
||||
return(c(param[1],param[2],param[2]*(1/param[3]-param[3])/sqrt(2),param[4]))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
24
R/cmGAL.R
24
R/cmGAL.R
|
|
@ -12,14 +12,14 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return A numeric value of the centered moment
|
||||
#'
|
||||
#' @export cmGAL
|
||||
#' @author Francois Pelletier
|
||||
cmGAL <- function(order,param,type="mu",log=FALSE)
|
||||
{
|
||||
testparGAL(param,type,log)
|
||||
if(log)
|
||||
{
|
||||
cmGAL(order,exp(param),type,log=FALSE)
|
||||
return(cmGAL(order,exp(param),type,log=FALSE))
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -27,16 +27,16 @@ cmGAL <- function(order,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(order==2)
|
||||
{
|
||||
param[4]*param[2]^2+param[4]*param[3]^2
|
||||
return(param[4]*param[2]^2+param[4]*param[3]^2)
|
||||
}
|
||||
if(order==3)
|
||||
{
|
||||
3*param[3]*param[4]*param[2]^2+2*param[3]^3*param[4]
|
||||
return(3*param[3]*param[4]*param[2]^2+2*param[3]^3*param[4])
|
||||
}
|
||||
|
||||
if(order==4)
|
||||
{
|
||||
(3*param[4]^2+3*param[4])*param[2]^4+(6*param[3]^2*param[4]^2+12*param[3]^2*param[4])*param[2]^2+3*param[3]^4*param[4]^2+6*param[3]^4*param[4]
|
||||
return((3*param[4]^2+3*param[4])*param[2]^4+(6*param[3]^2*param[4]^2+12*param[3]^2*param[4])*param[2]^2+3*param[3]^4*param[4]^2+6*param[3]^4*param[4])
|
||||
}
|
||||
else
|
||||
stop("order must be 2,3 or 4")
|
||||
|
|
@ -45,15 +45,15 @@ cmGAL <- function(order,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(order==2)
|
||||
{
|
||||
(1/2)*param[4]*param[2]^2*(param[3]^4+1)/param[3]^2
|
||||
return((1/2)*param[4]*param[2]^2*(param[3]^4+1)/param[3]^2)
|
||||
}
|
||||
if(order==3)
|
||||
{
|
||||
(1/2)*param[4]*param[2]^3*sqrt(2)*(1-param[3]^6)/param[3]^3
|
||||
return((1/2)*param[4]*param[2]^3*sqrt(2)*(1-param[3]^6)/param[3]^3)
|
||||
}
|
||||
if(order==4)
|
||||
{
|
||||
(3/4)*param[4]*((param[4]+2)*param[3]^8+2*param[4]*param[3]^4+param[4]+2)*param[2]^4/param[3]^4
|
||||
return((3/4)*param[4]*((param[4]+2)*param[3]^8+2*param[4]*param[3]^4+param[4]+2)*param[2]^4/param[3]^4)
|
||||
}
|
||||
else
|
||||
stop("order must be 2,3 or 4")
|
||||
|
|
@ -73,11 +73,11 @@ skewnessGAL <- function(param,type="mu",log=FALSE)
|
|||
testparGAL(param,type,log)
|
||||
if(log)
|
||||
{
|
||||
skewnessGAL(exp(param),type,log=FALSE)
|
||||
return(skewnessGAL(exp(param),type,log=FALSE))
|
||||
}
|
||||
else
|
||||
{
|
||||
cmGAL(3,param,type) / (cmGAL(2,param,type)^(3/2))
|
||||
return(cmGAL(3,param,type) / (cmGAL(2,param,type)^(3/2)))
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -94,10 +94,10 @@ kurtosisGAL <- function(param,type="mu",log=FALSE,adjust=TRUE)
|
|||
testparGAL(param,type,log)
|
||||
if(log)
|
||||
{
|
||||
kurtosisGAL(exp(param),type,log=FALSE)
|
||||
return(kurtosisGAL(exp(param),type,log=FALSE))
|
||||
}
|
||||
else
|
||||
{
|
||||
cmGAL(4,param,type) / (cmGAL(2,param,type)^2) - 3*adjust
|
||||
return(cmGAL(4,param,type) / (cmGAL(2,param,type)^2) - 3*adjust)
|
||||
}
|
||||
}
|
||||
10
R/dGAL.r
10
R/dGAL.r
|
|
@ -4,7 +4,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return density at quantile x
|
||||
#'
|
||||
#' @export dGAL
|
||||
#' @author Francois Pelletier
|
||||
dGAL <- function(x,param,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -13,7 +13,7 @@ dGAL <- function(x,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
dGAL(x,changetypeGAL(param=param,log=log),type="kappa",log=log)
|
||||
return(dGAL(x,changetypeGAL(param=param,log=log),type="kappa",log=log))
|
||||
}
|
||||
else if(type=="kappa")
|
||||
{
|
||||
|
|
@ -23,14 +23,14 @@ dGAL <- function(x,param,type="mu",log=FALSE)
|
|||
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)
|
||||
return(num1/denom1 * (num2/denom2)^expo1 * besselK(besselarg,expo1))
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
dGAL(x,changetypeGAL(param=param,log=log),type="kappa",log=log)
|
||||
return(dGAL(x,changetypeGAL(param=param,log=log),type="kappa",log=log))
|
||||
}
|
||||
else if(type=="kappa")
|
||||
{
|
||||
|
|
@ -40,7 +40,7 @@ dGAL <- function(x,param,type="mu",log=FALSE)
|
|||
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)
|
||||
return(num1/denom1 * (num2/denom2)^expo1 * besselK(besselarg,expo1))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -11,7 +11,7 @@
|
|||
#' @param target Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return The derivative matrix of the type change function
|
||||
#'
|
||||
#' @export dchangetypeGAL
|
||||
#' @author Francois Pelletier
|
||||
dchangetypeGAL <- function(param,type="mu",target="kappa",log=FALSE)
|
||||
{
|
||||
|
|
@ -31,17 +31,17 @@ dchangetypeGAL <- function(param,type="mu",target="kappa",log=FALSE)
|
|||
{
|
||||
if(type=="mu" && target=="kappa")
|
||||
{
|
||||
matrix(c(1,0,0,0,
|
||||
return(matrix(c(1,0,0,0,
|
||||
0,1,0,0,
|
||||
0,(param[3]*sqrt(4*param[2]^2+param[3]^2)-param[3]^2)/(2*param[2]^2*sqrt(4*param[2]^2+param[3]^2)),-(sqrt(4*param[2]^2+param[3]^2)-param[3])/(2*param[2]*sqrt(4*param[2]^2+param[3]^2)),0,
|
||||
0,0,0,1),4,4)
|
||||
0,0,0,1),4,4))
|
||||
}
|
||||
else if(type=="kappa" && target=="mu")
|
||||
{
|
||||
matrix(c(1,0,0,0,
|
||||
return(matrix(c(1,0,0,0,
|
||||
0,1,0,0,
|
||||
0,-(param[3]^2-1)/(sqrt(2)*param[3]),-((param[3]^2+1)*param[2])/(sqrt(2)*param[3]^2),0,
|
||||
0,0,0,1),4,4)
|
||||
0,0,0,1),4,4))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -16,7 +16,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return The value of the derivative at the transform variate point of evaluation
|
||||
#'
|
||||
#' @export diffcgfEsscherGAL
|
||||
#' @author Francois Pelletier
|
||||
diffcgfEsscherGAL <- function(u,order,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -27,11 +27,11 @@ diffcgfEsscherGAL <- function(u,order,param,eval.time=1,type="mu",log=FALSE)
|
|||
}
|
||||
if(order==2)
|
||||
{
|
||||
2*eval.time*param[4]*(2*param[3]^2+param[2]^4+2*param[2]^2+param[2]^4*u^2+2*param[2]^2*u*param[3]+2*param[3]*param[2]^2+2*param[2]^4*u)/(-2+param[2]^2*u^2+2*param[2]^2*u+param[2]^2+2*param[3]*u+2*param[3])^2
|
||||
return(2*eval.time*param[4]*(2*param[3]^2+param[2]^4+2*param[2]^2+param[2]^4*u^2+2*param[2]^2*u*param[3]+2*param[3]*param[2]^2+2*param[2]^4*u)/(-2+param[2]^2*u^2+2*param[2]^2*u+param[2]^2+2*param[3]*u+2*param[3])^2)
|
||||
}
|
||||
if(order==3)
|
||||
{
|
||||
-4*eval.time*param[4]*(6*param[2]^4+param[2]^6+3*param[2]^4*u^2*param[3]+6*param[2]^4*u*param[3]+6*param[2]^2*u*param[3]^2+4*param[3]^3+6*param[3]*param[2]^2+6*param[2]^4*u+param[2]^6*u^3+3*param[2]^6*u^2+3*param[2]^6*u+3*param[2]^4*param[3]+6*param[2]^2*param[3]^2)/(-2+param[2]^2*u^2+2*param[2]^2*u+param[2]^2+2*param[3]*u+2*param[3])^3
|
||||
return(-4*eval.time*param[4]*(6*param[2]^4+param[2]^6+3*param[2]^4*u^2*param[3]+6*param[2]^4*u*param[3]+6*param[2]^2*u*param[3]^2+4*param[3]^3+6*param[3]*param[2]^2+6*param[2]^4*u+param[2]^6*u^3+3*param[2]^6*u^2+3*param[2]^6*u+3*param[2]^4*param[3]+6*param[2]^2*param[3]^2)/(-2+param[2]^2*u^2+2*param[2]^2*u+param[2]^2+2*param[3]*u+2*param[3])^3)
|
||||
}
|
||||
if(order==4)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@
|
|||
#' @param log Logical for log-parameters
|
||||
#' @return The value of the derivative at the transform variate point
|
||||
#' of evaluation
|
||||
#'
|
||||
#' @export diffcgfGAL
|
||||
#' @author Francois Pelletier
|
||||
diffcgfGAL <- function(u,order,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -29,20 +29,20 @@ diffcgfGAL <- function(u,order,param,eval.time=1,type="mu",log=FALSE)
|
|||
}
|
||||
if(order==2)
|
||||
{
|
||||
2*eval.time*param[4]*(2*param[2]^2*u*param[3]+
|
||||
return(2*eval.time*param[4]*(2*param[2]^2*u*param[3]+
|
||||
2*param[3]^2+2*param[2]^2+param[2]^4*u^2)/
|
||||
(-2+param[2]^2*u^2+2*param[3]*u)^2
|
||||
(-2+param[2]^2*u^2+2*param[3]*u)^2)
|
||||
}
|
||||
if(order==3)
|
||||
{
|
||||
-4*eval.time*param[4]*(3*param[2]^4*u^2*param[3]+
|
||||
return(-4*eval.time*param[4]*(3*param[2]^4*u^2*param[3]+
|
||||
6*param[2]^2*u*param[3]^2+param[2]^6*u^3+
|
||||
6*param[2]^4*u+6*param[2]^2*param[3]+4*param[3]^3)/
|
||||
(-2+param[2]^2*u^2+2*param[3]*u)^3
|
||||
(-2+param[2]^2*u^2+2*param[3]*u)^3)
|
||||
}
|
||||
if(order==4)
|
||||
{
|
||||
(12*param[2]^8*param[4]*u^4+48*param[3]*param[2]^6*param[4]*u^3+
|
||||
return((12*param[2]^8*param[4]*u^4+48*param[3]*param[2]^6*param[4]*u^3+
|
||||
(144*param[2]^6+144*param[3]^2*param[2]^4)*param[4]*u^2+
|
||||
(288*param[3]*param[2]^4+192*param[3]^3*param[2]^2)*param[4]*u+
|
||||
(48*param[2]^4+192*param[3]^2*param[2]^2+96*param[3]^4)*param[4])/
|
||||
|
|
@ -51,7 +51,7 @@ diffcgfGAL <- function(u,order,param,eval.time=1,type="mu",log=FALSE)
|
|||
(32*param[3]^3*param[2]^2-48*param[3]*param[2]^4)*u^5+
|
||||
(24*param[2]^4-96*param[3]^2*param[2]^2+16*param[3]^4)*u^4+
|
||||
(96*param[3]*param[2]^2-64*param[3]^3)*u^3+
|
||||
(96*param[3]^2-32*param[2]^2)*u^2+(-64)*param[3]*u+16)
|
||||
(96*param[3]^2-32*param[2]^2)*u^2+(-64)*param[3]*u+16))
|
||||
}
|
||||
}
|
||||
if(type=="kappa")
|
||||
|
|
|
|||
30
R/dmGAL.R
30
R/dmGAL.R
|
|
@ -12,7 +12,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return A vector of the derivative of the analytical moment
|
||||
#'
|
||||
#' @export dmGAL
|
||||
#' @author Francois Pelletier
|
||||
dmGAL <- function(param,order,type="mu",log=FALSE)
|
||||
{ if(log)
|
||||
|
|
@ -22,31 +22,31 @@ dmGAL <- function(param,order,type="mu",log=FALSE)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
c(1,0,eparam[4],eparam[3])
|
||||
return(c(1,0,eparam[4],eparam[3]))
|
||||
}
|
||||
else if(type=="kappa")
|
||||
{
|
||||
c(1,
|
||||
return(c(1,
|
||||
-(1/2)*sqrt(2)*eparam[4]*(-1+eparam[3]^2)/eparam[3],
|
||||
-(1/2)*eparam[4]*eparam[2]*sqrt(2)*(eparam[3]^2+1)/eparam[3]^2,
|
||||
-(1/2)*sqrt(2)*eparam[2]*(-1+eparam[3]^2)/eparam[3])
|
||||
-(1/2)*sqrt(2)*eparam[2]*(-1+eparam[3]^2)/eparam[3]))
|
||||
}
|
||||
}
|
||||
if(order==2)
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
c(0,
|
||||
return(c(0,
|
||||
eparam[4]*eparam[2]/sqrt(eparam[4]*eparam[2]^2+eparam[4]*eparam[3]^2),
|
||||
eparam[4]*eparam[3]/sqrt(eparam[4]*eparam[2]^2+eparam[4]*eparam[3]^2),
|
||||
(1/2)*(eparam[2]^2+eparam[3]^2)/sqrt(eparam[4]*eparam[2]^2+eparam[4]*eparam[3]^2))
|
||||
(1/2)*(eparam[2]^2+eparam[3]^2)/sqrt(eparam[4]*eparam[2]^2+eparam[4]*eparam[3]^2)))
|
||||
}
|
||||
else if(type=="kappa")
|
||||
{
|
||||
c(0,
|
||||
return(c(0,
|
||||
(1/2)*sqrt(2)*eparam[4]*eparam[2]*(eparam[3]^4+1)/(sqrt(eparam[4]*eparam[2]^2*(eparam[3]^4+1)/eparam[3]^2)*eparam[3]^2),
|
||||
(1/2)*sqrt(2)*eparam[4]*eparam[2]^2*(eparam[3]^4-1)/(sqrt(eparam[4]*eparam[2]^2*(eparam[3]^4+1)/eparam[3]^2)*eparam[3]^3),
|
||||
(1/4)*sqrt(2)*eparam[2]^2*(eparam[3]^4+1)/(sqrt(eparam[4]*eparam[2]^2*(eparam[3]^4+1)/eparam[3]^2)*eparam[3]^2))
|
||||
(1/4)*sqrt(2)*eparam[2]^2*(eparam[3]^4+1)/(sqrt(eparam[4]*eparam[2]^2*(eparam[3]^4+1)/eparam[3]^2)*eparam[3]^2)))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -56,31 +56,31 @@ dmGAL <- function(param,order,type="mu",log=FALSE)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
c(1,0,param[4],param[3])
|
||||
return(c(1,0,param[4],param[3]))
|
||||
}
|
||||
else if(type=="kappa")
|
||||
{
|
||||
c(1,
|
||||
return(c(1,
|
||||
-(1/2)*sqrt(2)*param[4]*(-1+param[3]^2)/param[3],
|
||||
-(1/2)*param[4]*param[2]*sqrt(2)*(param[3]^2+1)/param[3]^2,
|
||||
-(1/2)*sqrt(2)*param[2]*(-1+param[3]^2)/param[3])
|
||||
-(1/2)*sqrt(2)*param[2]*(-1+param[3]^2)/param[3]))
|
||||
}
|
||||
}
|
||||
if(order==2)
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
c(0,
|
||||
return(c(0,
|
||||
param[4]*param[2]/sqrt(param[4]*param[2]^2+param[4]*param[3]^2),
|
||||
param[4]*param[3]/sqrt(param[4]*param[2]^2+param[4]*param[3]^2),
|
||||
(1/2)*(param[2]^2+param[3]^2)/sqrt(param[4]*param[2]^2+param[4]*param[3]^2))
|
||||
(1/2)*(param[2]^2+param[3]^2)/sqrt(param[4]*param[2]^2+param[4]*param[3]^2)))
|
||||
}
|
||||
else if(type=="kappa")
|
||||
{
|
||||
c(0,
|
||||
return(c(0,
|
||||
(1/2)*sqrt(2)*param[4]*param[2]*(param[3]^4+1)/(sqrt(param[4]*param[2]^2*(param[3]^4+1)/param[3]^2)*param[3]^2),
|
||||
(1/2)*sqrt(2)*param[4]*param[2]^2*(param[3]^4-1)/(sqrt(param[4]*param[2]^2*(param[3]^4+1)/param[3]^2)*param[3]^3),
|
||||
(1/4)*sqrt(2)*param[2]^2*(param[3]^4+1)/(sqrt(param[4]*param[2]^2*(param[3]^4+1)/param[3]^2)*param[3]^2))
|
||||
(1/4)*sqrt(2)*param[2]^2*(param[3]^4+1)/(sqrt(param[4]*param[2]^2*(param[3]^4+1)/param[3]^2)*param[3]^2)))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,9 +15,10 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @param start Starting value of the process
|
||||
|
||||
#' @export dnormapproxEsscherLM
|
||||
#' @return Normal density function approximation of the Esscher transform
|
||||
#' of the specified Laplace motion
|
||||
#' @author Francois Pelletier
|
||||
dnormapproxEsscherLM <- function(x,param,hEsscher=0,eval.time=1,type="mu",log=FALSE,start=0)
|
||||
{
|
||||
dnorm(x,start+eval.time*(mGAL(1,param,type,log)+hEsscher*cmGAL(2,param,type,log)),
|
||||
|
|
|
|||
|
|
@ -13,8 +13,9 @@
|
|||
#' @param eval.time Time of the process
|
||||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
|
||||
#' @export dsaddleapproxGAL
|
||||
#' @return Saddlepoint approximation of the density function
|
||||
#' @author Francois Pelletier
|
||||
dsaddleapproxGAL <- function(x,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
s <- saddlepointGAL(x,param,eval.time,type,log)
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
#' @param scale Scale shift (in standard deviations)
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return The matrix derivative of the transformed parameter vector
|
||||
#'
|
||||
#' @export dscaleGAL
|
||||
#' @author Francois Pelletier
|
||||
dscaleGAL <- function(param,type="kappa",location,scale,log=FALSE)
|
||||
{
|
||||
|
|
@ -24,7 +24,7 @@ dscaleGAL <- function(param,type="kappa",location,scale,log=FALSE)
|
|||
{
|
||||
if(type=="kappa")
|
||||
{
|
||||
diag(c(scale,scale,1,1))
|
||||
return(diag(c(scale,scale,1,1)))
|
||||
}
|
||||
else if (type=="mu")
|
||||
{
|
||||
|
|
|
|||
30
R/mGAL.R
30
R/mGAL.R
|
|
@ -12,14 +12,14 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return A numeric value of the raw moment
|
||||
#'
|
||||
#' @export mGAL
|
||||
#' @author Francois Pelletier
|
||||
mGAL <- function(order,param,type="mu",log=FALSE)
|
||||
{
|
||||
testparGAL(param,type,log)
|
||||
if(log)
|
||||
{
|
||||
mGAL(order,exp(param),type,log=FALSE)
|
||||
return(mGAL(order,exp(param),type,log=FALSE))
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -27,25 +27,25 @@ mGAL <- function(order,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(order==1)
|
||||
{
|
||||
param[1]+param[4]*param[3]
|
||||
return(param[1]+param[4]*param[3])
|
||||
}
|
||||
if(order==2)
|
||||
{
|
||||
param[1]^2+2*param[1]*param[4]*param[3]+param[4]^2*param[3]^2+
|
||||
param[4]*param[2]^2+param[4]*param[3]^2
|
||||
return(param[1]^2+2*param[1]*param[4]*param[3]+param[4]^2*param[3]^2+
|
||||
param[4]*param[2]^2+param[4]*param[3]^2)
|
||||
}
|
||||
if(order==3)
|
||||
{
|
||||
3*param[1]*param[4]*param[2]^2+3*param[1]^2*param[4]*param[3]+
|
||||
return(3*param[1]*param[4]*param[2]^2+3*param[1]^2*param[4]*param[3]+
|
||||
3*param[1]*param[4]^2*param[3]^2+param[1]^3+
|
||||
3*param[1]*param[4]*param[3]^2+param[4]^3*param[3]^3+
|
||||
3*param[4]^2*param[3]*param[2]^2+3*param[4]^2*param[3]^3+
|
||||
3*param[4]*param[2]^2*param[3]+2*param[4]*param[3]^3
|
||||
3*param[4]*param[2]^2*param[3]+2*param[4]*param[3]^3)
|
||||
}
|
||||
|
||||
if(order==4)
|
||||
{
|
||||
6*param[1]^2*param[4]*param[3]^2+18*param[4]^2*param[3]^2*param[2]^2+
|
||||
return(6*param[1]^2*param[4]*param[3]^2+18*param[4]^2*param[3]^2*param[2]^2+
|
||||
12*param[4]*param[2]^2*param[3]^2+
|
||||
12*param[1]*param[4]*param[2]^2*param[3]+4*param[1]^3*param[4]*param[3]+
|
||||
8*param[1]*param[4]*param[3]^3+12*param[1]*param[4]^2*param[3]*param[2]^2+
|
||||
|
|
@ -54,7 +54,7 @@ mGAL <- function(order,param,type="mu",log=FALSE)
|
|||
6*param[4]^3*param[3]^2*param[2]^2+6*param[4]^3*param[3]^4+
|
||||
3*param[4]^2*param[2]^4+11*param[4]^2*param[3]^4+
|
||||
3*param[4]*param[2]^4+6*param[4]*param[3]^4+
|
||||
12*param[1]*param[4]^2*param[3]^3+4*param[1]*param[4]^3*param[3]^3
|
||||
12*param[1]*param[4]^2*param[3]^3+4*param[1]*param[4]^3*param[3]^3)
|
||||
}
|
||||
else
|
||||
stop("order must be 1,2,3 or 4")
|
||||
|
|
@ -63,26 +63,26 @@ mGAL <- function(order,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(order==1)
|
||||
{
|
||||
(1/2)*(param[4]*param[2]*sqrt(2)-param[4]*param[2]*sqrt(2)*param[2]^2+2*param[1]*param[2])/param[2]
|
||||
return((1/2)*(param[4]*param[2]*sqrt(2)-param[4]*param[2]*sqrt(2)*param[2]^2+2*param[1]*param[2])/param[2])
|
||||
}
|
||||
if(order==2)
|
||||
{
|
||||
(1/2)*(-2*param[1]*param[4]*param[2]*(param[2]+1)*(param[2]-1)*param[2]*sqrt(2)+
|
||||
return((1/2)*(-2*param[1]*param[4]*param[2]*(param[2]+1)*(param[2]-1)*param[2]*sqrt(2)+
|
||||
param[4]*param[2]^2*(param[4]+1)*param[2]^4+(-2*param[4]^2*param[2]^2+2*param[1]^2)*param[2]^2+
|
||||
param[4]*param[2]^2*(param[4]+1))/param[2]^2
|
||||
param[4]*param[2]^2*(param[4]+1))/param[2]^2)
|
||||
}
|
||||
if(order==3)
|
||||
{
|
||||
(1/4)*(-(param[2]-1)*param[4]*param[2]*(param[2]+1)*(((-2*param[2]^2+1+param[2]^4)*param[4]+
|
||||
return((1/4)*(-(param[2]-1)*param[4]*param[2]*(param[2]+1)*(((-2*param[2]^2+1+param[2]^4)*param[4]+
|
||||
2*param[2]^2+2*param[2]^4+2)*(param[4]+1)*param[2]^2+
|
||||
6*param[1]^2*param[2]^2)*sqrt(2)+(6*(param[4]*((-2*param[2]^2+1+param[2]^4)*param[4]+
|
||||
param[2]^4+1)*param[2]^2+(2/3)*param[1]^2*param[2]^2))*
|
||||
param[2]*param[1])/param[2]^3
|
||||
param[2]*param[1])/param[2]^3)
|
||||
}
|
||||
|
||||
if(order==4)
|
||||
{
|
||||
1/4*(4*param[1]^4*param[2]^4+param[4]^4*param[2]^4+6*param[4]^3*param[2]^4+11*param[4]^2*param[2]^4+6*param[4]*param[2]^4-24*param[4]^2*param[2]^4*param[1]^2*param[2]^2+12*param[4]^2*param[2]^2*param[1]^2*param[2]^2+12*param[4]^2*param[2]^6*param[1]^2*param[2]^2+12*param[4]*param[2]^6*param[1]^2*param[2]^2-4*param[4]^4*param[2]^4*param[2]^2+6*param[4]^4*param[2]^4*param[2]^4-4*param[4]^4*param[2]^4*param[2]^6+param[4]^4*param[2]^4*param[2]^8-12*param[4]^3*param[2]^4*param[2]^2+12*param[4]^3*param[2]^4*param[2]^4-12*param[4]^3*param[2]^4*param[2]^6+6*param[4]^3*param[2]^4*param[2]^8+11*param[4]^2*param[2]^4*param[2]^8-8*param[4]^2*param[2]^4*param[2]^2+6*param[4]^2*param[2]^4*param[2]^4-8*param[4]^2*param[2]^4*param[2]^6+6*param[4]*param[2]^4*param[2]^8+12*param[4]*param[2]^2*param[1]^2*param[2]^2-12*param[4]^3*param[2]^3*param[2]^3*param[1]*2^(1/2)+4*param[4]^3*param[2]^3*param[2]*param[1]*2^(1/2)+12*param[4]^2*param[2]^3*param[2]*param[1]*2^(1/2)+12*param[4]^3*param[2]^3*param[2]^5*param[1]*2^(1/2)+12*param[4]^2*param[2]^3*param[2]^5*param[1]*2^(1/2)+8*param[4]*param[2]^3*param[2]*param[1]*2^(1/2)+8*param[4]*param[2]*param[2]^3*param[1]^3*2^(1/2)-12*param[4]^2*param[2]^3*param[2]^3*param[1]*2^(1/2)-4*param[4]^3*param[2]^3*param[2]^7*param[1]*2^(1/2)-12*param[4]^2*param[2]^3*param[2]^7*param[1]*2^(1/2)-8*param[4]*param[2]^3*param[2]^7*param[1]*2^(1/2)-8*param[4]*param[2]*param[2]^5*param[1]^3*2^(1/2))/param[2]^4
|
||||
return(1/4*(4*param[1]^4*param[2]^4+param[4]^4*param[2]^4+6*param[4]^3*param[2]^4+11*param[4]^2*param[2]^4+6*param[4]*param[2]^4-24*param[4]^2*param[2]^4*param[1]^2*param[2]^2+12*param[4]^2*param[2]^2*param[1]^2*param[2]^2+12*param[4]^2*param[2]^6*param[1]^2*param[2]^2+12*param[4]*param[2]^6*param[1]^2*param[2]^2-4*param[4]^4*param[2]^4*param[2]^2+6*param[4]^4*param[2]^4*param[2]^4-4*param[4]^4*param[2]^4*param[2]^6+param[4]^4*param[2]^4*param[2]^8-12*param[4]^3*param[2]^4*param[2]^2+12*param[4]^3*param[2]^4*param[2]^4-12*param[4]^3*param[2]^4*param[2]^6+6*param[4]^3*param[2]^4*param[2]^8+11*param[4]^2*param[2]^4*param[2]^8-8*param[4]^2*param[2]^4*param[2]^2+6*param[4]^2*param[2]^4*param[2]^4-8*param[4]^2*param[2]^4*param[2]^6+6*param[4]*param[2]^4*param[2]^8+12*param[4]*param[2]^2*param[1]^2*param[2]^2-12*param[4]^3*param[2]^3*param[2]^3*param[1]*2^(1/2)+4*param[4]^3*param[2]^3*param[2]*param[1]*2^(1/2)+12*param[4]^2*param[2]^3*param[2]*param[1]*2^(1/2)+12*param[4]^3*param[2]^3*param[2]^5*param[1]*2^(1/2)+12*param[4]^2*param[2]^3*param[2]^5*param[1]*2^(1/2)+8*param[4]*param[2]^3*param[2]*param[1]*2^(1/2)+8*param[4]*param[2]*param[2]^3*param[1]^3*2^(1/2)-12*param[4]^2*param[2]^3*param[2]^3*param[1]*2^(1/2)-4*param[4]^3*param[2]^3*param[2]^7*param[1]*2^(1/2)-12*param[4]^2*param[2]^3*param[2]^7*param[1]*2^(1/2)-8*param[4]*param[2]^3*param[2]^7*param[1]*2^(1/2)-8*param[4]*param[2]*param[2]^5*param[1]^3*2^(1/2))/param[2]^4)
|
||||
}
|
||||
else
|
||||
stop("order must be 1,2,3 or 4")
|
||||
|
|
|
|||
|
|
@ -13,15 +13,15 @@
|
|||
#' @param Data Data sample
|
||||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @return gradient matrix
|
||||
#'
|
||||
#' @export mean.variance.GMM.gradient.GAL
|
||||
#' @author François Pelletier
|
||||
mean.variance.GMM.gradient <- function(param,Data,type="mu")
|
||||
mean.variance.GMM.gradient.GAL <- function(param,Data,type="mu")
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
matrix(c(-1,0,-param[4],-param[3],
|
||||
return(matrix(c(-1,0,-param[4],-param[3],
|
||||
-2*(mean(Data)-param[1]-param[3]*param[4]),-2*param[2]*param[4],2*param[4]*(mean(Data)-param[1]-param[3]*param[4])+2*param[3]*param[4],-2*param[3]*(mean(Data)-param[1]-param[3]*param[4])-param[2]^2-param[3]^2),
|
||||
nrow=4,ncol=2)
|
||||
nrow=4,ncol=2))
|
||||
}
|
||||
}
|
||||
|
||||
10
R/mgfGAL.R
10
R/mgfGAL.R
|
|
@ -11,7 +11,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return Moment generating function value at point u for given parameter vector
|
||||
#'
|
||||
#' @export mgfGAL
|
||||
#' @author Francois Pelletier
|
||||
mgfGAL <- function(u,param,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -20,22 +20,22 @@ mgfGAL <- function(u,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
exp(exp(param[1])*u)*(1-(1/2)*exp(param[2])^2*u^2-exp(param[3])*u)^(-exp(param[4]))
|
||||
return(exp(exp(param[1])*u)*(1-(1/2)*exp(param[2])^2*u^2-exp(param[3])*u)^(-exp(param[4])))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
exp(exp(param[1])*u)*((exp(param[2])^2*u^2)/2+(exp(param[3])*exp(param[2])*u)/sqrt(2)-(exp(param[2])*u)/(sqrt(2)*exp(param[3]))+1)^(-exp(param[4]))
|
||||
return(exp(exp(param[1])*u)*((exp(param[2])^2*u^2)/2+(exp(param[3])*exp(param[2])*u)/sqrt(2)-(exp(param[2])*u)/(sqrt(2)*exp(param[3]))+1)^(-exp(param[4])))
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
exp(param[1]*u)*(1-(1/2)*param[2]^2*u^2-param[3]*u)^(-param[4])
|
||||
return(exp(param[1]*u)*(1-(1/2)*param[2]^2*u^2-param[3]*u)^(-param[4]))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
exp(param[1]*u)*((param[2]^2*u^2)/2+(param[3]*param[2]*u)/sqrt(2)-(param[2]*u)/(sqrt(2)*param[3])+1)^(-param[4])
|
||||
return(exp(param[1]*u)*((param[2]^2*u^2)/2+(param[3]*param[2]*u)/sqrt(2)-(param[2]*u)/(sqrt(2)*param[3])+1)^(-param[4]))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -15,8 +15,9 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @param start Starting value of the process
|
||||
|
||||
#' @export pnormapproxEsscherLM
|
||||
#' @return Normal distribution function approximation
|
||||
#' @author Francois Pelletier
|
||||
pnormapproxEsscherLM <- function(x,param,hEsscher=0,eval.time=1,type="mu",log=FALSE,start=0)
|
||||
{
|
||||
pnorm(x,start+eval.time*(mGAL(1,param,type,log)+hEsscher*cmGAL(2,param,type,log)),
|
||||
|
|
|
|||
|
|
@ -13,8 +13,9 @@
|
|||
#' @param eval.time Time of the process
|
||||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
|
||||
#' @return Saddlepoint approximation of the distribution function
|
||||
#' @export psaddleapproxEsscherGAL
|
||||
#' @author Francois Pelletier
|
||||
psaddleapproxEsscherGAL <- function(x,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
s <- saddlepointEsscherGAL(x,param,eval.time,type,log)
|
||||
|
|
@ -23,11 +24,11 @@ psaddleapproxEsscherGAL <- function(x,param,eval.time=1,type="mu",log=FALSE)
|
|||
|
||||
if(x==mGAL(1,param,type,log))
|
||||
{
|
||||
1/2 + diffcgfEsscherGAL(0,3,param,eval.time,type,log)/
|
||||
(6*sqrt(2*pi)*diffcgfEsscherGAL(0,2,param,eval.time,type,log)^(3/2))
|
||||
return(1/2 + diffcgfEsscherGAL(0,3,param,eval.time,type,log)/
|
||||
(6*sqrt(2*pi)*diffcgfEsscherGAL(0,2,param,eval.time,type,log)^(3/2)))
|
||||
}
|
||||
else
|
||||
{
|
||||
pnorm(w)+dnorm(w)*(1/w-1/u)
|
||||
return(pnorm(w)+dnorm(w)*(1/w-1/u))
|
||||
}
|
||||
}
|
||||
|
|
@ -13,8 +13,9 @@
|
|||
#' @param eval.time Time of the process
|
||||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
|
||||
#' @return Saddlepoint approximation of the distribution function
|
||||
#' @export psaddleapproxGAL
|
||||
#' @author Francois Pelletier
|
||||
psaddleapproxGAL <- function(x,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
s <- saddlepointGAL(x,param,eval.time,type,log)
|
||||
|
|
@ -23,11 +24,11 @@ psaddleapproxGAL <- function(x,param,eval.time=1,type="mu",log=FALSE)
|
|||
|
||||
if(x==mGAL(1,param,type,log))
|
||||
{
|
||||
1/2 + diffcgfGAL(0,3,param,eval.time,type,log)/
|
||||
(6*sqrt(2*pi)*diffcgfGAL(0,2,param,eval.time,type,log)^(3/2))
|
||||
return(1/2 + diffcgfGAL(0,3,param,eval.time,type,log)/
|
||||
(6*sqrt(2*pi)*diffcgfGAL(0,2,param,eval.time,type,log)^(3/2)))
|
||||
}
|
||||
else
|
||||
{
|
||||
pnorm(w)+dnorm(w)*(1/w-1/u)
|
||||
return(pnorm(w)+dnorm(w)*(1/w-1/u))
|
||||
}
|
||||
}
|
||||
|
|
|
|||
10
R/rGAL.R
10
R/rGAL.R
|
|
@ -12,7 +12,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return A vector of random numbers
|
||||
#'
|
||||
#' @export rGAL
|
||||
#' @author Francois Pelletier
|
||||
rGAL <- function(n,param,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -21,7 +21,7 @@ rGAL <- function(n,param,type="mu",log=FALSE)
|
|||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
rGAL(n,changetypeGAL(param,type="mu",target="kappa"),type="kappa",log=log)
|
||||
return(rGAL(n,changetypeGAL(param,type="mu",target="kappa"),type="kappa",log=log))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
|
|
@ -30,14 +30,14 @@ rGAL <- function(n,param,type="mu",log=FALSE)
|
|||
rgamma2 <- rgamma(n, shape = exp(param[4]), scale = exp(param[3]))
|
||||
|
||||
# simulation de la variable GAL
|
||||
exp(param[1]) + exp(param[2])/sqrt(2)*(rgamma1 - rgamma2)
|
||||
return(exp(param[1]) + exp(param[2])/sqrt(2)*(rgamma1 - rgamma2))
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
rGAL(n,changetypeGAL(param,type="mu",target="kappa"),type="kappa",log=log)
|
||||
return(rGAL(n,changetypeGAL(param,type="mu",target="kappa"),type="kappa",log=log))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
|
|
@ -46,7 +46,7 @@ rGAL <- function(n,param,type="mu",log=FALSE)
|
|||
rgamma2 <- rgamma(n, shape = param[4], scale = param[3])
|
||||
|
||||
# simulation de la variable GAL
|
||||
param[1] + param[2]/sqrt(2)*(rgamma1 - rgamma2)
|
||||
return(param[1] + param[2]/sqrt(2)*(rgamma1 - rgamma2))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -11,24 +11,24 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return Risk neutral parameter vector
|
||||
#'
|
||||
#' @export riskneutralparGAL
|
||||
#' @author Francois Pelletier
|
||||
riskneutralparGAL <- function(param,riskfree,type="mu",log=FALSE)
|
||||
{
|
||||
testparGAL(param,type,log)
|
||||
if(type=="kappa")
|
||||
{
|
||||
riskneutralparGAL(changetypeGAL(param,type="kappa",target="mu"),riskfree,type="mu",log)
|
||||
return(riskneutralparGAL(changetypeGAL(param,type="kappa",target="mu"),riskfree,type="mu",log))
|
||||
}
|
||||
if(type=="mu")
|
||||
{
|
||||
if(log)
|
||||
{
|
||||
c(log(riskfree+log(1-exp(param[3])-exp(param[2])^2/2)*param[4]),param[2],param[3],param[4])
|
||||
return(c(log(riskfree+log(1-exp(param[3])-exp(param[2])^2/2)*param[4]),param[2],param[3],param[4]))
|
||||
}
|
||||
else
|
||||
{
|
||||
c(riskfree+log(1-param[3]-param[2]^2/2)*param[4],param[2],param[3],param[4])
|
||||
return(c(riskfree+log(1-param[3]-param[2]^2/2)*param[4],param[2],param[3],param[4]))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,19 +15,19 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return The value of the saddlepoint for each point of the vector of quantiles
|
||||
#'
|
||||
#' @export saddlepointEsscherGAL
|
||||
#' @author Francois Pelletier
|
||||
saddlepointEsscherGAL <- function(x,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
(-eval.time*param[1]*param[2]^2+eval.time*param[4]*param[2]^2+x*param[2]^2-
|
||||
return((-eval.time*param[1]*param[2]^2+eval.time*param[4]*param[2]^2+x*param[2]^2-
|
||||
eval.time*param[1]*param[3]+x*param[3]-
|
||||
sqrt(eval.time^2*param[1]^2*param[3]^2-2*eval.time*param[1]*param[3]^2*x+
|
||||
eval.time^2*param[4]^2*param[2]^4+x^2*param[3]^2+
|
||||
2*eval.time^2*param[1]^2*param[2]^2-
|
||||
4*eval.time*param[1]*param[2]^2*x+2*x^2*param[2]^2))/
|
||||
(param[2]^2*(eval.time*param[1]-x))
|
||||
(param[2]^2*(eval.time*param[1]-x)))
|
||||
}
|
||||
else if (type=="kappa")
|
||||
{
|
||||
|
|
|
|||
|
|
@ -13,17 +13,17 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return The value of the saddlepoint for each point of the vector of quantiles
|
||||
#'
|
||||
#' @export saddlepointGAL
|
||||
#' @author Francois Pelletier
|
||||
saddlepointGAL <- function(x,param,eval.time=1,type="mu",log=FALSE)
|
||||
{
|
||||
if(type=="mu")
|
||||
{
|
||||
(-eval.time*param[1]*param[3]+eval.time*param[4]*param[2]^2+x*param[3]-
|
||||
return((-eval.time*param[1]*param[3]+eval.time*param[4]*param[2]^2+x*param[3]-
|
||||
(eval.time^2*param[1]^2*param[3]^2-2*eval.time*param[1]*param[3]^2*x+
|
||||
eval.time^2*param[4]^2*param[2]^4+x^2*param[3]^2+2*eval.time^2*param[1]^2*
|
||||
param[2]^2-4*eval.time*param[1]*param[2]^2*x+2*x^2*param[2]^2)^(1/2))/
|
||||
param[2]^2/(eval.time*param[1]-x)
|
||||
param[2]^2/(eval.time*param[1]-x))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
#' @param scale Scale shift (in standard deviations)
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return The transformed parameter vector
|
||||
#'
|
||||
#' @export scaleGAL
|
||||
#' @author Francois Pelletier
|
||||
scaleGAL <- function(param,type="kappa",location,scale,log=FALSE)
|
||||
{
|
||||
|
|
@ -24,13 +24,13 @@ scaleGAL <- function(param,type="kappa",location,scale,log=FALSE)
|
|||
{
|
||||
if(type=="kappa")
|
||||
{
|
||||
param * c(scale,scale,1,1) + c(location,0,0,0)
|
||||
return(param * c(scale,scale,1,1) + c(location,0,0,0))
|
||||
}
|
||||
else if (type=="mu")
|
||||
{
|
||||
changetypeGAL(
|
||||
return(changetypeGAL(
|
||||
scaleGAL(changetypeGAL(param,type="mu",target="kappa"),type="kappa",location,scale),
|
||||
type="kappa",target="mu")
|
||||
type="kappa",target="mu"))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return a vector of estimated parameters
|
||||
#'
|
||||
#' @export startparamGAL
|
||||
#' @author Francois Pelletier
|
||||
startparamGAL <- function(data,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -26,12 +26,12 @@ startparamGAL <- function(data,type="mu",log=FALSE)
|
|||
mu <- mom[3]*sigma*sqrt(2/(3*(mom[4])))
|
||||
theta <- mom[1]-tau*mu
|
||||
if(log==FALSE)
|
||||
c(theta,sigma,mu,tau)
|
||||
return(c(theta,sigma,mu,tau))
|
||||
else
|
||||
log(c(theta,sigma,mu,tau))
|
||||
return(log(c(theta,sigma,mu,tau)))
|
||||
}
|
||||
if(type=="kappa")
|
||||
{
|
||||
changetypeGAL(startparamGAL(data,type="mu",log),type="kappa",target="mu",log)
|
||||
return(changetypeGAL(startparamGAL(data,type="mu",log),type="kappa",target="mu",log))
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@
|
|||
#' @param type Choose between "mu" or "kappa" parametrization
|
||||
#' @param log Logical for log-parameters
|
||||
#' @return logical
|
||||
#'
|
||||
#' @export testparGAL
|
||||
#' @author Francois Pelletier
|
||||
testparGAL <- function(param,type="mu",log=FALSE)
|
||||
{
|
||||
|
|
@ -49,5 +49,5 @@ testparGAL <- function(param,type="mu",log=FALSE)
|
|||
stop("param 4 must be positive")
|
||||
}
|
||||
}
|
||||
TRUE
|
||||
return(TRUE)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -30,4 +30,7 @@ transform of the specified Laplace motion
|
|||
Normal approximation of the density function of the Esscher
|
||||
transform of a Laplace Motion
|
||||
}
|
||||
\author{
|
||||
Francois Pelletier
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -24,4 +24,7 @@ Saddlepoint approximation of the density function
|
|||
Saddlepoint approximation of the density function of the
|
||||
GAL distribution
|
||||
}
|
||||
\author{
|
||||
Francois Pelletier
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -29,4 +29,7 @@ Normal distribution function approximation
|
|||
Normal approximation of the distribution function of the
|
||||
Esscher transform of a Laplace Motion
|
||||
}
|
||||
\author{
|
||||
Francois Pelletier
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -24,4 +24,7 @@ Saddlepoint approximation of the distribution function
|
|||
Saddlepoint approximation of the distribution function of
|
||||
the Esscher transform of the GAL distribution
|
||||
}
|
||||
\author{
|
||||
Francois Pelletier
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -24,4 +24,7 @@ Saddlepoint approximation of the distribution function
|
|||
Saddlepoint approximation of the distribution function of
|
||||
the GAL distribution
|
||||
}
|
||||
\author{
|
||||
Francois Pelletier
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue