[Eventstudies-commits] r104 - in pkg: R man vignettes

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jul 28 10:30:13 CEST 2013


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)
+
 @ 
 
 



More information about the Eventstudies-commits mailing list