[Eventstudies-commits] r283 - pkg/R

[noreply at r-forge.r-project.org]

Author: chiraganand
Date: 2014-04-03 17:19:51 +0200 (Thu, 03 Apr 2014)
New Revision: 283

Modified:
   pkg/R/eventstudy.R
   pkg/R/marketResidual.R
   pkg/R/remap.cumprod.R
   pkg/R/remap.cumsum.R
Log:
Moved functions around.

Modified: pkg/R/eventstudy.R
===================================================================
--- pkg/R/eventstudy.R	2014-04-03 10:04:54 UTC (rev 282)
+++ pkg/R/eventstudy.R	2014-04-03 15:19:51 UTC (rev 283)
@@ -2,7 +2,7 @@
                        eventList,
                        width = 10,
                        is.levels =  FALSE,
-                       type = "marketResidual",
+                       type = "None",
                        to.remap = TRUE,
                        remap = "cumsum",
                        inference = TRUE,
@@ -71,7 +71,7 @@
   index(outputModel) <- as.Date(index(outputModel))
     
 ### Convert to event frame
-  es <- phys2eventtime(z=outputModel, events=eventList, width=width)
+  es <- phys2eventtime(z=outputModel, events=eventList, width=0)
 
   if (is.null(es$z.e) || length(es$z.e) == 0) {
     es.w <- NULL

Modified: pkg/R/marketResidual.R
===================================================================
--- pkg/R/marketResidual.R	2014-04-03 10:04:54 UTC (rev 282)
+++ pkg/R/marketResidual.R	2014-04-03 15:19:51 UTC (rev 283)
@@ -8,34 +8,37 @@
 ## Value: Market residual after extracting market returns from the firm return
 
 marketResidual <- function(firm.returns, market.returns){
+  mm.residual <- function(y,x){
+    ## Identify start and end date
+    startdate <- start(x)
+    enddate <- end(x)
+    
+    fulldata <- merge(x,y,all=TRUE)
+    fulldata <- window(fulldata,start=startdate,end=enddate)
+    
+    ## Storing NA observations
+    non.na.loc <- complete.cases(fulldata)
+    fulldata <- fulldata[complete.cases(fulldata),]
+    colnames(fulldata) <- c("x","y")
+    reg <- lm(y ~ x, data = fulldata)
+    
+    result <- rep(NA,length(non.na.loc))
+    result[non.na.loc] <- reg$residuals
+    result <- zoo(result,order.by=index(x))
+    result
+  }
+  
   ## Checking
   if(NCOL(firm.returns)>1){
-    result <- mm.residual(firm.returns[,1], market.returns)
-    for(i in 2:NCOL(firm.returns)){
-      res <- mm.residual(firm.returns[,i], market.returns)
-      result <- cbind(result,res)
+    result <- NULL
+    for(i in 1:NCOL(firm.returns)){
+      res <- mm.residual(y=firm.returns[,i],x=market.returns)
+      result <- merge(result,res,all=TRUE)
     }
     colnames(result) <- colnames(firm.returns)
   } else {
-    result <- mm.residual(firm.returns, market.returns)
+    result <- mm.residual(y=firm.returns,x=market.returns)
   }
-  result <- zoo(result)
   return(result)
 }
 
-mm.residual <- function(firm.returns, market.returns){
-  ## Storing NA observations
-    na.date <- firm.returns[which(complete.cases(firm.returns)==FALSE)]
-    firm <- firm.returns
-    market <- market.returns
-    mm.data <- merge(firm,market,all=TRUE)
-    colnames(mm.data) <- c("firm","market")
-    reg <- lm(firm ~ market, data = mm.data)
-    resid <- xts(reg$residuals,as.Date(attr(reg$residuals,"names")))
-    suppressWarnings(tot.resid <- rbind(resid,
-                                        xts(rep(NA,NROW(na.date)),
-                                            index(na.date))))
-    colnames(tot.resid) <- "firm.residual"
-  return(tot.resid)
-
-}

Modified: pkg/R/remap.cumprod.R
===================================================================
--- pkg/R/remap.cumprod.R	2014-04-03 10:04:54 UTC (rev 282)
+++ pkg/R/remap.cumprod.R	2014-04-03 15:19:51 UTC (rev 283)
@@ -5,7 +5,7 @@
 #    values are like "0.01" for 1%
 # is.returns is false                         in this case is.pc is ignored!
 #    values are like 1.01 for 1%
-remap.cumprod <- function(z, is.pc=TRUE, is.returns=TRUE, base=100) {
+remap.cumprod <- function(z, is.pc=FALSE, is.returns=TRUE, base=100) {
   z <- firstValueZero(z)
   for (i in 1:NCOL(z)) {
     tmp <- z[,i]

Modified: pkg/R/remap.cumsum.R
===================================================================
--- pkg/R/remap.cumsum.R	2014-04-03 10:04:54 UTC (rev 282)
+++ pkg/R/remap.cumsum.R	2014-04-03 15:19:51 UTC (rev 283)
@@ -1,6 +1,6 @@
 
 # If is.pc then a value like "1" means 0.01
-remap.cumsum <- function(z, is.pc=TRUE, base=0) {
+remap.cumsum <- function(z, is.pc=FALSE, base=0) {
   z <- firstValueZero(z)
   for (i in 1:NCOL(z)) {
     tmp <- z[,i]