From noreply at r-forge.r-project.org Mon Jul 8 20:30:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 8 Jul 2013 20:30:59 +0200 (CEST) Subject: [Eventstudies-commits] r70 - pkg Message-ID: <20130708183059.D2E511848DA@r-forge.r-project.org> Author: vikram Date: 2013-07-08 20:30:59 +0200 (Mon, 08 Jul 2013) New Revision: 70 Modified: pkg/DESCRIPTION Log: Minor change in description Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2013-05-08 07:14:27 UTC (rev 69) +++ pkg/DESCRIPTION 2013-07-08 18:30:59 UTC (rev 70) @@ -1,8 +1,7 @@ Package: eventstudies Type: Package Title: Event study and extreme event analysis -Version: 1.0 -Date: 2013-04-02 +Version: 1.1 Author: Ajay Shah, Vimal Balasubramaniam, Vikram Bahure Maintainer: Vikram Bahure Depends: R (>= 2.12.0), zoo, xts, boot From noreply at r-forge.r-project.org Fri Jul 12 13:33:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 13:33:57 +0200 (CEST) Subject: [Eventstudies-commits] r71 - pkg/tests Message-ID: <20130712113357.DCC5C180969@r-forge.r-project.org> Author: chiraganand Date: 2013-07-12 13:33:57 +0200 (Fri, 12 Jul 2013) New Revision: 71 Added: pkg/tests/test_inr_inference.R Removed: pkg/tests/inr_inference.R Log: Renamed inr_inference test file. Deleted: pkg/tests/inr_inference.R =================================================================== --- pkg/tests/inr_inference.R 2013-07-08 18:30:59 UTC (rev 70) +++ pkg/tests/inr_inference.R 2013-07-12 11:33:57 UTC (rev 71) @@ -1,22 +0,0 @@ -library(eventstudies) -data(inr) - -inr_returns <- diff(log(inr))[-1] - -eventslist<-data.frame(unit=rep("inr",10), - when=as.Date(c( - "2010-04-20","2010-07-02","2010-07-27", - "2010-09-16","2010-11-02","2011-01-25", - "2011-03-17","2011-05-03","2011-06-16", - "2011-07-26") - ) - ) - -event_time_data <- phys2eventtime(inr_returns,eventslist,width=10) -w <- window(event_time_data$z.e,start=-10,end=10) - -all.equal(inference.Ecar(w)[,2],c(-.000015327,-.002526819,.0011990000,.001193535,.001846734, - -.000105473,-.001659772,.001644518,-0.001325236,.001546369, - -.000809734,-.001499191,-.000289414,-.000003273,-.000416662, - -.001150000,-.000759748,.002306711,-.000487299,.001122457, - .000635890)) Copied: pkg/tests/test_inr_inference.R (from rev 70, pkg/tests/inr_inference.R) =================================================================== --- pkg/tests/test_inr_inference.R (rev 0) +++ pkg/tests/test_inr_inference.R 2013-07-12 11:33:57 UTC (rev 71) @@ -0,0 +1,22 @@ +library(eventstudies) +data(inr) + +inr_returns <- diff(log(inr))[-1] + +eventslist<-data.frame(unit=rep("inr",10), + when=as.Date(c( + "2010-04-20","2010-07-02","2010-07-27", + "2010-09-16","2010-11-02","2011-01-25", + "2011-03-17","2011-05-03","2011-06-16", + "2011-07-26") + ) + ) + +event_time_data <- phys2eventtime(inr_returns,eventslist,width=10) +w <- window(event_time_data$z.e,start=-10,end=10) + +all.equal(inference.Ecar(w)[,2],c(-.000015327,-.002526819,.0011990000,.001193535,.001846734, + -.000105473,-.001659772,.001644518,-0.001325236,.001546369, + -.000809734,-.001499191,-.000289414,-.000003273,-.000416662, + -.001150000,-.000759748,.002306711,-.000487299,.001122457, + .000635890)) From noreply at r-forge.r-project.org Fri Jul 12 14:32:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 12 Jul 2013 14:32:37 +0200 (CEST) Subject: [Eventstudies-commits] r72 - pkg/R Message-ID: <20130712123237.BB2BB184D79@r-forge.r-project.org> Author: chiraganand Date: 2013-07-12 14:32:37 +0200 (Fri, 12 Jul 2013) New Revision: 72 Modified: pkg/R/phys2eventtime.R Log: Don't interpolate if data is missing. Modified: pkg/R/phys2eventtime.R =================================================================== --- pkg/R/phys2eventtime.R 2013-07-12 11:33:57 UTC (rev 71) +++ pkg/R/phys2eventtime.R 2013-07-12 12:32:37 UTC (rev 72) @@ -52,8 +52,6 @@ if (width > 0) { for (i in 1:ncol(z.e)) { tmp <- z.e[,i] - tmp <- na.locf(tmp, na.rm=FALSE, maxgap=4) - tmp <- na.locf(tmp, na.rm=FALSE, maxgap=4, fromLast=TRUE) tmp2 <- window(tmp, start=-width, end=+width) if (any(is.na(tmp2))) { outcomes[as.numeric(colnames(z.e)[i])] <- "wdatamissing" From noreply at r-forge.r-project.org Sat Jul 13 12:30:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 12:30:57 +0200 (CEST) Subject: [Eventstudies-commits] r73 - in pkg: R data man Message-ID: <20130713103057.9B439184AAE@r-forge.r-project.org> Author: vikram Date: 2013-07-13 12:30:57 +0200 (Sat, 13 Jul 2013) New Revision: 73 Added: pkg/R/AMM.R pkg/R/firmExposures.R pkg/R/makeX.R pkg/R/manyfirmsAMM.R pkg/R/onefirmAMM.R pkg/data/ammData.rda pkg/data/firmExposuresData.rda pkg/man/AMM.Rd pkg/man/ammData.Rd pkg/man/firmExposures.Rd pkg/man/firmExposuresData.Rd pkg/man/makeX.Rd pkg/man/manyfirmsAMM.Rd pkg/man/onefirmAMM.Rd Log: Added AMM functionality function and related documentation files and codebase; Work in progress Added: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R (rev 0) +++ pkg/R/AMM.R 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,470 @@ +########################## +# Generalised AMM function +########################## +AMM <- function(amm.type=c("onefirm","manyfirms","firmExposures"), ...){ + #----------------------------- + # Getting RHS variables in AMM + #----------------------------- + print("Preparing explanatory variables for computation of Augmented Market Models") + print("If any argument is missing then please refer to the documentation for detailed explanation.") + # Checking arguments + nlags.check <- testObject(nlags) + if(nlags.check==FALSE){ nlags <- NA} + verbose.check <- testObject(verbose) + if(verbose.check==FALSE){ verbose <- FALSE} + dates.check <- testObject(dates) + if(dates.check==FALSE){ dates <- NULL} + + rM1.check <- testObject(rM1) + if(rM1.check==FALSE){ stop("Input rM1 (stock market index) is missing")} + others.check <- testObject(others) + if(others.check==FALSE){ stop("Input 'others' (time series of other regressor or interest) is missing")} + rM1.check <- testObject(rM1) + if(rM1.check==FALSE){ stop("Input rM1 (stock market index) is missing")} + rM1purge.check <- testObject(rM1purge) + if(rM1purge.check==FALSE){ stop("Input rM1purge is missing")} + switch.to.innov.check <- testObject(switch.to.innov) + if(switch.to.innov.check==FALSE){ stop("Input switch.to.innov is missing")} + + if(amm.type!="manyfirms"){ + X <- makeX(rM1, others, switch.to.innov, + rM1purge, nlags, dates, verbose) + }else{ + regressors <- makeX(rM1, others, switch.to.innov, rM1purge, nlags, + dates, verbose) + } + + #--------- + # One firm + #--------- + if(amm.type=="onefirm"){ + # Checking if arguments are provided + rj.check <- testObject(rj) + if(rj.check==FALSE){ stop("Input rj (firm data) is missing")} + + result <- onefirmAMM(rj, X, nlags, verbose, dates) + } + + #----------- + # Many firms + #----------- + if(amm.type=="manyfirms"){ + # Checking if arguments are provided + regressors.check <- testObject(regressors) + if(regressors.check==FALSE){ stop("Input regressors is missing. Refer documentation.")} + regressand.check <- testObject(regressand) + if(regressand.check==FALSE){ stop("Input regressand is missing. Refer documentation.")} + dates.check <- testObject(dates) + if(dates.check==FALSE){ dates <- NULL} + periodnames.check <- testObject(periodnames) + if(periodnames.check==FALSE){ periodnames <- NULL} + + result <- manyfirmsAMM(regressand,regressors, + lags=nlags,dates, periodnames,verbose) + } + + #--------------- + # Firm exposures + #--------------- + if(amm.type=="firmExposures"){ + rj.check <- testObject(rj) + if(rj.check==FALSE){ stop("Input rj (firm data) is missing")} + + result <- firmExposures(rj, X, nlags, verbose) + } + + return(result) +} + +####################### +# AMM for one firm +####################### +onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL){ + exposures <- data.frame(matrix(NA,ncol=ncol(X),nrow=(length(dates)-1))) + colnames(exposures) <- colnames(X) + sds <- exposures + periodnames <- NULL + + if(is.null(dates)){ + res <- firmExposures(rj,X,verbose=verbose,nlags=nlags) + exposures <- res$exposure + sds <- res$s.exposure + }else{ + for(i in 1:(length(dates)-1)){ + tmp <- window(rj,start=dates[i],end=dates[i+1]) + rhs <- window(X,start=dates[i],end=dates[i+1]) + res <- firmExposures(rj=tmp, + X=rhs, + verbose=verbose, + nlags=nlags) + exposures[i,] <- res$exposure + periodnames <- c(periodnames,paste(dates[i],dates[i+1],sep=" TO ")) + sds[i,] <- res$s.exposure + } + rownames(exposures) <- rownames(sds) <- periodnames + } + rval <- list(exposures=exposures,sds=sds) + return(rval) +} + +######################## +# Many firms AMM +######################## +manyfirmsAMM <-function(regressand,regressors, + lags,dates=NULL, periodnames=NULL,verbose=FALSE){ + if(is.null(dates)){ + dates=c(start(regressors),end(regressors)) + periodnames="Full" + } + nperiods <- length(periodnames) + if(length(dates) != (nperiods+1)){ + cat("Mistake in length of dates versus length of periods.\n") + return(NULL) + } + + nfirms <- ncol(regressand) + + # Let's get "exposure' and 'sds'. Setting up structures:- + exposures <- matrix(NA,nrow=nfirms,ncol=nperiods*ncol(regressors)) + rownames(exposures) <- colnames(regressand) + tmp <- NULL + for(i in 1:length(periodnames)){ + for(j in 1:ncol(regressors)){ + tmp <- c(tmp, paste(colnames(regressors)[j], + periodnames[i],sep=".")) + } + } + colnames(exposures) <- tmp + sds <- exposures + colnames(sds) <- paste("sd",colnames(exposures),sep=".") + + # Setup a list structure for an OLS that failed + empty <- list(exposures=rep(NA,ncol(regressors)), + s.exposures=rep(NA,ncol(regressors))) + + for(i in 1:ncol(regressand)){ + cat("Doing",colnames(regressand)[i]) + if (verbose) {cat ("Doing", colnames(regressand)[i])} + rj <- regressand[,i] + dataset <- cbind(rj, regressors) # This is the full time-series + this.exp <- this.sds <- NULL + for(j in 1:nperiods){ # now we chop it up + t1 <- dates[j] + t2 <- dates[j+1] + # if (j != nperiods) {t2 <- t2-1} # I don't know why I wrote this now :-( But this created problems. + this <- window(dataset,start=t1, end=t2) + fe <- firmExposures(this[,1],this[,-1],nlags=lags,verbose) + if(is.null(fe)) {fe <- empty} + this.exp <- c(this.exp, fe$exposures) + this.sds <- c(this.sds, fe$s.exposures) + } + exposures[i,] <- this.exp + sds[i,] <- this.sds + } + list(exposures=exposures, sds=sds, sig=exposures/sds) +} + +############################################### +# Estimating one firm's exposure in one period. +############################################### +firmExposures <- function(rj, X, nlags=NA, verbose=FALSE) { + do.ols <- function(nlags) { + tmp <- cbind(rj, X[,1]) # Assume 1st is stock index, and no lags are required there. + labels <- c("rj","rM1") + if (NCOL(X) > 1) { + for (i in 2:NCOL(X)) { + for (j in 0:nlags) { + tmp <- cbind(tmp, lag(X[,i], -j)) + labels <- c(labels, paste(colnames(X)[i], j, sep=".")) + } + } + } + tmp <- na.omit(tmp) + if (nrow(tmp) < 30) { # refuse to do the work. + return(NULL) # returns out of do.ols() only + } + + colnames(tmp) <- labels # So the OLS results will look nice + lm(rj ~ ., data=as.data.frame(tmp)) + } + + if (is.na(nlags)) { + if (verbose) {cat("Trying to find the best lag structure...\n")} + bestlag <- 0 + bestm <- NULL + bestAIC <- Inf + for (trylag in 0:min(10,log10(length(rj)))) { + thism <- do.ols(trylag) + thisAIC <- AIC(thism, k=log(length(thism$fitted.values))) + if (verbose) {cat(trylag, " lags, SBC = ", thisAIC, "\n")} + if (thisAIC < bestAIC) { + bestlag <- trylag + bestAIC <- thisAIC + bestm <- thism + } + } + nlags <- bestlag + m <- bestm + } else { + m <- do.ols(nlags) + if (is.null(m)) {return(NULL)} + } + # In either event, you endup holding an "m" here. + if (verbose) {cat("\n\nThe OLS:\n"); print(summary(m))} + + # Compute a series of exposure measures, and their standard errors. + beta <- m$coefficients + Sigma <- vcovHAC(m) + # First the rM1 + exposures <- beta[2] # no lags for rM1 + s.exposures <- sqrt(Sigma[2,2]) + # From here on, there's a block of 1+nlags coeffs for each + # of the non-rM1 regressors. + if (NCOL(X) > 1) { + for (i in 2:NCOL(X)) { + n.block1 <- 2 + ((i-2)*(1+nlags)) # Just 2 for the 1st case. + n.block2 <- length(beta) - n.block1 - (1 + nlags) + w <- c(rep(0, n.block1), rep(1, 1+nlags), rep(0, n.block2)) + exposures <- c(exposures, w %*% beta) + s.exposures <- c(s.exposures, sqrt(w %*% Sigma %*% w)) + } + } + names(exposures) <- names(s.exposures) <- colnames(X) + results <- list(exposures=exposures, + s.exposures=s.exposures, nlags=nlags, + lm.res=m) + class(results) <- "amm" + results +} + +########################### +# Maintaing NAs in AR model +########################### +ARinnovations <- function(x) { + stopifnot(NCOL(x) == 1) + dt <- NULL + if (class(x) == "zoo") { + dt <- index(x) + x <- as.numeric(x) + } + non.na.locations <- !is.na(x) + x <- x[non.na.locations] + m <- ar(x) + e <- m$resid + # Relocate with the old NA structure + result <- rep(NA, length(non.na.locations)) + result[non.na.locations] <- e + if (!is.null(dt)) {result <- zoo(result, order.by=dt)} + list(result=result, m=m) +} + +# --------------------------------------------------------------------------- +# The workhorse called by makeX to return a nice matrix of RHS +# variables to be used in an analysis. +do.one.piece <- function(rM1, others, switch.to.innov, rM1purge, nlags, verbose=FALSE) { + cat(" do.one.piece invocation\n") + thedates <- index(rM1) + if (verbose) { + cat(" Doing work for period from ", + as.character(head(thedates,1)), " to ", + as.character(tail(thedates,1)), "\n") + } + otherlags <- NULL + for (i in 1:NCOL(others)) { + if (switch.to.innov[i]) { + a <- ARinnovations(others[,i]) + innovated <- a$result + if (verbose) { + cat(" AR model for ", colnames(others, do.NULL=FALSE)[i], "\n") + print(a$m) + } + otherlags <- c(otherlags, a$m$order) + } else { + innovated <- others[,i] + otherlags <- c(otherlags, 0) + } + if (i > 1) { + innov <- cbind(innov, innovated) + } else { + innov <- innovated + } + } + if (NCOL(innov) > 1) {colnames(innov) <- colnames(others)} + rM1.purged <- rM1 + if (rM1purge) { + firstpass <- TRUE + for (i in 1:NCOL(innov)) { + for (j in 0:nlags) { + if (firstpass) { + z <- lag(innov[,i],-j) + labels <- paste(colnames(innov,do.NULL=FALSE)[i],j,sep=".") + firstpass <- FALSE + } else { + z <- cbind(z, lag(innov[,i], -j)) + labels <- c(labels, paste(colnames(innov,do.NULL=FALSE)[i],j,sep=".")) + } + } + } + if (NCOL(z) > 1) {colnames(z) <- labels} + m <- lm(rM1 ~ ., as.data.frame(cbind(rM1, z))) + if (verbose) { + cat(" Model explaining rM1:\n") + print(summary(m)) + } + how.many.NAs <- nlags + max(otherlags) + rM1.purged <- zoo(c(rep(NA,how.many.NAs),m$residuals), + order.by=thedates) + } + # if (verbose) {cat(" Finished do.one.piece()\n")} + list(rM1.purged=rM1.purged, innov=innov) +} + +# A function that calls do.one.piece, and works through several +# different periods to provide the right RHS matrix. +makeX <- function(rM1, others, + switch.to.innov=rep(TRUE, NCOL(others)), + rM1purge=TRUE, + nlags=5, + dates=NULL, + verbose=TRUE) { + if (verbose) {cat("0. Checking args\n")} + stopifnot(all.equal(index(rM1), index(others)), + length(switch.to.innov)==NCOL(others)) + if (!is.null(dates)) { + stopifnot(class(dates) == "Date") + } + if (verbose) {cat("1. Checking dates.\n")} + if (is.null(dates)) { + dates <- c(start(rM1),end(rM1)) + } + if(head(dates,1)!=head(index(rM1),1)){ + stop("Start date provided and the start date of the dataset do not match \n") + } + if(tail(dates,1)!=tail(index(rM1),1)){ + stop("End date provided and the end date of the dataset do not match \n") + } + if (verbose) {cat("2. Run through all the pieces --\n")} + for (i in 1:(length(dates)-1)) { + t1 <- dates[i] + t2 <- dates[i+1] + if (i != (length(dates)-1)) {t2 <- t2 -1} + if (verbose) { + cat(" Focusing down from date = ", as.character(t1), " to ", as.character(t2), "\n") + } + tmp.rM1 <- window(rM1, start=t1, end=t2) + tmp.others <- window(others, start=t1, end=t2) + a <- do.one.piece(tmp.rM1, tmp.others, switch.to.innov, rM1purge, nlags, verbose) + if (i > 1) { + res.rM1 <- c(res.rM1, a$rM1.purged) + res.innov <- rbind(res.innov, a$innov) + } else { + res.rM1 <- a$rM1.purged + res.innov <- a$innov + } + } + if (verbose) {cat("2. Make a clean X and send it back --\n")} + X <- cbind(res.rM1, res.innov) + if (NCOL(res.innov) == 1) {colnames(X) <- c("rM1","z")} + else {colnames(X) <- c("rM1", colnames(res.innov))} + X +} + +############################################################################# +# Exposure is a vector of exposures +# var.exposures is a vector of the s.error of each exposure +# X is a matrix of firm characteristics +# Note: They all should have the same number of rows. +lm.for.amm.exposure <- function(exposures, var.exposures, X) { + m.ols <- lm(exposures ~ -1 + X) +# Likelihood function for OLS-by-MLE where each obs has a known standard error -- + mine.lf <- function(theta, y, X, y.se2) { + if (theta[1] <= 0) return(NA) # Refuse to look at -ve sigma. + -sum(dnorm(y, mean= X %*% theta[-1], sd=sqrt(theta[1]+y.se2), log=TRUE)) + } + ## Use OLS as starting values for the MLE -- + seeds <- c(summary(m.ols)$sigma, coef(m.ols)) + p <- optim(seeds, method="L-BFGS-B", fn=mine.lf, hessian=TRUE, + lower=c(1e-2, -Inf, -Inf, -Inf), upper=rep(Inf, 4), + y=exposures, X=X, y.se2=var.exposures) + inverted <- solve(p$hessian) + # Now get to generation of a nicely organised matrix collecting up the results. + # First setup a clean set of OLS results -- + results <- summary(m.ols)$coefficients[,c(1,3)] + rownames(results) <- substr(rownames(results), 2, 1000) + colnames(results) <- c("OLS estimates", "OLS t stats") + results <- rbind(results, c(summary(m.ols)$sigma, "NA")) + rownames(results)[nrow(results)] <- "Sigma" +# Now augment it on the right with the MLE -- + tmp <- p$par/sqrt(diag(inverted)) + results <- cbind(results, cbind(c(p$par[-1], p$par[1]), + c(tmp[-1], tmp[1]))) + colnames(results) <- c(colnames(results)[1:2], "MLE estimates", "MLE t stats") + results +} + + +#################################################### + +print.amm <- +function(amm, verbose=FALSE) { + if (verbose) {print(summary(amm$lm.res))} + cat("Summary statistics of exposure:\n") + sstats <- cbind(amm$exposure, amm$s.exposure, + amm$exposure/amm$s.exposure) + colnames(sstats) <- c("Exposure", "Std.Err", "t statistic") + rownames(sstats) <- names(amm$exposures) + print(sstats) + return(0) +} + +################################################################################ +# You got to write a plot function that does cool stuff with the AMM results! +################################################################################ + +simulated.mean <- function (beta, stdev, fun=NULL, no.of.draws){ + na1 <- is.na(beta) + na2 <- is.na(stdev) + if (!identical(na1, na2)) { + cat("Panic - two is.na() are not identical.\n") + return(-1) + } + b <- beta[!is.na(beta)] + s <- stdev[!is.na(stdev)] + N <- length(b) + draws <- NULL + for (i in 1:no.of.draws) { + if(!is.null(fun)){ + draws <- c(draws, mean(fun((rnorm(N) * s) + b))) + }else{ + draws <- c(draws, mean(rnorm(N)*s+b)) + } + } + draws +} + +######################################### +kernel.plots <- function(draws, logscale=NULL) { + nplots <- ncol(draws) + hilo <- range(draws) + par(mfrow=c(nplots,1), mai=c(.4,.8,.2,.2)) + for (i in 1:nplots) { + if(!is.null(logscale)){ + plot(density(draws[,i]), main=colnames(draws)[i], xlab="", + col="blue", xlim=hilo, log=logscale,lwd=2) + }else{ + plot(density(draws[,i]), main=colnames(draws)[i], xlab="", + col="blue", xlim=hilo, lwd=2) + } + } + } + +############################################################################################# + + + +########################### +# Checking if object exists +########################### +testObject <- function(object){ + exists(as.character(substitute(object))) +} Added: pkg/R/firmExposures.R =================================================================== --- pkg/R/firmExposures.R (rev 0) +++ pkg/R/firmExposures.R 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,73 @@ +############################################### +# Estimating one firm's exposure in one period. +############################################### +firmExposures <- function(rj, X, nlags=NA, verbose=FALSE) { + do.ols <- function(nlags) { + tmp <- cbind(rj, X[,1]) # Assume 1st is stock index, and no lags are required there. + labels <- c("rj","rM1") + if (NCOL(X) > 1) { + for (i in 2:NCOL(X)) { + for (j in 0:nlags) { + tmp <- cbind(tmp, lag(X[,i], -j)) + labels <- c(labels, paste(colnames(X)[i], j, sep=".")) + } + } + } + tmp <- na.omit(tmp) + if (nrow(tmp) < 30) { # refuse to do the work. + return(NULL) # returns out of do.ols() only + } + + colnames(tmp) <- labels # So the OLS results will look nice + lm(rj ~ ., data=as.data.frame(tmp)) + } + + if (is.na(nlags)) { + if (verbose) {cat("Trying to find the best lag structure...\n")} + bestlag <- 0 + bestm <- NULL + bestAIC <- Inf + for (trylag in 0:min(10,log10(length(rj)))) { + thism <- do.ols(trylag) + thisAIC <- AIC(thism, k=log(length(thism$fitted.values))) + if (verbose) {cat(trylag, " lags, SBC = ", thisAIC, "\n")} + if (thisAIC < bestAIC) { + bestlag <- trylag + bestAIC <- thisAIC + bestm <- thism + } + } + nlags <- bestlag + m <- bestm + } else { + m <- do.ols(nlags) + if (is.null(m)) {return(NULL)} + } + # In either event, you endup holding an "m" here. + if (verbose) {cat("\n\nThe OLS:\n"); print(summary(m))} + + # Compute a series of exposure measures, and their standard errors. + beta <- m$coefficients + Sigma <- vcovHAC(m) + # First the rM1 + exposures <- beta[2] # no lags for rM1 + s.exposures <- sqrt(Sigma[2,2]) + # From here on, there's a block of 1+nlags coeffs for each + # of the non-rM1 regressors. + if (NCOL(X) > 1) { + for (i in 2:NCOL(X)) { + n.block1 <- 2 + ((i-2)*(1+nlags)) # Just 2 for the 1st case. + n.block2 <- length(beta) - n.block1 - (1 + nlags) + w <- c(rep(0, n.block1), rep(1, 1+nlags), rep(0, n.block2)) + exposures <- c(exposures, w %*% beta) + s.exposures <- c(s.exposures, sqrt(w %*% Sigma %*% w)) + } + } + names(exposures) <- names(s.exposures) <- colnames(X) + results <- list(exposures=exposures, + s.exposures=s.exposures, nlags=nlags, + lm.res=m) + class(results) <- "amm" + results +} + Added: pkg/R/makeX.R =================================================================== --- pkg/R/makeX.R (rev 0) +++ pkg/R/makeX.R 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,54 @@ + +############################################################### +# A function that calls do.one.piece, and works through several +# different periods to provide the right RHS matrix. +############################################################### +source('AMM.R') +makeX <- function(rM1, others, + switch.to.innov=rep(TRUE, NCOL(others)), + rM1purge=TRUE, + nlags=5, + dates=NULL, + verbose=TRUE) { + if (verbose) {cat("0. Checking args\n")} + stopifnot(all.equal(index(rM1), index(others)), + length(switch.to.innov)==NCOL(others)) + if (!is.null(dates)) { + stopifnot(class(dates) == "Date") + } + if (verbose) {cat("1. Checking dates.\n")} + if (is.null(dates)) { + dates <- c(start(rM1),end(rM1)) + } + if(head(dates,1)!=head(index(rM1),1)){ + stop("Start date provided and the start date of the dataset do not match \n") + } + if(tail(dates,1)!=tail(index(rM1),1)){ + stop("End date provided and the end date of the dataset do not match \n") + } + if (verbose) {cat("2. Run through all the pieces --\n")} + for (i in 1:(length(dates)-1)) { + t1 <- dates[i] + t2 <- dates[i+1] + if (i != (length(dates)-1)) {t2 <- t2 -1} + if (verbose) { + cat(" Focusing down from date = ", as.character(t1), " to ", as.character(t2), "\n") + } + tmp.rM1 <- window(rM1, start=t1, end=t2) + tmp.others <- window(others, start=t1, end=t2) + a <- do.one.piece(tmp.rM1, tmp.others, switch.to.innov, rM1purge, nlags, verbose) + if (i > 1) { + res.rM1 <- c(res.rM1, a$rM1.purged) + res.innov <- rbind(res.innov, a$innov) + } else { + res.rM1 <- a$rM1.purged + res.innov <- a$innov + } + } + if (verbose) {cat("2. Make a clean X and send it back --\n")} + X <- cbind(res.rM1, res.innov) + if (NCOL(res.innov) == 1) {colnames(X) <- c("rM1","z")} + else {colnames(X) <- c("rM1", colnames(res.innov))} + X +} + Added: pkg/R/manyfirmsAMM.R =================================================================== --- pkg/R/manyfirmsAMM.R (rev 0) +++ pkg/R/manyfirmsAMM.R 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,58 @@ + +######################## +# Many firms AMM +######################## +source('AMM.R') +manyfirmsAMM <-function(regressand,regressors, + lags,dates=NULL, periodnames=NULL,verbose=FALSE){ + if(is.null(dates)){ + dates=c(start(regressors),end(regressors)) + periodnames="Full" + } + nperiods <- length(periodnames) + if(length(dates) != (nperiods+1)){ + cat("Mistake in length of dates versus length of periods.\n") + return(NULL) + } + nfirms <- ncol(regressand) + + # Let's get "exposure' and 'sds'. Setting up structures:- + + exposures <- matrix(NA,nrow=nfirms,ncol=nperiods*ncol(regressors)) + rownames(exposures) <- colnames(regressand) + tmp <- NULL + for(i in 1:length(periodnames)){ + for(j in 1:ncol(regressors)){ + tmp <- c(tmp, paste(colnames(regressors)[j], + periodnames[i],sep=".")) + } + } + colnames(exposures) <- tmp + sds <- exposures + colnames(sds) <- paste("sd",colnames(exposures),sep=".") + + # Setup a list structure for an OLS that failed + empty <- list(exposures=rep(NA,ncol(regressors)), + s.exposures=rep(NA,ncol(regressors))) + + for(i in 1:ncol(regressand)){ + cat("Doing",colnames(regressand)[i]) + if (verbose) {cat ("Doing", colnames(regressand)[i])} + rj <- regressand[,i] + dataset <- cbind(rj, regressors) # This is the full time-series + this.exp <- this.sds <- NULL + for(j in 1:nperiods){ # now we chop it up + t1 <- dates[j] + t2 <- dates[j+1] + # if (j != nperiods) {t2 <- t2-1} # I don't know why I wrote this now :-( But this created problems. + this <- window(dataset,start=t1, end=t2) + fe <- firmExposures(this[,1],this[,-1],nlags=lags,verbose) + if(is.null(fe)) {fe <- empty} + this.exp <- c(this.exp, fe$exposures) + this.sds <- c(this.sds, fe$s.exposures) + } + exposures[i,] <- this.exp + sds[i,] <- this.sds + } + list(exposures=exposures, sds=sds, sig=exposures/sds) +} Added: pkg/R/onefirmAMM.R =================================================================== --- pkg/R/onefirmAMM.R (rev 0) +++ pkg/R/onefirmAMM.R 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,31 @@ +####################### +# AMM for one firm +####################### +source('AMM.R') +onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL){ + exposures <- data.frame(matrix(NA,ncol=ncol(X),nrow=(length(dates)-1))) + colnames(exposures) <- colnames(X) + sds <- exposures + periodnames <- NULL + + if(is.null(dates)){ + res <- firmExposures(rj,X=rhs,verbose=verbose,nlags=nlags) + exposures <- res$exposure + sds <- res$s.exposure + }else{ + for(i in 1:(length(dates)-1)){ + tmp <- window(rj,start=dates[i],end=dates[i+1]) + rhs <- window(X,start=dates[i],end=dates[i+1]) + res <- firmExposures(rj=tmp, + X=rhs, + verbose=verbose, + nlags=nlags) + exposures[i,] <- res$exposure + periodnames <- c(periodnames,paste(dates[i],dates[i+1],sep=" TO ")) + sds[i,] <- res$s.exposure + } + rownames(exposures) <- rownames(sds) <- periodnames + } + rval <- list(exposures=exposures,sds=sds) + return(rval) +} Added: pkg/data/ammData.rda =================================================================== (Binary files differ) Property changes on: pkg/data/ammData.rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/data/firmExposuresData.rda =================================================================== (Binary files differ) Property changes on: pkg/data/firmExposuresData.rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Added: pkg/man/AMM.Rd =================================================================== --- pkg/man/AMM.Rd (rev 0) +++ pkg/man/AMM.Rd 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,67 @@ +\name{AMM} +\alias{AMM} + +\title{A function that estimates exposure for a single firm over multiple periods} + +\description{This function does three tasks: One firm AMM model, many firms AMM model and firm exposures. One should refer to the individual functions manual for arguments. +} + +\usage{ +AMM(amm.type=c("one.firm","manyfirms","firmExposures"), ...) +} + +\arguments{ + \item{amm.type}{Type of AMM to be performed: On one firm or many firms or just firm exposure} + +} +\value{ The function returns the exposures, HAC adjusted standard + errors, the number of lags used, and the residuals from the fitted + model. + +\item{exposures}{This contains the exposure estimates for the firm +j} + +\item{s.exposures}{This contains the HAC adjusted standard error +of the exposures estimated for the firm rj.} + +\item{nlags}{Specifies the lag length provided by the user} + +\item{lm.res}{The model estimates used in the analysis are stored here.} +} + +\author{Vikram Bahure} + +\seealso{ \code{\link{firmExposures}}, +\code{\link{manyfirmsAMM}} +\code{\link{onefirmAMM}}} + +\examples{ +# Create RHS before running AMM() +data("ammData",package="amm") +NIFTY_INDEX <- y3c3$NIFTY_INDEX +INRUSD <- y3c3$INRUSD +Company_A <- y3c3$Company_A +Company_B <- y3c3$Company_B +Company_C <- y3c3$Company_C +regressand <- cbind(Company_A,Company_B,Company_C) + +# One firm +of <- amm(amm.type="onefirm",rj=Company_A, + nlags=NA, + verbose=TRUE, + dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")), + rM1=NIFTY_INDEX, others=INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) + +# Many firm +mf<- amm(amm.type="manyfirm",regressand, + lags=NA, nlags=NA, + verbose=TRUE, + dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")),periodnames=c("P1","P2","P3","P4"), + rM1=NIFTY_INDEX, others=INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE) +} + +\keyword{AMM} \ No newline at end of file Added: pkg/man/ammData.Rd =================================================================== --- pkg/man/ammData.Rd (rev 0) +++ pkg/man/ammData.Rd 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,17 @@ +\name{ammData} +\alias{ammData} + + +\title{Three years and three random companies} + +\description{Data for testing and examples in the package} + +\usage{data(ammData)} + +\examples{ +library(zoo) +data(ammData) +str(y3c3) +} + +\keyword{ammData} \ No newline at end of file Added: pkg/man/firmExposures.Rd =================================================================== --- pkg/man/firmExposures.Rd (rev 0) +++ pkg/man/firmExposures.Rd 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,72 @@ +\name{firmExposures} +\alias{firmExposures} + +\title{A function that estimates exposure for a single firm in a +single period} + +\description{This function typically utilises an rj vector + and an X matrix of explanatory variables obtained + using the makeX function. This would compute the exposure + for all columns in X. +} + +\usage{ +firmExposures(rj, X, nlags = NA, verbose = FALSE) +} + +\arguments{ + \item{rj}{A vector of data for one firm} + + \item{X}{A matrix of explanatory variables obtained from + the makeX function. The first variable is always the + stock market index. Other variables could be + such as currency or bond returns, or other variables as + desired by the user. + } + + \item{nlags}{Number of lags of explanatory variables. When unspecified + the best lag using the AIC is used. + } + + \item{verbose}{Default is FALSE. When set to TRUE, the function + prints detailed results while running this function. + } +} + + +\value{ The function returns the exposures, HAC adjusted standard + errors, the number of lags used, and the residuals from the fitted + model. + +\item{exposures}{This contains the exposure estimates for the firm +j} + +\item{s.exposures}{This contains the HAC adjusted standard error +of the exposures estimated for the firm rj.} + +\item{nlags}{Specifies the lag length provided by the user} + +\item{lm.res}{The model estimates used in the analysis are stored here.} + +} + +\author{Ajay Shah, Vimal Balasubramaniam} + +\seealso{ +\code{\link{manyfirmsAMM}} +} + +\examples{ +# firmExposures +data("firmExposuresData",package="amm") +rj <- test$Company_A +rM1 <- test$NIFTY_INDEX +rM2 <- test$usdinr +rM3 <- test$baa +X <- makeX(rM1, others=rM2, + switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) +a <- firmExposures(rj, X, nlags=0, verbose=FALSE) +print(a) +} + +\keyword{firmExposures} \ No newline at end of file Added: pkg/man/firmExposuresData.Rd =================================================================== --- pkg/man/firmExposuresData.Rd (rev 0) +++ pkg/man/firmExposuresData.Rd 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,19 @@ +\name{firmExposuresData} +\alias{firmExposuresData} + + +\title{Data for testing the amm package and examples therein} + +\description{This is a zoo data that is used for testing purposes} + +\usage{data(firmExposuresData)} + +\author{Vimal Balasubramaniam} + +\examples{ +library(zoo) +data(firmExposuresData) +str(test) +} + +\keyword{firmExposuresData} \ No newline at end of file Added: pkg/man/makeX.Rd =================================================================== --- pkg/man/makeX.Rd (rev 0) +++ pkg/man/makeX.Rd 2013-07-13 10:30:57 UTC (rev 73) @@ -0,0 +1,78 @@ +\name{makeX} +\alias{makeX} +\title{A function to prepare explanatory variables for computation +of Augmented Market Models +} + +\description{ + This function creates a matrix of explanatory variables in the + form specified by the user for further estimation of Augmented + market models +} + +\usage{ +makeX(rM1, others, switch.to.innov = rep(TRUE, NCOL(others)), rM1purge = TRUE, nlags = 5, dates = NULL, verbose = TRUE) +} + +\arguments{ + \item{rM1}{This is generally fixed to the stock market index. The + first column vector of this matrix contains this variable. +} + + \item{others}{A zoo matrix with other regressors of interest in the + AMM - this could be currency, bond returns, foreign flows or any + other variable. +} + + \item{switch.to.innov}{is a vector of booleans with one element for + each column in 'others'. This controls whether or not that column in + 'others' is switched from raw values to AR residuals. +} + + \item{rM1purge}{whether or not the effects of all these 'others' are + purged from 'rM1' (i.e., is it replaced by residuals of a model + explaining rM1 using all these 'others'). +} + + \item{nlags}{The number of lag terms present in this model explaining + rM1 using all these 'others'. +} + + \item{dates}{Specified break dates (either from structural breaks in + exchange rate regimes) so that all these steps are constructed within + each sub-period divided by the dates. +} + + \item{verbose}{Whether detailed print while running this function + is required. +} + +} + +\section{Warning}{The input data has to be all na.omit(). There + should be no NAs in the dataset fed into this function. +} + +\value{This function generates a user specified matrix of explanatory + variables that will be further used in running Augmented market + models. +} + + +\author{Ajay Shah, Vimal Balasubramaniam} + +\seealso{ \code{\link{do.one.piece}}} + +\examples{ +# makeX +data("test",package="amm") +rj <- test$Company_A +rM1 <- test$NIFTY_INDEX +rM2 <- test$usdinr +rM3 <- test$baa +X <- makeX(rM1, others=rM2, + switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) +} + +\keyword{makeX} +\keyword{do.one.piece} \ No newline at end of file [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/eventstudies -r 73 From noreply at r-forge.r-project.org Sat Jul 13 17:20:13 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 13 Jul 2013 17:20:13 +0200 (CEST) Subject: [Eventstudies-commits] r74 - in pkg: R data man Message-ID: <20130713152013.265501809A8@r-forge.r-project.org> Author: vikram Date: 2013-07-13 17:20:12 +0200 (Sat, 13 Jul 2013) New Revision: 74 Added: pkg/R/excessReturn.R pkg/R/marketResidual.R pkg/data/marketmodelData.rda pkg/man/excessReturn.Rd pkg/man/marketResidual.Rd Modified: pkg/R/AMM.R pkg/man/AMM.Rd pkg/man/firmExposures.Rd pkg/man/makeX.Rd pkg/man/onefirmAMM.Rd Log: Added function, documentation for market residual, excess return and minor corrections in AMM function; Work in progress Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-13 10:30:57 UTC (rev 73) +++ pkg/R/AMM.R 2013-07-13 15:20:12 UTC (rev 74) @@ -5,8 +5,12 @@ #----------------------------- # Getting RHS variables in AMM #----------------------------- - print("Preparing explanatory variables for computation of Augmented Market Models") - print("If any argument is missing then please refer to the documentation for detailed explanation.") + #print("Preparing explanatory variables for computation of Augmented Market Models") + print("If there is missing argument then please refer to the documentation for detailed explanation") + if(amm.type!= "onefirm" & amm.type!="manyfirms" & amm.type!="firmExposures"){ + stop("Input amm.type is missing") + } + # Checking arguments nlags.check <- testObject(nlags) if(nlags.check==FALSE){ nlags <- NA} Added: pkg/R/excessReturn.R =================================================================== --- pkg/R/excessReturn.R (rev 0) +++ pkg/R/excessReturn.R 2013-07-13 15:20:12 UTC (rev 74) @@ -0,0 +1,13 @@ +############### +# Excess return +############### +# Argument: +# 1. data.object: This is a time series object with firm return and market return +# 2. firm.name: It is the firm column name in the data object +# 3. market.name: It is the market (index) column name in the data object +# Output: +# Value: Excess market return +excessReturn <- function(firm.name,market.name,data.object){ + ma.ret <- data.object[,firm.name]-data.object[,market.name] + return(ma.ret) +} Added: pkg/R/marketResidual.R =================================================================== --- pkg/R/marketResidual.R (rev 0) +++ pkg/R/marketResidual.R 2013-07-13 15:20:12 UTC (rev 74) @@ -0,0 +1,27 @@ +######################### +# Market model adjustment +######################### +# Argument: +# 1. mm.formula: Here the input is the linear model (lm) formula for eg: a ~ b + c +# If formula is not given then first column will be dependent and rest will be independent +# 2. data.object: Single time series object with all the variables +# Output: +# Value: Market residual after extracting market returns from the firm return +marketResidual <- function(mm.formula=NULL,data.object){ + # Storing NA observations + na.date <- data.object[which(complete.cases(data.object)==FALSE)] + # Extracting market residuals + if(is.null(mm.formula)==TRUE){ + formula <- paste(colnames(data.object)[1],"~", + colnames(data.object)[2:NCOL(data.object)],sep="") + reg <- lm(as.formula(formula),data=data.object) + }else{ + + reg <- lm(as.formula(mm.formula),data=data.object) + } + resid <- xts(reg$residuals,as.Date(attr(reg$residuals,"names"))) + suppressWarnings(tot.resid <- rbind(resid, + xts(rep(NA,nrow(na.date)), + index(na.date)))) + return(tot.resid) +} Added: pkg/data/marketmodelData.rda =================================================================== (Binary files differ) Property changes on: pkg/data/marketmodelData.rda ___________________________________________________________________ Added: svn:mime-type + application/octet-stream Modified: pkg/man/AMM.Rd =================================================================== --- pkg/man/AMM.Rd 2013-07-13 10:30:57 UTC (rev 73) +++ pkg/man/AMM.Rd 2013-07-13 15:20:12 UTC (rev 74) @@ -37,7 +37,7 @@ \examples{ # Create RHS before running AMM() -data("ammData",package="amm") +data("ammData") NIFTY_INDEX <- y3c3$NIFTY_INDEX INRUSD <- y3c3$INRUSD Company_A <- y3c3$Company_A @@ -46,7 +46,7 @@ regressand <- cbind(Company_A,Company_B,Company_C) # One firm -of <- amm(amm.type="onefirm",rj=Company_A, +of <- AMM(amm.type="onefirm",rj=Company_A, nlags=NA, verbose=TRUE, dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", @@ -55,7 +55,7 @@ switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) # Many firm -mf<- amm(amm.type="manyfirm",regressand, +mf<- AMM(amm.type="manyfirm",regressand, lags=NA, nlags=NA, verbose=TRUE, dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", Added: pkg/man/excessReturn.Rd =================================================================== --- pkg/man/excessReturn.Rd (rev 0) +++ pkg/man/excessReturn.Rd 2013-07-13 15:20:12 UTC (rev 74) @@ -0,0 +1,29 @@ +\name{excessReturn} +\alias{excessReturn} + +\title{A function that estimates excess return} + +\description{ This function estimates excess return. If the the firm return is rj and market return is rM then output will be rj less rM. +} + +\usage{excessReturn(firm.name, market.name, data.object) +} + +\arguments{ + \item{data.object}{This is a time series object with firm return and market return} + \item{firm.name}{It is the firm column name in the data object} + \item{market.name}{It is the market (index) column name in the data object} + +} +\value{ Excess market return} + +\author{Vikram Bahure} + +\examples{ +data(marketmodelData) +er.result <- excessReturn(firm.name="ranbaxyacp",market.name="nifty", + data.object=mmData) + +} + +\keyword{excessReturn} \ No newline at end of file Modified: pkg/man/firmExposures.Rd =================================================================== --- pkg/man/firmExposures.Rd 2013-07-13 10:30:57 UTC (rev 73) +++ pkg/man/firmExposures.Rd 2013-07-13 15:20:12 UTC (rev 74) @@ -58,7 +58,7 @@ \examples{ # firmExposures -data("firmExposuresData",package="amm") +data("firmExposuresData") rj <- test$Company_A rM1 <- test$NIFTY_INDEX rM2 <- test$usdinr Modified: pkg/man/makeX.Rd =================================================================== --- pkg/man/makeX.Rd 2013-07-13 10:30:57 UTC (rev 73) +++ pkg/man/makeX.Rd 2013-07-13 15:20:12 UTC (rev 74) @@ -65,7 +65,7 @@ \examples{ # makeX -data("test",package="amm") +data("firmExposuresData") rj <- test$Company_A rM1 <- test$NIFTY_INDEX rM2 <- test$usdinr Added: pkg/man/marketResidual.Rd =================================================================== --- pkg/man/marketResidual.Rd (rev 0) +++ pkg/man/marketResidual.Rd 2013-07-13 15:20:12 UTC (rev 74) @@ -0,0 +1,33 @@ +\name{marketResidual} +\alias{marketResidual} + +\title{This function extracts market return from the firm return } + +\description{ This function extracts market return using regression from the firm return to get the residual return +} + +\usage{marketResidual(mm.formula=NULL, data.object) +} + +\arguments{ + \item{data.object}{Single time series object with all the variables} + \item{mm.formula}{Here the input is the linear model (lm) formula for eg: a ~ b + c + If formula is not given then first column will be treated as + dependent and rest will be independent} + +} +\value{ Market residual after extracting market returns from the firm return +} + +\author{Vikram Bahure} + +\examples{ +data(marketmodelData) +# Forumla for market model +mm.formula <- paste("ranbaxyacp","~","nifty","+","drug",sep="") +# Extracting market residual +mm.result <- marketResidual(mm.formula=mm.formula,data.object=mmData) + +} + +\keyword{marketResidual} \ No newline at end of file Modified: pkg/man/onefirmAMM.Rd =================================================================== --- pkg/man/onefirmAMM.Rd 2013-07-13 10:30:57 UTC (rev 73) +++ pkg/man/onefirmAMM.Rd 2013-07-13 15:20:12 UTC (rev 74) @@ -42,7 +42,7 @@ \examples{ # Create RHS before running onefirmAMM() -data("ammData",package="amm") +data("ammData") NIFTY_INDEX <- y3c3$NIFTY_INDEX INRUSD <- y3c3$INRUSD Company_A <- y3c3$Company_A From noreply at r-forge.r-project.org Tue Jul 16 07:15:02 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 07:15:02 +0200 (CEST) Subject: [Eventstudies-commits] r75 - pkg/R Message-ID: <20130716051502.CDEAF18525D@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 07:15:02 +0200 (Tue, 16 Jul 2013) New Revision: 75 Modified: pkg/R/AMM.R Log: Restructured the AMM function, fixed parsing of ellipses. Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-13 15:20:12 UTC (rev 74) +++ pkg/R/AMM.R 2013-07-16 05:15:02 UTC (rev 75) @@ -1,79 +1,113 @@ ########################## # Generalised AMM function ########################## -AMM <- function(amm.type=c("onefirm","manyfirms","firmExposures"), ...){ - #----------------------------- - # Getting RHS variables in AMM - #----------------------------- - #print("Preparing explanatory variables for computation of Augmented Market Models") - print("If there is missing argument then please refer to the documentation for detailed explanation") - if(amm.type!= "onefirm" & amm.type!="manyfirms" & amm.type!="firmExposures"){ - stop("Input amm.type is missing") + +AMM <- function(amm.type = NULL, ...) { + + ## List of models currently supported + modelsList <- c("onefirm", + "manyfirms", + "firmExposures") + + if (is.null(amm.type) || length(amm.type) != 1) { + stop("Argument amm.type not provided or incorrect") } + if (match(amm.type, modelsList, nomatch = -1) == -1) { + stop("Unknown model provided") + } + + # NULLify all the values before use + rj <- NULL + rM1 <- NULL + rM1purge <- NULL + nlags <- NULL + others <- NULL + switch.to.innov <- NULL + verbose <- NULL + dates <- NULL + regressand <- NULL + periodnames <- NULL + + # parse the input arguments for the model + modelArgs <- list(...) + # assign values + for (i in 1:length(modelArgs)) { + eval(parse(text = paste(names(modelArgs)[i], "<-", "modelArgs[[i]]"))) + } + + # Checking required arguments + if (match("rM1", names(modelArgs), nomatch = -1) == -1) { + stop("Input rM1 (stock market index) is missing") + } + if (match("others", names(modelArgs), nomatch = -1) == -1) { + stop("Input 'others' (time series of other regressor or interest) is missing") + } + if (match("rM1purge", names(modelArgs), nomatch = -1) == -1) { + stop("Input rM1purge is missing") + } + if (match("switch.to.innov", names(modelArgs), nomatch = -1) == -1) { + stop("Input switch.to.innov is missing") + } - # Checking arguments - nlags.check <- testObject(nlags) - if(nlags.check==FALSE){ nlags <- NA} - verbose.check <- testObject(verbose) - if(verbose.check==FALSE){ verbose <- FALSE} - dates.check <- testObject(dates) - if(dates.check==FALSE){ dates <- NULL} + # Checking remaining arguments + if (match("nlags", names(modelArgs), nomatch = -1) == -1) { + nlags <- NA + } + if (match("verbose", names(modelArgs), nomatch = -1) == -1) { + verbose <- FALSE + } + if (match("dates", names(modelArgs), nomatch = -1) == -1) { + dates <- NULL + } + + ## Assign values - rM1.check <- testObject(rM1) - if(rM1.check==FALSE){ stop("Input rM1 (stock market index) is missing")} - others.check <- testObject(others) - if(others.check==FALSE){ stop("Input 'others' (time series of other regressor or interest) is missing")} - rM1.check <- testObject(rM1) - if(rM1.check==FALSE){ stop("Input rM1 (stock market index) is missing")} - rM1purge.check <- testObject(rM1purge) - if(rM1purge.check==FALSE){ stop("Input rM1purge is missing")} - switch.to.innov.check <- testObject(switch.to.innov) - if(switch.to.innov.check==FALSE){ stop("Input switch.to.innov is missing")} + ##----------- + ## One firm + ##----------- + if(amm.type == "onefirm") { + # Checking required arguments + if (match("rj", names(modelArgs), nomatch = -1) == -1) { + stop("Input rj (firm data) is missing") + } - if(amm.type!="manyfirms"){ X <- makeX(rM1, others, switch.to.innov, rM1purge, nlags, dates, verbose) - }else{ - regressors <- makeX(rM1, others, switch.to.innov, rM1purge, nlags, - dates, verbose) - } - - #--------- - # One firm - #--------- - if(amm.type=="onefirm"){ - # Checking if arguments are provided - rj.check <- testObject(rj) - if(rj.check==FALSE){ stop("Input rj (firm data) is missing")} - result <- onefirmAMM(rj, X, nlags, verbose, dates) } - - #----------- - # Many firms - #----------- - if(amm.type=="manyfirms"){ - # Checking if arguments are provided - regressors.check <- testObject(regressors) - if(regressors.check==FALSE){ stop("Input regressors is missing. Refer documentation.")} - regressand.check <- testObject(regressand) - if(regressand.check==FALSE){ stop("Input regressand is missing. Refer documentation.")} - dates.check <- testObject(dates) - if(dates.check==FALSE){ dates <- NULL} - periodnames.check <- testObject(periodnames) - if(periodnames.check==FALSE){ periodnames <- NULL} - + + ##----------- + ## Many firms + ##----------- + if(amm.type == "manyfirms") { + # Checking required arguments + if (match("regressand", names(modelArgs), nomatch = -1) == -1) { + stop("Input regressand is missing. Refer documentation.") + } + + # Checking remaining arguments + if (match("periodnames", names(modelArgs), nomatch = -1) == -1) { + periodnames <- NULL + } + + regressors <- makeX(rM1, others, switch.to.innov, + rM1purge, nlags, dates, verbose) result <- manyfirmsAMM(regressand,regressors, - lags=nlags,dates, periodnames,verbose) + lags=nlags,dates, periodnames,verbose) } #--------------- # Firm exposures #--------------- - if(amm.type=="firmExposures"){ - rj.check <- testObject(rj) - if(rj.check==FALSE){ stop("Input rj (firm data) is missing")} + if (amm.type=="firmExposures") { + # Checking required arguments + if (match("rj", names(modelArgs), nomatch = -1) == -1) { + stop("Input rj (firm data) is missing") + } + X <- makeX(rM1, others, switch.to.innov, + rM1purge, nlags, dates, verbose) + result <- firmExposures(rj, X, nlags, verbose) } From noreply at r-forge.r-project.org Tue Jul 16 07:16:51 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 07:16:51 +0200 (CEST) Subject: [Eventstudies-commits] r76 - pkg/R Message-ID: <20130716051651.37E3B184B1D@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 07:16:50 +0200 (Tue, 16 Jul 2013) New Revision: 76 Added: pkg/R/eventstudy.R Log: Added main wrapper function for eventstudies. Added: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R (rev 0) +++ pkg/R/eventstudy.R 2013-07-16 05:16:50 UTC (rev 76) @@ -0,0 +1,46 @@ +eventstudy <- function(inputData = NULL, + eventList, + width = 10, + type = "marketResiduals", + to.remap = TRUE, + remap = "cumsum", + to.plot = TRUE, + ...) { + # type = "marketResiduals", "excessReturn", "AMM", "None" + if (type == "None" && !is.null(inputData)) { + outputModel <- inputData + } else { + stop("inputData or \"None\" type missing") + } + +### Run models + ## AMM + if (type == "AMM") { + outputModel <- AMM(...) + } + + ## marketResiduals + if (type == "marketResiduals") { + outputModel <- marketResiduals(...) + } + + ## excessReturn + if (type == "excessReturn") { + outputModel <- excessReturn(...) + } + +### Convert to event frame + es <- phys2eventtime(z=outputModel, events=eventList, width=width) + es.w <- window(es$z.e, start = -width, end = width) + +### Remapping event frame + if (to.remap == TRUE) { + es.w <- switch(remap, + cumsum = remap.cumsum(es.w, is.pc = FALSE, base = 0), + cumprod = remap.cumprod(es.w, is.pc = TRUE, is.returns = TRUE, base = 100), + reindex = remap.event.reindex(es.w) + ) + } + +### Bootstrap + result <- inference.Ecar(z.e = es.w, to.plot = to.plot) From noreply at r-forge.r-project.org Tue Jul 16 07:18:48 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 07:18:48 +0200 (CEST) Subject: [Eventstudies-commits] r77 - pkg/R Message-ID: <20130716051848.DBFFB184659@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 07:18:48 +0200 (Tue, 16 Jul 2013) New Revision: 77 Modified: pkg/R/eventstudy.R Log: Fixed missing brace. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2013-07-16 05:16:50 UTC (rev 76) +++ pkg/R/eventstudy.R 2013-07-16 05:18:48 UTC (rev 77) @@ -44,3 +44,6 @@ ### Bootstrap result <- inference.Ecar(z.e = es.w, to.plot = to.plot) + + return(result) +} From noreply at r-forge.r-project.org Tue Jul 16 07:33:30 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 07:33:30 +0200 (CEST) Subject: [Eventstudies-commits] r78 - pkg/R Message-ID: <20130716053330.A96E41859D2@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 07:33:30 +0200 (Tue, 16 Jul 2013) New Revision: 78 Removed: pkg/R/firmExposures.R pkg/R/makeX.R pkg/R/manyfirmsAMM.R pkg/R/onefirmAMM.R Log: Removing unnecessary files, functions are already inside AMM.R. Deleted: pkg/R/firmExposures.R =================================================================== --- pkg/R/firmExposures.R 2013-07-16 05:18:48 UTC (rev 77) +++ pkg/R/firmExposures.R 2013-07-16 05:33:30 UTC (rev 78) @@ -1,73 +0,0 @@ -############################################### -# Estimating one firm's exposure in one period. -############################################### -firmExposures <- function(rj, X, nlags=NA, verbose=FALSE) { - do.ols <- function(nlags) { - tmp <- cbind(rj, X[,1]) # Assume 1st is stock index, and no lags are required there. - labels <- c("rj","rM1") - if (NCOL(X) > 1) { - for (i in 2:NCOL(X)) { - for (j in 0:nlags) { - tmp <- cbind(tmp, lag(X[,i], -j)) - labels <- c(labels, paste(colnames(X)[i], j, sep=".")) - } - } - } - tmp <- na.omit(tmp) - if (nrow(tmp) < 30) { # refuse to do the work. - return(NULL) # returns out of do.ols() only - } - - colnames(tmp) <- labels # So the OLS results will look nice - lm(rj ~ ., data=as.data.frame(tmp)) - } - - if (is.na(nlags)) { - if (verbose) {cat("Trying to find the best lag structure...\n")} - bestlag <- 0 - bestm <- NULL - bestAIC <- Inf - for (trylag in 0:min(10,log10(length(rj)))) { - thism <- do.ols(trylag) - thisAIC <- AIC(thism, k=log(length(thism$fitted.values))) - if (verbose) {cat(trylag, " lags, SBC = ", thisAIC, "\n")} - if (thisAIC < bestAIC) { - bestlag <- trylag - bestAIC <- thisAIC - bestm <- thism - } - } - nlags <- bestlag - m <- bestm - } else { - m <- do.ols(nlags) - if (is.null(m)) {return(NULL)} - } - # In either event, you endup holding an "m" here. - if (verbose) {cat("\n\nThe OLS:\n"); print(summary(m))} - - # Compute a series of exposure measures, and their standard errors. - beta <- m$coefficients - Sigma <- vcovHAC(m) - # First the rM1 - exposures <- beta[2] # no lags for rM1 - s.exposures <- sqrt(Sigma[2,2]) - # From here on, there's a block of 1+nlags coeffs for each - # of the non-rM1 regressors. - if (NCOL(X) > 1) { - for (i in 2:NCOL(X)) { - n.block1 <- 2 + ((i-2)*(1+nlags)) # Just 2 for the 1st case. - n.block2 <- length(beta) - n.block1 - (1 + nlags) - w <- c(rep(0, n.block1), rep(1, 1+nlags), rep(0, n.block2)) - exposures <- c(exposures, w %*% beta) - s.exposures <- c(s.exposures, sqrt(w %*% Sigma %*% w)) - } - } - names(exposures) <- names(s.exposures) <- colnames(X) - results <- list(exposures=exposures, - s.exposures=s.exposures, nlags=nlags, - lm.res=m) - class(results) <- "amm" - results -} - Deleted: pkg/R/makeX.R =================================================================== --- pkg/R/makeX.R 2013-07-16 05:18:48 UTC (rev 77) +++ pkg/R/makeX.R 2013-07-16 05:33:30 UTC (rev 78) @@ -1,54 +0,0 @@ - -############################################################### -# A function that calls do.one.piece, and works through several -# different periods to provide the right RHS matrix. -############################################################### -source('AMM.R') -makeX <- function(rM1, others, - switch.to.innov=rep(TRUE, NCOL(others)), - rM1purge=TRUE, - nlags=5, - dates=NULL, - verbose=TRUE) { - if (verbose) {cat("0. Checking args\n")} - stopifnot(all.equal(index(rM1), index(others)), - length(switch.to.innov)==NCOL(others)) - if (!is.null(dates)) { - stopifnot(class(dates) == "Date") - } - if (verbose) {cat("1. Checking dates.\n")} - if (is.null(dates)) { - dates <- c(start(rM1),end(rM1)) - } - if(head(dates,1)!=head(index(rM1),1)){ - stop("Start date provided and the start date of the dataset do not match \n") - } - if(tail(dates,1)!=tail(index(rM1),1)){ - stop("End date provided and the end date of the dataset do not match \n") - } - if (verbose) {cat("2. Run through all the pieces --\n")} - for (i in 1:(length(dates)-1)) { - t1 <- dates[i] - t2 <- dates[i+1] - if (i != (length(dates)-1)) {t2 <- t2 -1} - if (verbose) { - cat(" Focusing down from date = ", as.character(t1), " to ", as.character(t2), "\n") - } - tmp.rM1 <- window(rM1, start=t1, end=t2) - tmp.others <- window(others, start=t1, end=t2) - a <- do.one.piece(tmp.rM1, tmp.others, switch.to.innov, rM1purge, nlags, verbose) - if (i > 1) { - res.rM1 <- c(res.rM1, a$rM1.purged) - res.innov <- rbind(res.innov, a$innov) - } else { - res.rM1 <- a$rM1.purged - res.innov <- a$innov - } - } - if (verbose) {cat("2. Make a clean X and send it back --\n")} - X <- cbind(res.rM1, res.innov) - if (NCOL(res.innov) == 1) {colnames(X) <- c("rM1","z")} - else {colnames(X) <- c("rM1", colnames(res.innov))} - X -} - Deleted: pkg/R/manyfirmsAMM.R =================================================================== --- pkg/R/manyfirmsAMM.R 2013-07-16 05:18:48 UTC (rev 77) +++ pkg/R/manyfirmsAMM.R 2013-07-16 05:33:30 UTC (rev 78) @@ -1,58 +0,0 @@ - -######################## -# Many firms AMM -######################## -source('AMM.R') -manyfirmsAMM <-function(regressand,regressors, - lags,dates=NULL, periodnames=NULL,verbose=FALSE){ - if(is.null(dates)){ - dates=c(start(regressors),end(regressors)) - periodnames="Full" - } - nperiods <- length(periodnames) - if(length(dates) != (nperiods+1)){ - cat("Mistake in length of dates versus length of periods.\n") - return(NULL) - } - nfirms <- ncol(regressand) - - # Let's get "exposure' and 'sds'. Setting up structures:- - - exposures <- matrix(NA,nrow=nfirms,ncol=nperiods*ncol(regressors)) - rownames(exposures) <- colnames(regressand) - tmp <- NULL - for(i in 1:length(periodnames)){ - for(j in 1:ncol(regressors)){ - tmp <- c(tmp, paste(colnames(regressors)[j], - periodnames[i],sep=".")) - } - } - colnames(exposures) <- tmp - sds <- exposures - colnames(sds) <- paste("sd",colnames(exposures),sep=".") - - # Setup a list structure for an OLS that failed - empty <- list(exposures=rep(NA,ncol(regressors)), - s.exposures=rep(NA,ncol(regressors))) - - for(i in 1:ncol(regressand)){ - cat("Doing",colnames(regressand)[i]) - if (verbose) {cat ("Doing", colnames(regressand)[i])} - rj <- regressand[,i] - dataset <- cbind(rj, regressors) # This is the full time-series - this.exp <- this.sds <- NULL - for(j in 1:nperiods){ # now we chop it up - t1 <- dates[j] - t2 <- dates[j+1] - # if (j != nperiods) {t2 <- t2-1} # I don't know why I wrote this now :-( But this created problems. - this <- window(dataset,start=t1, end=t2) - fe <- firmExposures(this[,1],this[,-1],nlags=lags,verbose) - if(is.null(fe)) {fe <- empty} - this.exp <- c(this.exp, fe$exposures) - this.sds <- c(this.sds, fe$s.exposures) - } - exposures[i,] <- this.exp - sds[i,] <- this.sds - } - list(exposures=exposures, sds=sds, sig=exposures/sds) -} Deleted: pkg/R/onefirmAMM.R =================================================================== --- pkg/R/onefirmAMM.R 2013-07-16 05:18:48 UTC (rev 77) +++ pkg/R/onefirmAMM.R 2013-07-16 05:33:30 UTC (rev 78) @@ -1,31 +0,0 @@ -####################### -# AMM for one firm -####################### -source('AMM.R') -onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL){ - exposures <- data.frame(matrix(NA,ncol=ncol(X),nrow=(length(dates)-1))) - colnames(exposures) <- colnames(X) - sds <- exposures - periodnames <- NULL - - if(is.null(dates)){ - res <- firmExposures(rj,X=rhs,verbose=verbose,nlags=nlags) - exposures <- res$exposure - sds <- res$s.exposure - }else{ - for(i in 1:(length(dates)-1)){ - tmp <- window(rj,start=dates[i],end=dates[i+1]) - rhs <- window(X,start=dates[i],end=dates[i+1]) - res <- firmExposures(rj=tmp, - X=rhs, - verbose=verbose, - nlags=nlags) - exposures[i,] <- res$exposure - periodnames <- c(periodnames,paste(dates[i],dates[i+1],sep=" TO ")) - sds[i,] <- res$s.exposure - } - rownames(exposures) <- rownames(sds) <- periodnames - } - rval <- list(exposures=exposures,sds=sds) - return(rval) -} From noreply at r-forge.r-project.org Tue Jul 16 07:35:48 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 07:35:48 +0200 (CEST) Subject: [Eventstudies-commits] r79 - pkg/tests Message-ID: <20130716053549.054431859CF@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 07:35:46 +0200 (Tue, 16 Jul 2013) New Revision: 79 Added: pkg/tests/unit_tests.R Modified: pkg/tests/test_eventstudy.R pkg/tests/test_inr_inference.R Log: Created test functions for existing tests, added unit testing code using RUnit. Modified: pkg/tests/test_eventstudy.R =================================================================== --- pkg/tests/test_eventstudy.R 2013-07-16 05:33:30 UTC (rev 78) +++ pkg/tests/test_eventstudy.R 2013-07-16 05:35:46 UTC (rev 79) @@ -1,5 +1,6 @@ library(eventstudies) +test.eventstudy <- function() { # An example dataset, with 3 firms -- p <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17, 35.89, 36.19, 37.1317, 36.7033, 37.7933, 37.8533, 285.325, 292.6, @@ -42,7 +43,7 @@ # But when we go to width=2, column 1 and 3 drop off because they have # only 1 obs before & after the event date respectively. a <- phys2eventtime(p, eventslist,width=2) -all.equal(a, structure(list(z.e = structure(c(NA, NA, NA, NA, 285.325, +test.result <- all.equal(a, structure(list(z.e = structure(c(NA, NA, NA, NA, 285.325, 292.6, 290.025, 286.2, 290.075, 295.05, 289.325, 285.625, 293.7, 298.5, 289.05, NA, NA, NA, NA), index = -9:9, class = @@ -51,3 +52,15 @@ "unitmissing", "wdatamissing", "wrongspan"), class = "factor")), .Names = c("z.e", "outcomes" ))) +s <- structure(list(z.e = structure(c(NA, NA, NA, NA, 285.325, + 292.6, 290.025, 286.2, 290.075, 295.05, + 289.325, 285.625, 293.7, 298.5, 289.05, + NA, NA, NA, NA), index = -9:9, class = + "zoo"), outcomes = structure(c(3L, 1L, + 3L, 4L, 4L, 2L), .Label = c("success", + "unitmissing", "wdatamissing", + "wrongspan"), class = "factor")), .Names + = c("z.e", "outcomes" )) + +checkTrue(isTRUE(test.result)) +} Modified: pkg/tests/test_inr_inference.R =================================================================== --- pkg/tests/test_inr_inference.R 2013-07-16 05:33:30 UTC (rev 78) +++ pkg/tests/test_inr_inference.R 2013-07-16 05:35:46 UTC (rev 79) @@ -1,22 +1,31 @@ library(eventstudies) + +test.inr.inference <- function() { data(inr) inr_returns <- diff(log(inr))[-1] -eventslist<-data.frame(unit=rep("inr",10), - when=as.Date(c( - "2010-04-20","2010-07-02","2010-07-27", - "2010-09-16","2010-11-02","2011-01-25", - "2011-03-17","2011-05-03","2011-06-16", - "2011-07-26") +eventslist <- data.frame(unit=rep("inr",10), + when=as.Date(c( + "2010-04-20","2010-07-02","2010-07-27", + "2010-09-16","2010-11-02","2011-01-25", + "2011-03-17","2011-05-03","2011-06-16", + "2011-07-26") + ) ) - ) event_time_data <- phys2eventtime(inr_returns,eventslist,width=10) w <- window(event_time_data$z.e,start=-10,end=10) -all.equal(inference.Ecar(w)[,2],c(-.000015327,-.002526819,.0011990000,.001193535,.001846734, - -.000105473,-.001659772,.001644518,-0.001325236,.001546369, - -.000809734,-.001499191,-.000289414,-.000003273,-.000416662, - -.001150000,-.000759748,.002306711,-.000487299,.001122457, - .000635890)) +test.result <- all.equal(inference.Ecar(w)[,2], + c(-0.00215361156303362, -0.00040191670837042, 0.00171845148444985, + 0.00143799970419951, 0.00149260146357282, -0.00284892904228684, + 0.0013220811191847, -0.000634983205805195, 0.00115930378269389, + -0.000508755768685365, -0.00190621828611177, 0.000128303517790052, + -0.000547070723466092, 0.000463708708964017, -0.00108666428087325, + -0.00121321855159642, 0.00216769754166339, -0.000166340225607797, + 0.00117626759805196, 0.000207307545758795, 0.000602629204764948 + )) + +checkTrue(isTRUE(test.result)) +} Added: pkg/tests/unit_tests.R =================================================================== --- pkg/tests/unit_tests.R (rev 0) +++ pkg/tests/unit_tests.R 2013-07-16 05:35:46 UTC (rev 79) @@ -0,0 +1,9 @@ +library(RUnit) + +testsuite <- defineTestSuite("Event Studies Test Suite", + dirs = ".", + testFileRegexp = "^test_.*\\.R$", + testFuncRegexp = "^.*$" + ) + +testresult <- runTestSuite(testsuite) From noreply at r-forge.r-project.org Tue Jul 16 07:53:26 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 07:53:26 +0200 (CEST) Subject: [Eventstudies-commits] r80 - pkg/data Message-ID: <20130716055326.7DD76184CDB@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 07:53:26 +0200 (Tue, 16 Jul 2013) New Revision: 80 Added: pkg/data/firmExposures.rda pkg/data/y3c3.rda Removed: pkg/data/ammData.rda pkg/data/firmExposuresData.rda Log: Renamed the data sets according to their object names Deleted: pkg/data/ammData.rda =================================================================== (Binary files differ) Copied: pkg/data/firmExposures.rda (from rev 78, pkg/data/firmExposuresData.rda) =================================================================== (Binary files differ) Deleted: pkg/data/firmExposuresData.rda =================================================================== (Binary files differ) Copied: pkg/data/y3c3.rda (from rev 78, pkg/data/ammData.rda) =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Tue Jul 16 08:05:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 08:05:54 +0200 (CEST) Subject: [Eventstudies-commits] r81 - pkg/R Message-ID: <20130716060555.0C16C1848A0@r-forge.r-project.org> Author: vimsaa Date: 2013-07-16 08:05:54 +0200 (Tue, 16 Jul 2013) New Revision: 81 Modified: pkg/R/AMM.R Log: Modified onefirmAMM Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-16 05:53:26 UTC (rev 80) +++ pkg/R/AMM.R 2013-07-16 06:05:54 UTC (rev 81) @@ -117,16 +117,18 @@ ####################### # AMM for one firm ####################### -onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL){ +onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL,residual=FALSE){ exposures <- data.frame(matrix(NA,ncol=ncol(X),nrow=(length(dates)-1))) colnames(exposures) <- colnames(X) sds <- exposures periodnames <- NULL - + m.residuals <- NULL if(is.null(dates)){ res <- firmExposures(rj,X,verbose=verbose,nlags=nlags) exposures <- res$exposure sds <- res$s.exposure + if(residual==TRUE) + m.residuals <- res$residuals }else{ for(i in 1:(length(dates)-1)){ tmp <- window(rj,start=dates[i],end=dates[i+1]) @@ -138,10 +140,11 @@ exposures[i,] <- res$exposure periodnames <- c(periodnames,paste(dates[i],dates[i+1],sep=" TO ")) sds[i,] <- res$s.exposure + m.residuals <- merge(m.residuals,res$residuals,all=TRUE) } rownames(exposures) <- rownames(sds) <- periodnames } - rval <- list(exposures=exposures,sds=sds) + rval <- list(exposures=exposures,sds=sds,residuals=m.residuals) return(rval) } @@ -267,8 +270,9 @@ s.exposures <- c(s.exposures, sqrt(w %*% Sigma %*% w)) } } + residuals <- m$resid names(exposures) <- names(s.exposures) <- colnames(X) - results <- list(exposures=exposures, + results <- list(exposures=exposures,residuals=residuals, s.exposures=s.exposures, nlags=nlags, lm.res=m) class(results) <- "amm" From noreply at r-forge.r-project.org Tue Jul 16 08:34:25 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 08:34:25 +0200 (CEST) Subject: [Eventstudies-commits] r82 - pkg/R Message-ID: <20130716063425.DB042184FA5@r-forge.r-project.org> Author: vimsaa Date: 2013-07-16 08:34:25 +0200 (Tue, 16 Jul 2013) New Revision: 82 Modified: pkg/R/AMM.R Log: The wrapper for the AMM functions have been modified. We should not use manyfirmsAMM for any work relating to event study and this has to be sufficiently clear in the way it is used... Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-16 06:05:54 UTC (rev 81) +++ pkg/R/AMM.R 2013-07-16 06:34:25 UTC (rev 82) @@ -6,7 +6,6 @@ ## List of models currently supported modelsList <- c("onefirm", - "manyfirms", "firmExposures") if (is.null(amm.type) || length(amm.type) != 1) { @@ -76,26 +75,6 @@ result <- onefirmAMM(rj, X, nlags, verbose, dates) } - ##----------- - ## Many firms - ##----------- - if(amm.type == "manyfirms") { - # Checking required arguments - if (match("regressand", names(modelArgs), nomatch = -1) == -1) { - stop("Input regressand is missing. Refer documentation.") - } - - # Checking remaining arguments - if (match("periodnames", names(modelArgs), nomatch = -1) == -1) { - periodnames <- NULL - } - - regressors <- makeX(rM1, others, switch.to.innov, - rM1purge, nlags, dates, verbose) - result <- manyfirmsAMM(regressand,regressors, - lags=nlags,dates, periodnames,verbose) - } - #--------------- # Firm exposures #--------------- From noreply at r-forge.r-project.org Tue Jul 16 09:07:46 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 09:07:46 +0200 (CEST) Subject: [Eventstudies-commits] r83 - pkg/R Message-ID: <20130716070747.0F93C1851A7@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 09:07:46 +0200 (Tue, 16 Jul 2013) New Revision: 83 Modified: pkg/R/AMM.R Log: Removed testObject function Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-16 06:34:25 UTC (rev 82) +++ pkg/R/AMM.R 2013-07-16 07:07:46 UTC (rev 83) @@ -478,14 +478,3 @@ } } } - -############################################################################################# - - - -########################### -# Checking if object exists -########################### -testObject <- function(object){ - exists(as.character(substitute(object))) -} From noreply at r-forge.r-project.org Tue Jul 16 09:14:35 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 09:14:35 +0200 (CEST) Subject: [Eventstudies-commits] r84 - pkg/tests Message-ID: <20130716071435.931131859DD@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 09:14:35 +0200 (Tue, 16 Jul 2013) New Revision: 84 Added: pkg/tests/test_AMM.R Log: Added file for testing AMM functionality. Added: pkg/tests/test_AMM.R =================================================================== --- pkg/tests/test_AMM.R (rev 0) +++ pkg/tests/test_AMM.R 2013-07-16 07:14:35 UTC (rev 84) @@ -0,0 +1,102 @@ +test.AMM <- function() { + library(eventstudies) + library(sandwich) + + data("firmExposures",package="eventstudies") + + rj <- firmExposures$Company_A + rM1 <- firmExposures$NIFTY_INDEX + rM2 <- firmExposures$usdinr + rM3 <- firmExposures$baa + + cat("Doing Testcase P2:\n") + X <- makeX(rM1, others=rM2, + switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) + a <- firmExposures(rj, X, nlags=0, verbose=FALSE) + test.result <- all.equal(c(a$exposures, a$s.exposures), + structure(c(0.716160223601197,-0.673093436292401, + 0.152101606133946,1.02143820457251), + .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1) + checkTrue(isTRUE(test.result)) + + cat("Doing Testcase P3:\n") + X <- makeX(rM1, others=rM2, + switch.to.innov=TRUE, rM1purge=FALSE, verbose=FALSE) + a <- firmExposures(rj, X, nlags=0, verbose=FALSE) + test.result <- all.equal(c(a$exposures, a$s.exposures), + structure(c(0.716160223601197,-0.673093436292401, + 0.152100337597009,1.02146106755333), + .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1) + checkTrue(isTRUE(test.result)) + + cat("Doing Testcase P4:\n") + a <- firmExposures(rj, X, nlags=1, verbose=FALSE) + test.result <- all.equal(c(a$exposures, a$s.exposures), + structure(c( 0.736264286484902, -1.450805, + 0.177929844631439, 1.646730), + .Names = c("rM1","z", "rM1", "z")),tolerance=1e-1) + checkTrue(isTRUE(test.result)) + + cat("Doing Testcase P5:\n") + X <- makeX(rM1, others=rM2, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1, verbose=FALSE) + a <- firmExposures(rj, X, nlags=1, verbose=FALSE) + test.result <- all.equal(c(a$exposures, a$s.exposures), + structure(c(0.7365566,-2.340171, + 0.1653025, 1.1436666), + .Names = c("rM1", "z", "rM1", "z")),tolerance=1e-1) + checkTrue(isTRUE(test.result)) + + cat("Doing Testcase P6:\n") + X <- makeX(rM1, others=cbind(rM2, rM3), + switch.to.innov=c(FALSE, FALSE), rM1purge=FALSE, verbose=FALSE) + a <- firmExposures(rj, X, nlags=0, verbose=FALSE) + test.result <- all.equal(c(a$exposures, a$s.exposures), + structure(c(0.7230599,-0.7642377, + 0.207374104922771,0.173380799334299, + 1.01806122963342,0.467821650129292), + .Names = c("rM1", "rM2", "rM3", "rM1", "rM2", "rM3")),tolerance=1e-1) + checkTrue(isTRUE(test.result)) + + cat("Doing Testcase P7:\n") + X <- makeX(rM1, others=cbind(rM2, rM3), + switch.to.innov=c(TRUE, TRUE), rM1purge=TRUE, nlags=1, verbose=FALSE) + a <- firmExposures(rj, X, nlags=1, verbose=FALSE) + test.result <- all.equal(c(a$exposures, a$s.exposures), + structure(c(0.7482719,-1.9468851,-0.4802211, + 0.1740678,1.2455112,0.6146619), + .Names = c("rM1", "rM2", "rM3", "rM1", "rM2", "rM3")),tolerance=1e-1) + checkTrue(isTRUE(test.result)) + +################################################################################ + # # + # THE NEXT CASES TESTS THE FUNCTION FOR THREE COMPANIES FOR THREE YEARS # + # # +################################################################################ + + + cat("Doing Testcases P8:\n") + data("y3c3", package="eventstudies") + + NIFTY_INDEX <- y3c3$NIFTY_INDEX + INRUSD <- y3c3$INRUSD + Company_A <- y3c3$Company_A + Company_B <- y3c3$Company_B + Company_C <- y3c3$Company_C + + regressors <- makeX(NIFTY_INDEX, others=INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1, + dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")), verbose=FALSE) + + regressand <- cbind(Company_A,Company_B,Company_C) + + res <- manyfirmsAMM(regressand,regressors,lags=1, + dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")),periodnames=c("P1","P2","P3","P4"), + verbose=FALSE) + + test.result <- all.equal(as.data.frame(res),structure(list(rM1.P1 = c(0.756294904326272, 0.359467326140834,0.914021428042946), z.P1 = c(-2.23264294525560, -1.05654919420689,0.296635483126946), rM1.P2 = c(1.02094561445355, 0.988758963378838,0.879236409569888), z.P2 = c(-4.72831391695047, -2.0508684999854,-1.02215809586573), rM1.P3 = c(1.20585808099744, 0.676388278572118,0.530718379431386), z.P3 = c(-1.32677083522489, -2.74055730512260, -1.50032216697694), rM1.P4 = c(1.11331096371784, 0.437117737120777,0.663182186702262), z.P4 = c(-2.05336868436562, -1.60350865767951,-0.466253391408585), rM1.P1 = c(0.143617135793294, 0.263130891045529,0.154272220123111), z.P1 = c(1.20226371286803, 1.22122136357895,1.02442932195400), rM1.P2 = c(0.203037609116444, 0.123122376136099,0.121880488983820), z.P2 = c(1.118400430819, 0.798694545623495,1.29755067543957), rM1.P3 = c(0.230304109532112, 0.289262660515515,0.164866239494693), z.P3 = c(1.17618117392934, 0.795008683829453,0.650736332270758), rM1.P4 = c(0.231338818884745, 0.213858364836974,0.207154237634752), z.P4 = c(0.771450066857429, 0.415931231130697,0.696448914066602), rM1.P1 = c(5.26604920888266, 1.36611602200152,5.9247311493511), z.P1 = c(-1.85703263049467, -0.865157804896683,0.289561687438957), rM1.P2 = c(5.02835715460001, 8.0307007906172,7.21392256382075), z.P2 = c(-4.2277468665565, -2.56777576762391,-0.787759673062059), rM1.P3 = c(5.23593818385294, 2.33831866638673,3.21908464133114), z.P3 = c(-1.12803270842405, -3.44720423923131,-2.30557614900882), rM1.P4 = c(4.81246929972659, 2.04395903547657,3.20139329165723), z.P4 = c(-2.66170005367969, -3.85522542589652,-0.669472493949494)), .Names = c("rM1.P1", "z.P1", "rM1.P2","z.P2", "rM1.P3", "z.P3", "rM1.P4", "z.P4", "rM1.P1", "z.P1","rM1.P2", "z.P2", "rM1.P3", "z.P3", "rM1.P4", "z.P4", "rM1.P1", "z.P1", "rM1.P2", "z.P2", "rM1.P3", "z.P3", "rM1.P4", "z.P4"),row.names = c("Company_A","Company_B", "Company_C"), class = "data.frame"),check.attributes=FALSE) + + checkTrue(isTRUE(test.result)) +} From noreply at r-forge.r-project.org Tue Jul 16 09:50:03 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 09:50:03 +0200 (CEST) Subject: [Eventstudies-commits] r85 - pkg Message-ID: <20130716075003.44665185621@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 09:50:03 +0200 (Tue, 16 Jul 2013) New Revision: 85 Modified: pkg/NAMESPACE Log: Added AMM functions in the namespace. Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2013-07-16 07:14:35 UTC (rev 84) +++ pkg/NAMESPACE 2013-07-16 07:50:03 UTC (rev 85) @@ -1,3 +1,9 @@ export(inference.Ecar, phys2eventtime, remap.cumsum, remap.cumprod, remap.event.reindex, ees, eesPlot) - - +export(AMM, + onefirmAMM, + firmExposures, + ARinnovations, + do.one.piece, + makeX, + lm.for.amm.exposure, + kernel.plots) From noreply at r-forge.r-project.org Tue Jul 16 09:55:37 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 09:55:37 +0200 (CEST) Subject: [Eventstudies-commits] r86 - pkg Message-ID: <20130716075537.D7E911859FA@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 09:55:37 +0200 (Tue, 16 Jul 2013) New Revision: 86 Modified: pkg/NAMESPACE Log: Removed functions from NAMESPACE which don't need to be exposed. Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2013-07-16 07:50:03 UTC (rev 85) +++ pkg/NAMESPACE 2013-07-16 07:55:37 UTC (rev 86) @@ -2,8 +2,4 @@ export(AMM, onefirmAMM, firmExposures, - ARinnovations, - do.one.piece, - makeX, - lm.for.amm.exposure, - kernel.plots) + makeX) From noreply at r-forge.r-project.org Tue Jul 16 10:10:16 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 10:10:16 +0200 (CEST) Subject: [Eventstudies-commits] r87 - pkg Message-ID: <20130716081016.7659F184CB9@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 10:10:16 +0200 (Tue, 16 Jul 2013) New Revision: 87 Modified: pkg/NAMESPACE Log: Added manyfirmsAMM function in the NAMESPACE. Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2013-07-16 07:55:37 UTC (rev 86) +++ pkg/NAMESPACE 2013-07-16 08:10:16 UTC (rev 87) @@ -1,5 +1,6 @@ export(inference.Ecar, phys2eventtime, remap.cumsum, remap.cumprod, remap.event.reindex, ees, eesPlot) export(AMM, onefirmAMM, + manyfirmsAMM, firmExposures, makeX) From noreply at r-forge.r-project.org Tue Jul 16 12:33:54 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 12:33:54 +0200 (CEST) Subject: [Eventstudies-commits] r88 - in pkg: . inst inst/tests tests Message-ID: <20130716103354.35CC1184DDE@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 12:33:53 +0200 (Tue, 16 Jul 2013) New Revision: 88 Added: pkg/inst/tests/ pkg/inst/tests/test_AMM.R pkg/inst/tests/test_eventstudy.R pkg/inst/tests/test_inr_inference.R pkg/tests/test-all.R Removed: pkg/tests/test_AMM.R pkg/tests/test_eventstudy.R pkg/tests/test_inr_inference.R pkg/tests/unit_tests.R Modified: pkg/DESCRIPTION Log: Removed RUnit test cases, using testthat now. All tests running now. Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2013-07-16 08:10:16 UTC (rev 87) +++ pkg/DESCRIPTION 2013-07-16 10:33:53 UTC (rev 88) @@ -4,7 +4,7 @@ Version: 1.1 Author: Ajay Shah, Vimal Balasubramaniam, Vikram Bahure Maintainer: Vikram Bahure -Depends: R (>= 2.12.0), zoo, xts, boot +Depends: R (>= 2.12.0), zoo, xts, boot, testthat (<= 0.7.1) Description: Implementation of short and long term event study methodology License: GPL-2 LazyLoad: yes Copied: pkg/inst/tests/test_AMM.R (from rev 86, pkg/tests/test_AMM.R) =================================================================== --- pkg/inst/tests/test_AMM.R (rev 0) +++ pkg/inst/tests/test_AMM.R 2013-07-16 10:33:53 UTC (rev 88) @@ -0,0 +1,127 @@ +context("Models") + +test_that("test.AMM", { + library(sandwich) + + load(system.file("data", "firmExposures.rda", package = "eventstudies")) + + rj <- firmExposures$Company_A + rM1 <- firmExposures$NIFTY_INDEX + rM2 <- firmExposures$usdinr + rM3 <- firmExposures$baa + + cat("Doing Testcase P2:\n") + X <- makeX(rM1, others=rM2, + switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) + a <- firmExposures(rj, X, nlags=0, verbose=FALSE) + expect_that(c(a$exposures, a$s.exposures), + equals(structure(c(0.716160223601197,-0.673093436292401, + 0.152101606133946,1.02143820457251), + .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1)) + + cat("Doing Testcase P3:\n") + X <- makeX(rM1, others=rM2, + switch.to.innov=TRUE, rM1purge=FALSE, verbose=FALSE) + a <- firmExposures(rj, X, nlags=0, verbose=FALSE) + expect_that(c(a$exposures, a$s.exposures), + equals(structure(c(0.716160223601197,-0.673093436292401, + 0.152100337597009,1.02146106755333), + .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1)) + + cat("Doing Testcase P4:\n") + a <- firmExposures(rj, X, nlags=1, verbose=FALSE) + expect_that(c(a$exposures, a$s.exposures), + equals(structure(c( 0.736264286484902, -1.450805, + 0.177929844631439, 1.646730), + .Names = c("rM1","z", "rM1", "z")),tolerance=1e-1)) + + + cat("Doing Testcase P5:\n") + X <- makeX(rM1, others=rM2, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1, verbose=FALSE) + a <- firmExposures(rj, X, nlags=1, verbose=FALSE) + expect_that(c(a$exposures, a$s.exposures), + equals(structure(c(0.7365566,-2.340171, + 0.1653025, 1.1436666), + .Names = c("rM1", "z", "rM1", "z")),tolerance=1e-1)) + + cat("Doing Testcase P6:\n") + X <- makeX(rM1, others=cbind(rM2, rM3), + switch.to.innov=c(FALSE, FALSE), rM1purge=FALSE, verbose=FALSE) + a <- firmExposures(rj, X, nlags=0, verbose=FALSE) + expect_that(c(a$exposures, a$s.exposures), + equals(structure(c(0.7230599,-0.7642377, + 0.207374104922771,0.173380799334299, + 1.01806122963342,0.467821650129292), + .Names = c("rM1", "rM2", "rM3", "rM1", "rM2", "rM3")),tolerance=1e-1)) + + cat("Doing Testcase P7:\n") + X <- makeX(rM1, others=cbind(rM2, rM3), + switch.to.innov=c(TRUE, TRUE), rM1purge=TRUE, nlags=1, verbose=FALSE) + a <- firmExposures(rj, X, nlags=1, verbose=FALSE) + expect_that(c(a$exposures, a$s.exposures), + equals(structure(c(0.7482719,-1.9468851,-0.4802211, + 0.1740678,1.2455112,0.6146619), + .Names = c("rM1", "rM2", "rM3", "rM1", "rM2", "rM3")),tolerance=1e-1)) + +################################################################################ + # # + # THE NEXT CASES TESTS THE FUNCTION FOR THREE COMPANIES FOR THREE YEARS # + # # +################################################################################ + + + cat("Doing Testcases P8:\n") + load(system.file("data", "y3c3.rda", package = "eventstudies")) + + NIFTY_INDEX <- y3c3$NIFTY_INDEX + INRUSD <- y3c3$INRUSD + Company_A <- y3c3$Company_A + Company_B <- y3c3$Company_B + Company_C <- y3c3$Company_C + + regressors <- makeX(NIFTY_INDEX, others=INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1, + dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")), verbose=FALSE) + + regressand <- cbind(Company_A,Company_B,Company_C) + + res <- manyfirmsAMM(regressand,regressors,lags=1, + dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")),periodnames=c("P1","P2","P3","P4"), + verbose=FALSE) + + expect_that(as.data.frame(res), + + equals(structure(list(rM1.P1 = c(0.756294904326272, 0.359467326140834,0.914021428042946), + z.P1 = c(-2.23264294525560, -1.05654919420689,0.296635483126946), + rM1.P2 = c(1.02094561445355, 0.988758963378838,0.879236409569888), + z.P2 = c(-4.72831391695047, -2.0508684999854,-1.02215809586573), + rM1.P3 = c(1.20585808099744, 0.676388278572118,0.530718379431386), + z.P3 = c(-1.32677083522489, -2.74055730512260, -1.50032216697694), + rM1.P4 = c(1.11331096371784, 0.437117737120777,0.663182186702262), + z.P4 = c(-2.05336868436562, -1.60350865767951,-0.466253391408585), + rM1.P1 = c(0.143617135793294, 0.263130891045529,0.154272220123111), + z.P1 = c(1.20226371286803, 1.22122136357895,1.02442932195400), + rM1.P2 = c(0.203037609116444, 0.123122376136099,0.121880488983820), + z.P2 = c(1.118400430819, 0.798694545623495,1.29755067543957), + rM1.P3 = c(0.230304109532112, 0.289262660515515,0.164866239494693), + z.P3 = c(1.17618117392934, 0.795008683829453,0.650736332270758), + rM1.P4 = c(0.231338818884745, 0.213858364836974,0.207154237634752), + z.P4 = c(0.771450066857429, 0.415931231130697,0.696448914066602), + rM1.P1 = c(5.26604920888266, 1.36611602200152,5.9247311493511), + z.P1 = c(-1.85703263049467, -0.865157804896683,0.289561687438957), + rM1.P2 = c(5.02835715460001, 8.0307007906172,7.21392256382075), + z.P2 = c(-4.2277468665565, -2.56777576762391,-0.787759673062059), + rM1.P3 = c(5.23593818385294, 2.33831866638673,3.21908464133114), + z.P3 = c(-1.12803270842405, -3.44720423923131,-2.30557614900882), + rM1.P4 = c(4.81246929972659, 2.04395903547657,3.20139329165723), + z.P4 = c(-2.66170005367969, -3.85522542589652,-0.669472493949494)), + .Names = c("rM1.P1", "z.P1", "rM1.P2","z.P2", "rM1.P3", "z.P3", + "rM1.P4", "z.P4", "rM1.P1", "z.P1","rM1.P2", "z.P2", "rM1.P3", "z.P3", + "rM1.P4", "z.P4", "rM1.P1", "z.P1", "rM1.P2", "z.P2", "rM1.P3", + "z.P3", "rM1.P4", "z.P4"), + row.names = c("Company_A","Company_B", "Company_C"), class = "data.frame"), + check.attributes=FALSE)) +}) Copied: pkg/inst/tests/test_eventstudy.R (from rev 86, pkg/tests/test_eventstudy.R) =================================================================== --- pkg/inst/tests/test_eventstudy.R (rev 0) +++ pkg/inst/tests/test_eventstudy.R 2013-07-16 10:33:53 UTC (rev 88) @@ -0,0 +1,59 @@ +context("Event study") + +test_that("test.eventstudy", { + +# An example dataset, with 3 firms -- +p <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17, 35.89, 36.19, + 37.1317, 36.7033, 37.7933, 37.8533, 285.325, 292.6, + 290.025, 286.2, 290.075, 295.05, 289.325, 285.625, + 293.7, 298.5, 289.05, 704.5438, 708.35, 735.8375, + 710.625, 711.65, 731.0125, 727.575, 715.0187, 724.2, + 713.1875, 695.1812), .Dim = c(11L, 3L), .Dimnames = + list( NULL, c("ITC", "Reliance", "Infosys")), index = + structure(c(12418, 12419, 12422, 12423, 12424, 12425, + 12426, 12429, 12430, 12431, 12432), class = "Date"), + class = "zoo") +# An example events list +eventslist <- data.frame(unit=c("ITC","Reliance","Infosys", + "ITC","Reliance","Junk"), + when=as.Date(c( + "2004-01-02", "2004-01-08", "2004-01-14", + "2005-01-15", "2004-01-01", "2005-01-01"))) +eventslist$unit <- as.character(eventslist$unit) + +# What we expect if we don't worry about width -- +rawres <- structure(list(z.e = structure(c(NA, NA, NA, NA, NA, NA, + NA, NA, 33.16, 34.0967, 35.3683, 34.46, 34.17, 35.89, 36.19, + 37.1317, 36.7033, 37.7933, 37.8533, NA, NA, NA, NA, 285.325, 292.6, + 290.025, 286.2, 290.075, 295.05, 289.325, 285.625, 293.7, 298.5, + 289.05, NA, NA, NA, NA, 704.5438, 708.35, 735.8375, 710.625, 711.65, + 731.0125, 727.575, 715.0187, 724.2, 713.1875, 695.1812, NA, NA, NA, + NA, NA, NA, NA, NA), .Dim = c(19L, 3L), .Dimnames = list( NULL, + c("1", "2", "3")), index = -9:9, class = "zoo"), outcomes = + structure(c(1L, 1L, 1L, 3L, 3L, 2L), .Label = c("success", + "unitmissing", "wrongspan" ), class = "factor")), .Names = c("z.e", + "outcomes")) + +# Check without the width handling -- +a <- phys2eventtime(p, eventslist,width=0) +expect_that(a, equals(rawres)) + +# Check with width of 1 -- +a <- phys2eventtime(p, eventslist,width=1) +expect_that(a, equals(rawres)) + +# But when we go to width=2, column 1 and 3 drop off because they have +# only 1 obs before & after the event date respectively. +a <- phys2eventtime(p, eventslist,width=2) +expect_that(a, equals(structure(list(z.e = structure(c(NA, NA, NA, NA, 285.325, + 292.6, 290.025, 286.2, 290.075, 295.05, + 289.325, 285.625, 293.7, 298.5, 289.05, + NA, NA, NA, NA), + index = -9:9, + class = "zoo"), + outcomes = structure(c(3L, 1L, 3L, 4L, 4L, 2L), + .Label = c("success", "unitmissing", + "wdatamissing", "wrongspan"), + class = "factor")), + .Names = c("z.e", "outcomes" )))) +}) Copied: pkg/inst/tests/test_inr_inference.R (from rev 86, pkg/tests/test_inr_inference.R) =================================================================== --- pkg/inst/tests/test_inr_inference.R (rev 0) +++ pkg/inst/tests/test_inr_inference.R 2013-07-16 10:33:53 UTC (rev 88) @@ -0,0 +1,31 @@ +context("Event study") + +test_that("test.inr.inference", { +library(eventstudies) + +load(system.file("data", "inr.rda", package = "eventstudies")) + +inr_returns <- diff(log(inr))[-1] + +eventslist <- data.frame(unit=rep("inr",10), + when=as.Date(c( + "2010-04-20","2010-07-02","2010-07-27", + "2010-09-16","2010-11-02","2011-01-25", + "2011-03-17","2011-05-03","2011-06-16", + "2011-07-26") + ) + ) + +event_time_data <- phys2eventtime(inr_returns,eventslist,width=10) +w <- window(event_time_data$z.e,start=-10,end=10) + +expect_that(inference.Ecar(w)[,2], + equals(c(-0.00215361156303362, -0.00040191670837042, 0.00171845148444985, + 0.00143799970419951, 0.00149260146357282, -0.00284892904228684, + 0.0013220811191847, -0.000634983205805195, 0.00115930378269389, + -0.000508755768685365, -0.00190621828611177, 0.000128303517790052, + -0.000547070723466092, 0.000463708708964017, -0.00108666428087325, + -0.00121321855159642, 0.00216769754166339, -0.000166340225607797, + 0.00117626759805196, 0.000207307545758795, 0.000602629204764948 + ))) +}) Added: pkg/tests/test-all.R =================================================================== --- pkg/tests/test-all.R (rev 0) +++ pkg/tests/test-all.R 2013-07-16 10:33:53 UTC (rev 88) @@ -0,0 +1,3 @@ +library(testthat) +library(eventstudies) +test_package("eventstudies") Deleted: pkg/tests/test_AMM.R =================================================================== --- pkg/tests/test_AMM.R 2013-07-16 08:10:16 UTC (rev 87) +++ pkg/tests/test_AMM.R 2013-07-16 10:33:53 UTC (rev 88) @@ -1,102 +0,0 @@ -test.AMM <- function() { - library(eventstudies) - library(sandwich) - - data("firmExposures",package="eventstudies") - - rj <- firmExposures$Company_A - rM1 <- firmExposures$NIFTY_INDEX - rM2 <- firmExposures$usdinr - rM3 <- firmExposures$baa - - cat("Doing Testcase P2:\n") - X <- makeX(rM1, others=rM2, - switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) - a <- firmExposures(rj, X, nlags=0, verbose=FALSE) - test.result <- all.equal(c(a$exposures, a$s.exposures), - structure(c(0.716160223601197,-0.673093436292401, - 0.152101606133946,1.02143820457251), - .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1) - checkTrue(isTRUE(test.result)) - - cat("Doing Testcase P3:\n") - X <- makeX(rM1, others=rM2, - switch.to.innov=TRUE, rM1purge=FALSE, verbose=FALSE) - a <- firmExposures(rj, X, nlags=0, verbose=FALSE) - test.result <- all.equal(c(a$exposures, a$s.exposures), - structure(c(0.716160223601197,-0.673093436292401, - 0.152100337597009,1.02146106755333), - .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1) - checkTrue(isTRUE(test.result)) - - cat("Doing Testcase P4:\n") - a <- firmExposures(rj, X, nlags=1, verbose=FALSE) - test.result <- all.equal(c(a$exposures, a$s.exposures), - structure(c( 0.736264286484902, -1.450805, - 0.177929844631439, 1.646730), - .Names = c("rM1","z", "rM1", "z")),tolerance=1e-1) - checkTrue(isTRUE(test.result)) - - cat("Doing Testcase P5:\n") - X <- makeX(rM1, others=rM2, - switch.to.innov=TRUE, rM1purge=TRUE, nlags=1, verbose=FALSE) - a <- firmExposures(rj, X, nlags=1, verbose=FALSE) - test.result <- all.equal(c(a$exposures, a$s.exposures), - structure(c(0.7365566,-2.340171, - 0.1653025, 1.1436666), - .Names = c("rM1", "z", "rM1", "z")),tolerance=1e-1) - checkTrue(isTRUE(test.result)) - - cat("Doing Testcase P6:\n") - X <- makeX(rM1, others=cbind(rM2, rM3), - switch.to.innov=c(FALSE, FALSE), rM1purge=FALSE, verbose=FALSE) - a <- firmExposures(rj, X, nlags=0, verbose=FALSE) - test.result <- all.equal(c(a$exposures, a$s.exposures), - structure(c(0.7230599,-0.7642377, - 0.207374104922771,0.173380799334299, - 1.01806122963342,0.467821650129292), - .Names = c("rM1", "rM2", "rM3", "rM1", "rM2", "rM3")),tolerance=1e-1) - checkTrue(isTRUE(test.result)) - - cat("Doing Testcase P7:\n") - X <- makeX(rM1, others=cbind(rM2, rM3), - switch.to.innov=c(TRUE, TRUE), rM1purge=TRUE, nlags=1, verbose=FALSE) - a <- firmExposures(rj, X, nlags=1, verbose=FALSE) - test.result <- all.equal(c(a$exposures, a$s.exposures), - structure(c(0.7482719,-1.9468851,-0.4802211, - 0.1740678,1.2455112,0.6146619), - .Names = c("rM1", "rM2", "rM3", "rM1", "rM2", "rM3")),tolerance=1e-1) - checkTrue(isTRUE(test.result)) - -################################################################################ - # # - # THE NEXT CASES TESTS THE FUNCTION FOR THREE COMPANIES FOR THREE YEARS # - # # -################################################################################ - - - cat("Doing Testcases P8:\n") - data("y3c3", package="eventstudies") - - NIFTY_INDEX <- y3c3$NIFTY_INDEX - INRUSD <- y3c3$INRUSD - Company_A <- y3c3$Company_A - Company_B <- y3c3$Company_B - Company_C <- y3c3$Company_C - - regressors <- makeX(NIFTY_INDEX, others=INRUSD, - switch.to.innov=TRUE, rM1purge=TRUE, nlags=1, - dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", - "2008-01-05","2009-01-03")), verbose=FALSE) - - regressand <- cbind(Company_A,Company_B,Company_C) - - res <- manyfirmsAMM(regressand,regressors,lags=1, - dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", - "2008-01-05","2009-01-03")),periodnames=c("P1","P2","P3","P4"), - verbose=FALSE) - - test.result <- all.equal(as.data.frame(res),structure(list(rM1.P1 = c(0.756294904326272, 0.359467326140834,0.914021428042946), z.P1 = c(-2.23264294525560, -1.05654919420689,0.296635483126946), rM1.P2 = c(1.02094561445355, 0.988758963378838,0.879236409569888), z.P2 = c(-4.72831391695047, -2.0508684999854,-1.02215809586573), rM1.P3 = c(1.20585808099744, 0.676388278572118,0.530718379431386), z.P3 = c(-1.32677083522489, -2.74055730512260, -1.50032216697694), rM1.P4 = c(1.11331096371784, 0.437117737120777,0.663182186702262), z.P4 = c(-2.05336868436562, -1.60350865767951,-0.466253391408585), rM1.P1 = c(0.143617135793294, 0.263130891045529,0.154272220123111), z.P1 = c(1.20226371286803, 1.22122136357895,1.02442932195400), rM1.P2 = c(0.203037609116444, 0.123122376136099,0.121880488983820), z.P2 = c(1.118400430819, 0.798694545623495,1.29755067543957), rM1.P3 = c(0.230304109532112, 0.289262660515515,0.164866239494693), z.P3 = c(1.17618117392934, 0.795008683829453,0.650736332270758), rM1.P4 = c(0.231338818884745, 0.213858364836974,0.207154237634752), z.P4 = c(0.771450066857429, 0.415931231130697,0.696448914066602), rM1.P1 = c(5.26604920888266, 1.36611602200152,5.9247311493511), z.P1 = c(-1.85703263049467, -0.865157804896683,0.289561687438957), rM1.P2 = c(5.02835715460001, 8.0307007906172,7.21392256382075), z.P2 = c(-4.2277468665565, -2.56777576762391,-0.787759673062059), rM1.P3 = c(5.23593818385294, 2.33831866638673,3.21908464133114), z.P3 = c(-1.12803270842405, -3.44720423923131,-2.30557614900882), rM1.P4 = c(4.81246929972659, 2.04395903547657,3.20139329165723), z.P4 = c(-2.66170005367969, -3.85522542589652,-0.669472493949494)), .Names = c("rM1.P1", "z.P1", "rM1.P2","z.P2", "rM1.P3", "z.P3", "rM1.P4", "z.P4", "rM1.P1", "z.P1","rM1.P2", "z.P2", "rM1.P3", "z.P3", "rM1.P4", "z.P4", "rM1.P1", "z.P1", "rM1.P2", "z.P2", "rM1.P3", "z.P3", "rM1.P4", "z.P4"),row.names = c("Company_A","Company_B", "Company_C"), class = "data.frame"),check.attributes=FALSE) - - checkTrue(isTRUE(test.result)) -} Deleted: pkg/tests/test_eventstudy.R =================================================================== --- pkg/tests/test_eventstudy.R 2013-07-16 08:10:16 UTC (rev 87) +++ pkg/tests/test_eventstudy.R 2013-07-16 10:33:53 UTC (rev 88) @@ -1,66 +0,0 @@ -library(eventstudies) - -test.eventstudy <- function() { -# An example dataset, with 3 firms -- -p <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17, 35.89, 36.19, - 37.1317, 36.7033, 37.7933, 37.8533, 285.325, 292.6, - 290.025, 286.2, 290.075, 295.05, 289.325, 285.625, - 293.7, 298.5, 289.05, 704.5438, 708.35, 735.8375, - 710.625, 711.65, 731.0125, 727.575, 715.0187, 724.2, - 713.1875, 695.1812), .Dim = c(11L, 3L), .Dimnames = - list( NULL, c("ITC", "Reliance", "Infosys")), index = - structure(c(12418, 12419, 12422, 12423, 12424, 12425, - 12426, 12429, 12430, 12431, 12432), class = "Date"), - class = "zoo") -# An example events list -eventslist <- data.frame(unit=c("ITC","Reliance","Infosys", - "ITC","Reliance","Junk"), - when=as.Date(c( - "2004-01-02", "2004-01-08", "2004-01-14", - "2005-01-15", "2004-01-01", "2005-01-01"))) -eventslist$unit <- as.character(eventslist$unit) - -# What we expect if we don't worry about width -- -rawres <- structure(list(z.e = structure(c(NA, NA, NA, NA, NA, NA, - NA, NA, 33.16, 34.0967, 35.3683, 34.46, 34.17, 35.89, 36.19, - 37.1317, 36.7033, 37.7933, 37.8533, NA, NA, NA, NA, 285.325, 292.6, - 290.025, 286.2, 290.075, 295.05, 289.325, 285.625, 293.7, 298.5, - 289.05, NA, NA, NA, NA, 704.5438, 708.35, 735.8375, 710.625, 711.65, - 731.0125, 727.575, 715.0187, 724.2, 713.1875, 695.1812, NA, NA, NA, - NA, NA, NA, NA, NA), .Dim = c(19L, 3L), .Dimnames = list( NULL, - c("1", "2", "3")), index = -9:9, class = "zoo"), outcomes = - structure(c(1L, 1L, 1L, 3L, 3L, 2L), .Label = c("success", - "unitmissing", "wrongspan" ), class = "factor")), .Names = c("z.e", - "outcomes")) - -# Check without the width handling -- -a <- phys2eventtime(p, eventslist,width=0) -all.equal(a, rawres) -# Check with width of 1 -- -a <- phys2eventtime(p, eventslist,width=1) -all.equal(a, rawres) - -# But when we go to width=2, column 1 and 3 drop off because they have -# only 1 obs before & after the event date respectively. -a <- phys2eventtime(p, eventslist,width=2) -test.result <- all.equal(a, structure(list(z.e = structure(c(NA, NA, NA, NA, 285.325, - 292.6, 290.025, 286.2, 290.075, 295.05, - 289.325, 285.625, 293.7, 298.5, 289.05, - NA, NA, NA, NA), index = -9:9, class = - "zoo"), outcomes = structure(c(3L, 1L, - 3L, 4L, 4L, 2L), .Label = c("success", - "unitmissing", "wdatamissing", - "wrongspan"), class = "factor")), .Names - = c("z.e", "outcomes" ))) -s <- structure(list(z.e = structure(c(NA, NA, NA, NA, 285.325, - 292.6, 290.025, 286.2, 290.075, 295.05, - 289.325, 285.625, 293.7, 298.5, 289.05, - NA, NA, NA, NA), index = -9:9, class = - "zoo"), outcomes = structure(c(3L, 1L, - 3L, 4L, 4L, 2L), .Label = c("success", - "unitmissing", "wdatamissing", - "wrongspan"), class = "factor")), .Names - = c("z.e", "outcomes" )) - -checkTrue(isTRUE(test.result)) -} Deleted: pkg/tests/test_inr_inference.R =================================================================== --- pkg/tests/test_inr_inference.R 2013-07-16 08:10:16 UTC (rev 87) +++ pkg/tests/test_inr_inference.R 2013-07-16 10:33:53 UTC (rev 88) @@ -1,31 +0,0 @@ -library(eventstudies) - -test.inr.inference <- function() { -data(inr) - -inr_returns <- diff(log(inr))[-1] - -eventslist <- data.frame(unit=rep("inr",10), - when=as.Date(c( - "2010-04-20","2010-07-02","2010-07-27", - "2010-09-16","2010-11-02","2011-01-25", - "2011-03-17","2011-05-03","2011-06-16", - "2011-07-26") - ) - ) - -event_time_data <- phys2eventtime(inr_returns,eventslist,width=10) -w <- window(event_time_data$z.e,start=-10,end=10) - -test.result <- all.equal(inference.Ecar(w)[,2], - c(-0.00215361156303362, -0.00040191670837042, 0.00171845148444985, - 0.00143799970419951, 0.00149260146357282, -0.00284892904228684, - 0.0013220811191847, -0.000634983205805195, 0.00115930378269389, - -0.000508755768685365, -0.00190621828611177, 0.000128303517790052, - -0.000547070723466092, 0.000463708708964017, -0.00108666428087325, - -0.00121321855159642, 0.00216769754166339, -0.000166340225607797, - 0.00117626759805196, 0.000207307545758795, 0.000602629204764948 - )) - -checkTrue(isTRUE(test.result)) -} Deleted: pkg/tests/unit_tests.R =================================================================== --- pkg/tests/unit_tests.R 2013-07-16 08:10:16 UTC (rev 87) +++ pkg/tests/unit_tests.R 2013-07-16 10:33:53 UTC (rev 88) @@ -1,9 +0,0 @@ -library(RUnit) - -testsuite <- defineTestSuite("Event Studies Test Suite", - dirs = ".", - testFileRegexp = "^test_.*\\.R$", - testFuncRegexp = "^.*$" - ) - -testresult <- runTestSuite(testsuite) From noreply at r-forge.r-project.org Tue Jul 16 12:51:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 12:51:59 +0200 (CEST) Subject: [Eventstudies-commits] r89 - in pkg: R inst/tests Message-ID: <20130716105159.6EA81185A1A@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 12:51:59 +0200 (Tue, 16 Jul 2013) New Revision: 89 Modified: pkg/R/AMM.R pkg/inst/tests/test_AMM.R pkg/inst/tests/test_eventstudy.R Log: Did some cleanup on the testing output Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-16 10:33:53 UTC (rev 88) +++ pkg/R/AMM.R 2013-07-16 10:51:59 UTC (rev 89) @@ -163,7 +163,6 @@ s.exposures=rep(NA,ncol(regressors))) for(i in 1:ncol(regressand)){ - cat("Doing",colnames(regressand)[i]) if (verbose) {cat ("Doing", colnames(regressand)[i])} rj <- regressand[,i] dataset <- cbind(rj, regressors) # This is the full time-series @@ -283,7 +282,6 @@ # The workhorse called by makeX to return a nice matrix of RHS # variables to be used in an analysis. do.one.piece <- function(rM1, others, switch.to.innov, rM1purge, nlags, verbose=FALSE) { - cat(" do.one.piece invocation\n") thedates <- index(rM1) if (verbose) { cat(" Doing work for period from ", Modified: pkg/inst/tests/test_AMM.R =================================================================== --- pkg/inst/tests/test_AMM.R 2013-07-16 10:33:53 UTC (rev 88) +++ pkg/inst/tests/test_AMM.R 2013-07-16 10:51:59 UTC (rev 89) @@ -1,4 +1,4 @@ -context("Models") +context("AMM") test_that("test.AMM", { library(sandwich) @@ -10,7 +10,7 @@ rM2 <- firmExposures$usdinr rM3 <- firmExposures$baa - cat("Doing Testcase P2:\n") + cat("\nDoing Testcase P2") X <- makeX(rM1, others=rM2, switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) a <- firmExposures(rj, X, nlags=0, verbose=FALSE) @@ -19,7 +19,7 @@ 0.152101606133946,1.02143820457251), .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1)) - cat("Doing Testcase P3:\n") + cat("\nDoing Testcase P3") X <- makeX(rM1, others=rM2, switch.to.innov=TRUE, rM1purge=FALSE, verbose=FALSE) a <- firmExposures(rj, X, nlags=0, verbose=FALSE) @@ -28,7 +28,7 @@ 0.152100337597009,1.02146106755333), .Names = c("rM1", "z", "rM1", "z")), tolerance=1e-1)) - cat("Doing Testcase P4:\n") + cat("\nDoing Testcase P4") a <- firmExposures(rj, X, nlags=1, verbose=FALSE) expect_that(c(a$exposures, a$s.exposures), equals(structure(c( 0.736264286484902, -1.450805, @@ -36,7 +36,7 @@ .Names = c("rM1","z", "rM1", "z")),tolerance=1e-1)) - cat("Doing Testcase P5:\n") + cat("\nDoing Testcase P5") X <- makeX(rM1, others=rM2, switch.to.innov=TRUE, rM1purge=TRUE, nlags=1, verbose=FALSE) a <- firmExposures(rj, X, nlags=1, verbose=FALSE) @@ -45,7 +45,7 @@ 0.1653025, 1.1436666), .Names = c("rM1", "z", "rM1", "z")),tolerance=1e-1)) - cat("Doing Testcase P6:\n") + cat("\nDoing Testcase P6") X <- makeX(rM1, others=cbind(rM2, rM3), switch.to.innov=c(FALSE, FALSE), rM1purge=FALSE, verbose=FALSE) a <- firmExposures(rj, X, nlags=0, verbose=FALSE) @@ -55,7 +55,7 @@ 1.01806122963342,0.467821650129292), .Names = c("rM1", "rM2", "rM3", "rM1", "rM2", "rM3")),tolerance=1e-1)) - cat("Doing Testcase P7:\n") + cat("\nDoing Testcase P7") X <- makeX(rM1, others=cbind(rM2, rM3), switch.to.innov=c(TRUE, TRUE), rM1purge=TRUE, nlags=1, verbose=FALSE) a <- firmExposures(rj, X, nlags=1, verbose=FALSE) @@ -71,7 +71,7 @@ ################################################################################ - cat("Doing Testcases P8:\n") + cat("\nDoing Testcases P8") load(system.file("data", "y3c3.rda", package = "eventstudies")) NIFTY_INDEX <- y3c3$NIFTY_INDEX Modified: pkg/inst/tests/test_eventstudy.R =================================================================== --- pkg/inst/tests/test_eventstudy.R 2013-07-16 10:33:53 UTC (rev 88) +++ pkg/inst/tests/test_eventstudy.R 2013-07-16 10:51:59 UTC (rev 89) @@ -1,4 +1,4 @@ -context("Event study") +context("phys2eventtime") test_that("test.eventstudy", { @@ -34,16 +34,17 @@ "unitmissing", "wrongspan" ), class = "factor")), .Names = c("z.e", "outcomes")) -# Check without the width handling -- +cat("\nCheck without width handling ") a <- phys2eventtime(p, eventslist,width=0) expect_that(a, equals(rawres)) -# Check with width of 1 -- +cat("\nCheck with width of 1 ") a <- phys2eventtime(p, eventslist,width=1) expect_that(a, equals(rawres)) # But when we go to width=2, column 1 and 3 drop off because they have # only 1 obs before & after the event date respectively. +cat("\nCheck with width of 2 ") a <- phys2eventtime(p, eventslist,width=2) expect_that(a, equals(structure(list(z.e = structure(c(NA, NA, NA, NA, 285.325, 292.6, 290.025, 286.2, 290.075, 295.05, From noreply at r-forge.r-project.org Tue Jul 16 12:52:39 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 12:52:39 +0200 (CEST) Subject: [Eventstudies-commits] r90 - pkg Message-ID: <20130716105239.89820184DDE@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 12:52:39 +0200 (Tue, 16 Jul 2013) New Revision: 90 Modified: pkg/DESCRIPTION Log: Removed version dependency of testthat Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2013-07-16 10:51:59 UTC (rev 89) +++ pkg/DESCRIPTION 2013-07-16 10:52:39 UTC (rev 90) @@ -4,7 +4,7 @@ Version: 1.1 Author: Ajay Shah, Vimal Balasubramaniam, Vikram Bahure Maintainer: Vikram Bahure -Depends: R (>= 2.12.0), zoo, xts, boot, testthat (<= 0.7.1) +Depends: R (>= 2.12.0), zoo, xts, boot, testthat Description: Implementation of short and long term event study methodology License: GPL-2 LazyLoad: yes From noreply at r-forge.r-project.org Tue Jul 16 12:59:44 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 12:59:44 +0200 (CEST) Subject: [Eventstudies-commits] r91 - pkg/inst/tests Message-ID: <20130716105944.EAB8E18532F@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 12:59:44 +0200 (Tue, 16 Jul 2013) New Revision: 91 Modified: pkg/inst/tests/test_eventstudy.R pkg/inst/tests/test_inr_inference.R Log: Fixed test cases names Modified: pkg/inst/tests/test_eventstudy.R =================================================================== --- pkg/inst/tests/test_eventstudy.R 2013-07-16 10:52:39 UTC (rev 90) +++ pkg/inst/tests/test_eventstudy.R 2013-07-16 10:59:44 UTC (rev 91) @@ -1,6 +1,6 @@ context("phys2eventtime") -test_that("test.eventstudy", { +test_that("test.phys2eventtime", { # An example dataset, with 3 firms -- p <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17, 35.89, 36.19, Modified: pkg/inst/tests/test_inr_inference.R =================================================================== --- pkg/inst/tests/test_inr_inference.R 2013-07-16 10:52:39 UTC (rev 90) +++ pkg/inst/tests/test_inr_inference.R 2013-07-16 10:59:44 UTC (rev 91) @@ -1,4 +1,4 @@ -context("Event study") +context("INR Inference") test_that("test.inr.inference", { library(eventstudies) From noreply at r-forge.r-project.org Tue Jul 16 13:18:47 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 13:18:47 +0200 (CEST) Subject: [Eventstudies-commits] r92 - pkg/R Message-ID: <20130716111847.C0F0618479F@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 13:18:47 +0200 (Tue, 16 Jul 2013) New Revision: 92 Modified: pkg/R/eventstudy.R Log: Added code to handle levels in the main wrapper. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2013-07-16 10:59:44 UTC (rev 91) +++ pkg/R/eventstudy.R 2013-07-16 11:18:47 UTC (rev 92) @@ -5,6 +5,7 @@ to.remap = TRUE, remap = "cumsum", to.plot = TRUE, + levels = FALSE, ...) { # type = "marketResiduals", "excessReturn", "AMM", "None" if (type == "None" && !is.null(inputData)) { @@ -13,6 +14,10 @@ stop("inputData or \"None\" type missing") } + if (levels == TRUE) { + inputData <- diff(log(inputData)) * 100 + } + ### Run models ## AMM if (type == "AMM") { From noreply at r-forge.r-project.org Tue Jul 16 13:20:57 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 13:20:57 +0200 (CEST) Subject: [Eventstudies-commits] r93 - pkg/R Message-ID: <20130716112057.B01F918479F@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 13:20:57 +0200 (Tue, 16 Jul 2013) New Revision: 93 Modified: pkg/R/AMM.R Log: Removed default verbosity from makeX Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-16 11:18:47 UTC (rev 92) +++ pkg/R/AMM.R 2013-07-16 11:20:57 UTC (rev 93) @@ -345,7 +345,7 @@ rM1purge=TRUE, nlags=5, dates=NULL, - verbose=TRUE) { + verbose=FALSE) { if (verbose) {cat("0. Checking args\n")} stopifnot(all.equal(index(rM1), index(others)), length(switch.to.innov)==NCOL(others)) From noreply at r-forge.r-project.org Tue Jul 16 15:55:56 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 15:55:56 +0200 (CEST) Subject: [Eventstudies-commits] r94 - in pkg: . R data inst/tests man Message-ID: <20130716135557.0E5C018514A@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 15:55:56 +0200 (Tue, 16 Jul 2013) New Revision: 94 Added: pkg/data/firmExposuresData.rda pkg/data/mmData.rda pkg/man/mmData.Rd pkg/man/y3c3.Rd Removed: pkg/data/firmExposures.rda pkg/data/marketmodelData.rda pkg/man/ammData.Rd Modified: pkg/DESCRIPTION pkg/NAMESPACE pkg/R/AMM.R pkg/R/eventstudy.R pkg/inst/tests/test_AMM.R pkg/man/AMM.Rd pkg/man/excessReturn.Rd pkg/man/firmExposures.Rd pkg/man/firmExposuresData.Rd pkg/man/makeX.Rd pkg/man/manyfirmsAMM.Rd pkg/man/marketResidual.Rd pkg/man/onefirmAMM.Rd Log: Lots of changes, R CMD checks passing now. Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/DESCRIPTION 2013-07-16 13:55:56 UTC (rev 94) @@ -4,7 +4,7 @@ Version: 1.1 Author: Ajay Shah, Vimal Balasubramaniam, Vikram Bahure Maintainer: Vikram Bahure -Depends: R (>= 2.12.0), zoo, xts, boot, testthat +Depends: R (>= 2.12.0), zoo, xts, boot, testthat, sandwich Description: Implementation of short and long term event study methodology License: GPL-2 LazyLoad: yes Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/NAMESPACE 2013-07-16 13:55:56 UTC (rev 94) @@ -1,4 +1,7 @@ export(inference.Ecar, phys2eventtime, remap.cumsum, remap.cumprod, remap.event.reindex, ees, eesPlot) +export(marketResidual, + excessReturn + ) export(AMM, onefirmAMM, manyfirmsAMM, Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/R/AMM.R 2013-07-16 13:55:56 UTC (rev 94) @@ -96,7 +96,7 @@ ####################### # AMM for one firm ####################### -onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL,residual=FALSE){ +onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL,residual=TRUE){ exposures <- data.frame(matrix(NA,ncol=ncol(X),nrow=(length(dates)-1))) colnames(exposures) <- colnames(X) sds <- exposures Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/R/eventstudy.R 2013-07-16 13:55:56 UTC (rev 94) @@ -1,13 +1,13 @@ eventstudy <- function(inputData = NULL, eventList, width = 10, - type = "marketResiduals", + type = "marketResidual", to.remap = TRUE, remap = "cumsum", to.plot = TRUE, levels = FALSE, ...) { - # type = "marketResiduals", "excessReturn", "AMM", "None" + # type = "marketResidual", "excessReturn", "AMM", "None" if (type == "None" && !is.null(inputData)) { outputModel <- inputData } else { @@ -24,9 +24,9 @@ outputModel <- AMM(...) } - ## marketResiduals - if (type == "marketResiduals") { - outputModel <- marketResiduals(...) + ## marketResidual + if (type == "marketResidual") { + outputModel <- marketResidual(...) } ## excessReturn Deleted: pkg/data/firmExposures.rda =================================================================== (Binary files differ) Copied: pkg/data/firmExposuresData.rda (from rev 86, pkg/data/firmExposures.rda) =================================================================== (Binary files differ) Deleted: pkg/data/marketmodelData.rda =================================================================== (Binary files differ) Copied: pkg/data/mmData.rda (from rev 86, pkg/data/marketmodelData.rda) =================================================================== (Binary files differ) Modified: pkg/inst/tests/test_AMM.R =================================================================== --- pkg/inst/tests/test_AMM.R 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/inst/tests/test_AMM.R 2013-07-16 13:55:56 UTC (rev 94) @@ -1,14 +1,12 @@ context("AMM") test_that("test.AMM", { - library(sandwich) - - load(system.file("data", "firmExposures.rda", package = "eventstudies")) + load(system.file("data", "firmExposuresData.rda", package = "eventstudies")) - rj <- firmExposures$Company_A - rM1 <- firmExposures$NIFTY_INDEX - rM2 <- firmExposures$usdinr - rM3 <- firmExposures$baa + rj <- firmExposuresData$Company_A + rM1 <- firmExposuresData$NIFTY_INDEX + rM2 <- firmExposuresData$usdinr + rM3 <- firmExposuresData$baa cat("\nDoing Testcase P2") X <- makeX(rM1, others=rM2, Modified: pkg/man/AMM.Rd =================================================================== --- pkg/man/AMM.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/AMM.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -7,16 +7,17 @@ } \usage{ -AMM(amm.type=c("one.firm","manyfirms","firmExposures"), ...) +AMM(amm.type=NULL, ...) } \arguments{ - \item{amm.type}{Type of AMM to be performed: On one firm or many firms or just firm exposure} - + \item{amm.type}{Type of AMM to be performed: On one firm "onefirm" or + just firm exposure "firmExposures"} + \item{...}{Accepts specific arguments for the model.} } -\value{ The function returns the exposures, HAC adjusted standard +\value{The function returns the exposures, HAC adjusted standard errors, the number of lags used, and the residuals from the fitted - model. + model. Default is NULL. \item{exposures}{This contains the exposure estimates for the firm j} @@ -37,7 +38,7 @@ \examples{ # Create RHS before running AMM() -data("ammData") +data("y3c3") NIFTY_INDEX <- y3c3$NIFTY_INDEX INRUSD <- y3c3$INRUSD Company_A <- y3c3$Company_A @@ -53,15 +54,6 @@ "2008-01-05","2009-01-03")), rM1=NIFTY_INDEX, others=INRUSD, switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) - -# Many firm -mf<- AMM(amm.type="manyfirm",regressand, - lags=NA, nlags=NA, - verbose=TRUE, - dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", - "2008-01-05","2009-01-03")),periodnames=c("P1","P2","P3","P4"), - rM1=NIFTY_INDEX, others=INRUSD, - switch.to.innov=TRUE, rM1purge=TRUE) } \keyword{AMM} \ No newline at end of file Deleted: pkg/man/ammData.Rd =================================================================== --- pkg/man/ammData.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/ammData.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -1,17 +0,0 @@ -\name{ammData} -\alias{ammData} - - -\title{Three years and three random companies} - -\description{Data for testing and examples in the package} - -\usage{data(ammData)} - -\examples{ -library(zoo) -data(ammData) -str(y3c3) -} - -\keyword{ammData} \ No newline at end of file Modified: pkg/man/excessReturn.Rd =================================================================== --- pkg/man/excessReturn.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/excessReturn.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -15,12 +15,12 @@ \item{market.name}{It is the market (index) column name in the data object} } -\value{ Excess market return} +\value{Excess market return} \author{Vikram Bahure} \examples{ -data(marketmodelData) +data(mmData) er.result <- excessReturn(firm.name="ranbaxyacp",market.name="nifty", data.object=mmData) Modified: pkg/man/firmExposures.Rd =================================================================== --- pkg/man/firmExposures.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/firmExposures.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -59,10 +59,10 @@ \examples{ # firmExposures data("firmExposuresData") -rj <- test$Company_A -rM1 <- test$NIFTY_INDEX -rM2 <- test$usdinr -rM3 <- test$baa +rj <- firmExposuresData$Company_A +rM1 <- firmExposuresData$NIFTY_INDEX +rM2 <- firmExposuresData$usdinr +rM3 <- firmExposuresData$baa X <- makeX(rM1, others=rM2, switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) a <- firmExposures(rj, X, nlags=0, verbose=FALSE) Modified: pkg/man/firmExposuresData.Rd =================================================================== --- pkg/man/firmExposuresData.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/firmExposuresData.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -13,7 +13,7 @@ \examples{ library(zoo) data(firmExposuresData) -str(test) +str(firmExposuresData) } \keyword{firmExposuresData} \ No newline at end of file Modified: pkg/man/makeX.Rd =================================================================== --- pkg/man/makeX.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/makeX.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -11,7 +11,7 @@ } \usage{ -makeX(rM1, others, switch.to.innov = rep(TRUE, NCOL(others)), rM1purge = TRUE, nlags = 5, dates = NULL, verbose = TRUE) +makeX(rM1, others, switch.to.innov = rep(TRUE, NCOL(others)), rM1purge = TRUE, nlags = 5, dates = NULL, verbose = FALSE) } \arguments{ @@ -61,18 +61,15 @@ \author{Ajay Shah, Vimal Balasubramaniam} -\seealso{ \code{\link{do.one.piece}}} - \examples{ # makeX data("firmExposuresData") -rj <- test$Company_A -rM1 <- test$NIFTY_INDEX -rM2 <- test$usdinr -rM3 <- test$baa +rj <- firmExposuresData$Company_A +rM1 <- firmExposuresData$NIFTY_INDEX +rM2 <- firmExposuresData$usdinr +rM3 <- firmExposuresData$baa X <- makeX(rM1, others=rM2, switch.to.innov=FALSE, rM1purge=FALSE, verbose=FALSE) } \keyword{makeX} -\keyword{do.one.piece} \ No newline at end of file Modified: pkg/man/manyfirmsAMM.Rd =================================================================== --- pkg/man/manyfirmsAMM.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/manyfirmsAMM.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -43,7 +43,7 @@ \examples{ # Running manyfirmsAMM() involves as many steps as working with onefirmAMM. -data("ammData",package="amm") +data("y3c3", package="eventstudies") NIFTY_INDEX <- y3c3$NIFTY_INDEX INRUSD <- y3c3$INRUSD Company_A <- y3c3$Company_A Modified: pkg/man/marketResidual.Rd =================================================================== --- pkg/man/marketResidual.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/marketResidual.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -22,7 +22,7 @@ \author{Vikram Bahure} \examples{ -data(marketmodelData) +data(mmData) # Forumla for market model mm.formula <- paste("ranbaxyacp","~","nifty","+","drug",sep="") # Extracting market residual Added: pkg/man/mmData.Rd =================================================================== --- pkg/man/mmData.Rd (rev 0) +++ pkg/man/mmData.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -0,0 +1,19 @@ +\name{mmData} +\alias{mmData} + + +\title{Data for testing the market model and examples therein} + +\description{This is a zoo data that is used for testing purposes} + +\usage{data(mmData)} + +\author{Vikram Bahure} + +\examples{ +library(zoo) +data(mmData) +str(mmData) +} + +\keyword{mmData} \ No newline at end of file Modified: pkg/man/onefirmAMM.Rd =================================================================== --- pkg/man/onefirmAMM.Rd 2013-07-16 11:20:57 UTC (rev 93) +++ pkg/man/onefirmAMM.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -10,7 +10,7 @@ } \usage{ -onefirmAMM(rj, X, nlags = NA, verbose = FALSE, dates) +onefirmAMM(rj, X, nlags = NA, verbose = FALSE, dates = NULL, residual = TRUE) } \arguments{ @@ -29,7 +29,9 @@ } \item{dates}{Default is NULL. If no dates are mentioned, onefirmAMM does what firmExposures() would do, i.e., estimate exposures for the full time period. - } + } + \item{residual}{Returns AMM Residuals if TRUE, AMM exposure + otherwise. Defaults to TRUE.} } \value{ The function returns the exposures, HAC adjusted standard errors, the number of lags used, and the residuals from the fitted @@ -42,7 +44,7 @@ \examples{ # Create RHS before running onefirmAMM() -data("ammData") +data("y3c3") NIFTY_INDEX <- y3c3$NIFTY_INDEX INRUSD <- y3c3$INRUSD Company_A <- y3c3$Company_A Copied: pkg/man/y3c3.Rd (from rev 86, pkg/man/ammData.Rd) =================================================================== --- pkg/man/y3c3.Rd (rev 0) +++ pkg/man/y3c3.Rd 2013-07-16 13:55:56 UTC (rev 94) @@ -0,0 +1,17 @@ +\name{y3c3} +\alias{y3c3} + + +\title{Three years and three random companies} + +\description{Data for testing and examples in the package} + +\usage{data(y3c3)} + +\examples{ +library(zoo) +data(y3c3) +str(y3c3) +} + +\keyword{y3c3} \ No newline at end of file From noreply at r-forge.r-project.org Tue Jul 16 16:07:04 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 16 Jul 2013 16:07:04 +0200 (CEST) Subject: [Eventstudies-commits] r95 - pkg/man Message-ID: <20130716140704.7A2E71853B3@r-forge.r-project.org> Author: chiraganand Date: 2013-07-16 16:07:04 +0200 (Tue, 16 Jul 2013) New Revision: 95 Modified: pkg/man/eventstudy-package.Rd Log: Fixed package name in the manual and provided latest information. Modified: pkg/man/eventstudy-package.Rd =================================================================== --- pkg/man/eventstudy-package.Rd 2013-07-16 13:55:56 UTC (rev 94) +++ pkg/man/eventstudy-package.Rd 2013-07-16 14:07:04 UTC (rev 95) @@ -1,5 +1,5 @@ -\name{eventstudy-package} -\alias{eventstudy} +\name{eventstudies-package} +\alias{eventstudies} \docType{package} \title{ @@ -12,10 +12,10 @@ \details{ \tabular{ll}{ -Package: \tab eventstudy\cr +Package: \tab eventstudies\cr Type: \tab Package\cr -Version: \tab 1.0\cr -Date: \tab 2013-04-04\cr +Version: \tab 1.1\cr +Date: \tab 2013-07-16\cr License: \tab GPL 2\cr LazyLoad: \tab yes\cr } From noreply at r-forge.r-project.org Mon Jul 22 11:29:59 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 11:29:59 +0200 (CEST) Subject: [Eventstudies-commits] r96 - pkg/inst/tests Message-ID: <20130722092959.C78D3185933@r-forge.r-project.org> Author: vikram Date: 2013-07-22 11:29:59 +0200 (Mon, 22 Jul 2013) New Revision: 96 Added: pkg/inst/tests/test_marketresiduals.R Modified: pkg/inst/tests/test_inr_inference.R Log: Added market residual test case Modified: pkg/inst/tests/test_inr_inference.R =================================================================== --- pkg/inst/tests/test_inr_inference.R 2013-07-16 14:07:04 UTC (rev 95) +++ pkg/inst/tests/test_inr_inference.R 2013-07-22 09:29:59 UTC (rev 96) @@ -3,7 +3,7 @@ test_that("test.inr.inference", { library(eventstudies) -load(system.file("data", "inr.rda", package = "eventstudies")) +load(system.file("data", "inr.rda",package = "eventstudies")) inr_returns <- diff(log(inr))[-1] Added: pkg/inst/tests/test_marketresiduals.R =================================================================== --- pkg/inst/tests/test_marketresiduals.R (rev 0) +++ pkg/inst/tests/test_marketresiduals.R 2013-07-22 09:29:59 UTC (rev 96) @@ -0,0 +1,17 @@ +context("Market residuals") + +test_that("test.market.residuals", { +library(eventstudies) + +load(system.file("data", "inr.rda", package = "eventstudies")) + +mm.formula <- paste("ranbaxyacp","~","nifty",sep="") +mm.result <- marketResidual(mm.formula=mm.formula,data.object=mmData) + +# Calculating manually +result <- lm(ranbaxyacp ~ nifty, data=mmData) +resid.res <- xts(result$resid,as.Date(attr(result$resid,"names"))) + +expect_that(mm.result,equals(resid.res)) + +}) From noreply at r-forge.r-project.org Mon Jul 22 11:39:42 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 22 Jul 2013 11:39:42 +0200 (CEST) Subject: [Eventstudies-commits] r97 - pkg/inst/tests Message-ID: <20130722093942.59E26185140@r-forge.r-project.org> Author: vikram Date: 2013-07-22 11:39:42 +0200 (Mon, 22 Jul 2013) New Revision: 97 Modified: pkg/inst/tests/test_marketresiduals.R Log: Minor correction. Test cases are working fine. Modified: pkg/inst/tests/test_marketresiduals.R =================================================================== --- pkg/inst/tests/test_marketresiduals.R 2013-07-22 09:29:59 UTC (rev 96) +++ pkg/inst/tests/test_marketresiduals.R 2013-07-22 09:39:42 UTC (rev 97) @@ -3,7 +3,7 @@ test_that("test.market.residuals", { library(eventstudies) -load(system.file("data", "inr.rda", package = "eventstudies")) +load(system.file("data", "mmData.rda", package = "eventstudies")) mm.formula <- paste("ranbaxyacp","~","nifty",sep="") mm.result <- marketResidual(mm.formula=mm.formula,data.object=mmData) From noreply at r-forge.r-project.org Tue Jul 23 11:27:36 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 11:27:36 +0200 (CEST) Subject: [Eventstudies-commits] r98 - in pkg: . R man Message-ID: <20130723092736.56D75183B6A@r-forge.r-project.org> Author: vikram Date: 2013-07-23 11:27:35 +0200 (Tue, 23 Jul 2013) New Revision: 98 Added: pkg/R/inference.bootstrap.R pkg/man/eventstudy.Rd pkg/man/inference.bootstrap.Rd pkg/man/inference.wilcox.Rd Removed: pkg/R/inference.Ecar.R pkg/man/inference.Ecar.Rd Modified: pkg/DESCRIPTION pkg/NAMESPACE pkg/R/eventstudy.R Log: Added wilcox non parametric test, changed inference.Ecar to inference.bootstrap, added man page for eventstudy function and required changes Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2013-07-22 09:39:42 UTC (rev 97) +++ pkg/DESCRIPTION 2013-07-23 09:27:35 UTC (rev 98) @@ -4,7 +4,7 @@ Version: 1.1 Author: Ajay Shah, Vimal Balasubramaniam, Vikram Bahure Maintainer: Vikram Bahure -Depends: R (>= 2.12.0), zoo, xts, boot, testthat, sandwich +Depends: R (>= 2.12.0), zoo, xts, boot, testthat, sandwich, exactRankTests Description: Implementation of short and long term event study methodology License: GPL-2 LazyLoad: yes Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2013-07-22 09:39:42 UTC (rev 97) +++ pkg/NAMESPACE 2013-07-23 09:27:35 UTC (rev 98) @@ -1,4 +1,5 @@ -export(inference.Ecar, phys2eventtime, remap.cumsum, remap.cumprod, remap.event.reindex, ees, eesPlot) +export(inference.bootstrap, inference.wilcox, phys2eventtime, + remap.cumsum, remap.cumprod, remap.event.reindex, ees, eesPlot) export(marketResidual, excessReturn ) Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2013-07-22 09:39:42 UTC (rev 97) +++ pkg/R/eventstudy.R 2013-07-23 09:27:35 UTC (rev 98) @@ -1,11 +1,16 @@ eventstudy <- function(inputData = NULL, eventList, width = 10, + levels = FALSE, type = "marketResidual", to.remap = TRUE, remap = "cumsum", + inference = TRUE, + inference.strategy = "bootstrap", to.plot = TRUE, - levels = FALSE, + xlab = "Event time", + ylab = "Cumulative returns of response series", + main = "Event study plot", ...) { # type = "marketResidual", "excessReturn", "AMM", "None" if (type == "None" && !is.null(inputData)) { @@ -46,9 +51,23 @@ reindex = remap.event.reindex(es.w) ) } - -### Bootstrap - result <- inference.Ecar(z.e = es.w, to.plot = to.plot) - + +### Inference: confidence intervals + if(inference == TRUE){ + ## Bootstrap + if(inference.strategy == "bootstrap"){ + result <- inference.bootstrap(z.e = es.w, to.plot = to.plot, xlab = xlab, + ylab = ylab, main = main) + } + ## Wilcoxon + if(inference.strategy == "wilcoxon"){ + result <- wilcox.CI(es.w = es.w, to.plot = to.plot, xlab = xlab, + ylab = ylab, main = main) + } + } else { + ## Providing event frame as default output + result <- es.w + } + return(result) } Deleted: pkg/R/inference.Ecar.R =================================================================== --- pkg/R/inference.Ecar.R 2013-07-22 09:39:42 UTC (rev 97) +++ pkg/R/inference.Ecar.R 2013-07-23 09:27:35 UTC (rev 98) @@ -1,69 +0,0 @@ -library(boot) -library(zoo) - - -# This does bootstrap inference for the difference in the -# average "car" between t1 and t2 (both in event time). -# z.e is a zoo object, where rows are in event time -# and columns are units of observation. -# Sampling with replacement is done within the units of -# observation. Each time, the Ecar(t1) and Ecar(t2) is -# computed. -# By default, the statistic of interest is the ratio -# Ecar(t2)/Ecar(t1) -# But if operator="difference" is sent in, then the -# statistic of interest shifts to Ecar(t2)-Ecar(t1). -inference.change.boot <- function(z.e, t1, t2, operator="ratio", conf=.95) { - stopifnot(operator %in% c("ratio","difference")) - - tmp <- t(as.matrix(z.e[c(t1,t2),])) - if (operator=="ratio") { - change <- tmp[,2]/tmp[,1] - } - if (operator=="difference") { - change <- tmp[,2]-tmp[,1] - } - - mymean <- function(x,d) {mean(x[d], na.rm=TRUE)} - b <- boot(change, mymean, R=1000) - ci <- boot.ci(b, type="bca", conf=conf) - list(est=b$t0, lo=ci$bca[1,4], hi=ci$bca[1,5]) -} - -# Plotting inference -plotInference <- function(inference){ - big <- max(abs(inference)) - hilo <- c(-big,big) - width <- (nrow(inference)-1)/2 - plot(-width:width, inference[,"Mean"], type="l", lwd=2, ylim=hilo, col="blue", - xlab="Event time", ylab="Cumulative returns of response series", - main=paste("Eventstudy plot")) - points(-width:width, inference[,"Mean"]) - lines(-width:width, inference[,"2.5%"], lwd=1, lty=2, col="blue") - lines(-width:width, inference[,"97.5%"], lwd=1, lty=2, col="blue") - abline(h=0,v=0) -} - -# z.e is a zoo object with certain rows (e.g. from -10 to 10) -# that define the event window, and columns with data for units. -# This function does bootstrap inference for the entire -# Ecar, i.e. main graph of the event study. -inference.Ecar <- function(z.e,to.plot=FALSE) { - Ecar <- function(transposed, d) { - colMeans(transposed[d,], na.rm=TRUE) - } - tmp <- t(as.matrix(z.e)) - b <- boot(tmp, Ecar, R=1000) - - results <- NULL - for (i in 1:ncol(b$t)) { - results <- rbind(results, quantile(b$t[,i], prob=c(.025,.975))) - } - results <- cbind(results[,1], b$t0, results[,2]) - rownames(results) <- rownames(z.e) - colnames(results) <- c("2.5%","Mean","97.5%") - if(to.plot==TRUE){ - plotInference(inference=results) - } - return(results) -} Copied: pkg/R/inference.bootstrap.R (from rev 95, pkg/R/inference.Ecar.R) =================================================================== --- pkg/R/inference.bootstrap.R (rev 0) +++ pkg/R/inference.bootstrap.R 2013-07-23 09:27:35 UTC (rev 98) @@ -0,0 +1,96 @@ +library(boot) +library(zoo) + + +# This does bootstrap inference for the difference in the +# average "car" between t1 and t2 (both in event time). +# z.e is a zoo object, where rows are in event time +# and columns are units of observation. +# Sampling with replacement is done within the units of +# observation. Each time, the Ecar(t1) and Ecar(t2) is +# computed. +# By default, the statistic of interest is the ratio +# Ecar(t2)/Ecar(t1) +# But if operator="difference" is sent in, then the +# statistic of interest shifts to Ecar(t2)-Ecar(t1). +inference.change.boot <- function(z.e, t1, t2, operator="ratio", conf=.95) { + stopifnot(operator %in% c("ratio","difference")) + + tmp <- t(as.matrix(z.e[c(t1,t2),])) + if (operator=="ratio") { + change <- tmp[,2]/tmp[,1] + } + if (operator=="difference") { + change <- tmp[,2]-tmp[,1] + } + + mymean <- function(x,d) {mean(x[d], na.rm=TRUE)} + b <- boot(change, mymean, R=1000) + ci <- boot.ci(b, type="bca", conf=conf) + list(est=b$t0, lo=ci$bca[1,4], hi=ci$bca[1,5]) +} + +# Plotting inference +plotInference <- function(inference, xlab, ylab, main){ + big <- max(abs(inference)) + hilo <- c(-big,big) + width <- (nrow(inference)-1)/2 + plot(-width:width, inference[,"Mean"], type="l", lwd=2, ylim=hilo, + col="dark slate blue", + xlab= xlab, ylab = ylab, + main=paste(main)) + points(-width:width, inference[,"Mean"]) + lines(-width:width, inference[,"2.5%"], lwd=1, lty=2, col="dark slate blue") + lines(-width:width, inference[,"97.5%"], lwd=1, lty=2, col="dark slate blue") + abline(h=0,v=0) +} + +# z.e is a zoo object with certain rows (e.g. from -10 to 10) +# that define the event window, and columns with data for units. +# This function does bootstrap inference for the entire +# Ecar, i.e. main graph of the event study. +inference.bootstrap <- function(z.e,to.plot=FALSE, + xlab = "Event time", + ylab = "Cumulative returns of response series", + main = "Eventstudy plot") { + Ecar <- function(transposed, d) { + colMeans(transposed[d,], na.rm=TRUE) + } + tmp <- t(as.matrix(z.e)) + b <- boot(tmp, Ecar, R=1000) + + results <- NULL + for (i in 1:ncol(b$t)) { + results <- rbind(results, quantile(b$t[,i], prob=c(.025,.975))) + } + results <- cbind(results[,1], b$t0, results[,2]) + rownames(results) <- rownames(z.e) + colnames(results) <- c("2.5%","Mean","97.5%") + if(to.plot==TRUE){ + plotInference(inference=results, xlab, ylab, main) + } + return(results) +} + +##################### +## Wilcoxon sign test +##################### +inference.wilcox <- function(es.w, to.plot = TRUE, xlab = "Event time", + ylab = "Cumulative returns of response series", + main = "Eventstudy plot" + ){ + wx.res <- apply(es.w,1,function(x) + res <- wilcox.exact(x, alternative = "two.sided", + conf.int = TRUE, + conf.level = 0.95)["conf.int"]) + list <- unlist(wx.res, recursive = FALSE) + CI <- do.call(rbind, list) + Mean <- apply(es.w,1,mean,na.rm=TRUE) + result <- cbind(CI[,1], Mean, CI[,2]) + colnames(result) <- c("2.5%","Mean","97.5%") + rownames(result) <- rownames(Mean) + if(to.plot = TRUE){ + plotInference(inference = result, xlab, ylab, main) + } + return(result) +} Added: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd (rev 0) +++ pkg/man/eventstudy.Rd 2013-07-23 09:27:35 UTC (rev 98) @@ -0,0 +1,59 @@ +\name{eventstudy} +\alias{eventstudy} + +\title{Performs event study using different methods and computes confidence intervals using different inference models} + +\description{ This function generates event study output and further computes confidence intervals using bootstrap or wilcox method. +} + +\usage{ +eventstudy(inputData, eventList, width = 10, type = "marketResidual", +to.remap = TRUE, remap = "cumsum", levels = FALSE, inference = TRUE, +inference.strategy = "bootstrap", to.plot = TRUE, xlab = "Event time", +ylab = "Cumulative returns of response series", main = "Event study plot", ...) +} + +\arguments{ + \item{inputData}{Data on which event study is to be performed} + \item{eventList}{A data frame with event dates. It has two columns 'unit' and 'when'. The first column 'unit' consists of column names of the event stock and 'when' is the respective event date} + \item{width}{It studies the performance of observations before and after the event} + \item{type}{This argument gives an option to use different market model adjustment like "marketResidual", "excessReturn", "AMM" and "None"} + \item{to.remap}{If TRUE then remap the event frame is done} + \item{remap}{This argument is used when to.remap is TRUE to estimate cumulative sum (cumsum), cumulative product (cumprod) or reindex the event frame} + \item{levels}{If the data is in returns format then levels is FALSE else TRUE} + \item{inference}{This argument is used to compute confidence interval for the estimator} + \item{inference.strategy}{If inference is TRUE then this argument gives an option to select different inference strategy to compute confidence intervals. Default to bootstrap.} + \item{xlab}{If to.plot is TRUE then the plot generated will take this X label} + \item{ylab}{If to.plot is TRUE then the plot generated will take this Y label} + \item{main}{If to.plot is TRUE then the plot generated will take this as main title} + \item{...}{Accepts specific arguments for the model.} +} +\value{ Output is mean estimate of abnormal returns and confidence interval using particular inference strategy +} + +\author{Vikram Bahure} + +\seealso{ \code{\link{AMM}}, +\code{\link{marketResidual}}, +\code{\link{excessReturn}}, +\code{\link{phys2eventtime}}, +\code{\link{inference.bootstrap}}, +\code{\link{inference.wilcox}}, +\code{\link{remap.cumsum}}, +\code{\link{remap.cumprod}}, +\code{\link{remap.event.reindex}}, +} + +\examples{ +## Performing event study +data("StockPriceReturns") +data("SplitDates") + +## Event study without adjustment +es <- eventstudy(inputData = StockPriceReturns, eventList = SplitDates, width = 10, + type = "None", to.remap = TRUE, remap = "cumsum", to.plot = FALSE, + inference = TRUE, inference.strategy = "bootstrap") + +} + +\keyword{eventstudy} \ No newline at end of file Deleted: pkg/man/inference.Ecar.Rd =================================================================== --- pkg/man/inference.Ecar.Rd 2013-07-22 09:39:42 UTC (rev 97) +++ pkg/man/inference.Ecar.Rd 2013-07-23 09:27:35 UTC (rev 98) @@ -1,36 +0,0 @@ -\name{inference.Ecar} -\alias{inference.Ecar} - -\title{ -Bootstrap inference for the event study. -} - -\description{ -This function does bootstrap inference to generate distribution of average of all the cumulative returns time-series. - } - -\usage{ -inference.Ecar(z.e,to.plot=FALSE) -} - -\arguments{ - \item{z.e}{z.e is the first component of the list returned by the function phys2eventtime.} - \item{to.plot}{This argument will generate an eventstudy plot of the inference estimated. If to.plot is equal to TRUE then function would generate the plot else it would not. } -} - -\value{ -A data frame with 3 columns, the lower confidence interval (CI), the mean and the upper CI which are the result of bootstrap inference. -} - -\seealso{ -phys2eventtime -} - -\examples{ -data(StockPriceReturns) -data(SplitDates) -es.results <- phys2eventtime(z=StockPriceReturns, events=SplitDates,width=5) -es.w <- window(es.results$z.e, start=-5, end=+5) -eventtime <- remap.cumsum(es.w, is.pc=FALSE, base=0) -inference.Ecar(z.e=eventtime, to.plot=FALSE) -} \ No newline at end of file Copied: pkg/man/inference.bootstrap.Rd (from rev 95, pkg/man/inference.Ecar.Rd) =================================================================== --- pkg/man/inference.bootstrap.Rd (rev 0) +++ pkg/man/inference.bootstrap.Rd 2013-07-23 09:27:35 UTC (rev 98) @@ -0,0 +1,41 @@ +\name{inference.bootstrap} +\alias{inference.bootstrap} + +\title{ +Bootstrap inference for the event study. +} + +\description{ +This function does bootstrap inference to generate distribution of average of all the cumulative returns time-series. + } + +\usage{ +inference.bootstrap(z.e, to.plot = TRUE, xlab = "Event time", + ylab = "Cumulative returns of response series", + main = "Event study plot") +} + +\arguments{ + \item{z.e}{z.e is the first component of the list returned by the function phys2eventtime.} + \item{to.plot}{This argument will generate an eventstudy plot of the inference estimated. If to.plot is equal to TRUE then function would generate the plot else it would not. } + \item{xlab}{If to.plot is TRUE then the plot generated will take this X label} + \item{ylab}{If to.plot is TRUE then the plot generated will take this Y label} + \item{main}{If to.plot is TRUE then the plot generated will take this as main title} +} + +\value{ +A data frame with 3 columns, the lower confidence interval (CI), the mean and the upper CI which are the result of bootstrap inference. +} + +\seealso{ +phys2eventtime +} + +\examples{ +data(StockPriceReturns) +data(SplitDates) +es.results <- phys2eventtime(z=StockPriceReturns, events=SplitDates,width=5) +es.w <- window(es.results$z.e, start=-5, end=+5) +eventtime <- remap.cumsum(es.w, is.pc=FALSE, base=0) +inference.bootstrap(z.e=eventtime, to.plot=FALSE) +} \ No newline at end of file Added: pkg/man/inference.wilcox.Rd =================================================================== --- pkg/man/inference.wilcox.Rd (rev 0) +++ pkg/man/inference.wilcox.Rd 2013-07-23 09:27:35 UTC (rev 98) @@ -0,0 +1,43 @@ +\name{inference.wilcox} +\alias{inference.wilcox} + +\title{ +Wilcox inference for the event study. +} + +\description{ +This function does wilcox inference to generate distribution of average of all the cumulative returns time-series. + } + +\usage{ +inference.wilcox(z.e,to.plot = TRUE, xlab = "Event time", + ylab = "Cumulative returns of response series", + main = "Event study plot") +} + +\arguments{ + \item{z.e}{z.e is the first component of the list returned by the function phys2eventtime.} + \item{to.plot}{This argument will generate an eventstudy plot of the inference estimated. If to.plot is equal to TRUE then function would generate the plot else it would not. } + \item{xlab}{If to.plot is TRUE then the plot generated will take this X label} + \item{ylab}{If to.plot is TRUE then the plot generated will take this Y label} + \item{main}{If to.plot is TRUE then the plot generated will take this as main title} +} + +\value{ +A data frame with 3 columns, the lower confidence interval (CI), the mean and the upper CI which are the result of wilcox inference. +} + +\author{Vikram Bahure} + +\seealso{ +phys2eventtime +} + +\examples{ +data(StockPriceReturns) +data(SplitDates) +es.results <- phys2eventtime(z=StockPriceReturns, events=SplitDates,width=5) +es.w <- window(es.results$z.e, start=-5, end=+5) +eventtime <- remap.cumsum(es.w, is.pc=FALSE, base=0) +inference.wilcox(z.e=eventtime, to.plot=FALSE) +} \ No newline at end of file From noreply at r-forge.r-project.org Tue Jul 23 12:54:21 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 23 Jul 2013 12:54:21 +0200 (CEST) Subject: [Eventstudies-commits] r99 - in pkg: . R inst/tests man vignettes Message-ID: <20130723105421.DBC2C184F3C@r-forge.r-project.org> Author: vikram Date: 2013-07-23 12:54:21 +0200 (Tue, 23 Jul 2013) New Revision: 99 Modified: pkg/NAMESPACE pkg/R/ees.R pkg/R/eventstudy.R pkg/R/inference.bootstrap.R pkg/inst/tests/test_inr_inference.R pkg/man/eventstudy.Rd pkg/man/inference.bootstrap.Rd pkg/man/inference.wilcox.Rd pkg/vignettes/eventstudies.Rnw Log: Made some corrections; now check result is OK Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/NAMESPACE 2013-07-23 10:54:21 UTC (rev 99) @@ -1,4 +1,4 @@ -export(inference.bootstrap, inference.wilcox, phys2eventtime, +export(eventstudy, inference.bootstrap, inference.wilcox, phys2eventtime, remap.cumsum, remap.cumprod, remap.event.reindex, ees, eesPlot) export(marketResidual, excessReturn Modified: pkg/R/ees.R =================================================================== --- pkg/R/ees.R 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/R/ees.R 2013-07-23 10:54:21 UTC (rev 99) @@ -817,7 +817,7 @@ # Replaing NA's with zeroes es.w[is.na(es.w)] <- 0 es.w <- remap.cumsum(es.w, is.pc=FALSE, base=0) - inference.Ecar(es.w) + inference.bootstrap(es.w) } #---------------------------------- Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/R/eventstudy.R 2013-07-23 10:54:21 UTC (rev 99) @@ -56,13 +56,13 @@ if(inference == TRUE){ ## Bootstrap if(inference.strategy == "bootstrap"){ - result <- inference.bootstrap(z.e = es.w, to.plot = to.plot, xlab = xlab, + result <- inference.bootstrap(es.w = es.w, to.plot = to.plot, xlab = xlab, ylab = ylab, main = main) } ## Wilcoxon if(inference.strategy == "wilcoxon"){ - result <- wilcox.CI(es.w = es.w, to.plot = to.plot, xlab = xlab, - ylab = ylab, main = main) + result <- inference.wilcox(es.w = es.w, to.plot = to.plot, xlab = xlab, + ylab = ylab, main = main) } } else { ## Providing event frame as default output Modified: pkg/R/inference.bootstrap.R =================================================================== --- pkg/R/inference.bootstrap.R 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/R/inference.bootstrap.R 2013-07-23 10:54:21 UTC (rev 99) @@ -4,7 +4,7 @@ # This does bootstrap inference for the difference in the # average "car" between t1 and t2 (both in event time). -# z.e is a zoo object, where rows are in event time +# es.w is a zoo object, where rows are in event time # and columns are units of observation. # Sampling with replacement is done within the units of # observation. Each time, the Ecar(t1) and Ecar(t2) is @@ -13,10 +13,10 @@ # Ecar(t2)/Ecar(t1) # But if operator="difference" is sent in, then the # statistic of interest shifts to Ecar(t2)-Ecar(t1). -inference.change.boot <- function(z.e, t1, t2, operator="ratio", conf=.95) { +inference.change.boot <- function(es.w, t1, t2, operator="ratio", conf=.95) { stopifnot(operator %in% c("ratio","difference")) - tmp <- t(as.matrix(z.e[c(t1,t2),])) + tmp <- t(as.matrix(es.w[c(t1,t2),])) if (operator=="ratio") { change <- tmp[,2]/tmp[,1] } @@ -45,18 +45,18 @@ abline(h=0,v=0) } -# z.e is a zoo object with certain rows (e.g. from -10 to 10) +# es.w is a zoo object with certain rows (e.g. from -10 to 10) # that define the event window, and columns with data for units. # This function does bootstrap inference for the entire # Ecar, i.e. main graph of the event study. -inference.bootstrap <- function(z.e,to.plot=FALSE, +inference.bootstrap <- function(es.w, to.plot=TRUE, xlab = "Event time", ylab = "Cumulative returns of response series", - main = "Eventstudy plot") { + main = "Event study plot") { Ecar <- function(transposed, d) { colMeans(transposed[d,], na.rm=TRUE) } - tmp <- t(as.matrix(z.e)) + tmp <- t(as.matrix(es.w)) b <- boot(tmp, Ecar, R=1000) results <- NULL @@ -64,7 +64,7 @@ results <- rbind(results, quantile(b$t[,i], prob=c(.025,.975))) } results <- cbind(results[,1], b$t0, results[,2]) - rownames(results) <- rownames(z.e) + rownames(results) <- rownames(es.w) colnames(results) <- c("2.5%","Mean","97.5%") if(to.plot==TRUE){ plotInference(inference=results, xlab, ylab, main) @@ -77,7 +77,7 @@ ##################### inference.wilcox <- function(es.w, to.plot = TRUE, xlab = "Event time", ylab = "Cumulative returns of response series", - main = "Eventstudy plot" + main = "Event study plot" ){ wx.res <- apply(es.w,1,function(x) res <- wilcox.exact(x, alternative = "two.sided", @@ -89,7 +89,7 @@ result <- cbind(CI[,1], Mean, CI[,2]) colnames(result) <- c("2.5%","Mean","97.5%") rownames(result) <- rownames(Mean) - if(to.plot = TRUE){ + if(to.plot == TRUE){ plotInference(inference = result, xlab, ylab, main) } return(result) Modified: pkg/inst/tests/test_inr_inference.R =================================================================== --- pkg/inst/tests/test_inr_inference.R 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/inst/tests/test_inr_inference.R 2013-07-23 10:54:21 UTC (rev 99) @@ -19,13 +19,13 @@ event_time_data <- phys2eventtime(inr_returns,eventslist,width=10) w <- window(event_time_data$z.e,start=-10,end=10) -expect_that(inference.Ecar(w)[,2], - equals(c(-0.00215361156303362, -0.00040191670837042, 0.00171845148444985, - 0.00143799970419951, 0.00149260146357282, -0.00284892904228684, - 0.0013220811191847, -0.000634983205805195, 0.00115930378269389, - -0.000508755768685365, -0.00190621828611177, 0.000128303517790052, - -0.000547070723466092, 0.000463708708964017, -0.00108666428087325, - -0.00121321855159642, 0.00216769754166339, -0.000166340225607797, - 0.00117626759805196, 0.000207307545758795, 0.000602629204764948 - ))) +expect_that(inference.bootstrap(w)[,2], + equals(c(-0.00215361156303362, -0.00040191670837042, 0.00171845148444985, + 0.00143799970419951, 0.00149260146357282, -0.00284892904228684, + 0.0013220811191847, -0.000634983205805195, 0.00115930378269389, + -0.000508755768685365, -0.00190621828611177, 0.000128303517790052, + -0.000547070723466092, 0.000463708708964017, -0.00108666428087325, + -0.00121321855159642, 0.00216769754166339, -0.000166340225607797, + 0.00117626759805196, 0.000207307545758795, 0.000602629204764948 + ))) }) Modified: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/man/eventstudy.Rd 2013-07-23 10:54:21 UTC (rev 99) @@ -7,10 +7,19 @@ } \usage{ -eventstudy(inputData, eventList, width = 10, type = "marketResidual", -to.remap = TRUE, remap = "cumsum", levels = FALSE, inference = TRUE, -inference.strategy = "bootstrap", to.plot = TRUE, xlab = "Event time", -ylab = "Cumulative returns of response series", main = "Event study plot", ...) +eventstudy(inputData = NULL, + eventList, + width = 10, + levels = FALSE, + type = "marketResidual", + to.remap = TRUE, + remap = "cumsum", + inference = TRUE, + inference.strategy = "bootstrap", + to.plot = TRUE, + xlab = "Event time", + ylab = "Cumulative returns of response series", + main = "Event study plot", ...) } \arguments{ @@ -23,6 +32,7 @@ \item{levels}{If the data is in returns format then levels is FALSE else TRUE} \item{inference}{This argument is used to compute confidence interval for the estimator} \item{inference.strategy}{If inference is TRUE then this argument gives an option to select different inference strategy to compute confidence intervals. Default to bootstrap.} + \item{to.plot}{This argument will generate an eventstudy plot of the inference estimated. If to.plot is equal to TRUE then function would generate the plot else it would not. } \item{xlab}{If to.plot is TRUE then the plot generated will take this X label} \item{ylab}{If to.plot is TRUE then the plot generated will take this Y label} \item{main}{If to.plot is TRUE then the plot generated will take this as main title} @@ -46,6 +56,7 @@ \examples{ ## Performing event study +library(eventstudies) data("StockPriceReturns") data("SplitDates") Modified: pkg/man/inference.bootstrap.Rd =================================================================== --- pkg/man/inference.bootstrap.Rd 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/man/inference.bootstrap.Rd 2013-07-23 10:54:21 UTC (rev 99) @@ -10,13 +10,13 @@ } \usage{ -inference.bootstrap(z.e, to.plot = TRUE, xlab = "Event time", +inference.bootstrap(es.w, to.plot = TRUE, xlab = "Event time", ylab = "Cumulative returns of response series", main = "Event study plot") } \arguments{ - \item{z.e}{z.e is the first component of the list returned by the function phys2eventtime.} + \item{es.w}{es.w is the first component of the list returned by the function phys2eventtime.} \item{to.plot}{This argument will generate an eventstudy plot of the inference estimated. If to.plot is equal to TRUE then function would generate the plot else it would not. } \item{xlab}{If to.plot is TRUE then the plot generated will take this X label} \item{ylab}{If to.plot is TRUE then the plot generated will take this Y label} @@ -37,5 +37,5 @@ es.results <- phys2eventtime(z=StockPriceReturns, events=SplitDates,width=5) es.w <- window(es.results$z.e, start=-5, end=+5) eventtime <- remap.cumsum(es.w, is.pc=FALSE, base=0) -inference.bootstrap(z.e=eventtime, to.plot=FALSE) +inference.bootstrap(es.w=eventtime, to.plot=FALSE) } \ No newline at end of file Modified: pkg/man/inference.wilcox.Rd =================================================================== --- pkg/man/inference.wilcox.Rd 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/man/inference.wilcox.Rd 2013-07-23 10:54:21 UTC (rev 99) @@ -10,13 +10,13 @@ } \usage{ -inference.wilcox(z.e,to.plot = TRUE, xlab = "Event time", +inference.wilcox(es.w,to.plot = TRUE, xlab = "Event time", ylab = "Cumulative returns of response series", main = "Event study plot") } \arguments{ - \item{z.e}{z.e is the first component of the list returned by the function phys2eventtime.} + \item{es.w}{es.w is the first component of the list returned by the function phys2eventtime.} \item{to.plot}{This argument will generate an eventstudy plot of the inference estimated. If to.plot is equal to TRUE then function would generate the plot else it would not. } \item{xlab}{If to.plot is TRUE then the plot generated will take this X label} \item{ylab}{If to.plot is TRUE then the plot generated will take this Y label} @@ -39,5 +39,5 @@ es.results <- phys2eventtime(z=StockPriceReturns, events=SplitDates,width=5) es.w <- window(es.results$z.e, start=-5, end=+5) eventtime <- remap.cumsum(es.w, is.pc=FALSE, base=0) -inference.wilcox(z.e=eventtime, to.plot=FALSE) +inference.wilcox(es.w=eventtime, to.plot=FALSE) } \ No newline at end of file Modified: pkg/vignettes/eventstudies.Rnw =================================================================== --- pkg/vignettes/eventstudies.Rnw 2013-07-23 09:27:35 UTC (rev 98) +++ pkg/vignettes/eventstudies.Rnw 2013-07-23 10:54:21 UTC (rev 99) @@ -43,11 +43,11 @@ In this package, there are three major functions \textit{phys2eventtime}, \textit{remap.cumsum} and -\textit{inference.Ecar}. \textit{phys2eventtime} changes the +\textit{inference.bootstrap}. \textit{phys2eventtime} changes the physical dates to event time frame on which event study analysis can be done with ease. \textit{remap.cumsum} can be used to convert returns to cumulative sum or product in the -event time frame. \textit{inference.Ecar} generates bootstrap +event time frame. \textit{inference.bootstrap} generates bootstrap inference for the event time response of the variable. In the section below, we illustrate event study analysis using the @@ -143,12 +143,12 @@ inference. A detailed explanation of the methodology is presented in Patnaik, Shah and Singh (2013). This specific approach used here is based on -\citet{davison1986efficient}. The \textit{inference.Ecar} function +\citet{davison1986efficient}. The \textit{inference.bootstrap} function does the bootstrap to generate distribution of $\bar{CR}$. The bootstrap generates confidence interval at 2.5\% and 97.5\% for the estimate. <<>>= -result <- inference.Ecar(z.e=es.cs, to.plot=TRUE) +result <- inference.bootstrap(es.w=es.cs, to.plot=TRUE) @ \begin{figure}[t] \begin{center} @@ -156,7 +156,7 @@ \setkeys{Gin}{width=0.8\linewidth} \setkeys{Gin}{height=0.8\linewidth} <>= - result <- inference.Ecar(z.e=es.cs, to.plot=TRUE) + result <- inference.bootstrap(es.w=es.cs, to.plot=TRUE) @ \end{center} \label{fig:one} From noreply at r-forge.r-project.org Wed Jul 24 07:14:24 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Jul 2013 07:14:24 +0200 (CEST) Subject: [Eventstudies-commits] r100 - pkg/vignettes Message-ID: <20130724051424.81996185D40@r-forge.r-project.org> Author: renukasane Date: 2013-07-24 07:14:24 +0200 (Wed, 24 Jul 2013) New Revision: 100 Modified: pkg/vignettes/eventstudies.Rnw Log: Adding the half-baked vignette - Vikram to add the new functions after which I will resume writing. Modified: pkg/vignettes/eventstudies.Rnw =================================================================== --- pkg/vignettes/eventstudies.Rnw 2013-07-23 10:54:21 UTC (rev 99) +++ pkg/vignettes/eventstudies.Rnw 2013-07-24 05:14:24 UTC (rev 100) @@ -1,4 +1,3 @@ - \documentclass[a4paper,11pt]{article} \usepackage{graphicx} \usepackage{a4wide} @@ -25,67 +24,133 @@ \end{abstract} \SweaveOpts{engine=R,pdf=TRUE} + \section{Introduction} -Event study has a long history which dates back to 1938 -\citep{dolley1938effect}. It is mostly used to study the response of -stock price or value of a firm due to events such as mergers \& -acquisitions, stock splits, quarterly results and so on. It is one -of the most widely used statistical tool. -Event study is used to study the response or -the effect on a variable, due to similar events. Efficient and liquid -markets are basic assumption in this methodology. It assumes the -effect on response variable is without delay. As event study output is -further used in econometric analysis, hence significance test such as -\textit{t-test}, \textit{J-test}, \textit{Patell-test} which are -parametric and \textit{GRANK}, \textit{RANK} which are non-parametric -can also be performed. +Event study methodology has been primarily used to evaluate the impact +of specific events on the value of the firm. The typical procedure for +conducting an event study involves \citep{MacKinlay} +\begin{itemize} + \item Defining the event of interest and the event window which is + larger than the specific period of interest. % Generally the event + % period itself is not included in the estimation period to prevent + % the event from influencing the normal performance model parameter + % estimates. + \item Determining the selection criteria for the inclusion of firms, + in the study + \item Determining a measure of abnormal returns, the most common + being the \textit{constant mean return model} and the + \textit{market model}. This is important to disentangle the effects + on stock prices of information that is specific to the firm under + question (e.g. stock split annoucement) and information that is + likely to affect stock prices marketwide (e.g. interest rates) +\end{itemize} -In this package, there are three major functions -\textit{phys2eventtime}, \textit{remap.cumsum} and -\textit{inference.bootstrap}. \textit{phys2eventtime} changes the -physical dates to event time frame on which event study analysis can -be done with ease. \textit{remap.cumsum} -can be used to convert returns to cumulative sum or product in the -event time frame. \textit{inference.bootstrap} generates bootstrap -inference for the event time response of the variable. +The \textbf{eventstudies} package makes possible BLAH. All functions +in this package are implemented in the R system for statistical +computing. The package, and R are available at no cost under the terms +of the general public license (GPL) from the comprehensive R archive +network (CRAN, \texttt{http://CRAN.R-project.org}). -In the section below, we illustrate event study analysis using the -package. We measure the impact of stock splits on the stock price of -the firm for SENSEX index constituents. +This paper is organised as follows. A skeletal event study model is +presented in Section \ref{s::model}. Section \ref{s:approach} +discusses the software approach used in this package. The +functionalities of the package are discussed in Section +\ref{s:package-func}: the construction of the data-set in section +\ref{ss:construction}, estimation in section \ref{ss:estimation} and +inference in section \ref{ss:inference}. Section \ref{s:conclusion} +conclues the paper. -\section{Performing Eventstudy analysis} -To measure the impact of stock splits on the stock price of the firm, -we create a dataset of 30 index companies of Bombay Stock Exchange -(BSE). We have a returns of stock price for each firm from 2001 to -2013 and respective stock splits date. Once we have the data then we -use following steps to perform event study analysis using the package. -\begin{enumerate} -\item Construction of data set - \begin{itemize} - \item A time series object of stock price returns - \item Event dates object with 2 columns, \textit{unit} and - \textit{when}. - \end{itemize} - \item Converting physical dates to event frame - \item Remapping event frame - \item Estimating bootstrap inference -\end{enumerate} -\subsection{Construction of data set} -% Stock returns and event dates -We have collected data of index constituents of Bombay stock exchange -(BSE) and corresponding stock splits dates. There are 30 -firms in SENSEX and we have stock split dates for each firm from 2000 -onwards. +% In this package, there are three major functions +% \textit{phys2eventtime}, \textit{remap.cumsum} and +% \textit{inference.Ecar}. \textit{phys2eventtime} changes the +% physical dates to event time frame on which event study analysis can +% be done with ease. \textit{remap.cumsum} +% can be used to convert returns to cumulative sum or product in the +% event time frame. \textit{inference.Ecar} generates bootstrap +% inference for the event time response of the variable. -A time series \textit{zoo} object is created for stock price returns -for 30 firms. For event dates, a data frame with two columns +\section{Skeletal event study model} \label{s:model} + +Let day-0 identify the stock split date under scrutiny and let days +t = ... -3,-2,-1 represent trading days leading up to the event. If +the return on the firm with the stock split $R_o$ is statistically +large compared to returns on previous dates, we may conclude that the +stock split event had a significant price impact. + +To disentangle the impact of the stock split on the returns of the +firm from general market-wide information, we use the market-model to +adjust the event-date return, thus removing the influence of market +information. + +The market model is calculated as follows: + +\[ R_t = a + b RM_t + e_t \] + +The firm-specific return $e_t$ is unrelated to the overall market and +has an expected value of zero. Hence, the expected event date return +conditional on the event date market return is + +\[ E(R_0|RM_0) = a + b RM_0 \] + +The abnormal return $A_0$ is simply the day-zero firm-specific return +$e_0$: + +\[ A_0 = R_0- E(R_0|RM_0) = R_0 - a - b RM_0 \] + +A series of abnormal returns from previous periods are also calculated +for comparison, and to determine statistical signficance. + +\[ A_t = R_t- E(R_t|RM_t) = R_t - a - b RM_t \] + +The event date abnormal return $A_0$ is then assessed for statistical +significance relative to the distribution of abnormal returns $A_t$ in +the control period. A common assumption used to formulate tests of +statistical significance is that abnormal returns are normally +distributed. + + +\section{Software approach} \label{s:approach} +The package offers the following functionalities: +\begin{itemize} + \item Coverting the data-set to an event frame. This requires: + \begin{itemize} + \item A time series object of stock price returns + \item Event dates object with two columns, \textit{unit} and + \textit{when}, the date of occurrence of the event. + \end{itemize} + \item Models for calculating returns. These include: + \begin{itemize} + \item Market model + \item Augmented market model + \item Excess returns model + \end{itemize} + \item Procedures for inference. These include: + \begin{itemize} + \item Bootstrapping + \item Wilcoxon signed rank test + \end{itemize} +\end{itemize} + + +\section{Example: Performing Eventstudy analysis} +\label{s:example} + +We demonstrate the package with a study of the impact of stock splits +on the stock price of the firm. The data-set consist of the returns +series of the thirty index companies, as of 2013, of the Bombay Stock +Exchange (BSE), from 2001 to 2013. We have stock split dates for each +firm from 2000 onwards. + +We first create a \textit{zoo} object for stock price returns for the +thirty firms. For event dates, a data frame with two columns \textit{unit} and \textit{when} is formed. \textit{unit} has name of the response series (firm name as in column name of time series object) along with event date in \textit{when}. \textit{unit} should -be in \textit{character} format and \textit{when} in \textit{Date} format. +be in \textit{character} format and \textit{when} in \textit{Date} +format. <<>>= library(eventstudies) @@ -95,29 +160,31 @@ head(SplitDates) @ +\subsection{Using the market model} + + \subsection{Converting physical dates to event frame} -After the formation of the dataset, our first step towards event study -analysis is to convert the physical dates to event time -frame. Using the \textit{phys2eventtime} function we convert the -dates in event time frame. +The first step towards event study analysis is to convert the physical +dates to event time frame. The event date and the returns on that +date are indexed to 0. Post-event dates are indexed to positive, and +pre-event dates as negative. This is done using the +\textit{phys2eventtime} function. -Here, we index the stock split date, stock price returns to day 0 and -similarly post event dates are indexed to positive and pre event -dates are indexed as negative. As we can see below the stock split dates -for BHEL, Bharti Airtel and Cipla are indexed to day 0. - The output for \textit{phys2eventtime} is a list. The first element of a list is a time series object which is converted to event time and the second element is \textit{outcomes} which shows if there was any \textit{NA} in the dataset. If the outcome is \textit{success} then all is well in the given window as specified by the -width. It gives \textit{wdatamissing} if there are too many \textit{NAs} within the crucial event +width. It gives \textit{wdatamissing} if there are too many +\textit{NAs} within the crucial event window or \textit{wrongspan} if the event date is not placed within the span of data for the unit or \textit{unitmissing} if a unit named in events is not in \textit{z}. <<>>= es <- phys2eventtime(z=StockPriceReturns, events=SplitDates, width=10) +str(es) +head(es$outcomes) es.w <- window(es$z.e, start=-10, end=10) SplitDates[1:3,] StockPriceReturns[SplitDates[1,2],SplitDates[1,1]] @@ -126,6 +193,10 @@ es.w[,1:3] @ +In this example, es.w contains the returns in event-time form for all +the stocks. In this you only get variables for whom all data is +avaialable. + \subsection{Remapping event frame} In event study analysis the variable of interest is cumulative returns. The \textit{remap.cumsum} function is used to @@ -145,7 +216,8 @@ This specific approach used here is based on \citet{davison1986efficient}. The \textit{inference.bootstrap} function does the bootstrap to generate distribution of $\bar{CR}$. The -bootstrap generates confidence interval at 2.5\% and 97.5\% for the estimate. +bootstrap generates confidence interval at 2.5\% and 97.5\% for the +estimate. <<>>= result <- inference.bootstrap(es.w=es.cs, to.plot=TRUE) From noreply at r-forge.r-project.org Wed Jul 24 08:10:41 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Jul 2013 08:10:41 +0200 (CEST) Subject: [Eventstudies-commits] r101 - pkg/data Message-ID: <20130724061041.2C88A1813D4@r-forge.r-project.org> Author: vikram Date: 2013-07-24 08:10:40 +0200 (Wed, 24 Jul 2013) New Revision: 101 Modified: pkg/data/StockPriceReturns.rda Log: Added Nifty series in the data to perform market residual and excess return event study Modified: pkg/data/StockPriceReturns.rda =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Wed Jul 24 09:22:31 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Jul 2013 09:22:31 +0200 (CEST) Subject: [Eventstudies-commits] r102 - pkg/data Message-ID: <20130724072231.592E7184289@r-forge.r-project.org> Author: vikram Date: 2013-07-24 09:22:31 +0200 (Wed, 24 Jul 2013) New Revision: 102 Modified: pkg/data/SplitDates.rda pkg/data/StockPriceReturns.rda Log: Changed the ampersand to and in column names and eventlist Modified: pkg/data/SplitDates.rda =================================================================== (Binary files differ) Modified: pkg/data/StockPriceReturns.rda =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Wed Jul 24 13:29:02 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 24 Jul 2013 13:29:02 +0200 (CEST) Subject: [Eventstudies-commits] r103 - in pkg: R inst/tests man vignettes Message-ID: <20130724112902.ACE2D184511@r-forge.r-project.org> Author: vikram Date: 2013-07-24 13:29:02 +0200 (Wed, 24 Jul 2013) New Revision: 103 Modified: pkg/R/AMM.R pkg/R/eventstudy.R pkg/R/excessReturn.R pkg/R/marketResidual.R pkg/inst/tests/test_marketresiduals.R pkg/man/eventstudy.Rd pkg/man/excessReturn.Rd pkg/man/marketResidual.Rd pkg/vignettes/eventstudies.Rnw Log: Made modification in the functionsand documentation; Modified vignette 99% only AMM part is remaining; Vimal the AMM function is not returning residuals, can you have look at it Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/R/AMM.R 2013-07-24 11:29:02 UTC (rev 103) @@ -75,6 +75,20 @@ result <- onefirmAMM(rj, X, nlags, verbose, dates) } + ##----------- + ## Many firms + ##----------- + if(amm.type == "manyfirms") { + # Checking required arguments + if (match("regerssand", names(modelArgs), nomatch = -1) == -1) { + stop("Input regressand (firm data) is missing") + } + + X <- makeX(rM1, others, switch.to.innov, + rM1purge, nlags, dates, verbose) + result <- manyfirmsAMM(regressand, regressors=X, nlags, verbose, dates) + } + #--------------- # Firm exposures #--------------- Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/R/eventstudy.R 2013-07-24 11:29:02 UTC (rev 103) @@ -15,10 +15,12 @@ # type = "marketResidual", "excessReturn", "AMM", "None" if (type == "None" && !is.null(inputData)) { outputModel <- inputData - } else { - stop("inputData or \"None\" type missing") } + ## else { + ## stop("inputData or \"None\" type missing") + ## } + if (levels == TRUE) { inputData <- diff(log(inputData)) * 100 } @@ -31,18 +33,19 @@ ## marketResidual if (type == "marketResidual") { - outputModel <- marketResidual(...) + outputModel <- marketResidual(data.object = inputData, ...) } ## excessReturn if (type == "excessReturn") { - outputModel <- excessReturn(...) + outputModel <- excessReturn(data.object = inputData, ...) } ### Convert to event frame es <- phys2eventtime(z=outputModel, events=eventList, width=width) + ## colnames(es) <- eventList[which(es$outcomes=="success"),1] es.w <- window(es$z.e, start = -width, end = width) - + ### Remapping event frame if (to.remap == TRUE) { es.w <- switch(remap, Modified: pkg/R/excessReturn.R =================================================================== --- pkg/R/excessReturn.R 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/R/excessReturn.R 2013-07-24 11:29:02 UTC (rev 103) @@ -3,11 +3,16 @@ ############### # Argument: # 1. data.object: This is a time series object with firm return and market return -# 2. firm.name: It is the firm column name in the data object -# 3. market.name: It is the market (index) column name in the data object +# 2. market.name: It is the market (index) column name in the data object # Output: # Value: Excess market return -excessReturn <- function(firm.name,market.name,data.object){ - ma.ret <- data.object[,firm.name]-data.object[,market.name] + +excessReturn <- function(data.object, market.name=NULL){ + if(is.null(market.name)==TRUE){ + stop("Column name for market index not provided") + } + cn.names <- colnames(data.object) + cn.names <- cn.names[-which(cn.names%in%market.name)] + ma.ret <- data.object[,cn.names]-data.object[,market.name] return(ma.ret) } Modified: pkg/R/marketResidual.R =================================================================== --- pkg/R/marketResidual.R 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/R/marketResidual.R 2013-07-24 11:29:02 UTC (rev 103) @@ -1,27 +1,56 @@ ######################### # Market model adjustment ######################### -# Argument: -# 1. mm.formula: Here the input is the linear model (lm) formula for eg: a ~ b + c -# If formula is not given then first column will be dependent and rest will be independent -# 2. data.object: Single time series object with all the variables -# Output: -# Value: Market residual after extracting market returns from the firm return -marketResidual <- function(mm.formula=NULL,data.object){ - # Storing NA observations - na.date <- data.object[which(complete.cases(data.object)==FALSE)] - # Extracting market residuals +## Argument: +## 1. data.object: Single time series object with all the variables +## 2. market.name: Column name of market index in the data +## Output: +## Value: Market residual after extracting market returns from the firm return + +marketResidual <- function(data.object, market.name=NULL){ +### Checking arguments + if(is.null(market.name)==TRUE){ + stop("Column name of market index not provided") + } + cn.names <- colnames(data.object) + cn.names <- cn.names[-which(cn.names%in%market.name)] + ## Market residual + formula <- paste(cn.names[1],"~",market.name,sep=" ") + tmp <- marketResidual.onefirm(mm.formula = formula, + data.object = data.object, + firm.name = cn.names[1]) + ## tmp <- tmp[complete.cases(tmp),] + if(length(cn.names)>1){ + for(i in 2:length(cn.names)){ + ## Getting formula + formula <- paste(cn.names[i],"~",market.name,sep=" ") + ## Market residual + tmp.resid <- marketResidual.onefirm(mm.formula = formula, + data.object = data.object, + firm.name = cn.names[i]) + ## tmp.resid <- tmp.resid[complete.cases(tmp.resid),] + tmp <- merge(tmp,tmp.resid,all=TRUE) + } + } + colnames(tmp) <- cn.names + return(tmp) +} + +marketResidual.onefirm <- function(mm.formula=NULL,data.object,firm.name){ +### Market residual one firm + ## Storing NA observations + na.date <- data.object[which(complete.cases(data.object[,firm.name])==FALSE), + firm.name] +### Checking arguments if(is.null(mm.formula)==TRUE){ - formula <- paste(colnames(data.object)[1],"~", - colnames(data.object)[2:NCOL(data.object)],sep="") - reg <- lm(as.formula(formula),data=data.object) - }else{ - - reg <- lm(as.formula(mm.formula),data=data.object) + print("Formula for market residual model not provided") } + ## Extracting market residuals + reg <- lm(as.formula(mm.formula),data=data.object) resid <- xts(reg$residuals,as.Date(attr(reg$residuals,"names"))) suppressWarnings(tot.resid <- rbind(resid, - xts(rep(NA,nrow(na.date)), + xts(rep(NA,NROW(na.date)), index(na.date)))) return(tot.resid) } + Modified: pkg/inst/tests/test_marketresiduals.R =================================================================== --- pkg/inst/tests/test_marketresiduals.R 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/inst/tests/test_marketresiduals.R 2013-07-24 11:29:02 UTC (rev 103) @@ -3,14 +3,16 @@ test_that("test.market.residuals", { library(eventstudies) -load(system.file("data", "mmData.rda", package = "eventstudies")) +load(system.file("data", "StockPriceReturns.rda", package = "eventstudies")) -mm.formula <- paste("ranbaxyacp","~","nifty",sep="") -mm.result <- marketResidual(mm.formula=mm.formula,data.object=mmData) +mm.result <- marketResidual(data.object=StockPriceReturns[,c("BHEL","nifty")], + market.name="nifty") +mm.result <- mm.result[complete.cases(mm.result),] # Calculating manually -result <- lm(ranbaxyacp ~ nifty, data=mmData) +result <- lm(BHEL ~ nifty, data=StockPriceReturns) resid.res <- xts(result$resid,as.Date(attr(result$resid,"names"))) +colnames(resid.res) <- "BHEL" expect_that(mm.result,equals(resid.res)) Modified: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/man/eventstudy.Rd 2013-07-24 11:29:02 UTC (rev 103) @@ -8,18 +8,18 @@ \usage{ eventstudy(inputData = NULL, - eventList, - width = 10, - levels = FALSE, - type = "marketResidual", - to.remap = TRUE, - remap = "cumsum", - inference = TRUE, - inference.strategy = "bootstrap", - to.plot = TRUE, - xlab = "Event time", - ylab = "Cumulative returns of response series", - main = "Event study plot", ...) + eventList, + width = 10, + levels = FALSE, + type = "marketResidual", + to.remap = TRUE, + remap = "cumsum", + inference = TRUE, + inference.strategy = "bootstrap", + to.plot = TRUE, + xlab = "Event time", + ylab = "Cumulative returns of response series", + main = "Event study plot", ...) } \arguments{ Modified: pkg/man/excessReturn.Rd =================================================================== --- pkg/man/excessReturn.Rd 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/man/excessReturn.Rd 2013-07-24 11:29:02 UTC (rev 103) @@ -6,12 +6,11 @@ \description{ This function estimates excess return. If the the firm return is rj and market return is rM then output will be rj less rM. } -\usage{excessReturn(firm.name, market.name, data.object) +\usage{excessReturn(data.object, market.name=NULL) } \arguments{ \item{data.object}{This is a time series object with firm return and market return} - \item{firm.name}{It is the firm column name in the data object} \item{market.name}{It is the market (index) column name in the data object} } @@ -20,9 +19,9 @@ \author{Vikram Bahure} \examples{ -data(mmData) -er.result <- excessReturn(firm.name="ranbaxyacp",market.name="nifty", - data.object=mmData) +data(StockPriceReturns) +er.result <- excessReturn(market.name="nifty", + data.object=StockPriceReturns) } Modified: pkg/man/marketResidual.Rd =================================================================== --- pkg/man/marketResidual.Rd 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/man/marketResidual.Rd 2013-07-24 11:29:02 UTC (rev 103) @@ -6,14 +6,12 @@ \description{ This function extracts market return using regression from the firm return to get the residual return } -\usage{marketResidual(mm.formula=NULL, data.object) +\usage{marketResidual(data.object, market.name=NULL) } \arguments{ - \item{data.object}{Single time series object with all the variables} - \item{mm.formula}{Here the input is the linear model (lm) formula for eg: a ~ b + c - If formula is not given then first column will be treated as - dependent and rest will be independent} + \item{data.object}{Single time series object with firm/firms and stock index data} + \item{market.name}{Column name of the market index in the data} } \value{ Market residual after extracting market returns from the firm return @@ -22,11 +20,9 @@ \author{Vikram Bahure} \examples{ -data(mmData) -# Forumla for market model -mm.formula <- paste("ranbaxyacp","~","nifty","+","drug",sep="") +data(StockPriceReturns) # Extracting market residual -mm.result <- marketResidual(mm.formula=mm.formula,data.object=mmData) +mm.result <- marketResidual(data.object=StockPriceReturns, market.name="nifty") } Modified: pkg/vignettes/eventstudies.Rnw =================================================================== --- pkg/vignettes/eventstudies.Rnw 2013-07-24 07:22:31 UTC (rev 102) +++ pkg/vignettes/eventstudies.Rnw 2013-07-24 11:29:02 UTC (rev 103) @@ -114,6 +114,14 @@ \section{Software approach} \label{s:approach} The package offers the following functionalities: + + \item Models for calculating returns. These include: + \begin{itemize} + \item Excess returns model + \item Market residual model + \item Augmented market model (AMM) + \end{itemize} + \begin{itemize} \item Coverting the data-set to an event frame. This requires: \begin{itemize} @@ -121,12 +129,7 @@ \item Event dates object with two columns, \textit{unit} and \textit{when}, the date of occurrence of the event. \end{itemize} - \item Models for calculating returns. These include: - \begin{itemize} - \item Market model - \item Augmented market model - \item Excess returns model - \end{itemize} + \item Procedures for inference. These include: \begin{itemize} \item Bootstrapping @@ -161,8 +164,48 @@ @ \subsection{Using the market model} +<<>>= +data(StockPriceReturns) +# Excess return +er.result <- excessReturn(market.name="nifty", + data.object=StockPriceReturns) +@ +<<>>= +# Extracting market residual +mm.result <- marketResidual(data.object=StockPriceReturns, market.name="nifty") +@ + +%AMM model +<<>>= +# Create RHS before running AMM() +data("y3c3") +NIFTY_INDEX <- y3c3$NIFTY_INDEX +INRUSD <- y3c3$INRUSD +Company_A <- y3c3$Company_A +Company_B <- y3c3$Company_B +Company_C <- y3c3$Company_C +regressand <- cbind(Company_A,Company_B,Company_C) + +## One firm +of <- AMM(amm.type="onefirm",rj=Company_A, + nlags=NA, + verbose=TRUE, + dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")), + rM1=NIFTY_INDEX, others=INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) +## Many firms +mf <- AMM(amm.type="manyfirm",regressand=regressand, + nlags=NA, + verbose=TRUE, + dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")), + rM1=NIFTY_INDEX, others=INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) + +@ \subsection{Converting physical dates to event frame} The first step towards event study analysis is to convert the physical dates to event time frame. The event date and the returns on that @@ -206,7 +249,8 @@ es.cs[,1:3] @ -\subsection{Bootstrap inference} +\subsection{Inference procedures} +\subsubsection{Bootstrap inference} After converting to event frame and estimating the interest variable, we need to check the stability of the result and derive other estimates like standard errors and confidence intervals. For this, @@ -224,7 +268,8 @@ @ \begin{figure}[t] \begin{center} - \caption{Stock splits event and response of respective stock returns} + \caption{Stock splits event and response of respective stock + returns: Bootstrap CI} \setkeys{Gin}{width=0.8\linewidth} \setkeys{Gin}{height=0.8\linewidth} <>= @@ -234,7 +279,77 @@ \label{fig:one} \end{figure} +\subsubsection{Wilcoxon signed rank tests} +It is a non-parametric inference test to compute confidence interval. +<<>>= +result <- inference.bootstrap(es.w=es.cs, to.plot=TRUE) +@ +\begin{figure}[t] + \begin{center} + \caption{Stock splits event and response of respective stock + returns: Wilcoxon CI} + \setkeys{Gin}{width=0.8\linewidth} + \setkeys{Gin}{height=0.8\linewidth} +<>= + result <- inference.wilcox(es.w=es.cs, to.plot=TRUE) +@ +\end{center} +\label{fig:two} +\end{figure} +\subsection{General eventstudy function} +This function is wrapper around all the internal functions. This +function gives an option to compute returns like excess return, market +residual and augmented market model. It also gives you an option to +choose inference procedure from bootstrap and wilcoxon to generate +confidence interval. + +<<>>= +## Event study without adjustment +es.na <- eventstudy(inputData = StockPriceReturns, eventList = SplitDates, + width = 10, to.remap = TRUE, remap = "cumsum", + to.plot = TRUE, inference = TRUE, + inference.strategy = "wilcoxon", + type = "None") + +## Event study using market residual and bootstrap +es.mm <- eventstudy(inputData = StockPriceReturns, eventList = SplitDates, + width = 10, to.remap = TRUE, remap = "cumsum", + to.plot = TRUE, inference = TRUE, + inference.strategy = "bootstrap", + type = "marketResidual", market.name = "nifty") + +## Event study using excess return and bootstrap +es.er <- eventstudy(inputData = StockPriceReturns, eventList = SplitDates, + width = 10, to.remap = TRUE, remap = "cumsum", + to.plot = TRUE, inference = TRUE, + inference.strategy = "bootstrap", + type = "excessReturn", market.name = "nifty") + +## Event study using augmented market model (AMM) and bootstrap +of <- AMM(amm.type="onefirm",rj=y3c3$Company_A, + nlags=NA, + verbose=TRUE, + dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", + "2008-01-05","2009-01-03")), + rM1=y3c3$NIFTY_INDEX, others=y3c3$INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) + +## es.ammonefirm <- eventstudy(inputData = NULL, +## eventList = SplitDates, +## width = 10, to.remap = TRUE, remap = "cumsum", +## to.plot = TRUE, inference = TRUE, +## inference.strategy = "bootstrap", +## type = "AMM", amm.type="onefirm", +## rj=y3c3$Company_A, +## rM1=y3c3$NIFTY_INDEX, others=y3c3$INRUSD, +## nlags=NA, verbose=TRUE, +## dates= as.Date(c("2005-01-15","2006-01-07", +## "2007-01-06","2008-01-05","2009-01-03")), +## switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) +@ + + \section{Computational details} The package code is purely written in R. It has dependencies to zoo (\href{http://cran.r-project.org/web/packages/zoo/index.html}{Zeileis From noreply at r-forge.r-project.org Sun Jul 28 10:30:13 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 28 Jul 2013 10:30:13 +0200 (CEST) Subject: [Eventstudies-commits] r104 - in pkg: R man vignettes Message-ID: <20130728083013.A23D3180FAF@r-forge.r-project.org> Author: vikram Date: 2013-07-28 10:30:13 +0200 (Sun, 28 Jul 2013) New Revision: 104 Modified: pkg/R/AMM.R pkg/R/eventstudy.R pkg/man/AMM.Rd pkg/man/eventstudy.Rd pkg/man/manyfirmsAMM.Rd pkg/vignettes/eventstudies.Rnw Log: Modified AMM function, vignette and documentation; Work in progress Modified: pkg/R/AMM.R =================================================================== --- pkg/R/AMM.R 2013-07-24 11:29:02 UTC (rev 103) +++ pkg/R/AMM.R 2013-07-28 08:30:13 UTC (rev 104) @@ -6,7 +6,7 @@ ## List of models currently supported modelsList <- c("onefirm", - "firmExposures") + "firmExposures","manyfirms") if (is.null(amm.type) || length(amm.type) != 1) { stop("Argument amm.type not provided or incorrect") @@ -58,6 +58,9 @@ if (match("dates", names(modelArgs), nomatch = -1) == -1) { dates <- NULL } + if (match("periodnames", names(modelArgs), nomatch = -1) == -1) { + periodnames <- NULL + } ## Assign values @@ -80,18 +83,20 @@ ##----------- if(amm.type == "manyfirms") { # Checking required arguments - if (match("regerssand", names(modelArgs), nomatch = -1) == -1) { + if (match("regressand", names(modelArgs), nomatch = -1) == -1) { stop("Input regressand (firm data) is missing") } X <- makeX(rM1, others, switch.to.innov, rM1purge, nlags, dates, verbose) - result <- manyfirmsAMM(regressand, regressors=X, nlags, verbose, dates) + result <- manyfirmsAMM(regressand, regressors=X, lags=nlags, + verbose = verbose, + dates = dates, periodnames = periodnames) } - #--------------- - # Firm exposures - #--------------- + ##--------------- + ## Firm exposures + ##--------------- if (amm.type=="firmExposures") { # Checking required arguments if (match("rj", names(modelArgs), nomatch = -1) == -1) { @@ -115,15 +120,26 @@ colnames(exposures) <- colnames(X) sds <- exposures periodnames <- NULL - m.residuals <- NULL if(is.null(dates)){ res <- firmExposures(rj,X,verbose=verbose,nlags=nlags) exposures <- res$exposure sds <- res$s.exposure - if(residual==TRUE) - m.residuals <- res$residuals + if(residual==TRUE){ + m.residuals <- xts(res$residuals,as.Date(attr(res$residuals,"names"))) + } }else{ - for(i in 1:(length(dates)-1)){ + tmp <- window(rj,start=dates[1],end=dates[1+1]) + rhs <- window(X,start=dates[1],end=dates[1+1]) + res <- firmExposures(rj=tmp, + X=rhs, + verbose=verbose, + nlags=nlags) + exposures[1,] <- res$exposure + periodnames <- c(periodnames,paste(dates[1],dates[1+1],sep=" TO ")) + sds[1,] <- res$s.exposure + m.residuals <- xts(res$residuals,as.Date(attr(res$residuals,"names"))) + colnames(m.residuals) <- paste(dates[1],"to",dates[1+1],sep=".") + for(i in 2:(length(dates)-1)){ tmp <- window(rj,start=dates[i],end=dates[i+1]) rhs <- window(X,start=dates[i],end=dates[i+1]) res <- firmExposures(rj=tmp, @@ -133,7 +149,9 @@ exposures[i,] <- res$exposure periodnames <- c(periodnames,paste(dates[i],dates[i+1],sep=" TO ")) sds[i,] <- res$s.exposure - m.residuals <- merge(m.residuals,res$residuals,all=TRUE) + period.resid <- xts(res$residuals,as.Date(attr(res$residuals,"names"))) + colnames(period.resid) <- paste(dates[i],"to",dates[i+1],sep=".") + m.residuals <- merge(m.residuals, period.resid, all=TRUE) } rownames(exposures) <- rownames(sds) <- periodnames } @@ -146,8 +164,11 @@ ######################## manyfirmsAMM <-function(regressand,regressors, lags,dates=NULL, periodnames=NULL,verbose=FALSE){ + ## Assigning value for coding usage + rawdates <- 1 if(is.null(dates)){ dates=c(start(regressors),end(regressors)) + rawdates <- NULL periodnames="Full" } nperiods <- length(periodnames) @@ -175,9 +196,9 @@ # Setup a list structure for an OLS that failed empty <- list(exposures=rep(NA,ncol(regressors)), s.exposures=rep(NA,ncol(regressors))) - - for(i in 1:ncol(regressand)){ - if (verbose) {cat ("Doing", colnames(regressand)[i])} + this.resid.final <- list() + for(i in 1:NCOL(regressand)){ + if (verbose) {cat ("Working on", colnames(regressand)[i],"\n")} rj <- regressand[,i] dataset <- cbind(rj, regressors) # This is the full time-series this.exp <- this.sds <- NULL @@ -190,11 +211,32 @@ if(is.null(fe)) {fe <- empty} this.exp <- c(this.exp, fe$exposures) this.sds <- c(this.sds, fe$s.exposures) +### Getting residual + if(j==1){ + this.resid <- xts(fe$residuals, + as.Date(fe$residuals,attr(fe$residuals,"names"))) + colnames(this.resid) <- paste(dates[j],"to",dates[j+1],sep=".") + } else { + tmp.resid <- xts(fe$residuals, + as.Date(fe$residuals,attr(fe$residuals,"names"))) + colnames(tmp.resid) <- paste(dates[j],"to",dates[j+1],sep=".") + this.resid <- merge(this.resid, tmp.resid, all=TRUE) + } } exposures[i,] <- this.exp sds[i,] <- this.sds + this.resid.final[[i]] <- this.resid } - list(exposures=exposures, sds=sds, sig=exposures/sds) + names(this.resid.final) <- colnames(regressand) + ## Merging all firms for no period break + if(is.null(rawdates)){ + final.resid <- do.call(merge,this.resid.final) + colnames(final.resid) <- colnames(regressand) + this.resid.final <- final.resid + } + + list(exposures=exposures, sds=sds, sig=exposures/sds, + residual=this.resid.final) } ############################################### Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2013-07-24 11:29:02 UTC (rev 103) +++ pkg/R/eventstudy.R 2013-07-28 08:30:13 UTC (rev 104) @@ -1,7 +1,7 @@ eventstudy <- function(inputData = NULL, eventList, width = 10, - levels = FALSE, + is.levels = FALSE, type = "marketResidual", to.remap = TRUE, remap = "cumsum", @@ -21,14 +21,25 @@ ## stop("inputData or \"None\" type missing") ## } - if (levels == TRUE) { + if (is.levels == TRUE) { inputData <- diff(log(inputData)) * 100 } ### Run models ## AMM if (type == "AMM") { - outputModel <- AMM(...) + if(amm.type == "onefirm"){ + tmp.outputModel <- AMM(rj = inputData, ...) + outputModel <- zoo(tmp.outputModel$residual,index(tmp.outputModel)) + } + if(amm.type == "manyfirms"){ + tmp.outputModel <- AMM(regressand = inputData, ...) + outputModel <- zoo(tmp.outputModel$residual,index(tmp.outputModel)) + } + if(amm.type == "firmExposures"){ + stop("amm.type firmExposures not used for event study analysis") + } + } ## marketResidual @@ -43,14 +54,15 @@ ### Convert to event frame es <- phys2eventtime(z=outputModel, events=eventList, width=width) - ## colnames(es) <- eventList[which(es$outcomes=="success"),1] + colnames(es) <- eventList[which(es$outcomes=="success"),1] es.w <- window(es$z.e, start = -width, end = width) ### Remapping event frame if (to.remap == TRUE) { es.w <- switch(remap, cumsum = remap.cumsum(es.w, is.pc = FALSE, base = 0), - cumprod = remap.cumprod(es.w, is.pc = TRUE, is.returns = TRUE, base = 100), + cumprod = remap.cumprod(es.w, is.pc = TRUE, + is.returns = TRUE, base = 100), reindex = remap.event.reindex(es.w) ) } Modified: pkg/man/AMM.Rd =================================================================== --- pkg/man/AMM.Rd 2013-07-24 11:29:02 UTC (rev 103) +++ pkg/man/AMM.Rd 2013-07-28 08:30:13 UTC (rev 104) @@ -46,14 +46,21 @@ Company_C <- y3c3$Company_C regressand <- cbind(Company_A,Company_B,Company_C) -# One firm +## One firm of <- AMM(amm.type="onefirm",rj=Company_A, - nlags=NA, verbose=TRUE, dates= as.Date(c("2005-01-15","2006-01-07","2007-01-06", "2008-01-05","2009-01-03")), rM1=NIFTY_INDEX, others=INRUSD, switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) + +## Many firms +mf <- AMM(amm.type="manyfirms",regressand=regressand, + verbose=TRUE, + dates= NULL, + rM1=NIFTY_INDEX, others=INRUSD, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) + } \keyword{AMM} \ No newline at end of file Modified: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd 2013-07-24 11:29:02 UTC (rev 103) +++ pkg/man/eventstudy.Rd 2013-07-28 08:30:13 UTC (rev 104) @@ -10,7 +10,7 @@ eventstudy(inputData = NULL, eventList, width = 10, - levels = FALSE, + is.levels = FALSE, type = "marketResidual", to.remap = TRUE, remap = "cumsum", @@ -29,7 +29,7 @@ \item{type}{This argument gives an option to use different market model adjustment like "marketResidual", "excessReturn", "AMM" and "None"} \item{to.remap}{If TRUE then remap the event frame is done} \item{remap}{This argument is used when to.remap is TRUE to estimate cumulative sum (cumsum), cumulative product (cumprod) or reindex the event frame} - \item{levels}{If the data is in returns format then levels is FALSE else TRUE} + \item{is.levels}{If the data is in returns format then is.levels is FALSE else TRUE} \item{inference}{This argument is used to compute confidence interval for the estimator} \item{inference.strategy}{If inference is TRUE then this argument gives an option to select different inference strategy to compute confidence intervals. Default to bootstrap.} \item{to.plot}{This argument will generate an eventstudy plot of the inference estimated. If to.plot is equal to TRUE then function would generate the plot else it would not. } Modified: pkg/man/manyfirmsAMM.Rd =================================================================== --- pkg/man/manyfirmsAMM.Rd 2013-07-24 11:29:02 UTC (rev 103) +++ pkg/man/manyfirmsAMM.Rd 2013-07-28 08:30:13 UTC (rev 104) @@ -9,7 +9,7 @@ matrix of data obtained from \code{makeX}, and a matrix of LHS variables} \usage{ -manyfirmsAMM(regressand, regressors, lags, dates = NULL, periodnames = NULL, verbose = FALSE) +manyfirmsAMM(regressand, regressors, nlags, dates = NULL, periodnames = NULL, verbose = FALSE) } \arguments{ @@ -23,7 +23,7 @@ market model} \item{dates}{A set of dates that mark out subperiods of - interest} + interest. If dates is NULL then full period is considered.} \item{periodnames}{Name for each subperiod that has been marked by the dates above.} @@ -54,7 +54,7 @@ dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", "2008-01-05","2009-01-03")), verbose=FALSE) regressand <- cbind(Company_A,Company_B,Company_C) -res <- manyfirmsAMM(regressand,regressors,lags=1, +res <- manyfirmsAMM(regressand,regressors,nlags=1, dates=as.Date(c("2005-01-15","2006-01-07","2007-01-06", "2008-01-05","2009-01-03")),periodnames=c("P1","P2","P3","P4"), verbose=FALSE) Modified: pkg/vignettes/eventstudies.Rnw =================================================================== --- pkg/vignettes/eventstudies.Rnw 2013-07-24 11:29:02 UTC (rev 103) +++ pkg/vignettes/eventstudies.Rnw 2013-07-28 08:30:13 UTC (rev 104) @@ -327,6 +327,14 @@ type = "excessReturn", market.name = "nifty") ## Event study using augmented market model (AMM) and bootstrap +data(inr) +inrusd <- zoo(diff(log(inr))*100,index(inr)) +all.data <- merge(StockPriceReturns,inrusd, all = FALSE) +all.data <- window(all.data, start="2004-01-01") +all.data <- all.data[-which(is.na(all.data$nifty)),] +cn.names <- which(colnames(all.data)%in%c("nifty","inr")) +stock.data <- all.data[,-cn.names] + of <- AMM(amm.type="onefirm",rj=y3c3$Company_A, nlags=NA, verbose=TRUE, @@ -335,18 +343,26 @@ rM1=y3c3$NIFTY_INDEX, others=y3c3$INRUSD, switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) -## es.ammonefirm <- eventstudy(inputData = NULL, -## eventList = SplitDates, -## width = 10, to.remap = TRUE, remap = "cumsum", -## to.plot = TRUE, inference = TRUE, -## inference.strategy = "bootstrap", -## type = "AMM", amm.type="onefirm", -## rj=y3c3$Company_A, -## rM1=y3c3$NIFTY_INDEX, others=y3c3$INRUSD, -## nlags=NA, verbose=TRUE, -## dates= as.Date(c("2005-01-15","2006-01-07", -## "2007-01-06","2008-01-05","2009-01-03")), -## switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) + +mf <- AMM(amm.type="manyfirms",regressand=StockPriceReturns[,1:3], + nlags=NA, verbose=TRUE, dates= NULL, + rM1=all.data$nifty, others=all.data$inr, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) +mf1 <- mf$residual +mf1 <- mf1[complete.cases(mf1),] +p1 <- phys2eventtime(z = mf1, events = SplitDates, width = 10) + +es.ammonefirm <- eventstudy(inputData = stock.data[,1:4], + eventList = SplitDates, + width = 10, to.remap = TRUE, remap = "cumsum", + to.plot = TRUE, inference = TRUE, + inference.strategy = "bootstrap", + type = "AMM", amm.type="manyfirms", + rM1=all.data$nifty, others=all.data$inr, + nlags=NA, verbose=TRUE, + dates= NULL, + switch.to.innov=TRUE, rM1purge=TRUE, nlags=1) + @