From noreply at r-forge.r-project.org Mon Aug 19 12:05:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 Aug 2013 12:05:04 +0200 (CEST) Subject: [Highfrequency-commits] r43 - pkg/highfrequency/man Message-ID: <20130819100505.0A155183BBB@r-forge.r-project.org> Author: kboudt Date: 2013-08-19 12:05:04 +0200 (Mon, 19 Aug 2013) New Revision: 43 Modified: pkg/highfrequency/man/spotVol.rd Log: Christophe Bergmeir bug report: There is an error in the user manual, page 60: 'Possible values are "TML","sd", "wsd", "OLS"'. With lowercase "wsd" and "sd", the function doesn't work, it needs to be upper case Modified: pkg/highfrequency/man/spotVol.rd =================================================================== --- pkg/highfrequency/man/spotVol.rd 2013-03-29 15:19:33 UTC (rev 42) +++ pkg/highfrequency/man/spotVol.rd 2013-08-19 10:05:04 UTC (rev 43) @@ -34,7 +34,7 @@ \item{dailyvol}{determines the estimation method for the component of intraday volatility that is constant over the day, but changes from day to day. Possible values are "bipower","rv", "medrv".} \item{periodicvol}{determines the estimation method for the component of intraday volatility that depends in a deterministic way on the intraday time - at which the return is observed. Possible values are "TML","sd", "wsd", "OLS".} + at which the return is observed. Possible values are "TML","SD", "WSD", "OLS".} \item{on}{ character, indicating the time scale in which "k" is expressed. Possible values are: "secs", "seconds", "mins", "minutes","hours".} \item{k}{ positive integer, indicating the number of periods to aggregate over. E.g. to aggregate a xts object to the 5 minute frequency set k=5 and on="minutes".} From noreply at r-forge.r-project.org Mon Aug 19 12:05:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 Aug 2013 12:05:33 +0200 (CEST) Subject: [Highfrequency-commits] r44 - pkg/highfrequency/R Message-ID: <20130819100533.8AC82183BBB@r-forge.r-project.org> Author: kboudt Date: 2013-08-19 12:05:32 +0200 (Mon, 19 Aug 2013) New Revision: 44 Modified: pkg/highfrequency/R/realized.R Log: Make it consistent with latest version on github Modified: pkg/highfrequency/R/realized.R =================================================================== --- pkg/highfrequency/R/realized.R 2013-08-19 10:05:04 UTC (rev 43) +++ pkg/highfrequency/R/realized.R 2013-08-19 10:05:32 UTC (rev 44) @@ -1,4144 +1,4677 @@ -# This file contains all realized measures previously implemented in RTAQ and realized -######################################################## -## Help functions: (not exported) -######################################################## -.multixts <- function( x, y=NULL) -{ - if(is.null(y)){ - test = is.xts(x) && (ndays(x)!=1); - return(test);} - if(!is.null(y)){ - test = (is.xts(x) && (ndays(x)!=1)) || ( ndays(y)!=1 && is.xts(y) ); - if( test ){ - test1 = dim(y) == dim(x); - if(!test1){ warning("Please make sure x and y have the same dimensions") } - if(test1){ test = list( TRUE, cbind(x,y) ); return(test) } - } - } -} -RV = function(rdata,...){ - if(hasArg(data)){ rdata = data } - returns=as.numeric(rdata); - RV = sum(returns*returns); - return(RV); -} -RBPCov_bi = function(ts1,ts2){ - n = length(ts1); - a = abs(ts1+ts2); - b = abs(ts1-ts2); - first = as.numeric(a[1:(n-1)])*as.numeric(a[2:n]); - last = as.numeric(b[1:(n-1)])*as.numeric(b[2:n]); - result = (pi/8)*sum(first-last); - return(result); -} -#Realized BiPower Variation (RBPVar) (RBPVar) -RBPVar = function(rdata,...){ - if(hasArg(data)){ rdata = data } + + + + + + highfrequency/R/realized.R at 6eae3f5a44710b42ebab370a781a3b1381e8bc17 ? jonathancornelissen/highfrequency ? GitHub + + + + + + + + + + + + - returns = as.vector(as.numeric(rdata)); - n = length(returns); - rbpvar = (pi/2)*sum(abs(returns[1:(n-1)])*abs(returns[2:n])); - return(rbpvar); -} - -# Check data: -rdatacheck = function (rdata, multi = FALSE) -{ - if ((dim(rdata)[2] < 2) & (multi)) { - stop("Your rdata object should have at least 2 columns") - } -} - -######## rowcov helper functions: -#Realized Outlyingness Weighted Quadratic Covariation (ROWQCov) -conhuber = function(di,alpha=0.05) -{# consistency factor ROWQCov based on Huber weight function - c = qchisq(p=1-alpha,df=di) - fw2 = function(t){ - z=t^2; return( huberweight(z,c)*( t^(di-1) )*exp(-z/2) ) } - fw1 = function(t){ - z=t^2; return( huberweight(z,c)*( t^(di+1) )*exp(-z/2) )} - c2 = integrate(fw2,0,Inf)$value; c1 = integrate(fw1,0,Inf)$value; - return( di*c2/c1 ) -} - -conHR = function(di,alpha=0.05) -{ - # consistency factor ROWQCov based on hard rejection weight function - return( (1-alpha)/pchisq(qchisq(1-alpha,df=di),df=di+2) ) -} - -huberweight = function(d,k){ - # Huber or soft rejection weight function - w = apply( cbind( rep(1,length(d) ) , (k/d) ),1,'min'); return(w); -} - -countzeroes = function( series ) -{ - return( sum( 1*(series==0) ) ) -} - -#Realized Outlyingness Weighted Variance (ROWVar): -univariateoutlyingness = function(rdata,...){ - require('robustbase'); - if(hasArg(data)){ rdata = data } - #computes outlyingness of each obs compared to row location and scale - location = 0; - scale = mad(rdata); - if(scale==0){ - scale = mean(rdata); - } - d = ((rdata - location)/scale)^2; -} - - -ROWVar = function(rdata, seasadjR = NULL, wfunction = "HR" , alphaMCD = 0.75, alpha = 0.001,...) -{ - require('robustbase'); - if(hasArg(data)){ rdata = data } - require(robustbase) - if (is.null(seasadjR)) { - seasadjR = rdata; - } - rdata = as.vector(rdata); seasadjR = as.vector(seasadjR); - intraT = length(rdata); N=1; - MCDcov = as.vector(covMcd( rdata , use.correction = FALSE )$raw.cov) - outlyingness = seasadjR^2/MCDcov - k = qchisq(p = 1 - alpha, df = N) - outlierindic = outlyingness > k - weights = rep(1, intraT) - if( wfunction == "HR" ){ - weights[outlierindic] = 0 - wR = sqrt(weights) * rdata - return((conHR(di = N, alpha = alpha) * sum(wR^2))/mean(weights)) - } - if( wfunction == "SR" ){ - weights[outlierindic] = k/outlyingness[outlierindic] - wR = sqrt(weights) * rdata - return((conhuber(di = N, alpha = alpha) * sum(wR^2))/mean(weights)) - } - -} -#### Two time scale helper functions: -TSRV = function ( pdata , K=300 , J=1 ) -{ - # based on rv.timescale - logprices = log(as.numeric(pdata)) - n = length(logprices) ; - nbarK = (n - K + 1)/(K) # average number of obs in 1 K-grid - nbarJ = (n - J + 1)/(J) - adj = (1 - (nbarK/nbarJ))^-1 - logreturns_K = logreturns_J = c(); - for( k in 1:K){ - sel = seq(k,n,K) - logreturns_K = c( logreturns_K , diff( logprices[sel] ) ) - } - for( j in 1:J){ - sel = seq(j,n,J) - logreturns_J = c( logreturns_J , diff( logprices[sel] ) ) - } - TSRV = adj * ( (1/K)*sum(logreturns_K^2) - ((nbarK/nbarJ) *(1/J)*sum(logreturns_J^2))) - return(TSRV) -} -RTSRV = function (pdata, startIV = NULL, noisevar = NULL, K = 300, J = 1, -eta = 9){ - logprices = log(as.numeric(pdata)) - n = length(logprices) - nbarK = (n - K + 1)/(K) - nbarJ = (n - J + 1)/(J) - adj = (1 - (nbarK/nbarJ))^-1 - zeta = 1/pchisq(eta, 3) - seconds = as.numeric(as.POSIXct(index(pdata))) - secday = last(seconds) - first(seconds) - logreturns_K = vdelta_K = logreturns_J = vdelta_J = c() - for (k in 1:K) { - sel = seq(k, n, K) - logreturns_K = c(logreturns_K, diff(logprices[sel])) - vdelta_K = c(vdelta_K, diff(seconds[sel])/secday) - } - for (j in 1:J) { - sel = seq(j, n, J) - logreturns_J = c(logreturns_J, diff(logprices[sel])) - vdelta_J = c(vdelta_J, diff(seconds[sel])/secday) - } - if (is.null(noisevar)) { - noisevar = max(0,1/(2 * nbarJ) * (sum(logreturns_J^2)/J - TSRV(pdata=pdata,K=K,J=J))) - } - if (!is.null(startIV)) { - RTSRV = startIV - } - if (is.null(startIV)) { - sel = seq(1, n, K) - RTSRV = medRV(diff(logprices[sel])) - } - iter = 1 - while (iter <= 20) { - I_K = 1 * (logreturns_K^2 <= eta * (RTSRV * vdelta_K + - 2 * noisevar)) - I_J = 1 * (logreturns_J^2 <= eta * (RTSRV * vdelta_J + - 2 * noisevar)) - if (sum(I_J) == 0) { - I_J = rep(1, length(logreturns_J)) - } - if (sum(I_K) == 0) { - I_K = rep(1, length(logreturns_K)) - } - RTSRV = adj * (zeta * (1/K) * sum(logreturns_K^2 * I_K)/mean(I_K) - - ((nbarK/nbarJ) * zeta * (1/J) * sum(logreturns_J^2 * - I_J)/mean(I_J))) - iter = iter + 1 - } - return(RTSRV) -} + + + + - -RTSCov_bi = -function (pdata1, pdata2, startIV1 = NULL, startIV2 = NULL, noisevar1 = NULL, -noisevar2 = NULL, K = 300, J = 1, -K_cov = NULL , J_cov = NULL , -K_var1 = NULL , K_var2 = NULL , -J_var1 = NULL , J_var2 = NULL , -eta = 9) -{ - if( is.null(K_cov)){ K_cov = K } ; if( is.null(J_cov)){ J_cov = J } - if( is.null(K_var1)){ K_var1 = K } ; if( is.null(K_var2)){ K_var2 = K } - if( is.null(J_var1)){ J_var1 = J } ; if( is.null(J_var2)){ J_var2 = J } - # Calculation of the noise variance and TSRV for the truncation - - - if ( is.null(noisevar1) ) { - logprices1 = log(as.numeric(pdata1)) - n_var1 = length(logprices1) - nbarK_var1 = (n_var1 - K_var1 + 1)/(K_var1) ; - nbarJ_var1 = (n_var1 - J_var1 + 1)/(J_var1) - adj_var1 = n_var1/((K_var1 - J_var1) * nbarK_var1) - - logreturns_K1 = logreturns_J1 = c() - for (k in 1:K_var1) { - sel.avg = seq(k, n_var1, K_var1) - logreturns_K1 = c(logreturns_K1, diff(logprices1[sel.avg])) - } - for (j in 1:J_var1) { - sel.avg = seq(j, n_var1, J_var1) - logreturns_J1 = c(logreturns_J1, diff(logprices1[sel.avg])) - } - if( is.null(noisevar1) ){ - noisevar1 = max(0,1/(2 * nbarJ_var1) * (sum(logreturns_J1^2)/J_var1 - TSRV(pdata1,K=K_var1,J=J_var1))) - } - } - if (is.null(noisevar2)) { - logprices2 = log(as.numeric(pdata2)) - n_var2 = length(logprices2) - nbarK_var2 = (n_var2 - K_var2 + 1)/(K_var2) ; - nbarJ_var2 = (n_var2 - J_var2 + 1)/(J_var2) - adj_var2 = n_var2/((K_var2 - J_var2) * nbarK_var2) - - logreturns_K2 = logreturns_J2 = c() - for (k in 1:K_var2) { - sel.avg = seq(k, n_var2, K_var2) - logreturns_K2 = c(logreturns_K2, diff(logprices2[sel.avg])) - } - for (j in 1:J_var2) { - sel.avg = seq(j, n_var2, J_var2) - logreturns_J2 = c(logreturns_J2, diff(logprices2[sel.avg])) - } - noisevar2 = max(0,1/(2 * nbarJ_var2) * (sum(logreturns_J2^2)/J_var2 - TSRV(pdata2,K=K_var2,J=J_var2))) - } - - if (!is.null(startIV1)) { - RTSRV1 = startIV1 - }else{ - RTSRV1 = RTSRV(pdata=pdata1, noisevar = noisevar1, K = K_var1, J = J_var1, eta = eta) - } - if (!is.null(startIV2)) { - RTSRV2 = startIV2 - }else{ - RTSRV2 = RTSRV(pdata=pdata2, noisevar = noisevar2, K = K_var2, J = J_var2, eta = eta) - } - - # Refresh time is for the covariance calculation - - x = refreshTime(list(pdata1, pdata2)) - newprice1 = x[, 1] - newprice2 = x[, 2] - logprices1 = log(as.numeric(newprice1)) - logprices2 = log(as.numeric(newprice2)) - seconds = as.numeric(as.POSIXct(index(newprice1))) - secday = last(seconds) - first(seconds) - K = K_cov ; J = J_cov ; - - n = length(logprices1) - nbarK_cov = (n - K_cov + 1)/(K_cov) - nbarJ_cov = (n - J_cov + 1)/(J_cov) - adj_cov = n/((K_cov - J_cov) * nbarK_cov) - - logreturns_K1 = logreturns_K2 = vdelta_K = c() - for (k in 1:K_cov) { - sel.avg = seq(k, n, K_cov) - logreturns_K1 = c(logreturns_K1, diff(logprices1[sel.avg])) - logreturns_K2 = c(logreturns_K2, diff(logprices2[sel.avg])) - vdelta_K = c(vdelta_K, diff(seconds[sel.avg])/secday) - } - - logreturns_J1 = logreturns_J2 = vdelta_J = c() - for (j in 1:J_cov) { - sel.avg = seq(j, n, J_cov) - logreturns_J1 = c(logreturns_J1, diff(logprices1[sel.avg])) - logreturns_J2 = c(logreturns_J2, diff(logprices2[sel.avg])) - vdelta_J = c(vdelta_J, diff(seconds[sel.avg])/secday) - } - - - I_K1 = 1 * (logreturns_K1^2 <= eta * (RTSRV1 * vdelta_K + 2 * noisevar1)) - I_K2 = 1 * (logreturns_K2^2 <= eta * (RTSRV2 * vdelta_K + 2 * noisevar2)) - I_J1 = 1 * (logreturns_J1^2 <= eta * (RTSRV1 * vdelta_J + 2 * noisevar1)) - I_J2 = 1 * (logreturns_J2^2 <= eta * (RTSRV2 * vdelta_J + 2 * noisevar2)) - if (eta == 9) { - ccc = 1.0415 - } else { - ccc = cfactor_RTSCV(eta = eta) - } - RTSCV = adj_cov * (ccc * (1/K_cov) * sum(logreturns_K1 * I_K1 * - logreturns_K2 * I_K2)/mean(I_K1 * I_K2) - ((nbarK_cov/nbarJ_cov) * - ccc * (1/J_cov) * sum(logreturns_J1 * logreturns_J2 * I_J1 * - I_J2)/mean(I_J1 * I_J2))) - return(RTSCV) -} + -TSCov_bi = function (pdata1, pdata2, K = 300, J = 1) -{ - x = refreshTime(list(pdata1, pdata2)) - newprice1 = x[, 1] - newprice2 = x[, 2] - logprices1 = log(as.numeric(newprice1)) - logprices2 = log(as.numeric(newprice2)) - seconds = as.numeric(as.POSIXct(index(newprice1))) - secday = last(seconds) - first(seconds) - n = length(logprices1) - nbarK = (n - K + 1)/(K) - nbarJ = (n - J + 1)/(J) - adj = n/((K - J) * nbarK) - - logreturns_K1 = logreturns_K2 = logreturns_J1 = logreturns_J2 = c() - vdelta_K = vdelta_J = c(); - - for (k in 1:K) { - sel.avg = seq(k, n, K) - logreturns_K1 = c(logreturns_K1, diff(logprices1[sel.avg])) - logreturns_K2 = c(logreturns_K2, diff(logprices2[sel.avg])) - vdelta_K = c(vdelta_K, diff(seconds[sel.avg]) / secday) - } - - for (j in 1:J) { - sel.avg = seq(j, n, J) - logreturns_J1 = c(logreturns_J1, diff(logprices1[sel.avg])) - logreturns_J2 = c(logreturns_J2, diff(logprices2[sel.avg])) - vdelta_J = c(vdelta_J, diff(seconds[sel.avg])/secday) - } - - TSCOV = adj * ((1/K) * sum(logreturns_K1 * logreturns_K2) - - ((nbarK/nbarJ) * (1/J) * sum(logreturns_J1 * logreturns_J2))) - return(TSCOV) -} + + -cfactor_RTSCV = function(eta=9){ - require('cubature'); require('mvtnorm') - # rho = 1 - c1 = pchisq(eta,df=1)/pchisq(eta,df=3) - # - rho = 0.001 - R = matrix( c(1,rho,rho,1) , ncol = 2 ) - int1 <- function(x) { dmvnorm(x,sigma=R) } - num = adaptIntegrate(int1, c(-3,-3), c(3,3), tol=1e-4)$integral - int2 <- function(x) { x[1]*x[2]*dmvnorm(x,sigma=R) } - denom = adaptIntegrate(int2, c(-3,-3), c(3,3), tol=1e-4)$integral - c2 = rho*num/denom - return( (c1+c2)/2 ) -} - -# Hayashi-Yoshida helper function: -rc.hy <- function(x,y, period=1,align.by="seconds", align.period =1, cts = TRUE, makeReturns=FALSE, ...) -{ - align.period = .getAlignPeriod(align.period, align.by) - cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) - x <- cdata$data - x.t <- cdata$milliseconds + + - cdatay <- .convertData(y, cts=cts, makeReturns=makeReturns) - y <- cdatay$data - y.t <- cdatay$milliseconds - - - errorCheck <- c(is.null(x.t),is.na(x.t), is.null(y.t), is.na(y.t)) - if(any(errorCheck)) - stop("ERROR: Time data is not in x or y.") - - - sum( .C("pcovcc", - as.double(x), #a - as.double(rep(0,length(x)/(period*align.period)+1)), - as.double(y), #b - as.double(x.t), #a - as.double(rep(0,length(x)/(period*align.period)+1)), #a - as.double(y.t), #b - as.integer(length(x)), #na - as.integer(length(x)/(period*align.period)), - as.integer(length(y)), #na - as.integer(period*align.period), - ans = double(length(x)/(period*align.period)+1), - COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), - PACKAGE="highfrequency")$ans) -} -# -# Realized variance calculation using a kernel estimator. -# -rv.kernel <- function(x, # Tick Data -kernel.type = "rectangular", # Kernel name (or number) -kernel.param = 1, # Kernel parameter (usually lags) -kernel.dofadj = TRUE, # Kernel Degree of freedom adjustment -align.by="seconds", # Align the tick data to [seconds|minutes|hours] -align.period = 1, # Align the tick data to this many [seconds|minutes|hours] -cts = TRUE, # Calendar Time Sampling is used -makeReturns = FALSE, # Convert to Returns -type = NULL, # Deprectated -adj = NULL, # Deprectated -q = NULL, ...){ # Deprectated - # Multiday adjustment: - multixts = .multixts(x); - if(multixts){ - result = apply.daily(x,rv.kernel,kernel.type,kernel.param,kernel.dofadj, - align.by,align.period,cts,makeReturns,type,adj,q); - return(result)} - if(!multixts){ #Daily estimation: - - # - # Handle deprication - # - - - if(!is.null(type)){ - warning("type is deprecated, use kernel.type") - kernel.type=type - } - if(!is.null(q)){ - warning("q is deprecated, use kernel.param") - kernel.param=q - } - if(!is.null(adj)){ - warning("adj is deprecated, use kernel.dofadj") - kernel.dofadj=adj - } - align.period = .getAlignPeriod(align.period, align.by) - cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) - x <- cdata$data - x <- .alignReturns(x, align.period) - type <- .kernel.chartoint(kernel.type) - .C("kernelEstimator", as.double(x), as.double(x), as.integer(length(x)), - as.integer(kernel.param), as.integer(ifelse(kernel.dofadj, 1, 0)), - as.integer(type), ab=double(kernel.param + 1), - ab2=double(kernel.param + 1), - ans=double(1),PACKAGE="highfrequency")$ans - } -} -rc.kernel <- function(x, # Tick Data for first asset -y, # Tick Data for second asset -kernel.type = "rectangular", # Kernel name (or number) -kernel.param = 1, # Kernel parameter (usually lags) -kernel.dofadj = TRUE, # Kernel Degree of freedom adjustment -align.by="seconds", # Align the tick data to [seconds|minutes|hours] -align.period = 1, # Align the tick data to this many [seconds|minutes|hours] -cts = TRUE, # Calendar Time Sampling is used -makeReturns = FALSE, # Convert to Returns -type = NULL, # Deprectated -adj = NULL, # Deprectated -q = NULL,...){ # Deprectated - # - # Handle deprication - # - if(!is.null(type)){ - warning("type is deprecated, use kernel.type") - kernel.type=type - } - if(!is.null(q)){ - warning("q is deprecated, use kernel.param") - kernel.param=q - } - if(!is.null(adj)){ - warning("adj is deprecated, use kernel.dofadj") - kernel.dofadj=adj - } - - align.period = .getAlignPeriod(align.period, align.by) - cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) - - x <- cdata$data - x <- .alignReturns(x, align.period) - cdatay <- .convertData(y, cts=cts, makeReturns=makeReturns) - y <- cdatay$data - y <- .alignReturns(y, align.period) - type <- .kernel.chartoint(kernel.type) - .C("kernelEstimator", as.double(x), as.double(y), as.integer(length(x)), - as.integer(kernel.param), as.integer(ifelse(kernel.dofadj, 1, 0)), - as.integer(type), ab=double(kernel.param + 1), - ab2=double(kernel.param + 1), - ans=double(1),PACKAGE="highfrequency")$ans -} + + + + -rKernel <- function(x,type=0) -{ - type <- .kernel.chartoint(type) - .C("justKernel", x=as.double(x),type= as.integer(type), ans=as.double(0),PACKAGE="highfrequency")$ans -} + + + + + + + -.kernel.chartoint <- function(type) -{ - if(is.character(type)) - { - ans <- switch(casefold(type), - rectangular=0, - bartlett=1, - second=2, - epanechnikov=3, - cubic=4, - fifth=5, - sixth=6, - seventh=7, - eighth=8, - parzen=9, - th=10, - mth=11, - tukeyhanning=10, - modifiedtukeyhanning=11, - -99) - if(ans==-99) - { - warning("Invalid Kernel, using Bartlet") - 1 - } - else - { - ans - } - } - else - { - type - } -} + -rKernel.available <- function() -{ - c("Rectangular", - "Bartlett", - "Second", - "Epanechnikov", - "Cubic", - "Fifth", - "Sixth", - "Seventh", - "Eighth", - "Parzen", - "TukeyHanning", - "ModifiedTukeyHanning") -} + + + -## REalized Variance: Average subsampled -rv.avg = function(x, period) -{ - mean(.rv.subsample(x, period)) -} -rc.avg = function( x, y, period ) -{ - mean(.rc.subsample(x, y, period)); -} + -.rv.subsample <- function(x, period, cts=TRUE, makeReturns=FALSE,...) -{ - cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) - x <- cdata$data - - .C("subsample", - - as.double(x), #a - as.double(x), #na - as.integer(length(x)), #na - as.integer(length(x)/period), #m - as.integer(period), #period - as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.integer(length(x)/period), #tmpn - ans = double(period), - COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), - PACKAGE="highfrequency")$ans -} +
+ + + -.rc.subsample <- function(x, y, period, cts=TRUE, makeReturns=FALSE, ... ) -{ - cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) - x <- cdata$data - - cdatay <- .convertData(y, cts=cts, makeReturns=makeReturns) - y <- cdatay$data - - .C("subsample", - as.double(x), #a - as.double(y), #na - as.integer(length(x)), #na - as.integer(length(x)/period), #m - as.integer(period), #period - as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.integer(length(x)/period), #tmpn - ans = double(period), - COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), - PACKAGE="highfrequency")$ans -} + +
+
-#### percentage of zeros calc: -.makeROlist = function(rdata, align.period, align.by,cts,makeReturns){ - align.period = .getAlignPeriod(align.period, align.by); - L = list(); - for(i in 1:length(rdata)){ - L[[i]] = .alignReturns(.convertData(rdata[[i]], cts=cts, makeReturns=makeReturns)$data, align.period); - } - return(L); -} + + + -rv.zero = function(x, period) -{ - ac <- .accum.naive(x=x,y=x,period=period) - sum((ac*ac)==0)/length(ac) -} +
+ Sign up + Sign in +
-rc.zero = function(x, y, period) -{ - acy <- .accum.naive(x=y,y=y,period=period) - acx <- .accum.naive(x=x,y=x,period=period) - sum((acx*acy)==0)/length(acy) -} +
-######################################################################### -# -# Utility Functions from realized package Scott Payseur -# -######################################################################### -.alignedAccum <- function(x,y, period, cum=TRUE, makeReturns...) -{ - x<-.accum.naive(x,x, period) - y<-.accum.naive(y,y, period) - if(cum) - { - ans <- cumsum(x*y) - } - else - { - ans <- x*y - } - ans -} + +
-.accum.naive <- function(x,y, period, ...) -{ - .C("rv", - as.double(x), #a - as.double(y), #b - as.integer(length(x)), #na - as.integer(period), #period - tmpa = as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.integer(length(x)/period), #tmpn - ans = double(1), - COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), - PACKAGE="highfrequency")$tmpa -} - - -.alignReturns <- function(x, period, ...) -{ - .C("rv", - as.double(x), #a - as.double(x), #b - as.integer(length(x)), #na - as.integer(period), #period - tmpa = as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.double(rep(0,as.integer(length(x)/period +1))), #tmp - as.integer(length(x)/period), #tmpn - ans = double(1), - COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), - PACKAGE="highfrequency")$tmpa -} - -.getAlignPeriod <- function(align.period, align.by) -{ - align.by <- gsub("(^ +)|( +$)", "",align.by) # Trim White + realizedObject [", as.character(time(xtmp[1])), " :: ", as.character(time(xtmp[length(x$milliseconds)])), "]", sep=""),"\n") - } - - if(is.na(millisstart)) - { - millisstart=34200000 - } - if(is.na(millisend)) - { - millisend=57600000 - } - if("list" %in% class(x)) - { - if(sum(names(x) == c("tts", "cts")) == 2) #realized obj - { - if(cts) - { - return(x$cts) - } - else - { - return(x$tts) - } - } - if(sum(names(x) == c("data", "milliseconds")) == 2) - { - if(makeReturns) - { # only works on non cts prices - errcheck <- try(.getReturns(.sameTime(x$data, x$milliseconds))) - if(class(errcheck) != "Error") - { - x$data <- errcheck - x$milliseconds <- intersect(x$milliseconds,x$milliseconds) - } - else - { - warning("It appears that these are already returns. Not creating returns") - } - } - else - { - x$data <- .sameTime(x$data, x$milliseconds) - x$milliseconds <- intersect(x$milliseconds,x$milliseconds) - } - if(cts) - { - toret <- list(data=.toCts(x=x$data, millis=intersect(x$milliseconds,x$milliseconds), millisstart=millisstart, millisend=millisend), - milliseconds=(((millisstart/1000)+1):(millisend/1000))*1000) - return(toret) - } - else [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/highfrequency -r 44 From noreply at r-forge.r-project.org Mon Aug 19 12:07:20 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 Aug 2013 12:07:20 +0200 (CEST) Subject: [Highfrequency-commits] r45 - pkg/highfrequency/R Message-ID: <20130819100720.33E92183BBB@r-forge.r-project.org> Author: kboudt Date: 2013-08-19 12:07:15 +0200 (Mon, 19 Aug 2013) New Revision: 45 Added: pkg/highfrequency/R/highfrequencyGSOC.R Log: Additional functionality implemented in GSoC 2013 by Giang Nguyen, with Kris Boudt and Jonathan Cornelissen as mentors Added: pkg/highfrequency/R/highfrequencyGSOC.R =================================================================== --- pkg/highfrequency/R/highfrequencyGSOC.R (rev 0) +++ pkg/highfrequency/R/highfrequencyGSOC.R 2013-08-19 10:07:15 UTC (rev 45) @@ -0,0 +1,1081 @@ + + + +minRQ = function(rdata,align.by=NULL,align.period = NULL, makeReturns = FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts = highfrequency:::.multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, minRQ, align.by, align.period, makeReturns) ##Check FUN + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if(makeReturns) + { + rdata = makeReturns(rdata) + } + q=as.zoo(abs(as.numeric(rdata))) + q=as.numeric(rollapply(q, width = 2, FUN = min, by = 1, align = "left")) + N=length(q)+1 + minRQ=pi*N/(3*pi-8)*(N/(N-1))*sum(q^4) + return(minRQ) + } +} + + +medRQ = function(rdata, align.by = NULL, align.period = NULL, makeReturns = FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts = highfrequency:::.multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, medRQ, align.by, align.period, makeReturns) ##Check FUN + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if(makeReturns) + { + rdata = makeReturns(rdata) + } + q=abs(as.numeric(rdata)) + q=as.numeric(rollmedian(q, k = 3)) + N = length(q)+2 + medRQ = 3*pi*N/(9*pi+72-53*sqrt(3))*(N/(N-2))*sum(q^4) + return(medRQ) + } +} + + +rQuar = function(rdata, align.by = NULL, align.period = NULL, makeReturns = FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts = highfrequency:::.multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, rQuar, align.by, align.period, ##check FUN + makeReturns) + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if (makeReturns) + { + rdata = makeReturns(rdata) + } + + q=as.numeric(rdata) + N = length(q)+1 + rQuar = N/3*sum(q^4) + return(rQuar) + } +} + + +rQPVar = function(rdata, align.by = NULL, align.period = NULL, makeReturns = FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts =highfrequency::: .multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, rQPVar, align.by, align.period, ##check FUN + makeReturns) + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if (makeReturns) + { + rdata = makeReturns(rdata) + } + + q=as.numeric(rdata) + q=abs(rollapply(q,width=4,FUN=prod,align="left")) + N = length(q)+3 + rQPVar = N/(N-3)*pi^2/4*sum(q) + return(rQPVar) + } +} + + +rTPVar = function(rdata, align.by = NULL, align.period = NULL, makeReturns = FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts = highfrequency:::.multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, rTPVar, align.by, align.period, ##check FUN + makeReturns) + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if (makeReturns) + { + rdata = makeReturns(rdata) + } + + q=as.numeric(rdata) + q=abs(rollapply(q,width = 3, FUN = prod, align = "left")) + N = length(q)+2 + rTPVar= N/(N-2)*gamma(1/2)^2/(4*gamma(7/6)^2)*sum(q^(4/3)) + return(rTPVar) + } +} + + + +## Standard error and confidence band of RV measures + ivInference = function(rdata, IVestimator="RV", IQestimator="rQuar", confidence=0.95, align.by= NULL, align.period = NULL, makeReturns = FALSE, ...) + { + if (hasArg(data)) + { + rdata = data + } + multixts =highfrequency:::.multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, ivInference, align.by, align.period, ##check FUN + makeReturns) + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + + if(makeReturns) + { + rdata=makeReturns(rdata) + } + + N=length(rdata) + p= as.numeric(confidence) + + ##IQ estimator: + IQ=function(rdata,IQestimator) + { + switch(IQestimator, + RQuart= rQuar(rdata), + QP= QP(rdata), + minRQ= minRQ(rdata), + medRQ= medRQ(rdata)) + } + iq= IQ(rdata,IQestimator) + + ##IV estimator: + IV=function(IVestimator,iq) + { + switch(IVestimator, + RV= sqrt(2*iq), + BV= sqrt(2.61*iq), + TV= sqrt(3.06*iq), + minRV= sqrt(3.81*iq), + medRV= sqrt(2.96*iq)) + } + iv= IV(IVestimator,iq) + + ##hatIV + hativ=function(rdata,IVestimator) + { + switch(IVestimator, + RV= highfrequency:::RV(rdata), + BV= highfrequency:::RBPVar(rdata), + TV= TP(rdata), + minRV= minRV(rdata), + medRV= medRV(rdata)) + } + + hatIV=hativ(rdata, IVestimator) + + stderr= 1/sqrt(N)*iv + + ##confidence band + lowband=as.numeric(hatIV-stderr*qnorm(p)) + highband=as.numeric(hatIV+stderr*qnorm(p)) + cb<-c(lowband,highband) + + ## reports: + out={} + out$hativ= hatIV + out$se= stderr + out$cb= cb + + + return(out) + } + } + + + + + +# thetaROWVar(k=qchisq(0.95,df=1),alpha=0.25); thetaROWVar(k=qchisq(0.99,df=1),alpha=0.25); + +# thetaROWVar(k=qchisq(0.999,df=1),alpha=0.25); + + + +thetaROWVar = function( alpha = 0.001 , alphaMCD = 0.5 ) + +{ + + IF_MCD = function( x , alpha = alphaMCD ){ + + N = 1 + + q = qchisq( 1-alpha , df = N ) + + calpha = (1-alpha)/pchisq( q , df = N+2 ) + + out = ( (x^2-q)/(1-alpha) )*( abs(x) <= sqrt(q) ) + + return( -1+q*calpha + calpha*out ) + + } + + + + int = function(x){ + + return( IF_MCD(x)*x^2*dnorm(x) ) + + } + + + + int = function(x){ + + return( IF_MCD(x)^2*dnorm(x) ) + + } + + + + avar_MCD = function(alpha){ + N = 1 + + q_alpha = qchisq( 1-alpha , df = N ) + + c_alpha = (1-alpha)/pchisq( q_alpha , df = N+2 ) + + a_alpha = -2*sqrt(q_alpha)*dnorm(sqrt(q_alpha))+1-alpha + + b_alpha = -2*q_alpha^(3/2)*dnorm(sqrt(q_alpha))+3*a_alpha + + + + avar = c_alpha^2*q_alpha^2+1-2*c_alpha*q_alpha + + avar = avar + c_alpha^2/(1-alpha)^2*(b_alpha+q_alpha^2*(1-alpha)-2*q_alpha*a_alpha) + + avar = avar + 2*( c_alpha*q_alpha - 1)*c_alpha*(1/(1-alpha))*(-q_alpha*(1-alpha)+a_alpha) + + return(avar) + + } + + N = 1 + + q_alpha = qchisq( 1-alpha , df = N ) + + c_alpha = (1-alpha)/pchisq( q_alpha , df = N+2 ) + + a_alpha = -2*sqrt(q_alpha)*dnorm(sqrt(q_alpha))+1-alpha + + b_alpha = -2*q_alpha^(3/2)*dnorm(sqrt(q_alpha))+3*a_alpha + + + + halfk = sqrt(k); halfq = sqrt(q_alpha) + + + + Ewu2 = 2*pnorm(halfk)-1; + + Ewu2u2 = -2*halfk*dnorm(halfk)+Ewu2; + + Ewu2u4 = -2*(k^(3/2))*dnorm(halfk)+3*Ewu2u2; + + + + Ewu2u2IF = (-1+c_alpha*q_alpha-(c_alpha*q_alpha)/(1-alpha))*a_alpha+c_alpha*b_alpha/(1-alpha) + + Ewu2u2IF = Ewu2u2IF + 2*(1-c_alpha*q_alpha)*( + + halfk*dnorm(halfk)-halfq*dnorm(halfq) + 1 - alpha/2 - pnorm(halfk) ) + + Ewu2IF = (alpha-1-c_alpha*q_alpha*alpha) + c_alpha*a_alpha/(1-alpha) + 2*(c_alpha*q_alpha-1)*( pnorm(halfk)-(1-alpha/2)) + + Ederwu2u4 = -k^(3/2)*dnorm(halfk); + + Ederwu2u2 = -halfk*dnorm(halfk); + + c1 = 1/Ewu2u2; c2 = 1/Ewu2; c3 = c2*Ederwu2u2-c1*Ederwu2u4 + + Avar0 = avar_MCD(alpha) + + theta = c3^2*Avar0 + c1^2*Ewu2u4 + c2^2*Ewu2 - 2*c1*c2*Ewu2u2; + + theta = theta + 2*c3*( c1*Ewu2u2IF-c2*Ewu2IF ); + + return( theta ); + +} + + +##Jump-test: BNS with threshold +BNSjumptest=function(rdata, IVestimator= "BV", IQestimator= "TP", type= "linear", logtransform= FALSE, max= FALSE, + align.by= NULL, align.period= NULL, makeReturns = FALSE, startV= NULL,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts = highfrequency:::.multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, BNSjumptest, align.by, align.period, makeReturns) ##Check FUN + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if(makeReturns) + { + rdata = makeReturns(rdata) + } + + N=length(rdata) + + ## hatQV + hatQV = highfrequency:::RV(rdata) + + + ## threshold BV + ##Gaussian kernel: + Gaus.ker= function(y) + { + ky=(1/sqrt(2*pi)*exp(-y^2/2)) + } + + ##hatV: + if(is.null(startV)) + { + hatV= medRV(rdata) + } + else(hatV=startV) + + ##zgamma function: + zgamma=function(x,y) + { + if(x^20 + + rSVd= sum(q[select.down]^2) + rSVu = sum(q[select.up]^2) + + out={} + out$rSVdownside = rSVd + out$rSVupside = rSVu + + return(out) + + } +} + +##Realized skewness +rSkew= function(rdata, align.by = NULL, align.period = NULL, makeReturns = FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts =highfrequency::: .multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, rSkew, align.by, align.period, ##check FUN + makeReturns) + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if (makeReturns) + { + rdata = makeReturns(rdata) + } + + q=as.numeric(rdata) + N= length(q) + + rv= highfrequency:::RV(rdata) + + rSkew= sqrt(N)*sum(q^3)/rv^(3/2) + + return(rSkew) + + } +} + +##Realized kurtosis +rKurt= function(rdata, align.by = NULL, align.period = NULL, makeReturns = FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts =highfrequency::: .multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, rKurt, align.by, align.period, ##check FUN + makeReturns) + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if (makeReturns) + { + rdata = makeReturns(rdata) + } + + q=as.numeric(rdata) + N= length(q) + + rv= highfrequency:::RV(rdata) + + rkurt= N*sum(q^4)/rv^(2) + + return(rkurt) + + } +} + +##Realized Multipower Variation (MPV) +rMPV= function(rdata, m= 2, p=2, align.by= NULL, align.period= NULL, makeReturns= FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + multixts =highfrequency::: .multixts(rdata) + if (multixts) + { + result = apply.daily(rdata, rMPV, align.by, align.period, makeReturns) + return(result) + } + if (!multixts) + { + if ((!is.null(align.by)) && (!is.null(align.period))) { + rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + } + if (makeReturns) + { + rdata = makeReturns(rdata) + } + + + if(m>p/2) + { m= as.numeric(m) ##m> p/2 + p= as.numeric(p) + q=as.numeric(rdata) + q=abs(rollapply(q,width=m,FUN=prod,align="left")) + N = length(rdata) + + dmp= (2^((p/m)/2)*gamma((p/m+1)/2)/gamma(1/2))^(-m) + + rmpv = dmp* N^(p/2)/(N-m+1)*sum(q^(p/m)) + return(rmpv) + } + else{warning("Please supply m>p/2 for the arguments m and p")} + + } +} + + + + +##Preaveraging estimators (matrix) + ##Preaverage return: +hatreturn= function(pdata,kn) +{ + rdata=makeReturns(pdata) + kn=as.numeric(kn) + if(kn==1){ hatre = rdata} + else{ + x = (1:(kn-1) )/kn + x[x > (1-x)] = (1-x)[x > (1-x)] + weightedsum = function(series){ return( sum(x*series) )} + hatre= rollapply(rdata,width = kn-1, FUN = weightedsum, align = "left") + hatre[is.na(hatre)] = rdata[is.na(hatre)] + } + return(hatre) +} + ##gfunction: +gfunction = function(x){ + # returns the minimum of x and 1-x + # whenevr x > 1-x , replace with 1-x + x[x > (1-x)] = (1-x)[x > (1-x)] + return(x) + +} + + #r#Univariate estimation: +crv=function(pdata) +{ + N= nrow(pdata) + theta= 0.8 ##recommendation by Hautsch and Podolskij + kn= floor(theta*sqrt(N)) + + ##psi: + psi1= 1 + psi2= 1/12 + + psi1kn= kn* sum((gfunction((1:kn)/kn) - gfunction(( (1:kn) - 1 )/kn ) )^2 ) + + psi2kn= 1/kn*sum(gfunction((1:kn)/kn)^2) + + r1= hatreturn(pdata,kn=kn) + rdata = makeReturns(pdata) + crv= 1/(sqrt(N)*theta*psi2kn)*sum(r1^2,na.rm=TRUE) - psi1kn*(1/N)/(2*theta^2*psi2kn)*sum(rdata^2,na.rm=TRUE) + return(crv) +} + + ##preav_bi +preav_bi= function(pdata1, pdata2) +{ + x = refreshTime(list(pdata1, pdata2)) + newprice1 = x[, 1] + newprice2 = x[, 2] + + N= nrow(x) + theta= 0.8 ##recommendation by Hautsch and Podolskij + kn= floor(theta*sqrt(N)) + + ##psi: + psi1= 1 + psi2= 1/12 + + psi1kn= kn* sum((gfunction((1:kn)/kn) - gfunction(( (1:kn) - 1 )/kn ) )^2 ) + + psi2kn= 1/kn*sum(gfunction((1:kn)/kn)^2) + + + r1 = hatreturn(newprice1,kn=kn) + r2 = hatreturn(newprice2,kn=kn) + + mrc= N/(N-kn+2)*1/(psi2*kn)*(sum(r1*r2,na.rm=TRUE)) + + return(mrc) +} + + + ##Preaveraging +MRC= function(pdata, pairwise = FALSE , makePsd= FALSE,...) +{ + + if (!is.list(pdata)) { + n = 1 + }else { + n = length(pdata) + } + if (n == 1) { + multixts = highfrequency:::.multixts(pdata); + if(multixts){ stop("This function does not support having an xts object of multiple days as input. Please provide a timeseries of one day as input"); } + mrc = crv(pdata) + } + + + if (n > 1) { + multixts = highfrequency:::.multixts(pdata[[1]]); + if(multixts){ stop("This function does not support having an xts object of multiple days as input. Please provide a timeseries of one day as input"); } + + if(pairwise){ + cov = matrix(rep(0, n * n), ncol = n) + diagonal = c() + for (i in 1:n) { + diagonal[i] = crv(pdata[[i]]) + } + diag(cov) = diagonal + + for (i in 2:n) { + for (j in 1:(i - 1)) { + cov[i, j] = cov[j, i] = preav_bi(pdata[[i]], pdata[[j]]) + } + } + + mrc = cov + + if(makePsd) + { + mrc=makePsd(mrc) + } + + }else{ + x = refreshTime(pdata) + N= nrow(x) + theta= 0.8 ##recommendation by Hautsch and Podolskij + kn= floor(theta*sqrt(N)) + + ##psi: + psi1= 1 + psi2= 1/12 + + psi1kn= kn* sum((gfunction((1:kn)/kn) - gfunction(( (1:kn) - 1 )/kn ) )^2 ) + psi2kn= 1/kn*sum(gfunction((1:kn)/kn)^2) + + preavreturn = c() + for( i in 1:ncol(x)){ + preavreturn = cbind( preavreturn , hatreturn(x[,i],kn) ) + } + + S = rCov(preavreturn) + + mrc= N/(N-kn+2)*1/(psi2*kn)*S + + if(makePsd) + { + mrc=makePsd(mrc) + } + + } + } + return(mrc) +} + + +##Realized beta: +rBeta= function(rdata, rindex, RCOVestimator= "rCov", RVestimator= "RV", makeReturns= FALSE,...) +{ + if (hasArg(data)) + { + rdata = data + } + + if (makeReturns) + { + rdata = makeReturns(rdata) + rindex= makeReturns(rindex) + } + + multixts = highfrequency:::.multixts(rdata) + + if (multixts) + { + print("No support for multiple days") + } + if (!multixts) + { + if(RCOVestimator=="rRTSCov" | RCOVestimator=="rTSCov"){ + if( min(rdata) <0 ){ + print("when using rRTSCov, rTSCov, introduce price data - transformation to price data done") + rdata = exp(cumsum(rdata)) + } + if( min(rindex) <0 ){ + print("when using rRTSCov, rTSCov, introduce price data - transformation to price data done") + rindex = exp(cumsum(rindex)) + } + } + rcovfun= function(rdata, rindex, RCOVestimator) + { + switch(RCOVestimator, + rCov= rCov(cbind(rdata,rindex) )[1,2], + rAVGCov= rAVGCov(list(rdata, rindex) )[1,2], + rBPCov= rBPCov(cbind(rdata, rindex) )[1,2], + rHYCov= rHYCov(list(rdata, rindex) )[1,2], + rKernelCov= rKernelCov(list(rdata, rindex) )[1,2], + rOWCov= rOWCov(cbind(rdata, rindex) )[1,2], + rRTSCov= rRTSCov(list(rdata, rindex))[1,2], + rThresholdCov= rThresholdCov(cbind(rdata, rindex) )[1,2], + rTSCov= rTSCov(list(rdata, rindex))[1,2] + ) + + } + rcov= rcovfun(rdata,rindex,RCOVestimator) + + if( is.null(RVestimator) ){ RVestimator = RCOVestimator } + + rvfun= function(rindex, RVestimator) + { + + switch(RVestimator, + RV= highfrequency:::RV(rindex), + BV= highfrequency:::RBPVar(rindex), + minRV= minRV(rindex ), + medRV= medRV(rindex ), + rCov= rCov(rindex ) , + rAVGCov= rAVGCov(rindex ) , + rBPCov= rBPCov(rindex ) , + rHYCov= rHYCov(rindex ) , + rKernelCov= rKernelCov(rindex ) , + rOWCov= rOWCov(rindex ) , + rRTSCov= rRTSCov(rindex) , + rThresholdCov= rThresholdCov(rindex ) , + rTSCov= rTSCov(rindex) + ) + + } + rv=rvfun(rindex,RVestimator) + + rbeta = rcov/rv + return(rbeta) + } +} From noreply at r-forge.r-project.org Mon Aug 19 12:11:33 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 19 Aug 2013 12:11:33 +0200 (CEST) Subject: [Highfrequency-commits] r46 - pkg/highfrequency/man Message-ID: <20130819101134.05A69183BBB@r-forge.r-project.org> Author: kboudt Date: 2013-08-19 12:11:33 +0200 (Mon, 19 Aug 2013) New Revision: 46 Added: pkg/highfrequency/man/AJjumptest.Rd pkg/highfrequency/man/BNSjumptest.Rd pkg/highfrequency/man/JOjumptest.Rd pkg/highfrequency/man/MRC.Rd pkg/highfrequency/man/RKurt.Rd pkg/highfrequency/man/RQPVar.Rd pkg/highfrequency/man/RQuar.Rd pkg/highfrequency/man/RSkew.Rd pkg/highfrequency/man/RTPVar.Rd pkg/highfrequency/man/RsV.Rd pkg/highfrequency/man/highfrequencyGSOC-package.Rd pkg/highfrequency/man/ivInference.Rd pkg/highfrequency/man/medRQ.Rd pkg/highfrequency/man/minRQ.Rd pkg/highfrequency/man/rBeta.Rd pkg/highfrequency/man/rMPV.Rd Log: Added: pkg/highfrequency/man/AJjumptest.Rd =================================================================== --- pkg/highfrequency/man/AJjumptest.Rd (rev 0) +++ pkg/highfrequency/man/AJjumptest.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,106 @@ +\name{AJjumptest} +\alias{AJjumptest} +\title{ +Ait- Sahalia and Jacod (2009) tests for the presence of jumps in the price series. +} +\description{ + +This test examines the presence of jumps in highfrequency price series. It is based on the theory of Ait-Sahalia and Jacod (2009) (AJ). It consists in comparing the multipower variation of equispaced returns computed at a fast time scale (\eqn{h}), \eqn{r_{t,i}} (\eqn{i=1, \ldots,N}) and those computed at the slower time scale (\eqn{kh}), \eqn{y_{t,i}}(\eqn{i=1, \ldots ,\mbox{N/k}}). + +They found that the limit (for \eqn{N} \eqn{\to} \eqn{\infty} ) of the realized power variation is invariant for different sampling scales and that their ratio is \eqn{1} in case of jumps and \eqn{\mbox{k}^{p/2}-1} if no jumps. +Therefore the AJ test detects the presence of jump using the ratio of realized power variation sampled from two scales. The null hypothesis is no jumps. + +Function returns three outcomes: 1.z-test value 2.critical value under confidence level of \eqn{95\%} and 3.p-value. + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +And there is \eqn{N/k} equispaced returns in period \eqn{t}. Let \eqn{y_{t,i}} be a return (with \eqn{i=1, \ldots ,\mbox{N/k}}) in period \eqn{t}. + +Then the AJjumptest is given by: +\deqn{ +\mbox{AJjumptest}_{t,N}= \frac{S_t(p,k,h)-k^{p/2-1}}{\sqrt{V_{t,N}}} +} + +in which, + +\deqn{ +\mbox{S}_t(p,k,h)= \frac{PV_{t,M}(p,kh)}{PV_{t,M}(p,h)} +} + +\deqn{ +\mbox{PV}_{t,N}(p,kh)= \sum_{i=1}^{N/k}{|y_{t,i}|^p} +} + +\deqn{ +\mbox{PV}_{t,N}(p,h)= \sum_{i=1}^{N}{|r_{t,i}|^p} +} + +\deqn{ +\mbox{V}_{t,N}= \frac{N(p,k) A_{t,N(2p)}}{N A_{t,N(p)}} +} + +\deqn{ +\mbox{N}(p,k)= \left(\frac{1}{\mu_p^2}\right)(k^{p-2}(1+k))\mu_{2p} + k^{p-2}(k-1) \mu_p^2 - 2k^{p/2-1}\mu_{k,p} +} + +\deqn{ +\mbox{A}_{t,n(2p)}= \frac{(1/N)^{(1-p/2)}}{\mu_p} \sum_{i=1}^{N}{|r_{t,i}|^p} \ \ \mbox{for} \ \ |r_j|< \alpha(1/N)^w +} + +\deqn{ +\mu_{k,p}= E(|U|^p |U+\sqrt{k-1}V|^p) +} + +\eqn{U, V}: independent standard normal random variables; \eqn{h=1/N}; \eqn{p, k, \alpha, w}: parameters. + +} +\usage{ +AJjumptest(pdata, p=4 , k=2, align.by= NULL, align.period = NULL, makeReturns= FALSE, ...) +} + +\arguments{ + \item{pdata}{a zoo/xts object containing all prices in period t for one asset.} + \item{p}{can be chosen among 2 or 3 or 4. The author suggests 4. 4 by default.} + \item{k}{can be chosen among 2 or 3 or 4. The author suggests 2. 2 by default.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +list +} + +\details{ +The theoretical framework underlying jump test is that the logarithmic price process \eqn{X_t} belongs to the class of Brownian semimartingales, which can be written as: +\deqn{ +\mbox{X}_{t}= \int_{0}^{t} a_udu + \int_{0}^{t}\sigma_{u}dW_{u} + Z_t +} +where \eqn{a} is the drift term, \eqn{\sigma} denotes the spot volatility process, \eqn{W} is a standard Brownian motion and \eqn{Z} is a jump process defined by: +\deqn{ +\mbox{Z}_{t}= \sum_{j=1}^{N_t}k_j +} +where \eqn{k_j} are nonzero random variables. The counting process can be either finite or infinite for finite or infinite activity jumps. + +The Ait-Sahalia and Jacod test is that: Using the convergence properties of power variation and its dependence on the time scale on which it is measured, Ait-Sahalia and Jacod (2009) define a new variable which converges to 1 in the presence of jumps in the underlying return series, or to another deterministic and known number in the absence of jumps. (Theodosiou& Zikes(2009)) +} + +\references{ +Ait-Sahalia, Y. and Jacod, J. (2009). Testing for jumps in a discretely observed process. The Annals of Statistics, 37(1), 184- 222. + +Theodosiou, M., & Zikes, F. (2009). A comprehensive comparison of alternative tests for jumps in asset prices. Unpublished manuscript, Graduate School of Business, Imperial College London. +} + +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +AJjumptest(sample_tdata$PRICE, p= 2, k= 3, align.by= "seconds", align.period= 5, makeReturns= TRUE) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ AJjumptest } Added: pkg/highfrequency/man/BNSjumptest.Rd =================================================================== --- pkg/highfrequency/man/BNSjumptest.Rd (rev 0) +++ pkg/highfrequency/man/BNSjumptest.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,86 @@ +\name{BNSjumptest} +\alias{BNSjumptest} +\title{ +Barndorff- Nielsen and Shephard (2006) tests for the presence of jumps in the price series. +} +\description{ + +This test examines the presence of jumps in highfrequency price series. It is based on theory of Barndorff- Nielsen and Shephard (BNS). The null hypothesis is no jumps. +Depending on users' choices of estimator (integrated variance (IVestimator), integrated quarticity (IQestimator)), mechanism (linear, ratio) and adjustment (logarith), the function returns the result. +Function returns three outcomes: 1.z-test value 2.critical value(with confidence level of 95\%) and 3.pvalue of the test. + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. + +Assume the Realized variance (RV), IVestimator and IQestimator are based on \eqn{N} equispaced returns. + +Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then the BNSjumptest is given by: +\deqn{ +\mbox{BNSjumptest}= \frac{RV - IVestimator}{\sqrt{(\theta-2)\frac{1}{N} {IQestimator}}} +} +in which, \eqn{IVestimator} can be: bipower variance (BV), minRV, medRV. +\eqn{IQestimator} can be: tripower quarticity (TP), quadpower quarticity (QP), minRQ, medRQ. + +\eqn{\theta}: depends on IVestimator. +(Huang and Tauchen (2005)) +} +\usage{ +BNSjumptest(rdata, IVestimator= "BV", IQestimator= "TP", type= "linear", logtransform= FALSE, + max= FALSE, align.by= NULL, align.period= NULL, makeReturns = FALSE, startV= NULL,...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{IVestimator}{can be chosen among jump robust integrated variance estimators: BV, minRV, medRV and corrected threshold bipower variation (CTBV). BV by default.} + \item{IQestimator}{can be chosen among jump robust integrated quarticity estimators: TP, QP, minRQ and medRQ. TP by default.} + \item{type}{a method of BNS testing: can be linear or ratio. Linear by default.} + \item{logtransform}{boolean, should be TRUE when QVestimator and IVestimator are in logarith form. FALSE by default.} + \item{max}{boolean, should be TRUE when max adjustment in SE. FALSE by default.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours" } + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{startV}{start point of auxiliary estimators in threshold estimation (Corsi et al. (2010). NULL by default.} + \item{...}{additional arguments.} +} + +\value{ +list +} + +\details{ +The theoretical framework underlying jump test is that the logarithmic price process \eqn{X_t} belongs to the class of Brownian semimartingales, which can be written as: +\deqn{ +\mbox{X}_{t}= \int_{0}^{t} a_udu + \int_{0}^{t}\sigma_{u}dW_{u} + Z_t +} +where \eqn{a} is the drift term, \eqn{\sigma} denotes the spot volatility process, \eqn{W} is a standard Brownian motion and \eqn{Z} is a jump process defined by: +\deqn{ +\mbox{Z}_{t}= \sum_{j=1}^{N_t}k_j +} +where \eqn{k_j} are nonzero random variables. The counting process can be either finite or infinite for finite or infinite activity jumps. + +Since the realized volatility converges to the sum of integrated variance and jump variation, while the robust IVestimator converges to the integrated variance, it follows that the difference between \eqn{RV_{t,N}} and the IVestimator captures the jump part only, and this observation underlines the BNS test for jumps. (Theodosiou& Zikes(2009)) +} + +\references{ +Barndorff-Nielsen, O. E., & Shephard, N. (2006). Econometrics of testing for jumps in financial economics using bipower variation. Journal of financial Econometrics, 4(1), 1-30. + +Corsi, F., Pirino, D., & Reno, R. (2010). Threshold bipower variation and the impact of jumps on volatility forecasting. Journal of Econometrics, 159(2), 276-288. + +Huang, X., & Tauchen, G. (2005). The relative contribution of jumps to total price variance. Journal of financial econometrics, 3(4), 456-499. + +Theodosiou, M., & Zikes, F. (2009). A comprehensive comparison of alternative tests for jumps in asset prices. Unpublished manuscript, Graduate School of Business, Imperial College London. +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +BNSjumptest(sample_tdata$PRICE, QVestimator= "RV", IVestimator= "minRV", + IQestimator = "medRQ", type= "linear", makeReturns = TRUE) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ BNSjumptest } Added: pkg/highfrequency/man/JOjumptest.Rd =================================================================== --- pkg/highfrequency/man/JOjumptest.Rd (rev 0) +++ pkg/highfrequency/man/JOjumptest.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,86 @@ +\name{JOjumptest} +\alias{JOjumptest} +\title{ +Jiang and Oomen (2008) tests for the presence of jumps in the price series. +} +\description{ + +This test examines the jump in highfrequency data. It is based on theory of Jiang and Oomen (JO). They found that the difference of simple return and logarithmic return can capture one half of integrated variance if there is no jump in the underlying sample path. The null hypothesis is no jumps. + +Function returns three outcomes: 1.z-test value 2.critical value under confidence level of \eqn{95\%} and 3.p-value. + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. + +Let \eqn{r_{t,i}} be a logarithmic return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Let \eqn{R_{t,i}} be a simple return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then the JOjumptest is given by: +\deqn{ +\mbox{JOjumptest}_{t,N}= \frac{N BV_{t}}{\sqrt{\Omega_{SwV}} \left(1-\frac{RV_{t}}{SwV_{t}} \right)} +} +in which, +\eqn{BV}: bipower variance; +\eqn{RV}: realized variance (defined by Andersen et al. (2012)); +\deqn{ + \mbox{SwV}_{t}=2 \sum_{i=1}^{N}(R_{t,i}-r_{t,i}) +} +\deqn{ + \Omega_{SwV}= \frac{\mu_6}{9} \frac{{N^3}{\mu_{6/p}^{-p}}}{N-p-1} \sum_{i=0}^{N-p}\prod_{k=1}^{p}|r_{t,i+k}|^{6/p} +} +\deqn{ + \mu_{p}= \mbox{E}[|\mbox{U}|^{p}] = 2^{p/2} \frac{\Gamma(1/2(p+1))}{\Gamma(1/2)} + % \mbox{E}[|\mbox{U}|^p]= +} +%\eqn{ \mbox{E}[|\mbox{U}|]^{\mbox{p}}} + \eqn{U}: independent standard normal random variables + + p: parameter (power). +} +\usage{ +JOjumptest(pdata, power=4,...) +} + +\arguments{ + \item{pdata}{a zoo/xts object containing all prices in period t for one asset.} + \item{power}{can be chosen among 4 or 6. 4 by default.} + \item{...}{additional arguments.} +} + +\value{ +list +} + +\details{ +The theoretical framework underlying jump test is that the logarithmic price process \eqn{X_t} belongs to the class of Brownian semimartingales, which can be written as: +\deqn{ +\mbox{X}_{t}= \int_{0}^{t} a_udu + \int_{0}^{t}\sigma_{u}dW_{u} + Z_t +} +where \eqn{a} is the drift term, \eqn{\sigma} denotes the spot volatility process, \eqn{W} is a standard Brownian motion and \eqn{Z} is a jump process defined by: +\deqn{ +\mbox{Z}_{t}= \sum_{j=1}^{N_t}k_j +} +where \eqn{k_j} are nonzero random variables. The counting process can be either finite or infinite for finite or infinite activity jumps. + +The Jiang and Oomen test is that: in the absence of jumps, the accumulated difference between the simple return and the log return captures one half of the integrated variance.(Theodosiou& Zikes(2009)) +} + +\references{ +Andersen, T. G., D. Dobrev, and E. Schaumburg (2012). Jump-robust volatility estimation using nearest neighbor truncation. Journal of Econometrics, 169(1), 75- 93. + +Jiang, J.G. and Oomen R.C.A (2008). Testing for jumps when asset prices are observed with noise- a "swap variance" approach. Journal of Econometrics,144(2), 352-370. + +Theodosiou, M., & Zikes, F. (2009). A comprehensive comparison of alternative tests for jumps in asset prices. Unpublished manuscript, Graduate School of Business, Imperial College London. +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_5minprices_jumps) +JOjumptest(sample_5minprices_jumps[,1], power= 6) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ JOjumptest } Added: pkg/highfrequency/man/MRC.Rd =================================================================== --- pkg/highfrequency/man/MRC.Rd (rev 0) +++ pkg/highfrequency/man/MRC.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,88 @@ +\name{MRC} +\alias{MRC} +\title{ +Modulated Realized Covariance (MRC): Return univariate or multivariate preaveraged estimator. +} +\description{ +Function returns univariate or multivariate preaveraged estimator, as difined in Hautsch & Podolskij (2013). + +} + +} + +\usage{ +MRC= function(pdata, pairwise=FALSE,makePsd= FALSE,...) +} + +\arguments{ + \item{pdata}{a list. Each list-item contains an xts object with the intraday price data of a stock.} + \item{pairwise}{boolean, should be TRUE when refresh times are based on pairs of assets. FALSE by default.} + \item{makePsd}{boolean, in case it is TRUE, the positive definite version of MRC is returned. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +an \eqn{d x d} matrix +} + +\details{ +In practice, market microstructure noise leads to a departure from the pure semimartingale model. We consider the process \eqn{Y} in period \eqn{\tau}: +\deqn{ +\mbox{Y}_{\tau} = X_{\tau} + \epsilon_{\tau} +} +where, the observed \eqn{d} dimensional log-prices are the sum of underlying Brownian semimartingale process \eqn{X} and a noise term \eqn{\epsilon_{\tau}}. + +\eqn{\epsilon_{\tau}} is an i.i.d process with \eqn{X}. + +It is intuitive that under mean zero i.i.d. microstructure noise some form of smoothing of the observed log-price should tend to diminish the impact of the noise. Effectively, we are going to approximate a continuous function by an average of observations of Y in a neighborhood, the noise being averaged away. + +Assume there is \eqn{N} equispaced returns in period \eqn{\tau} of a list (after refeshing data). Let \eqn{r_{\tau_i}} be a return (with \eqn{i=1, \ldots,N}) of an asset in period \eqn{\tau}. Assume there is \eqn{d} assets. + +In order to define the univariate pre-averaging estimator, we first define the pre-averaged returns as +\deqn{ +\bar{r}_{\tau_j}^{(k)}= \sum_{h=1}^{k_N-1}g\left(\frac{h}{k_N}\right)r_{\tau_{j+h}}^{(k)} +} +where g is a non-zero real-valued function \eqn{g:[0,1]} \eqn{\rightarrow} \eqn{R} given by \eqn{g(x)} = \eqn{\min(x,1-x)}. \eqn{k_N} is a sequence of integers satisfying \eqn{\mbox{k}_{N} = \lfloor\theta N^{1/2}\rfloor}. We use \eqn{\theta = 0.8} as recommendations in (Hautsch & Podolskij (2013)). The pre-averaged returns are simply a weighted average over the returns in a local window. This averaging diminishes the influence of the noise. The order of the window size \eqn{k_n} is chosen to lead to optimal convergence rates. The pre-averaging estimator is then simply the analogue of the Realized Variance but based on pre-averaged returns and an additional term to remove bias due to noise +\deqn{ +\hat{C}= \frac{N^{-1/2}}{\theta \psi_2}\sum_{i=0}^{N-k_N+1} (\bar{r}_{\tau_i})^2-\frac{\psi_1^{k_N}N^{-1}}{2\theta^2\psi_2^{k_N}}\sum_{i=0}^{N}r_{\tau_i}^2 +} +with +\deqn{ +\psi_1^{k_N}= k_N \sum_{j=1}^{k_N}\left(g\left(\frac{j+1}{k_N}\right)-g\left(\frac{j}{k_N}\right)\right)^2,\quad +} +\deqn{ +\psi_2^{k_N}= \frac{1}{k_N}\sum_{j=1}^{k_N-1}g^2\left(\frac{j}{k_N}\right). +} +\deqn{ +\psi_2= \frac{1}{12} +} +The multivariate counterpart is very similar. The estimator is called the Modulated Realized Covariance (MRC) and is defined as +\deqn{ +\mbox{MRC}= \frac{N}{N-k_N+2}\frac{1}{\psi_2k_N}\sum_{i=0}^{N-k_N+1}\bar{\boldsymbol{r}}_{\tau_i}\cdot \bar{\boldsymbol{r}}'_{\tau_i} -\frac{\psi_1^{k_N}}{\theta^2\psi_2^{k_N}}\hat{\Psi} +} +where \eqn{\hat{\Psi}_N = \frac{1}{2N}\sum_{i=1}^N \boldsymbol{r}_{\tau_i}(\boldsymbol{r}_{\tau_i})'}. It is a bias correction to make it consistent. However, due to this correction, the estimator is not ensured PSD. An alternative is to slightly enlarge the bandwidth such that \eqn{\mbox{k}_{N} = \lfloor\theta N^{1/2+\delta}\rfloor}. \eqn{\delta = 0.1} results in a consistent estimate without the bias correction and a PSD estimate, in which case: +\deqn{ + \mbox{MRC}^{\delta}= \frac{N}{N-k_N+2}\frac{1}{\psi_2k_N}\sum_{i=0}^{N-k_N+1}\bar{\boldsymbol{r}}_i\cdot \bar{\boldsymbol{r}}'_i +} + +} + +\references{ +Hautsch, N., & Podolskij, M. (2013). Preaveraging-Based Estimation of Quadratic Variation in the Presence of Noise and Jumps: Theory, Implementation, and Empirical Evidence. Journal of Business & Economic Statistics, 31(2), 165-183. + +} + +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_5minprices_jumps) +a= list (sample_5minprices_jumps["2010-01-04",1], + sample_5minprices_jumps["2010-01-04",2] ) +MRC(a, pairwise=TRUE,makePsd=TRUE) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ preaveraging } Added: pkg/highfrequency/man/RKurt.Rd =================================================================== --- pkg/highfrequency/man/RKurt.Rd (rev 0) +++ pkg/highfrequency/man/RKurt.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,49 @@ +\name{rKurt} +\alias{rKurt} +\title{ +Realized kurtosis of highfrequency return series. +} +\description{ + +Function returns Realized kurtosis, defined in Amaya et al. (2011). + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then, the rKurt is given by +\deqn{ +\mbox{rKurt}_{t}= \frac{N \sum_{i=1}^{N}(r_{t,i})^4}{RV_{t}^2} +} +in which +\eqn{RV_t:} realized variance +} + +\usage{ +rKurt (rdata,align.by=NULL,align.period=NULL,makeReturns=FALSE,...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +numeric +} +\references{ +Amaya, D., Christoffersen, P., Jacobs, K. and Vasquez, A. (2011). Do realized skewness and kurtosis predict the cross-section of equity returns?. CREATES research paper. p. 3-7. +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +rKurt(sample_tdata$PRICE,align.by ="minutes", align.period =5, makeReturns = TRUE) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ rKurt } Added: pkg/highfrequency/man/RQPVar.Rd =================================================================== --- pkg/highfrequency/man/RQPVar.Rd (rev 0) +++ pkg/highfrequency/man/RQPVar.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,47 @@ +\name{rQPVar} +\alias{rQPVar} +\title{ +Realized quadpower variation of highfrequency return series. +} +\description{ + +Function returns the rQPVar, defined in Andersen et al. (2012). + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then, the rQPVar is given by +\deqn{ +\mbox{rQPVar}_{t}=\frac{N}{N-3} \frac{\pi^2}{4} \sum_{i=4}^{N} \mbox(|r_{t,i}| |r_{t,i-1}| |r_{t,i-2}| |r_{t,i-3}|) +} +} +\usage{ +rQPVar (rdata, align.by=NULL, align.period=NULL, makeReturns=FALSE,...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +numeric +} +\references{ +Andersen, T. G., D. Dobrev, and E. Schaumburg (2012). Jump-robust volatility estimation using nearest neighbor truncation. Journal of Econometrics, 169(1), 75- 93. +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +rQPVar(rdata= sample_tdata$PRICE, align.by= "minutes", align.period =5, makeReturns= TRUE) +rQPVar +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ rQPVar} Added: pkg/highfrequency/man/RQuar.Rd =================================================================== --- pkg/highfrequency/man/RQuar.Rd (rev 0) +++ pkg/highfrequency/man/RQuar.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,47 @@ +\name{rQuar} +\alias{rQuar} +\title{ +Realized quarticity of highfrequency return series. +} +\description{ + +Function returns the rQuar, defined in Andersen et al. (2012). + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then, the rQuar is given by +\deqn{ +\mbox{rQuar}_{t}=\frac{N}{3} \sum_{i=1}^{N} \mbox(r_{t,i}^4) +} +} +\usage{ +rQuar (rdata, align.by=NULL, align.period=NULL, makeReturns=FALSE,...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +numeric +} +\references{ +Andersen, T. G., D. Dobrev, and E. Schaumburg (2012). Jump-robust volatility estimation using nearest neighbor truncation. Journal of Econometrics, 169(1), 75- 93. +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +rQuar(rdata= sample_tdata$PRICE, align.by= "minutes", align.period =5, makeReturns= TRUE) +rQuar +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ rQuar} Added: pkg/highfrequency/man/RSkew.Rd =================================================================== --- pkg/highfrequency/man/RSkew.Rd (rev 0) +++ pkg/highfrequency/man/RSkew.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,50 @@ +\name{rSkew} +\alias{rSkew} +\title{ +Realized skewness of highfrequency return series. +} +\description{ + +Function returns Realized skewness, defined in Amaya et al. (2011). + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then, the rSkew is given by +\deqn{ +\mbox{rSkew}_{t}= \frac{\sqrt{N} \sum_{i=1}^{N}(r_{t,i})^3}{RV_{t}^{3/2}} +} + +in which +\eqn{RV_{t}:} realized variance +} + +\usage{ +rSkew (rdata,align.by=NULL,align.period=NULL,makeReturns=FALSE,...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +numeric +} +\references{ +Amaya, D., Christoffersen, P., Jacobs, K. and Vasquez, A. (2011). Do realized skewness and kurtosis predict the cross-section of equity returns?. CREATES research paper. p. 3-7. +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +rSkew(sample_tdata$PRICE,align.by ="minutes", align.period =5, makeReturns = TRUE) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ rSkew } Added: pkg/highfrequency/man/RTPVar.Rd =================================================================== --- pkg/highfrequency/man/RTPVar.Rd (rev 0) +++ pkg/highfrequency/man/RTPVar.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,47 @@ +\name{rTPVar} +\alias{rTPVar} +\title{ +Realized tripower variation of highfrequency return series. +} +\description{ + +Function returns the rTPVar, defined in Andersen et al. (2012). + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then, the rTPVar is given by +\deqn{ +\mbox{rTPVar}_{t}=\frac{N}{N-2} \frac{\Gamma^2 \left(1/2\right)}{4 \Gamma^2 \left(7/6\right)} \sum_{i=3}^{N} \mbox({|r_{t,i}|}^{4/3} {|r_{t,i-1}|}^{4/3} {|r_{t,i-2}|}^{4/3}) +} +} +\usage{ +rTPVar (rdata, align.by=NULL, align.period=NULL, makeReturns=FALSE,...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +numeric +} +\references{ +Andersen, T. G., D. Dobrev, and E. Schaumburg (2012). Jump-robust volatility estimation using nearest neighbor truncation. Journal of Econometrics, 169(1), 75- 93. +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +rTPVar(rdata= sample_tdata$PRICE, align.by= "minutes", align.period =5, makeReturns= TRUE) +rTPVar +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ rTPVar} Added: pkg/highfrequency/man/RsV.Rd =================================================================== --- pkg/highfrequency/man/RsV.Rd (rev 0) +++ pkg/highfrequency/man/RsV.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,51 @@ +\name{rSV} +\alias{rSV} +\title{ +Realized semivariance of highfrequency return series. +} +\description{ + +Function returns Realized semivariance, defined in Barndorff-Nielsen et al. (2008). + +Function returns two outcomes: 1.Downside realized semivariance and 2.Upside realized semivariance. + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. Let \eqn{r_{t,i}} be a return (with \eqn{i=1, \ldots,N}) in period \eqn{t}. + +Then, the rSV is given by +\deqn{ +\mbox{rSVdownside}_{t}= \sum_{i=1}^{N} (r_{t,i})^2 \ \times \ I [ r_{t,i} <0 ] +} +\deqn{ +\mbox{rSVupside}_{t}= \sum_{i=1}^{N} (r_{t,i})^2 \ \times \ I [ r_{t,i} >0 ] +} +} +\usage{ +rSV (rdata,align.by=NULL,align.period=NULL,makeReturns=FALSE,...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +list +} +\references{ +Barndorff- Nielsen, O.E., Kinnebrock, S. and Shephard N. (2008). Measuring downside risk- realized semivariance. CREATES research paper. p. 3-5 +} +\author{ +Giang Nguyen, Jonathan Cornelissen and Kris Boudt +} + +\examples{ +data(sample_tdata) +rSV(sample_tdata$PRICE,align.by ="minutes", align.period =5, makeReturns = TRUE) +} +% Add one or more standard keywords, see file 'KEYWORDS' in the +% R documentation directory. +\keyword{ highfrequency } +\keyword{ rSV } Added: pkg/highfrequency/man/highfrequencyGSOC-package.Rd =================================================================== --- pkg/highfrequency/man/highfrequencyGSOC-package.Rd (rev 0) +++ pkg/highfrequency/man/highfrequencyGSOC-package.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,36 @@ +\name{highfrequencyGSOC-package} +\alias{highfrequencyGSOC-package} +\alias{highfrequencyGSOC} +\docType{package} +\title{ +Additional functionality for the highfrequency package +} +\description{ +Additional functionality for the highfrequency package: jump test, standard error +} +\details{ +\tabular{ll}{ +Package: \tab highfrequencyGSOC\cr +Type: \tab Package\cr +Version: \tab 1.0\cr +Date: \tab 2013-07-02\cr +License: \tab GPL\cr +} +~~ An overview of how to use the package, including the most important functions ~~ +} +\author{ +Giang Nguyen, Kris Boudt, Jonathan Cornelissen + +Maintainer: Giang Nguyen +~~ The author and/or maintainer of the package ~~ +} +\references{ + +} +~~ Optionally other standard keywords, one per line, from file KEYWORDS in the R documentation directory ~~ +\keyword{ package } +\seealso{ +} +\examples{ + +} Added: pkg/highfrequency/man/ivInference.Rd =================================================================== --- pkg/highfrequency/man/ivInference.Rd (rev 0) +++ pkg/highfrequency/man/ivInference.Rd 2013-08-19 10:11:33 UTC (rev 46) @@ -0,0 +1,82 @@ +\name{ivInference} +\alias{ivInference} +\title{ +Function returns the value, the standard error and the confidence band of the integrated variance (IV) estimator. +} +\description{ + +This function supplies information about standard error and confidence band of integrated variance (IV) estimators under Brownian semimartingales model such as: bipower variation, minRV, medRV. +Depending on users' choices of estimator (integrated variance (IVestimator), integrated quarticity (IQestimator)) and confidence level, the function returns the result.(Barndorff (2002)) +Function returns three outcomes: 1.value of IV estimator 2.standard error of IV estimator and 3.confidence band of IV estimator. + +Assume there is \eqn{N} equispaced returns in period \eqn{t}. + +Then the ivInference is given by: +\deqn{ +\mbox{standard error}= \frac{1}{\sqrt{N}} *sd +} +\deqn{ +\mbox{confidence band}= \hat{IV} \pm cv*se +} +in which, +\deqn{ +\mbox{sd}= \sqrt{\theta \times \hat{IQ}} +} + +\eqn{cv:} critical value. + +\eqn{se:} standard error. + +\eqn{\theta:} depending on IQestimator, \eqn{\theta} can take different value (Andersen et al. (2012)). + +\eqn{\hat{IQ}} integrated quarticity estimator. +} + +\usage{ +ivInference (rdata, IVestimator="RV", IQestimator="rQuar", confidence=0.95, + align.by= NULL, align.period = NULL, makeReturns = FALSE, ...) +} + +\arguments{ + \item{rdata}{a zoo/xts object containing all returns in period t for one asset.} + \item{IVestimator}{can be chosen among integrated variance estimators: RV, BV, minRV or medRV. RV by default.} + \item{IQestimator}{can be chosen among integrated quarticity estimators: rQuar, TP, QP, minRQ or medRQ. rQuar by default.} + \item{confidence}{confidence level set by users. 0.95 by default. } + \item{align.by}{a string, align the tick data to "seconds"|"minutes"|"hours"} + \item{align.period}{an integer, align the tick data to this many [seconds|minutes|hours].} + \item{makeReturns}{boolean, should be TRUE when rdata contains prices instead of returns. FALSE by default.} + \item{...}{additional arguments.} +} + +\value{ +list +} + +\details{ +The theoretical framework is the logarithmic price process \eqn{X_t} belongs to the class of Brownian semimartingales, which can be written as: +\deqn{ +\mbox{X}_{t}= \int_{0}^{t} a_udu + \int_{0}^{t}\sigma_{u}dW_{u} +} +where \eqn{a} is the drift term, \eqn{\sigma} denotes the spot volatility process, \eqn{W} is a standard Brownian motion (assume that there are no jumps). + +} + +\references{ [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/highfrequency -r 46 From noreply at r-forge.r-project.org Fri Aug 23 13:01:18 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 23 Aug 2013 13:01:18 +0200 (CEST) Subject: [Highfrequency-commits] r47 - pkg/highfrequency/R Message-ID: <20130823110118.CB1421833B9@r-forge.r-project.org> Author: kboudt Date: 2013-08-23 13:01:18 +0200 (Fri, 23 Aug 2013) New Revision: 47 Modified: pkg/highfrequency/R/highfrequencyGSOC.R Log: Update Modified: pkg/highfrequency/R/highfrequencyGSOC.R =================================================================== --- pkg/highfrequency/R/highfrequencyGSOC.R 2013-08-19 10:11:33 UTC (rev 46) +++ pkg/highfrequency/R/highfrequencyGSOC.R 2013-08-23 11:01:18 UTC (rev 47) @@ -1,8 +1,4 @@ - - - -minRQ = function(rdata,align.by=NULL,align.period = NULL, makeReturns = FALSE,...) -{ +minRQ = function(rdata,align.by=NULL,align.period = NULL, makeReturns = FALSE,...){ if (hasArg(data)) { rdata = data @@ -10,7 +6,7 @@ multixts = highfrequency:::.multixts(rdata) if (multixts) { - result = apply.daily(rdata, minRQ, align.by, align.period, makeReturns) ##Check FUN + result = apply.daily(rdata, minRQ, align.by, align.period, makeReturns) return(result) } if (!multixts) @@ -40,7 +36,7 @@ multixts = highfrequency:::.multixts(rdata) if (multixts) { - result = apply.daily(rdata, medRQ, align.by, align.period, makeReturns) ##Check FUN + result = apply.daily(rdata, medRQ, align.by, align.period, makeReturns) return(result) } if (!multixts) @@ -52,15 +48,14 @@ { rdata = makeReturns(rdata) } - q=abs(as.numeric(rdata)) - q=as.numeric(rollmedian(q, k = 3)) + q = abs(as.numeric(rdata)) + q = as.numeric(rollmedian(q, k = 3,align="center")) N = length(q)+2 medRQ = 3*pi*N/(9*pi+72-53*sqrt(3))*(N/(N-2))*sum(q^4) return(medRQ) } } - rQuar = function(rdata, align.by = NULL, align.period = NULL, makeReturns = FALSE,...) { if (hasArg(data)) @@ -70,7 +65,7 @@ multixts = highfrequency:::.multixts(rdata) if (multixts) { - result = apply.daily(rdata, rQuar, align.by, align.period, ##check FUN + result = apply.daily(rdata, rQuar, align.by, align.period, makeReturns) return(result) } @@ -133,7 +128,7 @@ multixts = highfrequency:::.multixts(rdata) if (multixts) { - result = apply.daily(rdata, rTPVar, align.by, align.period, ##check FUN + result = apply.daily(rdata, rTPVar, align.by, align.period, makeReturns) return(result) } @@ -158,68 +153,32 @@ ## Standard error and confidence band of RV measures - ivInference = function(rdata, IVestimator="RV", IQestimator="rQuar", confidence=0.95, align.by= NULL, align.period = NULL, makeReturns = FALSE, ...) - { - if (hasArg(data)) - { - rdata = data - } +ivInference = function(rdata, IVestimator="RV", IQestimator="rQuar", confidence=0.95, align.by= NULL, align.period = NULL, makeReturns = FALSE, ...) +{ + if (hasArg(data)){ rdata = data } + multixts =highfrequency:::.multixts(rdata) if (multixts) { result = apply.daily(rdata, ivInference, align.by, align.period, ##check FUN makeReturns) return(result) - } - if (!multixts) - { - if ((!is.null(align.by)) && (!is.null(align.period))) { + }else{ + if((!is.null(align.by)) && (!is.null(align.period))){ rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) } - if(makeReturns) - { - rdata=makeReturns(rdata) - } + if(makeReturns){ rdata=makeReturns(rdata) } - N=length(rdata) - p= as.numeric(confidence) + N = length(rdata) + p = as.numeric(confidence) - ##IQ estimator: - IQ=function(rdata,IQestimator) - { - switch(IQestimator, - RQuart= rQuar(rdata), - QP= QP(rdata), - minRQ= minRQ(rdata), - medRQ= medRQ(rdata)) - } - iq= IQ(rdata,IQestimator) + iq = .hatiq(rdata,IQestimator) - ##IV estimator: - IV=function(IVestimator,iq) - { - switch(IVestimator, - RV= sqrt(2*iq), - BV= sqrt(2.61*iq), - TV= sqrt(3.06*iq), - minRV= sqrt(3.81*iq), - medRV= sqrt(2.96*iq)) - } - iv= IV(IVestimator,iq) + iv = .IV(IVestimator,iq) - ##hatIV - hativ=function(rdata,IVestimator) - { - switch(IVestimator, - RV= highfrequency:::RV(rdata), - BV= highfrequency:::RBPVar(rdata), - TV= TP(rdata), - minRV= minRV(rdata), - medRV= medRV(rdata)) - } - hatIV=hativ(rdata, IVestimator) + hatIV = .hativ(rdata, IVestimator) stderr= 1/sqrt(N)*iv @@ -234,256 +193,101 @@ out$se= stderr out$cb= cb - return(out) } - } - +} - - - -# thetaROWVar(k=qchisq(0.95,df=1),alpha=0.25); thetaROWVar(k=qchisq(0.99,df=1),alpha=0.25); - -# thetaROWVar(k=qchisq(0.999,df=1),alpha=0.25); - - - thetaROWVar = function( alpha = 0.001 , alphaMCD = 0.5 ) - { + N = 1; + q_alpha = qchisq( 1-alpha , df = N ); + c_alpha = (1-alpha)/pchisq( q_alpha , df = N+2 ); + a_alpha = -2*sqrt(q_alpha)*dnorm(sqrt(q_alpha))+1-alpha; + b_alpha = -2*q_alpha^(3/2)*dnorm(sqrt(q_alpha))+3*a_alpha; - IF_MCD = function( x , alpha = alphaMCD ){ - - N = 1 - - q = qchisq( 1-alpha , df = N ) - - calpha = (1-alpha)/pchisq( q , df = N+2 ) - - out = ( (x^2-q)/(1-alpha) )*( abs(x) <= sqrt(q) ) - - return( -1+q*calpha + calpha*out ) - - } - - - - int = function(x){ - - return( IF_MCD(x)*x^2*dnorm(x) ) - - } - - - - int = function(x){ - - return( IF_MCD(x)^2*dnorm(x) ) - - } - - - - avar_MCD = function(alpha){ - N = 1 - - q_alpha = qchisq( 1-alpha , df = N ) - - c_alpha = (1-alpha)/pchisq( q_alpha , df = N+2 ) - - a_alpha = -2*sqrt(q_alpha)*dnorm(sqrt(q_alpha))+1-alpha - - b_alpha = -2*q_alpha^(3/2)*dnorm(sqrt(q_alpha))+3*a_alpha - - - - avar = c_alpha^2*q_alpha^2+1-2*c_alpha*q_alpha - - avar = avar + c_alpha^2/(1-alpha)^2*(b_alpha+q_alpha^2*(1-alpha)-2*q_alpha*a_alpha) - - avar = avar + 2*( c_alpha*q_alpha - 1)*c_alpha*(1/(1-alpha))*(-q_alpha*(1-alpha)+a_alpha) - - return(avar) - - } - - N = 1 - - q_alpha = qchisq( 1-alpha , df = N ) - - c_alpha = (1-alpha)/pchisq( q_alpha , df = N+2 ) - - a_alpha = -2*sqrt(q_alpha)*dnorm(sqrt(q_alpha))+1-alpha - - b_alpha = -2*q_alpha^(3/2)*dnorm(sqrt(q_alpha))+3*a_alpha - - - + k = qchisq(1-alpha, df= 1); #TODO GIANG ## suggestion in the article. halfk = sqrt(k); halfq = sqrt(q_alpha) - - Ewu2 = 2*pnorm(halfk)-1; - Ewu2u2 = -2*halfk*dnorm(halfk)+Ewu2; - Ewu2u4 = -2*(k^(3/2))*dnorm(halfk)+3*Ewu2u2; - - - + Ewu2u2IF = (-1+c_alpha*q_alpha-(c_alpha*q_alpha)/(1-alpha))*a_alpha+c_alpha*b_alpha/(1-alpha) - Ewu2u2IF = Ewu2u2IF + 2*(1-c_alpha*q_alpha)*( - - halfk*dnorm(halfk)-halfq*dnorm(halfq) + 1 - alpha/2 - pnorm(halfk) ) - + halfk*dnorm(halfk)-halfq*dnorm(halfq) + 1 - alpha/2 - pnorm(halfk) ) Ewu2IF = (alpha-1-c_alpha*q_alpha*alpha) + c_alpha*a_alpha/(1-alpha) + 2*(c_alpha*q_alpha-1)*( pnorm(halfk)-(1-alpha/2)) - Ederwu2u4 = -k^(3/2)*dnorm(halfk); - Ederwu2u2 = -halfk*dnorm(halfk); - c1 = 1/Ewu2u2; c2 = 1/Ewu2; c3 = c2*Ederwu2u2-c1*Ederwu2u4 - - Avar0 = avar_MCD(alpha) - + Avar0 = .avar_MCD(alpha) theta = c3^2*Avar0 + c1^2*Ewu2u4 + c2^2*Ewu2 - 2*c1*c2*Ewu2u2; - theta = theta + 2*c3*( c1*Ewu2u2IF-c2*Ewu2IF ); return( theta ); - } - ##Jump-test: BNS with threshold BNSjumptest=function(rdata, IVestimator= "BV", IQestimator= "TP", type= "linear", logtransform= FALSE, max= FALSE, align.by= NULL, align.period= NULL, makeReturns = FALSE, startV= NULL,...) { - if (hasArg(data)) - { - rdata = data - } + if (hasArg(data)){ rdata = data } + multixts = highfrequency:::.multixts(rdata) - if (multixts) - { + + if (multixts){ result = apply.daily(rdata, BNSjumptest, align.by, align.period, makeReturns) ##Check FUN return(result) - } - if (!multixts) - { - if ((!is.null(align.by)) && (!is.null(align.period))) { + }else{ + if((!is.null(align.by)) && (!is.null(align.period))) { rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) - } - if(makeReturns) - { - rdata = makeReturns(rdata) - } + } + if(makeReturns){ rdata = makeReturns(rdata) } + N=length(rdata) ## hatQV hatQV = highfrequency:::RV(rdata) - ## threshold BV - ##Gaussian kernel: - Gaus.ker= function(y) - { - ky=(1/sqrt(2*pi)*exp(-y^2/2)) - } - - ##hatV: + + ## hatV: TODO this is not the right place, move to where it is always needed if(is.null(startV)) { - hatV= medRV(rdata) - } - else(hatV=startV) - - ##zgamma function: - zgamma=function(x,y) - { - if(x^2 Author: kboudt Date: 2013-08-25 12:58:00 +0200 (Sun, 25 Aug 2013) New Revision: 48 Modified: pkg/highfrequency/R/realized.R Log: Modified: pkg/highfrequency/R/realized.R =================================================================== --- pkg/highfrequency/R/realized.R 2013-08-23 11:01:18 UTC (rev 47) +++ pkg/highfrequency/R/realized.R 2013-08-25 10:58:00 UTC (rev 48) @@ -1,4677 +1,4140 @@ +# This file contains all realized measures previously implemented in RTAQ and realized +######################################################## +## Help functions: (not exported) +######################################################## +.multixts <- function( x, y=NULL) +{ + if(is.null(y)){ + test = is.xts(x) && (ndays(x)!=1); + return(test);} + if(!is.null(y)){ + test = (is.xts(x) && (ndays(x)!=1)) || ( ndays(y)!=1 && is.xts(y) ); + if( test ){ + test1 = dim(y) == dim(x); + if(!test1){ warning("Please make sure x and y have the same dimensions") } + if(test1){ test = list( TRUE, cbind(x,y) ); return(test) } + } + } +} +RV = function(rdata,...){ + if(hasArg(data)){ rdata = data } + returns=as.numeric(rdata); + RV = sum(returns*returns); + return(RV); +} +RBPCov_bi = function(ts1,ts2){ + n = length(ts1); + a = abs(ts1+ts2); + b = abs(ts1-ts2); + first = as.numeric(a[1:(n-1)])*as.numeric(a[2:n]); + last = as.numeric(b[1:(n-1)])*as.numeric(b[2:n]); + result = (pi/8)*sum(first-last); + return(result); +} - - - - - - highfrequency/R/realized.R at 6eae3f5a44710b42ebab370a781a3b1381e8bc17 ? jonathancornelissen/highfrequency ? GitHub - - - - - - - - - - - - +#Realized BiPower Variation (RBPVar) (RBPVar) +RBPVar = function(rdata,...){ + if(hasArg(data)){ rdata = data } + returns = as.vector(as.numeric(rdata)); + n = length(returns); + rbpvar = (pi/2)*sum(abs(returns[1:(n-1)])*abs(returns[2:n])); + return(rbpvar); +} + +# Check data: +rdatacheck = function (rdata, multi = FALSE) +{ + if ((dim(rdata)[2] < 2) & (multi)) { + stop("Your rdata object should have at least 2 columns") + } +} + +######## rowcov helper functions: +#Realized Outlyingness Weighted Quadratic Covariation (ROWQCov) +conhuber = function(di,alpha=0.05) +{# consistency factor ROWQCov based on Huber weight function + c = qchisq(p=1-alpha,df=di) + fw2 = function(t){ + z=t^2; return( huberweight(z,c)*( t^(di-1) )*exp(-z/2) ) } + fw1 = function(t){ + z=t^2; return( huberweight(z,c)*( t^(di+1) )*exp(-z/2) )} + c2 = integrate(fw2,0,Inf)$value; c1 = integrate(fw1,0,Inf)$value; + return( di*c2/c1 ) +} + +conHR = function(di,alpha=0.05) +{ + # consistency factor ROWQCov based on hard rejection weight function + return( (1-alpha)/pchisq(qchisq(1-alpha,df=di),df=di+2) ) +} + +huberweight = function(d,k){ + # Huber or soft rejection weight function + w = apply( cbind( rep(1,length(d) ) , (k/d) ),1,'min'); return(w); +} + +countzeroes = function( series ) +{ + return( sum( 1*(series==0) ) ) +} + +#Realized Outlyingness Weighted Variance (ROWVar): +univariateoutlyingness = function(rdata,...){ + require('robustbase'); + if(hasArg(data)){ rdata = data } + #computes outlyingness of each obs compared to row location and scale + location = 0; + scale = mad(rdata); + if(scale==0){ + scale = mean(rdata); + } + d = ((rdata - location)/scale)^2; +} + + +ROWVar = function(rdata, seasadjR = NULL, wfunction = "HR" , alphaMCD = 0.75, alpha = 0.001,...) +{ + require('robustbase'); + if(hasArg(data)){ rdata = data } + require(robustbase) + if (is.null(seasadjR)) { + seasadjR = rdata; + } + rdata = as.vector(rdata); seasadjR = as.vector(seasadjR); + intraT = length(rdata); N=1; + MCDcov = as.vector(covMcd( rdata , use.correction = FALSE )$raw.cov) + outlyingness = seasadjR^2/MCDcov + k = qchisq(p = 1 - alpha, df = N) + outlierindic = outlyingness > k + weights = rep(1, intraT) + if( wfunction == "HR" ){ + weights[outlierindic] = 0 + wR = sqrt(weights) * rdata + return((conHR(di = N, alpha = alpha) * sum(wR^2))/mean(weights)) + } + if( wfunction == "SR" ){ + weights[outlierindic] = k/outlyingness[outlierindic] + wR = sqrt(weights) * rdata + return((conhuber(di = N, alpha = alpha) * sum(wR^2))/mean(weights)) + } + +} +#### Two time scale helper functions: +TSRV = function ( pdata , K=300 , J=1 ) +{ + # based on rv.timescale + logprices = log(as.numeric(pdata)) + n = length(logprices) ; + nbarK = (n - K + 1)/(K) # average number of obs in 1 K-grid + nbarJ = (n - J + 1)/(J) + adj = (1 - (nbarK/nbarJ))^-1 + logreturns_K = logreturns_J = c(); + for( k in 1:K){ + sel = seq(k,n,K) + logreturns_K = c( logreturns_K , diff( logprices[sel] ) ) + } + for( j in 1:J){ + sel = seq(j,n,J) + logreturns_J = c( logreturns_J , diff( logprices[sel] ) ) + } + TSRV = adj * ( (1/K)*sum(logreturns_K^2) - ((nbarK/nbarJ) *(1/J)*sum(logreturns_J^2))) + return(TSRV) +} - - - - +RTSRV = function (pdata, startIV = NULL, noisevar = NULL, K = 300, J = 1, +eta = 9){ + logprices = log(as.numeric(pdata)) + n = length(logprices) + nbarK = (n - K + 1)/(K) + nbarJ = (n - J + 1)/(J) + adj = (1 - (nbarK/nbarJ))^-1 + zeta = 1/pchisq(eta, 3) + seconds = as.numeric(as.POSIXct(index(pdata))) + secday = last(seconds) - first(seconds) + logreturns_K = vdelta_K = logreturns_J = vdelta_J = c() + for (k in 1:K) { + sel = seq(k, n, K) + logreturns_K = c(logreturns_K, diff(logprices[sel])) + vdelta_K = c(vdelta_K, diff(seconds[sel])/secday) + } + for (j in 1:J) { + sel = seq(j, n, J) + logreturns_J = c(logreturns_J, diff(logprices[sel])) + vdelta_J = c(vdelta_J, diff(seconds[sel])/secday) + } + if (is.null(noisevar)) { + noisevar = max(0,1/(2 * nbarJ) * (sum(logreturns_J^2)/J - TSRV(pdata=pdata,K=K,J=J))) + } + if (!is.null(startIV)) { + RTSRV = startIV + } + if (is.null(startIV)) { + sel = seq(1, n, K) + RTSRV = medRV(diff(logprices[sel])) + } + iter = 1 + while (iter <= 20) { + I_K = 1 * (logreturns_K^2 <= eta * (RTSRV * vdelta_K + + 2 * noisevar)) + I_J = 1 * (logreturns_J^2 <= eta * (RTSRV * vdelta_J + + 2 * noisevar)) + if (sum(I_J) == 0) { + I_J = rep(1, length(logreturns_J)) + } + if (sum(I_K) == 0) { + I_K = rep(1, length(logreturns_K)) + } + RTSRV = adj * (zeta * (1/K) * sum(logreturns_K^2 * I_K)/mean(I_K) - + ((nbarK/nbarJ) * zeta * (1/J) * sum(logreturns_J^2 * + I_J)/mean(I_J))) + iter = iter + 1 + } + return(RTSRV) +} + +RTSCov_bi = +function (pdata1, pdata2, startIV1 = NULL, startIV2 = NULL, noisevar1 = NULL, +noisevar2 = NULL, K = 300, J = 1, +K_cov = NULL , J_cov = NULL , +K_var1 = NULL , K_var2 = NULL , +J_var1 = NULL , J_var2 = NULL , +eta = 9) +{ + if( is.null(K_cov)){ K_cov = K } ; if( is.null(J_cov)){ J_cov = J } + if( is.null(K_var1)){ K_var1 = K } ; if( is.null(K_var2)){ K_var2 = K } + if( is.null(J_var1)){ J_var1 = J } ; if( is.null(J_var2)){ J_var2 = J } + # Calculation of the noise variance and TSRV for the truncation - + + + if ( is.null(noisevar1) ) { + logprices1 = log(as.numeric(pdata1)) + n_var1 = length(logprices1) + nbarK_var1 = (n_var1 - K_var1 + 1)/(K_var1) ; + nbarJ_var1 = (n_var1 - J_var1 + 1)/(J_var1) + adj_var1 = n_var1/((K_var1 - J_var1) * nbarK_var1) + + logreturns_K1 = logreturns_J1 = c() + for (k in 1:K_var1) { + sel.avg = seq(k, n_var1, K_var1) + logreturns_K1 = c(logreturns_K1, diff(logprices1[sel.avg])) + } + for (j in 1:J_var1) { + sel.avg = seq(j, n_var1, J_var1) + logreturns_J1 = c(logreturns_J1, diff(logprices1[sel.avg])) + } + if( is.null(noisevar1) ){ + noisevar1 = max(0,1/(2 * nbarJ_var1) * (sum(logreturns_J1^2)/J_var1 - TSRV(pdata1,K=K_var1,J=J_var1))) + } + } + if (is.null(noisevar2)) { + logprices2 = log(as.numeric(pdata2)) + n_var2 = length(logprices2) + nbarK_var2 = (n_var2 - K_var2 + 1)/(K_var2) ; + nbarJ_var2 = (n_var2 - J_var2 + 1)/(J_var2) + adj_var2 = n_var2/((K_var2 - J_var2) * nbarK_var2) + + logreturns_K2 = logreturns_J2 = c() + for (k in 1:K_var2) { + sel.avg = seq(k, n_var2, K_var2) + logreturns_K2 = c(logreturns_K2, diff(logprices2[sel.avg])) + } + for (j in 1:J_var2) { + sel.avg = seq(j, n_var2, J_var2) + logreturns_J2 = c(logreturns_J2, diff(logprices2[sel.avg])) + } + noisevar2 = max(0,1/(2 * nbarJ_var2) * (sum(logreturns_J2^2)/J_var2 - TSRV(pdata2,K=K_var2,J=J_var2))) + } + + if (!is.null(startIV1)) { + RTSRV1 = startIV1 + }else{ + RTSRV1 = RTSRV(pdata=pdata1, noisevar = noisevar1, K = K_var1, J = J_var1, eta = eta) + } + if (!is.null(startIV2)) { + RTSRV2 = startIV2 + }else{ + RTSRV2 = RTSRV(pdata=pdata2, noisevar = noisevar2, K = K_var2, J = J_var2, eta = eta) + } + + # Refresh time is for the covariance calculation + + x = refreshTime(list(pdata1, pdata2)) + newprice1 = x[, 1] + newprice2 = x[, 2] + logprices1 = log(as.numeric(newprice1)) + logprices2 = log(as.numeric(newprice2)) + seconds = as.numeric(as.POSIXct(index(newprice1))) + secday = last(seconds) - first(seconds) + K = K_cov ; J = J_cov ; + + n = length(logprices1) + nbarK_cov = (n - K_cov + 1)/(K_cov) + nbarJ_cov = (n - J_cov + 1)/(J_cov) + adj_cov = n/((K_cov - J_cov) * nbarK_cov) + + logreturns_K1 = logreturns_K2 = vdelta_K = c() + for (k in 1:K_cov) { + sel.avg = seq(k, n, K_cov) + logreturns_K1 = c(logreturns_K1, diff(logprices1[sel.avg])) + logreturns_K2 = c(logreturns_K2, diff(logprices2[sel.avg])) + vdelta_K = c(vdelta_K, diff(seconds[sel.avg])/secday) + } + + logreturns_J1 = logreturns_J2 = vdelta_J = c() + for (j in 1:J_cov) { + sel.avg = seq(j, n, J_cov) + logreturns_J1 = c(logreturns_J1, diff(logprices1[sel.avg])) + logreturns_J2 = c(logreturns_J2, diff(logprices2[sel.avg])) + vdelta_J = c(vdelta_J, diff(seconds[sel.avg])/secday) + } + + + I_K1 = 1 * (logreturns_K1^2 <= eta * (RTSRV1 * vdelta_K + 2 * noisevar1)) + I_K2 = 1 * (logreturns_K2^2 <= eta * (RTSRV2 * vdelta_K + 2 * noisevar2)) + I_J1 = 1 * (logreturns_J1^2 <= eta * (RTSRV1 * vdelta_J + 2 * noisevar1)) + I_J2 = 1 * (logreturns_J2^2 <= eta * (RTSRV2 * vdelta_J + 2 * noisevar2)) + if (eta == 9) { + ccc = 1.0415 + } else { + ccc = cfactor_RTSCV(eta = eta) + } + RTSCV = adj_cov * (ccc * (1/K_cov) * sum(logreturns_K1 * I_K1 * + logreturns_K2 * I_K2)/mean(I_K1 * I_K2) - ((nbarK_cov/nbarJ_cov) * + ccc * (1/J_cov) * sum(logreturns_J1 * logreturns_J2 * I_J1 * + I_J2)/mean(I_J1 * I_J2))) + return(RTSCV) +} - - +TSCov_bi = function (pdata1, pdata2, K = 300, J = 1) +{ + x = refreshTime(list(pdata1, pdata2)) + newprice1 = x[, 1] + newprice2 = x[, 2] + logprices1 = log(as.numeric(newprice1)) + logprices2 = log(as.numeric(newprice2)) + seconds = as.numeric(as.POSIXct(index(newprice1))) + secday = last(seconds) - first(seconds) + n = length(logprices1) + nbarK = (n - K + 1)/(K) + nbarJ = (n - J + 1)/(J) + adj = n/((K - J) * nbarK) + + logreturns_K1 = logreturns_K2 = logreturns_J1 = logreturns_J2 = c() + vdelta_K = vdelta_J = c(); + + for (k in 1:K) { + sel.avg = seq(k, n, K) + logreturns_K1 = c(logreturns_K1, diff(logprices1[sel.avg])) + logreturns_K2 = c(logreturns_K2, diff(logprices2[sel.avg])) + vdelta_K = c(vdelta_K, diff(seconds[sel.avg]) / secday) + } + + for (j in 1:J) { + sel.avg = seq(j, n, J) + logreturns_J1 = c(logreturns_J1, diff(logprices1[sel.avg])) + logreturns_J2 = c(logreturns_J2, diff(logprices2[sel.avg])) + vdelta_J = c(vdelta_J, diff(seconds[sel.avg])/secday) + } + + TSCOV = adj * ((1/K) * sum(logreturns_K1 * logreturns_K2) - + ((nbarK/nbarJ) * (1/J) * sum(logreturns_J1 * logreturns_J2))) + return(TSCOV) +} - - +cfactor_RTSCV = function(eta=9){ + require('cubature'); require('mvtnorm') + # rho = 1 + c1 = pchisq(eta,df=1)/pchisq(eta,df=3) + # + rho = 0.001 + R = matrix( c(1,rho,rho,1) , ncol = 2 ) + int1 <- function(x) { dmvnorm(x,sigma=R) } + num = adaptIntegrate(int1, c(-3,-3), c(3,3), tol=1e-4)$integral + int2 <- function(x) { x[1]*x[2]*dmvnorm(x,sigma=R) } + denom = adaptIntegrate(int2, c(-3,-3), c(3,3), tol=1e-4)$integral + c2 = rho*num/denom + return( (c1+c2)/2 ) +} + +# Hayashi-Yoshida helper function: +rc.hy <- function(x,y, period=1,align.by="seconds", align.period =1, cts = TRUE, makeReturns=FALSE, ...) +{ + align.period = .getAlignPeriod(align.period, align.by) + cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) + x <- cdata$data + x.t <- cdata$milliseconds + cdatay <- .convertData(y, cts=cts, makeReturns=makeReturns) + y <- cdatay$data + y.t <- cdatay$milliseconds + + + errorCheck <- c(is.null(x.t),is.na(x.t), is.null(y.t), is.na(y.t)) + if(any(errorCheck)) + stop("ERROR: Time data is not in x or y.") + + + sum( .C("pcovcc", + as.double(x), #a + as.double(rep(0,length(x)/(period*align.period)+1)), + as.double(y), #b + as.double(x.t), #a + as.double(rep(0,length(x)/(period*align.period)+1)), #a + as.double(y.t), #b + as.integer(length(x)), #na + as.integer(length(x)/(period*align.period)), + as.integer(length(y)), #na + as.integer(period*align.period), + ans = double(length(x)/(period*align.period)+1), + COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), + PACKAGE="highfrequency")$ans) +} +# +# Realized variance calculation using a kernel estimator. +# +rv.kernel <- function(x, # Tick Data +kernel.type = "rectangular", # Kernel name (or number) +kernel.param = 1, # Kernel parameter (usually lags) +kernel.dofadj = TRUE, # Kernel Degree of freedom adjustment +align.by="seconds", # Align the tick data to [seconds|minutes|hours] +align.period = 1, # Align the tick data to this many [seconds|minutes|hours] +cts = TRUE, # Calendar Time Sampling is used +makeReturns = FALSE, # Convert to Returns +type = NULL, # Deprectated +adj = NULL, # Deprectated +q = NULL, ...){ # Deprectated + # Multiday adjustment: + multixts = .multixts(x); + if(multixts){ + result = apply.daily(x,rv.kernel,kernel.type,kernel.param,kernel.dofadj, + align.by,align.period,cts,makeReturns,type,adj,q); + return(result)} + if(!multixts){ #Daily estimation: + + # + # Handle deprication + # + + + if(!is.null(type)){ + warning("type is deprecated, use kernel.type") + kernel.type=type + } + if(!is.null(q)){ + warning("q is deprecated, use kernel.param") + kernel.param=q + } + if(!is.null(adj)){ + warning("adj is deprecated, use kernel.dofadj") + kernel.dofadj=adj + } + align.period = .getAlignPeriod(align.period, align.by) + cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) + x <- cdata$data + x <- .alignReturns(x, align.period) + type <- .kernel.chartoint(kernel.type) + .C("kernelEstimator", as.double(x), as.double(x), as.integer(length(x)), + as.integer(kernel.param), as.integer(ifelse(kernel.dofadj, 1, 0)), + as.integer(type), ab=double(kernel.param + 1), + ab2=double(kernel.param + 1), + ans=double(1),PACKAGE="highfrequency")$ans + } +} - - - - +rc.kernel <- function(x, # Tick Data for first asset +y, # Tick Data for second asset +kernel.type = "rectangular", # Kernel name (or number) +kernel.param = 1, # Kernel parameter (usually lags) +kernel.dofadj = TRUE, # Kernel Degree of freedom adjustment +align.by="seconds", # Align the tick data to [seconds|minutes|hours] +align.period = 1, # Align the tick data to this many [seconds|minutes|hours] +cts = TRUE, # Calendar Time Sampling is used +makeReturns = FALSE, # Convert to Returns +type = NULL, # Deprectated +adj = NULL, # Deprectated +q = NULL,...){ # Deprectated + # + # Handle deprication + # + if(!is.null(type)){ + warning("type is deprecated, use kernel.type") + kernel.type=type + } + if(!is.null(q)){ + warning("q is deprecated, use kernel.param") + kernel.param=q + } + if(!is.null(adj)){ + warning("adj is deprecated, use kernel.dofadj") + kernel.dofadj=adj + } + + align.period = .getAlignPeriod(align.period, align.by) + cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) + + x <- cdata$data + x <- .alignReturns(x, align.period) + cdatay <- .convertData(y, cts=cts, makeReturns=makeReturns) + y <- cdatay$data + y <- .alignReturns(y, align.period) + type <- .kernel.chartoint(kernel.type) + .C("kernelEstimator", as.double(x), as.double(y), as.integer(length(x)), + as.integer(kernel.param), as.integer(ifelse(kernel.dofadj, 1, 0)), + as.integer(type), ab=double(kernel.param + 1), + ab2=double(kernel.param + 1), + ans=double(1),PACKAGE="highfrequency")$ans +} - - - - - - - +rKernel <- function(x,type=0) +{ + type <- .kernel.chartoint(type) + .C("justKernel", x=as.double(x),type= as.integer(type), ans=as.double(0),PACKAGE="realized")$ans +} - +.kernel.chartoint <- function(type) +{ + if(is.character(type)) + { + ans <- switch(casefold(type), + rectangular=0, + bartlett=1, + second=2, + epanechnikov=3, + cubic=4, + fifth=5, + sixth=6, + seventh=7, + eighth=8, + parzen=9, + th=10, + mth=11, + tukeyhanning=10, + modifiedtukeyhanning=11, + -99) + if(ans==-99) + { + warning("Invalid Kernel, using Bartlet") + 1 + } + else + { + ans + } + } + else + { + type + } +} - - +rKernel.available <- function() +{ + c("Rectangular", + "Bartlett", + "Second", + "Epanechnikov", + "Cubic", + "Fifth", + "Sixth", + "Seventh", + "Eighth", + "Parzen", + "TukeyHanning", + "ModifiedTukeyHanning") +} - +## REalized Variance: Average subsampled +rv.avg = function(x, period) +{ + mean(.rv.subsample(x, period)) +} - +rc.avg = function( x, y, period ) +{ + mean(.rc.subsample(x, y, period)); +} -
- - - +.rv.subsample <- function(x, period, cts=TRUE, makeReturns=FALSE,...) +{ + cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) + x <- cdata$data + + .C("subsample", + + as.double(x), #a + as.double(x), #na + as.integer(length(x)), #na + as.integer(length(x)/period), #m + as.integer(period), #period + as.double(rep(0,as.integer(length(x)/period +1))), #tmp + as.double(rep(0,as.integer(length(x)/period +1))), #tmp + as.integer(length(x)/period), #tmpn + ans = double(period), + COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), + PACKAGE="highfrequency")$ans +} - -
-
+.rc.subsample <- function(x, y, period, cts=TRUE, makeReturns=FALSE, ... ) +{ + cdata <- .convertData(x, cts=cts, makeReturns=makeReturns) + x <- cdata$data + + cdatay <- .convertData(y, cts=cts, makeReturns=makeReturns) + y <- cdatay$data + + .C("subsample", + as.double(x), #a + as.double(y), #na + as.integer(length(x)), #na + as.integer(length(x)/period), #m + as.integer(period), #period + as.double(rep(0,as.integer(length(x)/period +1))), #tmp + as.double(rep(0,as.integer(length(x)/period +1))), #tmp + as.integer(length(x)/period), #tmpn + ans = double(period), + COPY=c(FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,TRUE), + PACKAGE="highfrequency")$ans +} - - - +#### percentage of zeros calc: +.makeROlist = function(rdata, align.period, align.by,cts,makeReturns){ + align.period = .getAlignPeriod(align.period, align.by); + L = list(); + for(i in 1:length(rdata)){ + L[[i]] = .alignReturns(.convertData(rdata[[i]], cts=cts, makeReturns=makeReturns)$data, align.period); + } + return(L); +} -
- Sign up - Sign in -
+rv.zero = function(x, period) +{ + ac <- .accum.naive(x=x,y=x,period=period) + sum((ac*ac)==0)/length(ac) +} -
+rc.zero = function(x, y, period) +{ + acy <- .accum.naive(x=y,y=y,period=period) + acx <- .accum.naive(x=x,y=x,period=period) + sum((acx*acy)==0)/length(acy) +} +######################################################################### +# +# Utility Functions from realized package Scott Payseur +# +######################################################################### +.alignedAccum <- function(x,y, period, cum=TRUE, makeReturns...) +{ + x<-.accum.naive(x,x, period) + y<-.accum.naive(y,y, period) + if(cum) + { + ans <- cumsum(x*y) + } + else + { + ans <- x*y + } + ans +} - - - + if("xts" %in% class(x)) + { + xtmp <- x + x <- list() + x$data <- as.numeric(xtmp[,1]) + + x$milliseconds <- (as.POSIXlt(time(xtmp))$hour*60*60 + as.POSIXlt(time(xtmp))$min*60 + as.POSIXlt(time(xtmp))$sec )*1000 + if(is.na(millisstart)) + { + millisstart = x$milliseconds[[1]] + } + if(is.na(millisend)) + { + millisend = x$milliseconds[[length(x$milliseconds)]] + } + + cat(paste("xts -> realizedObject [", as.character(time(xtmp[1])), " :: ", as.character(time(xtmp[length(x$milliseconds)])), "]", sep=""),"\n") + } + + if(is.na(millisstart)) + { + millisstart=34200000 + } + if(is.na(millisend)) + { + millisend=57600000 + } + if("list" %in% class(x)) + { + if(sum(names(x) == c("tts", "cts")) == 2) #realized obj + { + if(cts) + { + return(x$cts) + } + else + { + return(x$tts) + } + } + if(sum(names(x) == c("data", "milliseconds")) == 2) + { + if(makeReturns) + { # only works on non cts prices + errcheck <- try(.getReturns(.sameTime(x$data, x$milliseconds))) + if(class(errcheck) != "Error") + { + x$data <- errcheck + x$milliseconds <- intersect(x$milliseconds,x$milliseconds) + } + else + { + warning("It appears that these are already returns. Not creating returns") + } + } + else + { + x$data <- .sameTime(x$data, x$milliseconds) + x$milliseconds <- intersect(x$milliseconds,x$milliseconds) + } + if(cts) + { + toret <- list(data=.toCts(x=x$data, millis=intersect(x$milliseconds,x$milliseconds), millisstart=millisstart, millisend=millisend), [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/highfrequency -r 48 From noreply at r-forge.r-project.org Thu Aug 29 16:41:15 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 29 Aug 2013 16:41:15 +0200 (CEST) Subject: [Highfrequency-commits] r49 - pkg/highfrequency/man Message-ID: <20130829144115.642A6181474@r-forge.r-project.org> Author: kboudt Date: 2013-08-29 16:41:14 +0200 (Thu, 29 Aug 2013) New Revision: 49 Modified: pkg/highfrequency/man/MRC.Rd Log: Replaced & with and in MRC.Rd Modified: pkg/highfrequency/man/MRC.Rd =================================================================== --- pkg/highfrequency/man/MRC.Rd 2013-08-25 10:58:00 UTC (rev 48) +++ pkg/highfrequency/man/MRC.Rd 2013-08-29 14:41:14 UTC (rev 49) @@ -4,14 +4,11 @@ Modulated Realized Covariance (MRC): Return univariate or multivariate preaveraged estimator. } \description{ -Function returns univariate or multivariate preaveraged estimator, as difined in Hautsch & Podolskij (2013). - +Function returns univariate or multivariate preaveraged estimator, as difined in Hautsch and Podolskij (2013). } -} - \usage{ -MRC= function(pdata, pairwise=FALSE,makePsd= FALSE,...) +MRC(pdata, pairwise=FALSE,makePsd= FALSE,...) } \arguments{ From noreply at r-forge.r-project.org Thu Aug 29 16:47:11 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 29 Aug 2013 16:47:11 +0200 (CEST) Subject: [Highfrequency-commits] r50 - pkg/highfrequency Message-ID: <20130829144712.0280018561D@r-forge.r-project.org> Author: kboudt Date: 2013-08-29 16:47:11 +0200 (Thu, 29 Aug 2013) New Revision: 50 Modified: pkg/highfrequency/NAMESPACE Log: Added GSoC functions in namespace Modified: pkg/highfrequency/NAMESPACE =================================================================== --- pkg/highfrequency/NAMESPACE 2013-08-29 14:41:14 UTC (rev 49) +++ pkg/highfrequency/NAMESPACE 2013-08-29 14:47:11 UTC (rev 50) @@ -51,9 +51,24 @@ aggregateTrades, aggregatets, previoustick, -heavyModel +heavyModel, + AJjumptest, + BNSjumptest, + ivInference, + JOjumptest, + medRQ, + minRQ, + MRC, + rBeta, + rKurt, + rMPV, + rQPVar, + rQuar, + rSkew, + rSV, + rTPVa )#end exported function S3method(print, harModel); S3method(summary, harModel); -S3method(plot, harModel); \ No newline at end of file +S3method(plot, harModel);