Ajout des fonctions EppsPulley.test, callCarrMadan

R/EppsPulley.test.R

@@ -0,0 +1,43 @@
+# Approximate Epps-Pulley normality test
+# 
+# Author: Francois Pelletier
+#
+# LGPL 3.0
+###############################################################################
+
+#' Approximate Epps-Pulley normality test
+#'
+#' An Approximation to the Limit Distribution
+#' of the Epps-Pulley Test Statistic for Normality
+#' By N. Henze
+#' Metrika (1990) 37:7-18
+#' @param x Sample
+#' @param alpha Tolerance level
+#' @return A list containing the test statistics
+#' 
+#' @author François Pelletier
+EppsPulley.test <- function(x,alpha=0.05)
+{
+	## Statistics
+	n <- length(x)
+	if (n<10) stop("n doit être supérieur à 10")
+	xbar <- mean(x)
+	S <- sd(x)
+	## Constants
+	gamma <- 3.55295
+	delta <- 1.23062
+	lambda <- 2.26664
+	xi <- -0.020682
+	## Calculations
+	T <- 2/n*sum(outer(x,x,function(x,y) exp(-0.5*(x-y)^2 / S^2))*
+							outer(1:n,1:n,function(x,y) x<y)) -
+			sqrt(2)*sum(exp(-0.25*(x-xbar)^2/S^2))+
+			n/sqrt(3)+1
+	Tmod <- (T - 0.365/n + 1.34/n^2)*(1 + 1.3/n)
+	Z <- gamma+delta*log((Tmod-xi)/(xi+lambda-Tmod))
+	Pvalue <- 1-pnorm(Z)
+	reject <- Pvalue<alpha
+	cat(sprintf("\nTest de normalité de Epps-Pulley\n\n T: %f\n T*: %f\np-value: %f\n\n",T,Tmod,Pvalue))
+	list(Tstat=T,Tmod=Tmod,Zscore=Z,Pvalue=Pvalue,Reject=reject)
+}
+

R/callCarrMadan.R

@@ -0,0 +1,58 @@
+# Call price using the Carr-Madan damping parameter and FFT
+# 
+# Author: Francois Pelletier
+#
+# LGPL 3.0
+###############################################################################
+
+
+#' Call price using the Carr-Madan damping parameter and FFT
+#' @param strikeprice Vector of strike prices, relative to a unit stock price
+#' @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 fft.control Control parameters list for the FFT discretization
+#' @return A European call option price vector
+#' 
+#' @author Francois Pelletier
+callCarrMadan <- function(strikeprice,char.fn,eval.time,expiry.time,rate,alpha,
+		...,fft.control=list(N=2^14,eta=.1))
+{
+	# Determine moneyness
+	moneyness <- strikeprice < 1
+	# Discretization step for Fourier transform
+	lambda <- lambda <- (2*pi) / (fft.control$N*fft.control$eta) 
+	# Evaluation points of the damped characteristic function of the call option log-price
+	u <- seq(0,(fft.control$N-1)*fft.control$eta,fft.control$eta)
+	# Upper bound
+	b <- (fft.control$N * lambda)/2
+	# Vector of indices
+	jvec <- 1:fft.control$N
+	# Simpson's hypothesis
+	simpsonh <- ((dampedcfcallCarrMadan(u,char.fn,eval.time,expiry.time,rate,alpha,moneyness,param)*
+					exp(1i*u*b)*fft.control$eta)/3)*
+			(3+(-1)^jvec+((jvec-1)==0))
+	# Log-price vector
+	ku <- seq(-b,(fft.control$N-1)*lambda-b,lambda)
+	# Log-price of the call option vector
+	if(moneyness)
+	{
+		callvec <- Re((exp(-alpha*ku)*fft(simpsonh))/pi)
+	}
+	else
+	{
+		callvec <- fft(simpsonh)/(sinh(alpha*ku)*pi)
+	}
+	# Price vector
+	Ku <- exp(ku)
+	# Index to select subset of prices in the strikeprice vector
+	Kindex <- Ku>=(min(strikeprice)-1) & Ku<=(max(strikeprice)+1)
+	# We use a smooth spline to get the prices for the strikeprice vector
+	sp0 <- smooth.spline(x=Ku[indice],y=callvec[indice])
+	predict(sp0,strikeprice)$y
+}
+	
+

R/putEpps.R

@@ -8,14 +8,14 @@
 #' European put option pricing using characteristic function 
 #' 
 #' As seen in Epps (2009)
-#' @param strikeprice Strike price, relative to a unit stock price
+#' @param strikeprice Strike price vector, relative to a unit stock price
 #' @param char.fn Characteristic function of the price level at expiry time
 #' @param eval.time Evaluation time
 #' @param expiry.time Expiry time
 #' @param rate Continuously compounded interest rate (force of interest)
 #' @param ... Parameters of the characteristic function
 #' @param int.bounds Integration bounds for the integrate() method used. Defaults to infinite bounds.
-#' @return European put option price
+#' @return European put option price vector
 #' 
 #' @author Francois Pelletier
 putEpps <- function(strikeprice,char.fn,eval.time,expiry.time,rate,...,int.bounds=c(-Inf,Inf))