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

Ajout des fonctions dampedcfcallCarrMadan, dchangetypeGAL, dmGAL,

Browse source 
dscaleGAL
This commit is contained in:
François Pelletier 2014-02-22 13:28:27 -05:00
parent 1debac4cff
commit 3ea9baa55d
14 changed files with 362 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

4
R/cfLM.R
View file

@ -7,15 +7,15 @@
#' Characteristic function of Laplace motion
#' @param u Transform variate
#' @param param Parameter vector
#' @param time Time of the process
#' @param param Parameter vector
#' @param type Choose between "mu" or "kappa" parametrization
#' @param log Logical for log-parameters
#' @param start Starting value of the process
#' @return Characteristic function value at point u for given parameter vector
#'
#' @author Francois Pelletier
cfLM <- function(u,param,time=1,type="mu",log=FALSE,start=0)
cfLM <- function(u,time,param,type="mu",log=FALSE,start=0)
{
testparGAL(param,type,log)
if(log)

44
R/dampedcfcallCarrMadan.R Normal file
View file

@ -0,0 +1,44 @@
# Damped characteristic function of the call option log-price
#
# Author: Francois Pelletier
#
# LGPL 3.0
###############################################################################
#' Damped characteristic function of the call option log-price
#' @param u Transform variate
#' @param char.fn Characteristic function of the log-price process
#' @param eval.time Evaluation time
#' @param expiry.time Expiry time
#' @param rate Continuously compounded interest rate (force of interest)
#' @param alpha Damping parameter
#' @param ... Parameters of the characteristic function
#' @param moneyness Boolean for moneyness of call option
#' (TRUE if strike price is lower than stock price)
#' @return Characteristic function value
#'
#' @author Francois Pelletier
dampedcfcallCarrMadan <- function(u,char.fn,eval.time,expiry.time,rate,alpha,...,moneyness=TRUE)
{
if(moneyness)
{
exp(-rate*(expiry.time-eval.time))*
char.fn(u-1i*(alpha+1),expiry.time-eval.time,...) /
(alpha^2+alpha-u^2+1i*u*(2*alpha+1))
}
else
{
auxiliairyf <- function(u,char.fn,eval.time,expiry.time,rate,alpha,...)
{
exp(-rate*(expiry.time-eval.time))*
(1/(1+1i*u)-exp(rate*(expiry.time-eval.time))/
(1i*u)-char.fn(u-1i,expiry.time-eval.time,...)/(u^2-1i*u))
}
(auxiliairyf(u-1i*alpha,char.fn,eval.time,expiry.time,rate,alpha,...)-
auxiliairyf(u+1i*alpha,char.fn,eval.time,expiry.time,rate,alpha,...))/2
}
}

47
R/dchangetypeGAL.R Normal file
View file

@ -0,0 +1,47 @@
# Derivative vector of the type change function
#
# Author: Francois Pelletier
#
# LGPL 3.0
###############################################################################
#' Derivative vector of the type change function
#' @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 derivative matrix of the type change function
#'
#' @author Francois Pelletier
dchangetypeGAL <- function(param,type="mu",target="kappa",log=FALSE)
{
testparGAL(param,type,log)
if(log)
{
if(type=="mu" && target=="kappa")
{
}
else if(type=="kappa" && target=="mu")
{
}
}
else
{
if(type=="mu" && target=="kappa")
{
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)
}
else if(type=="kappa" && target=="mu")
{
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)
}
}
}

87
R/dmGAL.R Normal file
View file

@ -0,0 +1,87 @@
# Derivative vector of the mean and standard deviation of GAL distribution
#
# Author: Francois Pelletier
#
# LGPL 3.0
###############################################################################
#' Derivative vector of the mean and standard deviation of GAL distribution
#' @param param Parameter vector
#' @param order 1 for mean, 2 for standard deviation
#' @param type Choose between "mu" or "kappa" parametrization
#' @param log Logical for log-parameters
#' @return A vector of the derivative of the analytical moment
#'
#' @author Francois Pelletier
dmGAL <- function(param,order,type="mu",log=FALSE)
{ if(log)
{
eparam <- exp(param)
if(order==1)
{
if(type=="mu")
{
c(1,0,eparam[4],eparam[3])
}
else if(type=="kappa")
{
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])
}
}
if(order==2)
{
if(type=="mu")
{
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))
}
else if(type=="kappa")
{
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))
}
}
}
else
{
if(order==1)
{
if(type=="mu")
{
c(1,0,param[4],param[3])
}
else if(type=="kappa")
{
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])
}
}
if(order==2)
{
if(type=="mu")
{
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))
}
else if(type=="kappa")
{
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))
}
}
}
}

34
R/dscaleGAL.R Normal file
View file

@ -0,0 +1,34 @@
# Derivative of scale and location transform to the GAL distribution
#
# Author: Francois Pelletier
#
# LGPL 3.0
###############################################################################
#' Derivative of scale and location transform to the GAL distribution
#' @param param Parameter vector
#' @param type Choose between "mu" or "kappa" parametrization
#' @param location Location shift (unitary)
#' @param scale Scale shift (in standard deviations)
#' @param log Logical for log-parameters
#' @return The matrix derivative of the transformed parameter vector
#'
#' @author Francois Pelletier
dscaleGAL <- function(param,type="kappa",location,scale,log=FALSE)
{
if(log)
{
}
else
{
if(type=="kappa")
{
diag(c(scale,scale,1,1))
}
else if (type=="mu")
{
}
}
}

21
R/scaleGAL.R
View file

@ -5,25 +5,32 @@
# LGPL 3.0
###############################################################################
#' Apply scale and location transform to the GAL distribution
#' @param param Parameter vector
#' @param type Choose between "mu" or "kappa" parametrization
#' @param location Location shift (unitary)
#' @param scale Scale shift (in standard deviations)
#' @param log Logical for log-parameters
#' @return The transformed parameter vector
#'
#' @author Francois Pelletier
scaleGAL <- function(param,type="kappa",location,scale)
scaleGAL <- function(param,type="kappa",location,scale,log=FALSE)
{
if(type=="kappa")
if(log)
{
param * c(scale,scale,1,1) + c(location,0,0,0)
}
else
{
changetypeGAL(
scaleGAL(changetypeGAL(param,type="mu",target="kappa"),type="kappa",location,scale),
type="kappa",target="mu")
if(type=="kappa")
{
param * c(scale,scale,1,1) + c(location,0,0,0)
}
else if (type=="mu")
{
changetypeGAL(
scaleGAL(changetypeGAL(param,type="mu",target="kappa"),type="kappa",location,scale),
type="kappa",target="mu")
}
}
}