From noreply at r-forge.r-project.org Mon Oct 14 14:01:07 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 14 Oct 2013 14:01:07 +0200 (CEST) Subject: [Highfrequency-commits] r55 - pkg/highfrequency/man Message-ID: <20131014120108.266D9183BC3@r-forge.r-project.org> Author: kboudt Date: 2013-10-14 14:01:06 +0200 (Mon, 14 Oct 2013) New Revision: 55 Added: pkg/highfrequency/man/heavyModelC.Rd Log: doc heavymodelC Added: pkg/highfrequency/man/heavyModelC.Rd =================================================================== --- pkg/highfrequency/man/heavyModelC.Rd (rev 0) +++ pkg/highfrequency/man/heavyModelC.Rd 2013-10-14 12:01:06 UTC (rev 55) @@ -0,0 +1,115 @@ +\name{heavyModelC} +\Rdversion{1.1} +\alias{heavyModelC} +\title{HEAVY Model estimation using C code} + +\description{ +This function is the same as heavyModel function, except for using C code to speed up the calculation process. + +This function calculatest the High frEquency bAsed VolatilitY (HEAVY) model proposed in Shephard and Sheppard (2010). This function is used as a predictive volatility model built to exploit highfrequency data. + + +} + +\usage{ +heavyModelC(data, p=matrix( c(0,0,1,1),ncol=2 ), q=matrix( c(1,0,0,1),ncol=2 ), + startingvalues = NULL, LB = NULL, UB = NULL, + backcast = NULL, compconst = FALSE); +} + +\arguments{ + \item{data}{ a (T x K) matrix containing the data, with T the number of days. For the traditional HEAVY model: K = 2, the first column contains the squared daily demeaned returns, the second column contains the realized measures. + } + \item{p}{ a (K x K) matrix containing the lag length for the model innovations. Position (i, j) in the matrix indicates the number of lags in equation i of the model for the innovations in data column j. For the traditional heavy model p is given by matrix( c(0,0,1,1),ncol=2 ) (default). + } + \item{q}{ + a (K x K) matrix containing the lag length for the conditional variances. Position (i, j) in the matrix indicates the number of lags in equation i of the model for conditional variances corresponding to series j. For the traditionalheavy model introduced above q is given by matrix( c(1,0,0,1),ncol=2 ) (default). + } + \item{startingvalues}{ a vector containing the starting values to be used in the optimization to find the optimal parameters estimates. + } + \item{LB}{ a vector of length K indicating the lower bounds to be used in the estimation. If NULL it is set to a vector of zeros by default. + } + \item{UB}{ a vector of length K indicating the upper bounds to be used in the estimation. If NULL it is set to a vector of Inf by default.} + \item{backcast}{ a vector of length K used to initialize the estimation. If NULL the unconditional estimates are taken. + } + \item{compconst}{ a boolean variable. In case TRUE, the omega values are estimated in the optimization. In case FALSE, volatility targeting is done and omega is just 1 minus the sum of all relevant alpha's and beta's multiplied by the unconditional variance. + } +} + +\details{ +Assume there are \eqn{T} daily returns and realized measures in the period \eqn{t}. Let \eqn{r_i} and \eqn{RM_i} be the \eqn{i^{th}} daily return and daily realized measure respectively (with \eqn{i=1, \ldots,T}). + +The most basic heavy model is the one with lag matrices p of \eqn{\left( \begin{array}{ccc} 0 & 1 \\ 0 & 1 \end{array} \right)} and q of \eqn{\left( \begin{array}{ccc} 1 & 0 \\ 0 & 1 \end{array} \right)}. This can be reprensented by the following equations: +\deqn{ +\mbox{var}{\left(r_t \right)} = h_t = w + \alpha RM_{t-1} + \beta h_{t-1}; w,\alpha \geq 0, \beta \in [0,1] +} +\deqn{ +\mbox{E}{\left(RM_t \right)} = \mu_t = w_R + \alpha_R RM_{t-1} + \beta_R \mu_{t-1}; w_R,\alpha_R, \beta_R \geq 0, \alpha_R+\beta_R \in [0,1] +} + +Equivalently, they can be presented in terms of matrix notation as below: + +\deqn{ +\left( \begin{array}{ccc} h_t \\ \mu_t \end{array} \right) = \left( \begin{array}{ccc} w \\ w_R \end{array} \right) + \left( \begin{array}{ccc} 0 & \alpha \\ 0 & \alpha_R \end{array} \right) \left( \begin{array}{ccc} r^2_{t-1} \\ RM_{t-1} \end{array} \right) + \left( \begin{array}{ccc} \beta & 0 \\ 0 & \beta_R \end{array} \right) \left( \begin{array}{ccc} h_{t-1} \\ \mu_{t-1} \end{array} \right) +} + +In this version, the parameters vector to be estimated is \eqn{\left( w, w_R,\alpha, \alpha_R, \beta, \beta_R \right) }. + +In terms of startingvalues, Shephard and Sheppard recommend for this version of the Heavy model to set \eqn{\beta} be around 0.6 and sum of \eqn{\alpha}+\eqn{\beta} to be close to but slightly less than one. + +In general, the lag length for the model innovation and the conditional covariance can be greater than 1. Consider, for example, matrix p is \eqn{\left( \begin{array}{ccc} 0 & 2 \\ 0 & 1 \end{array} \right)} and matrix q is the same as above. Matrix notation will be as below: +\deqn{ +\left( \begin{array}{ccc} h_t \\ \mu_t \end{array} \right) = \left( \begin{array}{ccc} w \\ w_R \end{array} \right) + \left( \begin{array}{ccc} 0 & \alpha_1 \\ 0 & \alpha_R \end{array} \right) \left( \begin{array}{ccc} r^2_{t-1} \\ RM_{t-1} \end{array} \right) +\left( \begin{array}{ccc} 0 & \alpha_2 \\ 0 & 0 \end{array} \right) \left( \begin{array}{ccc} r^2_{t-2} \\ RM_{t-2} \end{array} \right) + \left( \begin{array}{ccc} \beta & 0 \\ 0 & \beta_R \end{array} \right) \left( \begin{array}{ccc} h_{t-1} \\ \mu_{t-1} \end{array} \right) +} + +In this version, the parameters vector to be estimated is \eqn{\left( w, w_R,\alpha_1, \alpha_R, \alpha_2, \beta, \beta_R \right) }. + + +} + + +\value{ +A list with the following values: +(i) loglikelihood: The log likelihood evaluated at the parameter estimates. +(ii) likelihoods: an xts object of length T containing the log likelihoods per day. +(iii) condvar: a (T x K) xts object containing the conditional variances +(iv) estparams: a vector with the parameter estimates. The order in which the +parameters are reported is as follows: First the estimates for omega then the +estimates for the non-zero alpha's with the most recent lags first in case max(p) > 1, +then the estimates for the non-zero beta's with the most recent lag first in case +max(q) > 1. +(v) convergence: an integer code indicating the successfulness of the optimization. See \verb{optim} for more information. +} + +\references{ +Shephard, N. and K. Sheppard (2010). Realising the future: forecasting with high +frequency based volatility (heavy) models. Journal of Applied Econometrics 25, +197-231. +} + +\examples{ + # Implementation of the heavy model on DJI: + data("realized_library"); + returns = realized_library$Dow.Jones.Industrials.Returns; + rk = realized_library$Dow.Jones.Industrials.Realized.Kernel; + returns = returns[!is.na(rk)]; rk = rk[!is.na(rk)]; # Remove NA's + data = cbind( returns^2, rk ); # Make data matrix with returns and realized measures + backcast = matrix( c(var(returns),mean(rk)) ,ncol=1); + + #For traditional (default) version: + startvalues = c(0.004,0.02,0.44,0.41,0.74,0.56); # Initial values; + output = heavyModelC( data = as.matrix(data,ncol=2), compconst=FALSE, + startingvalues = startvalues, backcast=backcast); + + #For general version: + startvalues = c(0.004,0.02,0.44,0.4,0.41,0.74,0.56); # Initial values; + p = matrix(c(2, 0,0 , 1), ncol = 2); + q = matrix(c(1,0, 0, 1), ncol = 2); + + output = heavyModelC( data = as.matrix(data,ncol=2), p=p, q=q, compconst=FALSE, + startingvalues = startvalues, backcast=backcast); + +} + +\author{Giang Nguyen, Jonathan Cornelissen and Kris Boudt} +\keyword{forecasting} \ No newline at end of file From noreply at r-forge.r-project.org Mon Oct 14 14:08:30 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 14 Oct 2013 14:08:30 +0200 (CEST) Subject: [Highfrequency-commits] r56 - in pkg/highfrequency: . R src Message-ID: <20131014120830.12A86185BAE@r-forge.r-project.org> Author: kboudt Date: 2013-10-14 14:08:29 +0200 (Mon, 14 Oct 2013) New Revision: 56 Modified: pkg/highfrequency/DESCRIPTION pkg/highfrequency/NAMESPACE pkg/highfrequency/R/highfrequencyGSOC.R pkg/highfrequency/src/highfrequency.c pkg/highfrequency/src/highfrequency.h Log: Previous upload contained polluted files. This update corrects these and also adds the corrected c-code. Modified: pkg/highfrequency/DESCRIPTION =================================================================== --- pkg/highfrequency/DESCRIPTION 2013-10-14 12:01:06 UTC (rev 55) +++ pkg/highfrequency/DESCRIPTION 2013-10-14 12:08:29 UTC (rev 56) @@ -1,11 +1,15 @@ -Package: highfrequency -Version: 0.1 -Date: 2011-04-04 -Title: highfrequency +Package: highfrequency +Version: 0.1 +Date: 2011-04-04 +Title: highfrequency Author: Jonathan Cornelissen, Kris Boudt, Scott Payseur -Maintainer: Jonathan Cornelissen +Maintainer: Jonathan Cornelissen + +Contributor: Giang Nguyen, Chris Blakely Description: The highfrequency package contains an extensive toolkit for the use of highfrequency financial data in R. It contains functionality to manage, clean and match highfrequency trades and quotes data. Furthermore, it enables users to: calculate easily various liquidity measures, estimate and forecast volatility, and investigate microstructure noise and intraday periodicity. License: GPL (>= 2) Depends: R (>= 2.12.0), xts, zoo -Suggests: realized, robustbase, cubature, mvtnorm, chron, timeDate, quantmod +Suggests: realized, robustbase, cubature, mvtnorm, chron, timeDate, + quantmod LazyLoad: yes +Packaged: 2012-12-24 14:16:40 UTC; jonathancornelissen Modified: pkg/highfrequency/NAMESPACE =================================================================== --- pkg/highfrequency/NAMESPACE 2013-10-14 12:01:06 UTC (rev 55) +++ pkg/highfrequency/NAMESPACE 2013-10-14 12:08:29 UTC (rev 56) @@ -1,6 +1,6 @@ -useDynLib(highfrequency); -import(zoo); -import(xts); +useDynLib(highfrequency); +import(zoo); +import(xts); export( minRV, @@ -29,12 +29,12 @@ spotVol, matchTradesQuotes, getTradeDirection, -tqLiquidity, +tqLiquidity, tradesCleanup, quotesCleanup, tradesCleanupFinal, -autoSelectExchangeQuotes, -autoSelectExchangeTrades, +autoSelectExchangeQuotes, +autoSelectExchangeTrades, exchangeHoursOnly, mergeQuotesSameTimestamp, mergeTradesSameTimestamp, @@ -52,24 +52,24 @@ aggregatets, previoustick, heavyModel, - AJjumptest, - BNSjumptest, - ivInference, - JOjumptest, - medRQ, - minRQ, - MRC, - rBeta, - rKurt, - rMPV, - rQPVar, - rQuar, - rSkew, - rSV, - rTPVar +AJjumptest, +BNSjumptest, +ivInference, +JOjumptest, +medRQ, +minRQ, +MRC, +rBeta, +rKurt, +rMPV, +rQPVar, +rQuar, +rSkew, +rSV, +rTPVar, +heavyModelC )#end exported function S3method(print, harModel); S3method(summary, harModel); S3method(plot, harModel); - Modified: pkg/highfrequency/R/highfrequencyGSOC.R =================================================================== --- pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-14 12:01:06 UTC (rev 55) +++ pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-14 12:08:29 UTC (rev 56) @@ -1,2008 +1,1661 @@ - - - - - - - - - highfrequency/R/highfrequencyGSOC.R at master ? jonathancornelissen/highfrequency ? GitHub - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - -
-
- - - - - -
- Sign up - -
- -
- - -
- - - - - -
- - This repository - - -
-
- -
- - -
This repository
-
- -
- - -
All repositories
-
- -
-
-
- - - - - - - - -
-
- -
-
- - - - - -
- -
-
- - - - -

- public - - - /highfrequency - - - Octocat-spinner-32 - - -

-
-
- -
- -
- -
- - -
-
- -
- - - -
-
- -
- - - - -
-

HTTPS clone URL

-
- - - -
-
- - - -
-

Subversion checkout URL

-
- - - -
-
- - -

You can clone with - HTTPS, - or Subversion. - - - - - -

- - - - - Clone in Desktop - - - - - Download ZIP - -
-
- -
- - - - - - - - - - -
- - - -
- - - branch: - master - - -
- -
-
- Switch branches/tags - -
- -
-
- -
-
- -
-
- -
- -
- - -
- - master -
-
- -
Nothing to show
-
- -
-
- - -
- -
Nothing to show
-
- -
-
-
- -
- highfrequency / R / highfrequencyGSOC.R -
-
- - -
- Fetching contributors? - -
-

Octocat-spinner-32-eaf2f5

-

Cannot retrieve contributors at this time

-
-
- -
-
-
-
- - file - 1484 lines (1179 sloc) - 39.408 kb -
-
-
- Edit - Raw - Blame - History -
- - Delete - -
- -
-
- - -
- 1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -13 -14 -15 -16 -17 -18 -19 -20 -21 -22 -23 -24 -25 -26 -27 -28 -29 -30 -31 -32 -33 -34 -35 -36 -37 -38 -39 -40 -41 -42 -43 -44 -45 -46 -47 -48 -49 -50 -51 -52 -53 -54 -55 -56 -57 -58 -59 -60 -61 -62 -63 -64 -65 -66 -67 -68 -69 -70 -71 -72 -73 -74 -75 -76 -77 -78 -79 -80 -81 -82 -83 -84 -85 -86 -87 -88 -89 -90 -91 -92 -93 -94 -95 -96 -97 -98 -99 -100 -101 -102 -103 -104 -105 -106 -107 -108 -109 -110 -111 -112 -113 -114 -115 -116 -117 -118 -119 -120 -121 -122 -123 -124 -125 -126 -127 -128 -129 -130 -131 -132 -133 -134 -135 -136 -137 -138 -139 -140 -141 -142 -143 -144 -145 -146 -147 -148 -149 -150 -151 -152 -153 -154 -155 -156 -157 -158 -159 -160 -161 -162 -163 -164 -165 -166 -167 -168 -169 -170 -171 -172 -173 -174 -175 -176 -177 -178 -179 -180 -181 -182 -183 -184 -185 -186 -187 [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/highfrequency -r 56 From noreply at r-forge.r-project.org Tue Oct 15 12:06:12 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 15 Oct 2013 12:06:12 +0200 (CEST) Subject: [Highfrequency-commits] r57 - pkg/highfrequency/R Message-ID: <20131015100612.DB20E183F49@r-forge.r-project.org> Author: kboudt Date: 2013-10-15 12:06:12 +0200 (Tue, 15 Oct 2013) New Revision: 57 Modified: pkg/highfrequency/R/realized.R Log: Modified: pkg/highfrequency/R/realized.R =================================================================== --- pkg/highfrequency/R/realized.R 2013-10-14 12:08:29 UTC (rev 56) +++ pkg/highfrequency/R/realized.R 2013-10-15 10:06:12 UTC (rev 57) @@ -1,4648 +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 master ? 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 - -
+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) + { [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/highfrequency -r 57 From noreply at r-forge.r-project.org Tue Oct 15 12:08:10 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 15 Oct 2013 12:08:10 +0200 (CEST) Subject: [Highfrequency-commits] r58 - pkg/highfrequency/man Message-ID: <20131015100810.538171844F1@r-forge.r-project.org> Author: kboudt Date: 2013-10-15 12:08:09 +0200 (Tue, 15 Oct 2013) New Revision: 58 Modified: 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: Modified: pkg/highfrequency/man/AJjumptest.Rd =================================================================== --- pkg/highfrequency/man/AJjumptest.Rd 2013-10-15 10:06:12 UTC (rev 57) +++ pkg/highfrequency/man/AJjumptest.Rd 2013-10-15 10:08:09 UTC (rev 58) @@ -1,630 +1,106 @@ - - - - - - - - - highfrequency/man/AJjumptest.Rd at master ? jonathancornelissen/highfrequency ? GitHub - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - -
-
- - - - - -
- Sign up - -
- -
- - - - - - - - -
- - This repository - - -
-
- -
- - -
This repository
-
- -
- - -
All repositories
-
- -
-
-
- - - - - - - - - -
- -
-
- - - - - -
- -
-
- - - - -

- public - - - /highfrequency - - - Octocat-spinner-32 - - -

-
-
- -
- -
- -
- - -
-
- -
- - - -
-
- -
- - - - -
-

HTTPS clone URL

-
- - - -
-
- - - -
-

Subversion checkout URL

-
- - - -
-
- - -

You can clone with - HTTPS, - or Subversion. - - - - - -

- - - - - Clone in Desktop - - - - - Download ZIP - -
-
- -
- - - - - - - - - - -
- - - -
- - - branch: - master - - -
- -
-
- Switch branches/tags - -
- -
-
- -
-
- -
-
- -
- -
- - -
- - master -
-
- -
Nothing to show
-
- -
-
- - -
- -
Nothing to show
-
- -
-
-
- -
- highfrequency / man / AJjumptest.Rd -
-
- - -
- Fetching contributors? - -
-

Octocat-spinner-32-eaf2f5

-

Cannot retrieve contributors at this time

-
-
- -
-
-
-
- - file - 107 lines (82 sloc) - 4.589 kb -
-
-
- Edit - Raw - Blame - History -
- - Delete - -
- -
-
- - - -
- 1 -2 -3 -4 -5 -6 -7 -8 -9 -10 -11 -12 -13 -14 -15 -16 -17 -18 -19 -20 -21 -22 -23 -24 -25 -26 -27 -28 -29 -30 -31 -32 -33 -34 -35 -36 -37 -38 -39 -40 -41 -42 -43 -44 -45 -46 -47 -48 -49 -50 -51 -52 -53 -54 -55 -56 -57 -58 -59 -60 -61 -62 -63 -64 -65 -66 -67 -68 -69 -70 -71 -72 -73 -74 -75 -76 -77 -78 -79 -80 -81 -82 -83 -84 -85 -86 -87 -88 -89 -90 -91 -92 -93 -94 -95 -96 -97 -98 -99 -100 -101 -102 -103 -104 -105 -106 - - [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/highfrequency -r 58 From noreply at r-forge.r-project.org Wed Oct 16 14:20:05 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Oct 2013 14:20:05 +0200 (CEST) Subject: [Highfrequency-commits] r59 - pkg/highfrequency/man Message-ID: <20131016122005.D70321859F6@r-forge.r-project.org> Author: kboudt Date: 2013-10-16 14:20:02 +0200 (Wed, 16 Oct 2013) New Revision: 59 Modified: pkg/highfrequency/man/JOjumptest.Rd Log: Modified: pkg/highfrequency/man/JOjumptest.Rd =================================================================== --- pkg/highfrequency/man/JOjumptest.Rd 2013-10-15 10:08:09 UTC (rev 58) +++ pkg/highfrequency/man/JOjumptest.Rd 2013-10-16 12:20:02 UTC (rev 59) @@ -78,7 +78,7 @@ \examples{ data(sample_5minprices_jumps) -JOjumptest(sample_5minprices_jumps[,1], power= 6) +JOjumptest(as.numeric(sample_5minprices_jumps[,1]), power= 6) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. From noreply at r-forge.r-project.org Wed Oct 16 14:20:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Oct 2013 14:20:46 +0200 (CEST) Subject: [Highfrequency-commits] r60 - pkg/highfrequency/R Message-ID: <20131016122046.A953C1859F6@r-forge.r-project.org> Author: kboudt Date: 2013-10-16 14:20:46 +0200 (Wed, 16 Oct 2013) New Revision: 60 Modified: pkg/highfrequency/R/highfrequencyGSOC.R Log: Modified: pkg/highfrequency/R/highfrequencyGSOC.R =================================================================== --- pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-16 12:20:02 UTC (rev 59) +++ pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-16 12:20:46 UTC (rev 60) @@ -1336,7 +1336,7 @@ lls = as.double( rep(0, TT) ), llRM = as.double( rep(0,K ) ), ll = as.double(0), - PACKAGE="highfrequencyGSOC"); + PACKAGE="highfrequency"); return((-1)*out$ll) } @@ -1368,7 +1368,7 @@ lls = as.double( rep(0, TT) ), llRM = as.double( rep(0,K ) ), ll = as.double(0), - PACKAGE="highfrequencyGSOC"); + PACKAGE="highfrequency"); return(out$ll) } @@ -1401,7 +1401,7 @@ lls = as.double( rep(0, TT) ), llRM = as.double( rep(0,K ) ), ll = as.double(0), - PACKAGE="highfrequencyGSOC"); + PACKAGE="highfrequency"); return((-1)*out$lls) } @@ -1648,7 +1648,7 @@ lls = as.double( rep(0, TT) ), llRM = as.double( rep(0,K ) ), ll = as.double(0), - PACKAGE="highfrequencyGSOC"); + PACKAGE="highfrequency"); if (!is.null(rownames(data))) { xx$condvar = xts(t(matrix(xx$h,K)), order.by = as.POSIXct(rownames(data))) From noreply at r-forge.r-project.org Wed Oct 16 14:20:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Oct 2013 14:20:54 +0200 (CEST) Subject: [Highfrequency-commits] r61 - pkg/highfrequency/R Message-ID: <20131016122054.77007185AEE@r-forge.r-project.org> Author: kboudt Date: 2013-10-16 14:20:53 +0200 (Wed, 16 Oct 2013) New Revision: 61 Modified: pkg/highfrequency/R/realized.R Log: Modified: pkg/highfrequency/R/realized.R =================================================================== --- pkg/highfrequency/R/realized.R 2013-10-16 12:20:46 UTC (rev 60) +++ pkg/highfrequency/R/realized.R 2013-10-16 12:20:53 UTC (rev 61) @@ -1,4140 +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); -} - -#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); -} - -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 -} - - -.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 - - if(casefold(align.by)=="min" || casefold(align.by)=="mins" ||casefold(align.by)=="minute"||casefold(align.by)=="minutes"||casefold(align.by)=="m"){ - ans <- align.period * 60 - } - if(casefold(align.by)=="sec" || casefold(align.by)=="secs" ||casefold(align.by)=="second"||casefold(align.by)=="seconds"||casefold(align.by)=="s"||casefold(align.by)==""){ - ans <- align.period - } - if(casefold(align.by)=="hour" || casefold(align.by)=="hours" ||casefold(align.by)=="h"){ - ans <- align.period * 60 * 60 - } - return(ans) -} - - -.alignIndices <- function(x, period, ...) -{ - .C("rvperiod", - as.double(x), #a - as.double(x), #b - as.integer(length(x)), #na - as.integer(period), #period - tmpa = as.double(rep(max(x),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 -} - -.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) } - } - } -} - -.convertData <- function(x, cts = TRUE, millisstart=NA, millisend=NA, makeReturns=FALSE) -{ - if(is.null(x)) - { - return(NULL) - } - if("realizedObject" %in% class(x)) - { - return(x) - } - if(is.null(version$language)) #splus - { - if("timeSeries" %in% class(x)) - { - x <- x[!is.na(x[,1]),1] - if(cts) - { - return(ts2realized(x, millisstart=millisstart, millisend=millisend, make.returns=makeReturns)$cts) - } - else - { - return(ts2realized(x, millisstart=millisstart, millisend=millisend, make.returns=makeReturns)$tts) - } - #list(milliseconds = positions(x)@.Data[[2]], data = matrix(seriesData(x), ncol=1)) - } - } - - 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), - milliseconds=(((millisstart/1000)+1):(millisend/1000))*1000) - return(toret) - } - else - { - toret <- list(data=x$data, - milliseconds=intersect(x$milliseconds,x$milliseconds)) - return(toret) - } - } - } - - - if("timeSeries" %in% class(x)) - { - stop("R timeSeries not implmented yet. Convert to realized object") - } - return(list(milliseconds = 1:dim(as.matrix(x))[[1]], data = as.matrix(x))) # not an object, fake the milliseconds and return -} - -.getReturns <- function(x) -{ - x <- as.numeric(x) - n <- length(x)[[1]] - return(log(x[2:n]) - log(x[1:(n-1)])) -} - -.sameTime <- function(x, millis) -{ - .C("sametime", - as.double(x), #a - as.integer(length(x)), #na - as.integer(millis), #millis - ans = double(length(union(millis,millis))), #tts - COPY=c(FALSE,FALSE,FALSE,TRUE), - PACKAGE="highfrequency")$ans -} - - -data.toCts <- function(x, millis, millisstart=34200000, millisend=57600000) -{ - .toCts(x=x, millis=millis, millisstart=millisstart, millisend=millisend) -} - -.toCts <- function(x, millis, millisstart=34200000, millisend=57600000) -{ - .C("tocts", - as.double(x), #a - as.integer(length(x)), - as.integer(millis), #millis - as.integer(millisstart), - as.integer(millisend), - ans = double(((millisend-millisstart)/1000)), #cts - COPY=c(FALSE,FALSE,FALSE,FALSE,TRUE), - PACKAGE="highfrequency")$ans -} - -data.toReturns <- function(x) -{ - x <- as.numeric(x) - n <- length(x) - log(x[2:n]) - log(x[1:(n-1)]) -} - -ts2realized <- function(x, make.returns=TRUE,millisstart=34200000, millisend=57600000) -{ - warning("SPLUS is no longer supported.") - # thedata <- data.sameTime(as.numeric(as.matrix(x at data)), .ts2millis(x)) - - # if(make.returns) - # { - - # thedata <- .getReturns(thedata) - - # tts <- list(data=as.numeric(thedata), milliseconds=intersect(.ts2millis(x),.ts2millis(x))[-1]) - # cts <- list(data=.toCts(x=as.numeric(thedata), millis=intersect(.ts2millis(x),.ts2millis(x)), millisstart=millisstart, millisend=millisend), - # milliseconds=(((millisstart/1000)+1):(millisend/1000))*1000) - # } - # else - # { - # tts <- list(data=as.numeric(thedata), milliseconds=intersect(.ts2millis(x),.ts2millis(x))) - # cts <- list(data=.toCts(x=as.numeric(thedata), millis=intersect(.ts2millis(x),.ts2millis(x)), millisstart=millisstart, millisend=millisend), - # milliseconds=(((millisstart/1000)+1):(millisend/1000))*1000) - - - # } - # ans <- list(tts=tts, cts=cts) - # ans -} - - -# Make positive definite -makePsd = function(S,method="covariance"){ - if(method=="correlation" & !any(diag(S)<=0) ){ - # Fan, J., Y. Li, and K. Yu (2010). Vast volatility matrix estimation using high frequency data for portfolio selection. - D = matrix(diag(S)^(1/2),ncol=1) - R = S/(D%*%t(D)) - out = eigen( x=R , symmetric = TRUE ) - mGamma = t(out$vectors) - vLambda = out$values - vLambda[vLambda<0] = 0 - Apsd = t(mGamma)%*%diag(vLambda)%*%mGamma - dApsd = matrix(diag(Apsd)^(1/2),ncol=1) - Apsd = Apsd/(dApsd%*%t(dApsd)) - D = diag( as.numeric(D) , ncol = length(D) ) - Spos = D%*%Apsd%*%D - return(Spos) - #check: eigen(Apsd)$values - }else{ - # Rousseeuw, P. and G. Molenberghs (1993). Transformation of non positive semidefinite correlation matrices. Communications in Statistics - Theory and Methods 22, 965-984. - out = eigen( x=S , symmetric = TRUE ) - mGamma = t(out$vectors) - vLambda = out$values - vLambda[vLambda<0] = 0 - Apsd = t(mGamma)%*%diag(vLambda)%*%mGamma - } -} - -### Do a daily apply but with list as output: -.applygetlist = function(x, FUN,cor=FALSE,align.by=NULL,align.period=NULL,makeReturns=FALSE,makePsd=FALSE,...){ - on="days";k=1; - x <- try.xts(x, error = FALSE); - INDEX = endpoints(x,on=on,k=k); - D = length(INDEX)-1; - result = list(); - FUN <- match.fun(FUN); - for(i in 1:(length(INDEX)-1)){ - result[[i]] = FUN(x[(INDEX[i] + 1):INDEX[i + 1]],cor,align.by,align.period,makeReturns,makePsd); - } - return(result); -} - -# Aggregation function: FAST previous tick aggregation -.aggregatets = function (ts, on = "minutes", k = 1) -{ - if (on == "secs" | on == "seconds") { - secs = k - tby = paste(k, "sec", sep = " ") - } - if (on == "mins" | on == "minutes") { - secs = 60 * k - tby = paste(60 * k, "sec", sep = " ") - } - if (on == "hours"){ - secs = 3600 * k; - tby = paste(3600 * k, "sec", sep = " "); - } - g = base:::seq(start(ts), end(ts), by = tby); - rawg = as.numeric(as.POSIXct(g, tz = "GMT")); - newg = rawg + (secs - rawg%%secs); - g = as.POSIXct(newg, origin = "1970-01-01",tz = "GMT"); - ts3 = na.locf(merge(ts, zoo(, g)))[as.POSIXct(g, tz = "GMT")]; - return(ts3) -} #Very fast and elegant way to do previous tick aggregation :D! - -#Make Returns: -makeReturns = function (ts) -{ - l = dim(ts)[1] - x = matrix(as.numeric(ts), nrow = l) - x[(2:l), ] = log(x[(2:l), ]) - log(x[(1:(l - 1)), ]) - x[1, ] = rep(0, dim(ts)[2]) - x = xts(x, order.by = index(ts)) - return(x); -} - -#Refresh Time: -refreshTime = function (pdata) -{ - dim = length(pdata) - lengths = rep(0, dim + 1) - for (i in 1:dim) { - lengths[i + 1] = length(pdata[[i]]) - } - minl = min(lengths[(2:(dim + 1))]) - lengths = cumsum(lengths) - alltimes = rep(0, lengths[dim + 1]) - for (i in 1:dim) { - alltimes[(lengths[i] + 1):lengths[i + 1]] = as.numeric(as.POSIXct(index(pdata[[i]]), - tz = "GMT")) - } - x = .C("refreshpoints", as.integer(alltimes), as.integer(lengths), - as.integer(rep(0, minl)), as.integer(dim), as.integer(0), - as.integer(rep(0, minl * dim)), as.integer(minl)) - newlength = x[[5]] - pmatrix = matrix(ncol = dim, nrow = newlength) - for (i in 1:dim) { - selection = x[[6]][((i - 1) * minl + 1):(i * minl)] - pmatrix[, i] = pdata[[i]][selection[1:newlength]] - } - time = as.POSIXct(x[[3]][1:newlength], origin = "1970-01-01", - tz = "GMT") [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/highfrequency -r 61 From noreply at r-forge.r-project.org Wed Oct 16 14:21:13 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 16 Oct 2013 14:21:13 +0200 (CEST) Subject: [Highfrequency-commits] r62 - pkg/highfrequency Message-ID: <20131016122113.D45461859F6@r-forge.r-project.org> Author: kboudt Date: 2013-10-16 14:21:08 +0200 (Wed, 16 Oct 2013) New Revision: 62 Modified: pkg/highfrequency/DESCRIPTION Log: Modified: pkg/highfrequency/DESCRIPTION =================================================================== --- pkg/highfrequency/DESCRIPTION 2013-10-16 12:20:53 UTC (rev 61) +++ pkg/highfrequency/DESCRIPTION 2013-10-16 12:21:08 UTC (rev 62) @@ -1,15 +1,15 @@ Package: highfrequency Version: 0.1 -Date: 2011-04-04 +Date: 2013-10-16 Title: highfrequency Author: Jonathan Cornelissen, Kris Boudt, Scott Payseur Maintainer: Jonathan Cornelissen -Contributor: Giang Nguyen, Chris Blakely Description: The highfrequency package contains an extensive toolkit for the use of highfrequency financial data in R. It contains functionality to manage, clean and match highfrequency trades and quotes data. Furthermore, it enables users to: calculate easily various liquidity measures, estimate and forecast volatility, and investigate microstructure noise and intraday periodicity. License: GPL (>= 2) Depends: R (>= 2.12.0), xts, zoo -Suggests: realized, robustbase, cubature, mvtnorm, chron, timeDate, - quantmod +Suggests: robustbase, cubature, mvtnorm, chron, timeDate, + quantmod, MASS, sandwich, numderiv +Contributors: Giang Nugyen +Thanks: A special thanks for additional contributions from Chris Blakely LazyLoad: yes -Packaged: 2012-12-24 14:16:40 UTC; jonathancornelissen From noreply at r-forge.r-project.org Mon Oct 21 13:41:02 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Oct 2013 13:41:02 +0200 (CEST) Subject: [Highfrequency-commits] r63 - in pkg/highfrequency: . R Message-ID: <20131021114102.B345E18617C@r-forge.r-project.org> Author: kboudt Date: 2013-10-21 13:41:01 +0200 (Mon, 21 Oct 2013) New Revision: 63 Modified: pkg/highfrequency/DESCRIPTION pkg/highfrequency/R/highfrequencyGSOC.R Log: Modified: pkg/highfrequency/DESCRIPTION =================================================================== --- pkg/highfrequency/DESCRIPTION 2013-10-16 12:21:08 UTC (rev 62) +++ pkg/highfrequency/DESCRIPTION 2013-10-21 11:41:01 UTC (rev 63) @@ -9,7 +9,7 @@ License: GPL (>= 2) Depends: R (>= 2.12.0), xts, zoo Suggests: robustbase, cubature, mvtnorm, chron, timeDate, - quantmod, MASS, sandwich, numderiv + quantmod, MASS, sandwich, numDeriv Contributors: Giang Nugyen Thanks: A special thanks for additional contributions from Chris Blakely LazyLoad: yes Modified: pkg/highfrequency/R/highfrequencyGSOC.R =================================================================== --- pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-16 12:21:08 UTC (rev 62) +++ pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-21 11:41:01 UTC (rev 63) @@ -8,7 +8,7 @@ { rdata = data } - multixts = highfrequency:::.multixts(rdata) + multixts = .multixts(rdata) if (multixts) { result = apply.daily(rdata, minRQ, align.by, align.period, makeReturns) @@ -17,7 +17,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata = .aggregatets(rdata, on = align.by, k = align.period) } if(makeReturns) { @@ -41,7 +41,7 @@ { rdata = data } - multixts = highfrequency:::.multixts(rdata) + multixts = .multixts(rdata) if (multixts) { result = apply.daily(rdata, medRQ, align.by, align.period, makeReturns) @@ -50,7 +50,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata = .aggregatets(rdata, on = align.by, k = align.period) } if(makeReturns) { @@ -72,7 +72,7 @@ { rdata = data } - multixts = highfrequency:::.multixts(rdata) + multixts = .multixts(rdata) if (multixts) { result = apply.daily(rdata, rQuar, align.by, align.period, @@ -82,7 +82,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata = .aggregatets(rdata, on = align.by, k = align.period) } if (makeReturns) { @@ -104,7 +104,7 @@ { rdata = data } - multixts =highfrequency::: .multixts(rdata) + multixts = .multixts(rdata) if (multixts) { result = apply.daily(rdata, rQPVar, align.by, align.period, ##check FUN @@ -114,7 +114,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata =.aggregatets(rdata, on = align.by, k = align.period) } if (makeReturns) { @@ -137,7 +137,7 @@ { rdata = data } - multixts = highfrequency:::.multixts(rdata) + multixts = .multixts(rdata) if (multixts) { result = apply.daily(rdata, rTPVar, align.by, align.period, @@ -147,7 +147,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata = .aggregatets(rdata, on = align.by, k = align.period) } if (makeReturns) { @@ -175,7 +175,7 @@ { if (hasArg(data)){ rdata = data } - multixts = highfrequency:::.multixts(rdata) + multixts = .multixts(rdata) if (multixts) { result = apply.daily(rdata, ivInference, align.by, align.period, @@ -184,7 +184,7 @@ } else{ if((!is.null(align.by)) && (!is.null(align.period))){ - rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata = .aggregatets(rdata, on = align.by, k = align.period) } if(makeReturns){ rdata=makeReturns(rdata) } @@ -226,7 +226,7 @@ { if (hasArg(data)){ rdata = data } - multixts = highfrequency:::.multixts(rdata) + multixts = .multixts(rdata) if (multixts) { @@ -235,7 +235,7 @@ }else{ if((!is.null(align.by)) && (!is.null(align.period))) { - rdata = highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata = .aggregatets(rdata, on = align.by, k = align.period) } if(makeReturns){ rdata = makeReturns(rdata) } @@ -243,7 +243,7 @@ N=length(rdata) ## hatQV - hatQV = highfrequency:::RV(rdata) + hatQV = RV(rdata) ## hatIV hatIV = .hativ( rdata, IVestimator, N=N, ... ) @@ -260,13 +260,13 @@ ##logtransform if(logtransform) { - hatQV = log(highfrequency:::RV(rdata)) + hatQV = log(RV(rdata)) hatIV = log(.hativ(rdata,IVestimator, N, ...)) } if(!logtransform) { - hatQV = highfrequency:::RV(rdata) + hatQV = RV(rdata) hatIV = .hativ(rdata,IVestimator, N, ...) } @@ -301,7 +301,7 @@ { product = .hatiq(rdata,IQestimator)/.hativ(rdata,IVestimator, N, ...)^2 } - a = sqrt(N)*(1-.hativ(rdata,IVestimator, N, ...)/highfrequency:::RV(rdata))/sqrt((theta-2)*product) + a = sqrt(N)*(1-.hativ(rdata,IVestimator, N, ...)/RV(rdata))/sqrt((theta-2)*product) out = {} out$ztest = a out$critical.value = qnorm(c(0.025,0.975)) @@ -319,8 +319,8 @@ R = .simre(pdata) r = makeReturns(pdata) N = length(pdata)-1 - bv = highfrequency:::RBPVar(r) - rv = highfrequency:::RV(r) + bv = RBPVar(r) + rv = RV(r) SwV = 2*sum(R-r) mu1 = 2^(6/2)*gamma(1/2*(6+1))/gamma(1/2) @@ -362,14 +362,14 @@ { if (hasArg(data)) { pdata = data } - multixts = highfrequency:::.multixts(pdata) + multixts = .multixts(pdata) if (multixts) { result = apply.daily(pdata, AJjumptest, align.by, align.period, makeReturns) return(result) }else{ - pdata = highfrequency:::.aggregatets(pdata, on = "seconds", k = 1) + pdata = .aggregatets(pdata, on = "seconds", k = 1) } N = length(pdata)-1; @@ -423,7 +423,7 @@ rdata = data } - multixts = highfrequency::: .multixts(rdata) + multixts = .multixts(rdata) if (multixts) { @@ -435,7 +435,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata =.aggregatets(rdata, on = align.by, k = align.period) } if (makeReturns) { @@ -468,7 +468,7 @@ rdata = data } - multixts =highfrequency::: .multixts(rdata) + multixts = .multixts(rdata) if (multixts) { @@ -480,7 +480,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata =.aggregatets(rdata, on = align.by, k = align.period) } if (makeReturns) { @@ -490,7 +490,7 @@ q=as.numeric(rdata) N= length(q) - rv= highfrequency:::RV(rdata) + rv= RV(rdata) rSkew= sqrt(N)*sum(q^3)/rv^(3/2) @@ -509,7 +509,7 @@ rdata = data } - multixts =highfrequency::: .multixts(rdata) + multixts = .multixts(rdata) if (multixts) { @@ -521,7 +521,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata =.aggregatets(rdata, on = align.by, k = align.period) } if (makeReturns) { @@ -531,7 +531,7 @@ q=as.numeric(rdata) N= length(q) - rv= highfrequency:::RV(rdata) + rv= RV(rdata) rkurt= N*sum(q^4)/rv^(2) @@ -549,7 +549,7 @@ rdata = data } - multixts =highfrequency::: .multixts(rdata) + multixts = .multixts(rdata) if (multixts) { @@ -560,7 +560,7 @@ if (!multixts) { if ((!is.null(align.by)) && (!is.null(align.period))) { - rdata =highfrequency:::.aggregatets(rdata, on = align.by, k = align.period) + rdata =.aggregatets(rdata, on = align.by, k = align.period) } if (makeReturns) { @@ -597,13 +597,13 @@ n = length(pdata) } if (n == 1) { - multixts = highfrequency:::.multixts(pdata); + multixts = .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]]); + multixts = .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){ @@ -675,7 +675,7 @@ rindex= makeReturns(rindex) } - multixts = highfrequency:::.multixts(rdata) + multixts = .multixts(rdata) if (multixts) { @@ -716,8 +716,8 @@ { switch(RVestimator, - RV= highfrequency:::RV(rindex), - BV= highfrequency:::RBPVar(rindex), + RV= RV(rindex), + BV= RBPVar(rindex), minRV= minRV(rindex ), medRV= medRV(rindex ), rCov= rCov(rindex ) , @@ -949,8 +949,8 @@ .hativ = function( rdata, IVestimator, startV = NULL, N,...) { switch(IVestimator, - RV = highfrequency:::RV(rdata), - BV = highfrequency:::RBPVar(rdata), + RV = RV(rdata), + BV = RBPVar(rdata), TV = rTPVar(rdata), minRV = minRV(rdata), medRV = medRV(rdata), @@ -1005,6 +1005,7 @@ x[(2:l), ] = x[(2:l), ]/x[(1:(l - 1)), ]-1 x[1, ] = rep(0, dim(pdata)[2]) x = xts(x, order.by = index(pdata)) + return(x) } From noreply at r-forge.r-project.org Mon Oct 21 20:15:26 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 21 Oct 2013 20:15:26 +0200 (CEST) Subject: [Highfrequency-commits] r64 - pkg/highfrequency/R Message-ID: <20131021181526.8B8E91813BB@r-forge.r-project.org> Author: kboudt Date: 2013-10-21 20:15:25 +0200 (Mon, 21 Oct 2013) New Revision: 64 Modified: pkg/highfrequency/R/highfrequencyGSOC.R Log: Modified: pkg/highfrequency/R/highfrequencyGSOC.R =================================================================== --- pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-21 11:41:01 UTC (rev 63) +++ pkg/highfrequency/R/highfrequencyGSOC.R 2013-10-21 18:15:25 UTC (rev 64) @@ -316,19 +316,19 @@ JOjumptest= function(pdata, power=4,...) { - R = .simre(pdata) - r = makeReturns(pdata) + R = as.zoo(.simre(pdata)); + r = as.zoo(makeReturns(pdata)); N = length(pdata)-1 bv = RBPVar(r) rv = RV(r) - SwV = 2*sum(R-r) + SwV = 2*sum(R-r,na.rm = TRUE) mu1 = 2^(6/2)*gamma(1/2*(6+1))/gamma(1/2) ##mupower: if(power==4) { - q = abs(rollapply(r, width = 4, FUN = prod, align = "left")) + q = abs(rollapply(r, width = 4, FUN = prod, align = "left",na.rm = TRUE)) mu2 = 2^((6/4)/2)*gamma(1/2*(6/4+1))/gamma(1/2) av = mu1/9 * N^3*(mu2)^(-4)/(N-4-1)*sum(q^(6/4),na.rm= TRUE) ##check formula JOtest = N*bv/sqrt(av)*(1- rv/SwV) @@ -342,7 +342,7 @@ if(power==6) { - q=abs(rollapply(r, width = 6, FUN = prod, align = "left")) + q=abs(rollapply(r, width = 6, FUN = prod, align = "left",na.rm = TRUE)) mu2= 2^((6/6)/2)*gamma(1/2*(6/6+1))/gamma(1/2) av=mu1/9 * N^3*(mu2)^(-6)/(N-6-1)*sum(q^(6/6),na.rm= TRUE) ##check formula JOtest= N*bv/sqrt(av)*(1- rv/SwV) @@ -1013,7 +1013,7 @@ ##Preaverage return: .hatreturn= function(pdata,kn) { - rdata=makeReturns(pdata) + rdata= as.zoo(makeReturns(pdata)); kn=as.numeric(kn) if(kn == 1){ hatre = rdata} else{ From noreply at r-forge.r-project.org Thu Oct 24 11:44:07 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Oct 2013 11:44:07 +0200 (CEST) Subject: [Highfrequency-commits] r65 - in pkg/highfrequency: . vignettes Message-ID: <20131024094407.BB587180484@r-forge.r-project.org> Author: kboudt Date: 2013-10-24 11:44:07 +0200 (Thu, 24 Oct 2013) New Revision: 65 Added: pkg/highfrequency/vignettes/ pkg/highfrequency/vignettes/highfrequency.Rnw pkg/highfrequency/vignettes/highfrequency.pdf Log: Added: pkg/highfrequency/vignettes/highfrequency.Rnw =================================================================== --- pkg/highfrequency/vignettes/highfrequency.Rnw (rev 0) +++ pkg/highfrequency/vignettes/highfrequency.Rnw 2013-10-24 09:44:07 UTC (rev 65) @@ -0,0 +1,5 @@ +%\VignetteIndexEntry{User manual} + +\documentclass{article} +\begin{document} +\end{document} \ No newline at end of file Added: pkg/highfrequency/vignettes/highfrequency.pdf =================================================================== (Binary files differ) Property changes on: pkg/highfrequency/vignettes/highfrequency.pdf ___________________________________________________________________ Added: svn:mime-type + application/octet-stream From noreply at r-forge.r-project.org Thu Oct 24 11:44:18 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Oct 2013 11:44:18 +0200 (CEST) Subject: [Highfrequency-commits] r66 - pkg/highfrequency Message-ID: <20131024094418.A7C4E180484@r-forge.r-project.org> Author: kboudt Date: 2013-10-24 11:44:18 +0200 (Thu, 24 Oct 2013) New Revision: 66 Modified: pkg/highfrequency/DESCRIPTION Log: Modified: pkg/highfrequency/DESCRIPTION =================================================================== --- pkg/highfrequency/DESCRIPTION 2013-10-24 09:44:07 UTC (rev 65) +++ pkg/highfrequency/DESCRIPTION 2013-10-24 09:44:18 UTC (rev 66) @@ -1,6 +1,6 @@ Package: highfrequency -Version: 0.1 -Date: 2013-10-16 +Version: 0.3 +Date: 2013-10-24 Title: highfrequency Author: Jonathan Cornelissen, Kris Boudt, Scott Payseur Maintainer: Jonathan Cornelissen From noreply at r-forge.r-project.org Sun Oct 27 10:36:35 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 27 Oct 2013 10:36:35 +0100 (CET) Subject: [Highfrequency-commits] r67 - pkg/highfrequency/man Message-ID: <20131027093635.975CB184313@r-forge.r-project.org> Author: kboudt Date: 2013-10-27 10:36:35 +0100 (Sun, 27 Oct 2013) New Revision: 67 Modified: pkg/highfrequency/man/JOjumptest.Rd Log: Modified: pkg/highfrequency/man/JOjumptest.Rd =================================================================== --- pkg/highfrequency/man/JOjumptest.Rd 2013-10-24 09:44:18 UTC (rev 66) +++ pkg/highfrequency/man/JOjumptest.Rd 2013-10-27 09:36:35 UTC (rev 67) @@ -78,7 +78,7 @@ \examples{ data(sample_5minprices_jumps) -JOjumptest(as.numeric(sample_5minprices_jumps[,1]), power= 6) +JOjumptest(sample_5minprices_jumps[,1], power= 6) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory.