[Eventstudies-commits] r381 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Oct 27 06:35:55 CET 2014
Author: chiraganand
Date: 2014-10-27 06:35:55 +0100 (Mon, 27 Oct 2014)
New Revision: 381
Modified:
pkg/NAMESPACE
pkg/R/eventstudy.R
Log:
Fixed event time conversion of firm returns based on other returns for each firm separately. Added function to compute adjusted returns.
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2014-10-27 05:33:59 UTC (rev 380)
+++ pkg/NAMESPACE 2014-10-27 05:35:55 UTC (rev 381)
@@ -2,7 +2,7 @@
remap.cumsum, remap.cumprod, remap.event.reindex, eesSummary, eesDates,
eesInference, get.clusters.formatted)
-export(marketResidual,
+export(marketModel,
excessReturn)
export(subperiod.lmAMM, manyfirmssubperiod.lmAMM, lmAMM, makeX)
Modified: pkg/R/eventstudy.R
===================================================================
--- pkg/R/eventstudy.R 2014-10-27 05:33:59 UTC (rev 380)
+++ pkg/R/eventstudy.R 2014-10-27 05:35:55 UTC (rev 381)
@@ -34,7 +34,7 @@
# compute estimation and event period
## :DOC: event period starts from event time + 1
- event.period <- as.character((-event.window + 1):event.window) #XXX
+ event.period <- as.character((-event.window + 1):event.window)
### Run models
## AMM
@@ -89,35 +89,24 @@
event.window = event.window,
list(firm.returns = firm.returns, market.returns = model.args$market.returns))
+ outcomes <- unique(sapply(returns.zoo, '[[', "outcomes"))
+
if (all(outcomes != "success")) {
- ## skip everything
to.remap = FALSE
inference = FALSE
} else {
- outputModel <- lapply(1:NCOL(firm.returns.eventtime$z.e), function(col) {
- cat("col", col, "\n")
- ## :DOC: convert market.returns to eventtime so that we can use
- ## model easily on estimation period and event period
- market.returns.event.list <- data.frame(name = "market.returns",
- when = firm.returns.eventtime$events[col])
- # these returns also need to be converted to event time
- market.returns <- other.returns[, "market.returns"]
- if (is.null(ncol(market.returns))) {
- attr(market.returns, which = "dim") <- c(length(market.returns) , 1)
- attr(market.returns, which = "dimnames") <- list(NULL, "market.returns")
- }
- market.returns.eventtime <- phys2eventtime(z = market.returns,
- events = market.returns.event.list,
- width = 0) # width doesn't matter for this
- colnames(market.returns.eventtime$z.e) <- colnames(firm.returns.eventtime$z.e)[col]
+ outputModel <- lapply(returns.zoo, function(firm) {
+ if (is.null(firm$z.e)) {
+ return(NULL)
+ }
+ estimation.period <- attributes(firm)[["estimation.period"]]
+ model <- marketModel(firm$z.e[estimation.period, "firm.returns"],
+ firm$z.e[estimation.period, "market.returns"])
- model <- marketModel(firm.returns.eventtime$z.e[estimation.period, col],
- market.returns.eventtime$z.e[estimation.period, ])
+ abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients[1] -
+ (model$coefficients[2] * firm$z.e[event.period, "market.returns"])
- abnormal.returns <- firm.returns.eventtime$z.e[event.period, col] -
- model$coefficients[1] - (model$coefficients[2] * market.returns.eventtime$z.e[event.period, ])
-
- return(abnormal.returns)
+ return(abnormal.returns)
})
if (is.null(outputModel)) {
@@ -125,11 +114,9 @@
return(NULL)
}
- if (length(outputModel) != 1) {
- outputModel <- do.call(cbind, outputModel)
- names(outputModel) <- colnames(firm.returns.eventtime$z.e)
- }
- } ## END else
+ outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)])
+ }
+
} ## END marketModel
@@ -200,28 +187,59 @@
## 4. estimation.period: vector
prepare.returns <- function(event.list, event.window, ...) {
returns <- unlist(list(...), recursive = FALSE)
+ other.returns.names <- names(returns)[-match("firm.returns", names(returns))]
- ## :DOC:to pick out the common dates of data. can't work on event
- ## time if the dates of data do not match before converting to
- ## event time.
- returns.zoo <- do.call(merge.zoo, append(returns, values = list(all = TRUE, fill = NA)))
+ returns.zoo <- lapply(1:nrow(event.list), function(i) {
+ cat("i:", i, "\n")
+ firm.name <- event.list[i, "name"]
+ # take only firms for which data is present
+ if (any(!firm.name %in% colnames(returns$firm.returns))) {
+ return(list(z.e = NULL, outcome = "unitmissing"))
+ }
- other.returns.names <- names(returns)[-match("firm.returns", names(returns))]
- other.returns <- returns.zoo[, other.returns.names]
- assign("other.returns", value = other.returns, envir = parent.frame())
+ ## :DOC:to pick out the common dates of data. can't work on
+ ## event time if the dates of data do not match before
+ ## converting to event time.
+ # all = FALSE: pick up dates
+ # for which data is available
+ # for all types of returns
+ firm.merged <- do.call("merge.zoo",
+ c(list(firm.returns = returns$firm.returns[, firm.name]),
+ returns[other.returns.names],
+ all = FALSE, fill = NA))
- returns.zoo <- returns.zoo[, -match(other.returns.names, colnames(returns.zoo))]
- firm.returns.eventtime <- phys2eventtime(z = returns.zoo, events = event.list, width = event.window)
- firm.returns.eventtime$z.e <- na.fill(firm.returns.eventtime$z.e, 0) # :DOC
- assign("firm.returns.eventtime", value = firm.returns.eventtime, envir = parent.frame())
- assign("outcomes", value = firm.returns.eventtime$outcomes, envir = parent.frame())
+ firm.returns.eventtime <- phys2eventtime(z = firm.merged,
+ events = rbind(
+ data.frame(name = "firm.returns",
+ when = event.list[i, "when"]),
+ data.frame(name = other.returns.names,
+ when = event.list[i, "when"])),
+ width = event.window)
+ colnames(firm.returns.eventtime$z.e) <- c("firm.returns", other.returns.names)
- ## :DOC: estimation period goes till event time (inclusive)
- assign("estimation.period",
- value = as.character(index(firm.returns.eventtime$z.e)[1]:(-event.window)),
- envir = parent.frame())
+ if (any(firm.returns.eventtime$outcomes == "success")) {
+ ## :DOC: estimation period goes till event time (inclusive)
+ attr(firm.returns.eventtime, which = "estimation.period") <-
+ as.character(index(firm.returns.eventtime$z.e)[1]:(-event.window))
+ }
+
+ return(firm.returns.eventtime)
+ })
+
+ names(returns.zoo) <- event.list[, "name"]
+ assign("returns.zoo", value = returns.zoo, envir = parent.frame())
}
+
+adjusted.returns <- function(firm.returns, rhsvars, intercept, betas) {
+ returns <- merge(firm.returns, rhsvars, all = FALSE, fill = NA)
+ pred <- intercept + apply(rhsvars, 1, function(n) { n %*% t(betas) })
+ returns <- returns[, -match(colnames(rhsvars), colnames(returns))]
+ adj.ret <- returns - pred
+ adj.ret
+}
+
+
#########################
## Functions for class es
#########################
More information about the Eventstudies-commits
mailing list