[Eventstudies-commits] r392 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 22 14:33:47 CET 2014
Author: chiraganand
Date: 2014-11-22 14:33:47 +0100 (Sat, 22 Nov 2014)
New Revision: 392
Modified:
pkg/R/eventstudy.R
pkg/R/lmAMM.R
pkg/R/marketModel.R
pkg/man/eventstudy.Rd
pkg/man/marketModel.Rd
Log:
Fixed creating of arguments to lmAMM, fixed handling of NULLs in model outputs, changed model examples to use the same data, throw a warning for less than 30 observations. Remove merge from marketModel.
Modified: pkg/R/eventstudy.R
===================================================================
--- pkg/R/eventstudy.R 2014-11-21 07:36:09 UTC (rev 391)
+++ pkg/R/eventstudy.R 2014-11-22 13:33:47 UTC (rev 392)
@@ -48,6 +48,7 @@
others = model.args$others))
outcomes <- do.call(c, sapply(returns.zoo, '[', "outcomes"))
+ names(outcomes) <- gsub(".outcomes", "", names(outcomes))
if (all(unique(outcomes) != "success")) {
cat("Error: no successful events\n")
@@ -64,31 +65,29 @@
## Estimating AMM regressors
args.makeX <- list()
- names.args.makeX <- names(model.args) %in% formalArgs(makeX)
- names.args.makeX <- names.args.makeX[-match("market.returns", names(model.args))]
- names.args.makeX <- names.args.makeX[-match("others", names(model.args))]
- args.makeX <- model.args[names.args.makeX]
+ if (!is.null(model.args$nlag.makeX)) {
+ args.makeX$nlags <- model.args$nlag.makeX
+ }
+ names.args.makeX <- names(model.args)[names(model.args) %in% formalArgs(makeX)]
+ names.args.makeX <- names.args.makeX[-match("market.returns", names.args.makeX)]
+ names.args.makeX <- names.args.makeX[-match("others", names.args.makeX)]
+ args.makeX <- append(args.makeX, model.args[names.args.makeX])
+
names.nonfirmreturns <- colnames(firm$z.e)[!colnames(firm$z.e) %in% c("firm.returns", "market.returns")]
args.makeX$market.returns <- firm$z.e[estimation.period, "market.returns"]
args.makeX$others <- firm$z.e[estimation.period, names.nonfirmreturns]
- if (!is.null(model.args$nlag.makeX)) {
- args.makeX$nlags <- model.args$nlag.makeX
- args.makeX <- args.makeX[-match("nlag.makeX", names(args.makeX))]
- }
regressors <- do.call(makeX, args.makeX)
args.lmAMM <- list()
- names.args.makeX <- names.args.makeX[-match("firm.returns", names(model.args))]
- args.lmAMM <- model.args[names(model.args) %in% formalArgs(lmAMM)]
- args.lmAMM$firm.returns <- firm$z.e[estimation.period, "firm.returns"]
- args.lmAMM$X <- regressors
if (!is.null(model.args$nlag.lmAMM)) {
args.lmAMM$nlags <- model.args$nlag.lmAMM
}
+ args.lmAMM <- append(args.lmAMM, model.args[names(model.args) %in% formalArgs(lmAMM)])
+ args.lmAMM$firm.returns <- firm$z.e[estimation.period, "firm.returns"]
+ args.lmAMM$X <- regressors
model <- do.call(lmAMM, args.lmAMM)
if (is.null(model)) {
- cat("lmAMM() returned NULL\n")
return(NULL)
}
@@ -97,17 +96,24 @@
for (i in 2:length(model$exposures)) { # 2: not market returns
abnormal.returns <- abnormal.returns - (model$exposures[i] * firm$z.e[event.period, names.nonfirmreturns[i - 1]])
- print(abnormal.returns)
}
return(abnormal.returns)
})
- if (is.null(outputModel)) {
- cat("Error: lmAMM() returned NULL\n")
+ ## remove the NULL values
+ null.values <- sapply(outputModel, is.null)
+ if (length(which(null.values)) > 0) {
+ outputModel <- outputModel[names(which(!null.values))]
+ outcomes[names(which(null.values))] <- "edatamissing" #:DOC: edatamissing: estimation data missing
}
- outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)])
+ if (length(outputModel) == 0) {
+ warning("lmAMM() returned NULL\n")
+ outputModel <- NULL
+ } else {
+ outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)])
+ }
}
} ## end AMM
@@ -120,6 +126,7 @@
market.returns = model.args$market.returns))
outcomes <- do.call(c, sapply(returns.zoo, '[', "outcomes"))
+ names(outcomes) <- gsub(".outcomes", "", names(outcomes))
if (all(unique(outcomes) != "success")) {
cat("Error: no successful events\n")
@@ -134,7 +141,8 @@
}
estimation.period <- attributes(firm)[["estimation.period"]]
model <- marketModel(firm$z.e[estimation.period, "firm.returns"],
- firm$z.e[estimation.period, "market.returns"],resid = FALSE)
+ firm$z.e[estimation.period, "market.returns"],
+ residuals = FALSE)
abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients["(Intercept)"] -
(model$coefficients["market.returns"] * firm$z.e[event.period, "market.returns"])
@@ -142,11 +150,18 @@
return(abnormal.returns)
})
- if (is.null(outputModel)) {
- cat("Error: marketModel() returned NULL\n")
+ null.values <- sapply(outputModel, is.null)
+ if (length(which(null.values)) > 0) {
+ outputModel <- outputModel[names(which(!null.values))]
+ outcomes[names(which(null.values))] <- "edatamissing"
}
- outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)])
+ if (length(outputModel) == 0) {
+ warning("marketModel() returned NULL")
+ outputModel <- NULL
+ } else {
+ outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)])
+ }
}
} ## END marketModel
@@ -161,9 +176,10 @@
market.returns = model.args$market.returns))
outcomes <- do.call(c, sapply(returns.zoo, '[', "outcomes"))
+ names(outcomes) <- gsub(".outcomes", "", names(outcomes))
if (all(unique(outcomes) != "success")) {
- cat("Error: no successful events\n")
+ message("No successful events")
to.remap = FALSE
inference = FALSE
outputModel <- NULL
@@ -183,8 +199,15 @@
return(abnormal.returns)
})
- if (is.null(outputModel)) {
- cat("Error: marketModel() returned NULL\n")
+ null.values <- sapply(outputModel, is.null)
+ if (length(which(null.values)) > 0) {
+ outputModel <- outputModel[names(which(!null.values))]
+ outcomes[names(which(null.values))] <- "edatamissing"
+ }
+
+ if (length(outputModel) == 0) {
+ warning("excessReturn() returned NULL\n")
+ outputModel <- NULL
} else {
outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)])
}
@@ -211,11 +234,13 @@
if (is.null(outputModel)) {
- return(NULL)
+ final.result <- list(result = NULL,
+ outcomes = as.character(outcomes))
+ class(final.result) <- "es"
+ return(final.result)
} else if (NCOL(outputModel) == 1) {
- name <- event.list[outcomes == "success", "name"]
- event.number <- rownames(event.list[outcomes == "success", ])
- cat("Event date exists only for", name,"\n")
+ event.number <- which(outcomes == "success")
+ message("Only one successful event: #", event.number)
attr(outputModel, which = "dim") <- c(length(outputModel) , 1)
attr(outputModel, which = "dimnames") <- list(NULL, event.number)
if (inference == TRUE) {
@@ -286,7 +311,9 @@
c(list(firm.returns = returns$firm.returns[, firm.name]),
returns[other.returns.names],
all = FALSE, fill = NA))
- ## other.returns.names needs re-assignment here
+ ## other.returns.names needs re-assignment here, since "returns"
+ ## may have a data.frame as one of the elements, as in case of
+ ## lmAMM.
other.returns.names <- colnames(firm.merged)[-match("firm.returns", colnames(firm.merged))]
firm.returns.eventtime <- phys2eventtime(z = firm.merged,
@@ -310,7 +337,7 @@
if (any(firm.returns.eventtime$outcomes == "wrongspan")) {
## :DOC: there could be NAs in firm and other returns in the merged object
- return(list(z.e = NULL, outcomes = "unitmissing")) # phys2eventtime output object
+ return(list(z.e = NULL, outcomes = "wrongspan")) # phys2eventtime output object
}
firm.returns.eventtime$outcomes <- "success" # keep one value
Modified: pkg/R/lmAMM.R
===================================================================
--- pkg/R/lmAMM.R 2014-11-21 07:36:09 UTC (rev 391)
+++ pkg/R/lmAMM.R 2014-11-22 13:33:47 UTC (rev 392)
@@ -141,6 +141,7 @@
}
tmp <- na.omit(tmp)
if (nrow(tmp) < 30) { # refuse to do the work.
+ warning("lmAmm(): less than 30 observations found, returning NULL")
return(NULL) # returns out of do.ols() only
}
Modified: pkg/R/marketModel.R
===================================================================
--- pkg/R/marketModel.R 2014-11-21 07:36:09 UTC (rev 391)
+++ pkg/R/marketModel.R 2014-11-22 13:33:47 UTC (rev 392)
@@ -1,50 +1,44 @@
marketModel <- function(firm.returns, market.returns, residuals = TRUE) {
- returns <- merge(firm.returns, market.returns, all = FALSE, fill = NA)
+ stopifnot(NROW(firm.returns) == NROW(market.returns)) #:DOC
- if (NCOL(market.returns) == 1) {
- market.returns.name <- "market.returns"
- } else {
- market.returns.name <- colnames(market.returns)
- }
- firms.name <- colnames(returns)[-match(market.returns.name, colnames(returns))]
-
# Single firm
- if (NCOL(returns[, firms.name]) == 1) {
- reg <- lm(returns[, firms.name] ~ returns[, market.returns.name],
+ if (NCOL(firm.returns) == 1) {
+ reg <- lm(firm.returns ~ market.returns,
na.action = na.exclude) # :DOC: na.exclude: NAs can
# be seen in prediction
if (residuals == TRUE) {
- resid <- returns[, firms.name] - predict(reg)
+ resid <- firm.returns - predict(reg)
result <- resid
} else {
result <- reg
}
# Multiple firms
- } else
+ } else {
reg <- list()
resids <- list()
- ## :DOC: we don't push the whole data.frame into lm() because it
- ## does na.omit, thereby removing rows from some firms even if
- ## they don't have NAs in them.
- for (i in 1:length(firms.name)) {
- reg[[i]] <- lm(returns[, firms.name[i]] ~ returns[, market.returns.name],
- na.action = na.exclude)
+ ## :DOC: we don't push the whole data.frame into lm() because it
+ ## does na.omit, thereby removing rows from some firms even if
+ ## they don't have NAs in them.
+ for (i in 1:NCOL(firm.returns)) {
+ reg[[i]] <- lm(firm.returns[, i] ~ market.returns,
+ na.action = na.exclude)
+ if (residuals == TRUE) {
+ resids[[i]] <- firm.returns[, i] - predict(reg[[i]])
+ }
+ }
+ names(reg) <- colnames(firm.returns)
+
if (residuals == TRUE) {
- resids[[i]] <- returns[, firms.name[i]] - predict(reg[[i]])
+ names(resids) <- colnames(firm.returns)
+ resids <- do.call("merge", resids)
+ result <- resids
+ } else {
+ result <- reg
}
- }
- names(reg) <- firms.name
+ } # END multiple firms
- if (residuals == TRUE) {
- names(resids) <- firms.name
- resids <- do.call("merge", resids)
- result <- resids
- } else {
- result <- reg
- }
-
return(result)
}
Modified: pkg/man/eventstudy.Rd
===================================================================
--- pkg/man/eventstudy.Rd 2014-11-21 07:36:09 UTC (rev 391)
+++ pkg/man/eventstudy.Rd 2014-11-22 13:33:47 UTC (rev 392)
@@ -227,7 +227,7 @@
# Event study without adjustment
es <- eventstudy(firm.returns = StockPriceReturns,
event.list = SplitDates,
- event.window = 10,
+ event.window = 7,
type = "None",
to.remap = TRUE,
remap = "cumsum",
@@ -239,7 +239,7 @@
# Event study using Market Model
es <- eventstudy(firm.returns = StockPriceReturns,
event.list = SplitDates,
- event.window = 10,
+ event.window = 7,
type = "marketModel",
to.remap = TRUE,
remap = "cumsum",
@@ -258,8 +258,8 @@
stringsAsFactors = FALSE)
es <- eventstudy(firm.returns = StockPriceReturns,
- event.list = events,
- event.window = 10,
+ event.list = SplitDates,
+ event.window = 7,
type = "lmAMM",
to.remap = TRUE,
remap = "cumsum",
@@ -268,7 +268,7 @@
# model arguments
model.args = list(
market.returns = OtherReturns[, "NiftyIndex"],
- others = OtherReturns[, c("USDINR", "CallMoneyRate")],
+ others = OtherReturns[, "USDINR"],
market.returns.purge = TRUE,
nlag.makeX = 5,
nlag.lmAMM = NULL
Modified: pkg/man/marketModel.Rd
===================================================================
--- pkg/man/marketModel.Rd 2014-11-21 07:36:09 UTC (rev 391)
+++ pkg/man/marketModel.Rd 2014-11-22 13:33:47 UTC (rev 392)
@@ -6,7 +6,7 @@
\description{This function extracts residuals from a market model using
function \code{stats:lm}.}
-\usage{marketModel(firm.returns, market.returns)}
+\usage{marketModel(firm.returns, market.returns, residuals = TRUE)}
\arguments{
@@ -15,7 +15,7 @@
\item{market.returns}{a \pkg{zoo} time series of market index returns.}
- \item{resid}{a \sQuote{logical} indicating whether to return
+ \item{residuals}{a \sQuote{logical} indicating whether to return
residuals or \sQuote{lm} object.}
}
More information about the Eventstudies-commits
mailing list