From noreply at r-forge.r-project.org Thu Nov 13 16:58:18 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 13 Nov 2014 16:58:18 +0100 (CET) Subject: [Eventstudies-commits] r382 - pkg/R Message-ID: <20141113155818.8E34F1874BD@r-forge.r-project.org> Author: chiraganand Date: 2014-11-13 16:58:18 +0100 (Thu, 13 Nov 2014) New Revision: 382 Modified: pkg/R/eventstudy.R Log: Fixed code to run excessReturn and lmAMM after converting all the returns to event time. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-10-27 05:35:55 UTC (rev 381) +++ pkg/R/eventstudy.R 2014-11-13 15:58:18 UTC (rev 382) @@ -2,7 +2,7 @@ event.list, event.window = 10, is.levels = FALSE, - type = "marketResidual", + type = "marketModel", to.remap = TRUE, remap = "cumsum", inference = TRUE, @@ -40,45 +40,72 @@ ## AMM if (type == "lmAMM") { - ## Estimating AMM regressors - args.makeX <- model.args[names(model.args) %in% formalArgs(makeX)] - if (!is.null(model.args$nlag.makeX)) { - args.makeX$nlags <- model.args$nlag.makeX - } - regressors <- do.call(makeX, args.makeX) + cat("preparing paramters\n") + prepare.returns(event.list = event.list, + event.window = event.window, + list(firm.returns = firm.returns, + market.returns = model.args$market.returns, + others = model.args$others)) - args.lmAMM <- model.args[names(model.args) %in% formalArgs(lmAMM)] - args.lmAMM$X <- regressors + outcomes <- unique(sapply(returns.zoo, '[[', "outcomes")) - if (!is.null(model.args$nlag.lmAMM)) { - args.lmAMM$nlags <- model.args$nlag.lmAMM - } + if (all(outcomes != "success")) { + to.remap = FALSE + inference = FALSE + } else { + outputModel <- lapply(returns.zoo, function(firm) { + if (is.null(firm$z.e)) { + return(NULL) + } + estimation.period <- attributes(firm)[["estimation.period"]] - if(NCOL(firm.returns)==1){ - ## One firm - args.lmAMM$firm.returns <- firm.returns - tmp <- resid(do.call(lmAMM, args.lmAMM)) - if (is.null(tmp)) { - cat("lmAMM() returned NULL\n") - return(NULL) + ## 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] + 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 + } + + model <- do.call(lmAMM, args.lmAMM) + if (is.null(model)) { + cat("lmAMM() returned NULL\n") + return(NULL) + } + + abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients[1] - + (model$exposures["market.returns"] * firm$z.e[event.period, "market.returns"]) + + 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: marketModel() returned NULL\n") + return(NULL) } - outputModel <- zoo(x = tmp, order.by = as.Date(names(tmp))) - } else { - ## More than one firm - # Extracting and merging - tmp.resid <- lapply(colnames(firm.returns), function(y) - { - args.lmAMM$firm.returns <- firm.returns[, y] - tmp <- resid(do.call(lmAMM, args.lmAMM)) - if (is.null(tmp)) { - cat("lmAMM() returned NULL\n") - return(NULL) - } - return(zoo(x = tmp, order.by = as.Date(names(tmp)))) - }) - names(tmp.resid) <- colnames(firm.returns) - outputModel <- do.call(merge.zoo, tmp.resid) + outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) } } ## end AMM @@ -122,12 +149,39 @@ ### excessReturn if (type == "excessReturn") { - outputModel <- excessReturn(firm.returns, model.args$market.returns) - if (is.null(outputModel)) { - cat("Error: excessReturn() returned NULL\n") - return(NULL) + cat("preparing paramters\n") + prepare.returns(event.list = event.list, + 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")) { + to.remap = FALSE + inference = FALSE + } else { + outputModel <- lapply(returns.zoo, function(firm) { + if (is.null(firm$z.e)) { + return(NULL) + } + estimation.period <- attributes(firm)[["estimation.period"]] + model <- excessReturn(firm$z.e[estimation.period, "firm.returns"], + firm$z.e[estimation.period, "market.returns"]) + + abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients[1] - + (model$coefficients[2] * firm$z.e[event.period, "market.returns"]) + + return(abnormal.returns) + }) + + if (is.null(outputModel)) { + cat("Error: marketModel() returned NULL\n") + return(NULL) + } + + outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) } - } + } ## end excessReturn if(NCOL(outputModel) == 1) { @@ -181,7 +235,6 @@ } ## return values: -## 1. other.returns: data.frame ## 2. firm.returns.eventtime: data.frame ## 3. outcomes: vector ## 4. estimation.period: vector @@ -207,6 +260,7 @@ c(list(firm.returns = returns$firm.returns[, firm.name]), returns[other.returns.names], all = FALSE, fill = NA)) + other.returns.names <- colnames(firm.merged)[-match("firm.returns", colnames(firm.merged))] firm.returns.eventtime <- phys2eventtime(z = firm.merged, events = rbind( @@ -215,6 +269,9 @@ data.frame(name = other.returns.names, when = event.list[i, "when"])), width = event.window) + if (any(firm.returns.eventtime$outcomes != "success")) { + return(NULL) #XXX + } colnames(firm.returns.eventtime$z.e) <- c("firm.returns", other.returns.names) if (any(firm.returns.eventtime$outcomes == "success")) { From noreply at r-forge.r-project.org Fri Nov 14 14:46:36 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 14 Nov 2014 14:46:36 +0100 (CET) Subject: [Eventstudies-commits] r383 - pkg/man Message-ID: <20141114134636.DC1B31833E1@r-forge.r-project.org> Author: chiraganand Date: 2014-11-14 14:46:36 +0100 (Fri, 14 Nov 2014) New Revision: 383 Added: pkg/man/marketModel.Rd Removed: pkg/man/marketResidual.Rd Modified: pkg/man/eventstudy.Rd Log: Modified eventstudy manual for market model, renamed the market model manual. Modified: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd 2014-11-13 15:58:18 UTC (rev 382) +++ pkg/man/eventstudy.Rd 2014-11-14 13:46:36 UTC (rev 383) @@ -16,7 +16,7 @@ event.list, event.window = 10, is.levels = FALSE, - type = "marketResidual", + type = "marketModel", to.remap = TRUE, remap = "cumsum", inference = TRUE, @@ -76,7 +76,7 @@ \item{model.args}{ All other arguments to be passed depends on whether \sQuote{type} - is \dQuote{marketResidual}, \dQuote{excessReturn}, or + is \dQuote{marketModel}, \dQuote{excessReturn}, or \dQuote{lmAMM}. When \dQuote{None}, no additional arguments will be needed. See \sQuote{Details}. } @@ -91,8 +91,8 @@ \dQuote{type} currently supports: \itemize{ - \item{\dQuote{marketResidual}: uses \code{\link{marketResidual}} - function to extract market returns from firms return using a + \item{\dQuote{marketModel}: uses \code{\link{marketModel}} + function to regress market returns on firms return using a linear model.} \item{\dQuote{excessReturn}: uses \code{\link{excessReturn}} to @@ -137,7 +137,7 @@ the relevant functions are listed here: \itemize{ - \item \dQuote{marketResidual}: \cr + \item \dQuote{marketModel}: \cr - market.returns \item \dQuote{excessReturn}: \cr - market.returns @@ -209,7 +209,7 @@ \author{Ajay Shah, Chirag Anand, Vikram Bahure, Vimal Balasubramaniam} \seealso{ \code{\link{lmAMM}}, - \code{\link{marketResidual}}, + \code{\link{marketModel}}, \code{\link{excessReturn}}, \code{\link{phys2eventtime}}, \code{\link{inference.bootstrap}}, @@ -240,7 +240,7 @@ es <- eventstudy(firm.returns = StockPriceReturns, event.list = SplitDates, event.window = 10, - type = "marketResidual", + type = "marketModel", to.remap = TRUE, remap = "cumsum", inference = TRUE, Copied: pkg/man/marketModel.Rd (from rev 374, pkg/man/marketResidual.Rd) =================================================================== --- pkg/man/marketModel.Rd (rev 0) +++ pkg/man/marketModel.Rd 2014-11-14 13:46:36 UTC (rev 383) @@ -0,0 +1,37 @@ +\name{marketModel} +\alias{marketModel} + +\title{Extract residuals from a market model} + +\description{This function extracts residuals from a market model using + function \code{stats:lm}.} + +\usage{marketModel(firm.returns, market.returns)} + +\arguments{ + + \item{firm.returns}{a \pkg{zoo} time series object (univariate or + otherwise) with firm returns.} + + \item{market.returns}{a \pkg{zoo} time series of market index returns.} +} + +\value{Residual returns unexplained by market index returns.} + +\author{Vikram Bahure} + +\examples{ +data("StockPriceReturns") +data("OtherReturns") + +mm.result <- marketModel(firm.returns = StockPriceReturns, + market.returns = OtherReturns$NiftyIndex) + +comparison <- merge(MarketResidual = mm.result$Infosys, + Infosys = StockPriceReturns$Infosys, + NiftyIndex = OtherReturns$NiftyIndex, + all = FALSE) +plot(comparison) +} + +\keyword{marketModel} Deleted: pkg/man/marketResidual.Rd =================================================================== --- pkg/man/marketResidual.Rd 2014-11-13 15:58:18 UTC (rev 382) +++ pkg/man/marketResidual.Rd 2014-11-14 13:46:36 UTC (rev 383) @@ -1,37 +0,0 @@ -\name{marketResidual} -\alias{marketResidual} - -\title{Extract residuals from a market model} - -\description{This function extracts residuals from a market model using - function \code{stats:lm}.} - -\usage{marketResidual(firm.returns, market.returns)} - -\arguments{ - - \item{firm.returns}{a \pkg{zoo} time series object (univariate or - otherwise) with firm returns.} - - \item{market.returns}{a \pkg{zoo} time series of market index returns.} -} - -\value{Residual returns unexplained by market index returns.} - -\author{Vikram Bahure} - -\examples{ -data("StockPriceReturns") -data("OtherReturns") - -mm.result <- marketResidual(firm.returns = StockPriceReturns, - market.returns = OtherReturns$NiftyIndex) - -comparison <- merge(MarketResidual = mm.result$Infosys, - Infosys = StockPriceReturns$Infosys, - NiftyIndex = OtherReturns$NiftyIndex, - all = FALSE) -plot(comparison) -} - -\keyword{marketResidual} From noreply at r-forge.r-project.org Sat Nov 15 12:37:06 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 15 Nov 2014 12:37:06 +0100 (CET) Subject: [Eventstudies-commits] r384 - pkg/R Message-ID: <20141115113706.8C21A1876AF@r-forge.r-project.org> Author: chiraganand Date: 2014-11-15 12:37:06 +0100 (Sat, 15 Nov 2014) New Revision: 384 Modified: pkg/R/eventstudy.R Log: Fixed assignment to global variable. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-14 13:46:36 UTC (rev 383) +++ pkg/R/eventstudy.R 2014-11-15 11:37:06 UTC (rev 384) @@ -41,11 +41,11 @@ if (type == "lmAMM") { cat("preparing paramters\n") - prepare.returns(event.list = event.list, - event.window = event.window, - list(firm.returns = firm.returns, - market.returns = model.args$market.returns, - others = model.args$others)) + returns.zoo <- prepare.returns(event.list = event.list, + event.window = event.window, + list(firm.returns = firm.returns, + market.returns = model.args$market.returns, + others = model.args$others)) outcomes <- unique(sapply(returns.zoo, '[[', "outcomes")) @@ -101,7 +101,7 @@ }) if (is.null(outputModel)) { - cat("Error: marketModel() returned NULL\n") + cat("Error: lmAMM() returned NULL\n") return(NULL) } @@ -112,9 +112,10 @@ ### marketModel if (type == "marketModel") { cat("preparing paramters\n") - prepare.returns(event.list = event.list, - event.window = event.window, - list(firm.returns = firm.returns, market.returns = model.args$market.returns)) + returns.zoo <- prepare.returns(event.list = event.list, + event.window = event.window, + list(firm.returns = firm.returns, + market.returns = model.args$market.returns)) outcomes <- unique(sapply(returns.zoo, '[[', "outcomes")) @@ -150,9 +151,10 @@ ### excessReturn if (type == "excessReturn") { cat("preparing paramters\n") - prepare.returns(event.list = event.list, - event.window = event.window, - list(firm.returns = firm.returns, market.returns = model.args$market.returns)) + returns.zoo <- prepare.returns(event.list = event.list, + event.window = event.window, + list(firm.returns = firm.returns, + market.returns = model.args$market.returns)) outcomes <- unique(sapply(returns.zoo, '[[', "outcomes")) @@ -245,9 +247,9 @@ 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 + # :DOC: take only firms for which data is present if (any(!firm.name %in% colnames(returns$firm.returns))) { - return(list(z.e = NULL, outcome = "unitmissing")) + return(list(z.e = NULL, outcome = "unitmissing")) # phys2eventtime output object } ## :DOC:to pick out the common dates of data. can't work on @@ -270,7 +272,8 @@ when = event.list[i, "when"])), width = event.window) if (any(firm.returns.eventtime$outcomes != "success")) { - return(NULL) #XXX + ## :DOC: there could be NAs in firm and other returns in the merged object + return(list(z.e = NULL, outcome = "wdatamissing")) # phys2eventtime output object } colnames(firm.returns.eventtime$z.e) <- c("firm.returns", other.returns.names) @@ -284,7 +287,7 @@ }) names(returns.zoo) <- event.list[, "name"] - assign("returns.zoo", value = returns.zoo, envir = parent.frame()) + return(returns.zoo) } From noreply at r-forge.r-project.org Sat Nov 15 15:15:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 15 Nov 2014 15:15:31 +0100 (CET) Subject: [Eventstudies-commits] r385 - pkg/R Message-ID: <20141115141532.0E55F187207@r-forge.r-project.org> Author: chiraganand Date: 2014-11-15 15:15:31 +0100 (Sat, 15 Nov 2014) New Revision: 385 Modified: pkg/R/eventstudy.R pkg/R/phys2eventtime.R Log: Fixed error handling for no successful outcomes, added type = None handling, fixed variable names, fixed attribute assignment. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-15 11:37:06 UTC (rev 384) +++ pkg/R/eventstudy.R 2014-11-15 14:15:31 UTC (rev 385) @@ -47,12 +47,15 @@ market.returns = model.args$market.returns, others = model.args$others)) - outcomes <- unique(sapply(returns.zoo, '[[', "outcomes")) + outcomes <- do.call(c, sapply(returns.zoo, '[', "outcomes")) - if (all(outcomes != "success")) { + if (all(unique(outcomes) != "success")) { + cat("Error: no successful events\n") to.remap = FALSE inference = FALSE + outputModel <- NULL } else { + returns.zoo <- returns.zoo[which(outcomes == "success")] outputModel <- lapply(returns.zoo, function(firm) { if (is.null(firm$z.e)) { return(NULL) @@ -102,7 +105,6 @@ if (is.null(outputModel)) { cat("Error: lmAMM() returned NULL\n") - return(NULL) } outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) @@ -117,12 +119,15 @@ list(firm.returns = firm.returns, market.returns = model.args$market.returns)) - outcomes <- unique(sapply(returns.zoo, '[[', "outcomes")) + outcomes <- do.call(c, sapply(returns.zoo, '[', "outcomes")) - if (all(outcomes != "success")) { + if (all(unique(outcomes) != "success")) { + cat("Error: no successful events\n") to.remap = FALSE inference = FALSE + outputModel <- NULL } else { + returns.zoo <- returns.zoo[which(outcomes == "success")] outputModel <- lapply(returns.zoo, function(firm) { if (is.null(firm$z.e)) { return(NULL) @@ -139,7 +144,6 @@ if (is.null(outputModel)) { cat("Error: marketModel() returned NULL\n") - return(NULL) } outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) @@ -156,12 +160,15 @@ list(firm.returns = firm.returns, market.returns = model.args$market.returns)) - outcomes <- unique(sapply(returns.zoo, '[[', "outcomes")) + outcomes <- do.call(c, sapply(returns.zoo, '[', "outcomes")) - if (all(outcomes != "success")) { + if (all(unique(outcomes) != "success")) { + cat("Error: no successful events\n") to.remap = FALSE inference = FALSE + outputModel <- NULL } else { + returns.zoo <- returns.zoo[which(outcomes == "success")] outputModel <- lapply(returns.zoo, function(firm) { if (is.null(firm$z.e)) { return(NULL) @@ -178,15 +185,34 @@ if (is.null(outputModel)) { cat("Error: marketModel() returned NULL\n") - return(NULL) + } else { + outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) } - - outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) } } ## end excessReturn - if(NCOL(outputModel) == 1) { +### None + if (type == "None") { + returns.zoo <- prepare.returns(event.list = event.list, + event.window = event.window, + list(firm.returns = firm.returns)) + + outcomes <- returns.zoo$outcomes # its only a single list in this case + if (all(unique(outcomes) != "success")) { + cat("Error: no successful events\n") + to.remap = FALSE + inference = FALSE + outputModel <- NULL + } else { + outputModel <- returns.zoo$z.e[event.period] + } + } ## end None + + + if (is.null(outputModel)) { + return(NULL) + } else if(NCOL(outputModel) == 1) { # XXX: needs checking and fixing name <- event.list[outcomes == "success", "name"] event.number <- rownames(event.list[outcomes == "success", ]) cat("Event date exists only for", name,"\n") @@ -201,35 +227,37 @@ ### Remapping event frame if (to.remap == TRUE) { - es.w <- switch(remap, + outputModel <- switch(remap, cumsum = remap.cumsum(outputModel, is.pc = FALSE, base = 0), cumprod = remap.cumprod(outputModel, is.pc = TRUE, is.returns = TRUE, base = 100), reindex = remap.event.reindex(outputModel) ) + remapping <- remap + } else { + remapping <- "none" } ### Inference: confidence intervals - if(inference == TRUE){ + if (inference == TRUE) { ## Bootstrap if(inference.strategy == "bootstrap"){ - result <- inference.bootstrap(es.w = es.w, to.plot = FALSE) + outputModel <- inference.bootstrap(es.w = outputModel, to.plot = FALSE) } ## Wilcoxon if(inference.strategy == "wilcoxon"){ - result <- inference.wilcox(es.w = es.w, to.plot = FALSE) + outputModel <- inference.wilcox(es.w = outputModel, to.plot = FALSE) } - } else { - ## Providing event frame as default output - result <- outputModel } - if(to.remap==TRUE){remapping <- remap} else {remapping <- "none"} - final.result <- list(result = result, + final.result <- list(result = outputModel, outcomes = as.character(outcomes)) - attr(final.result, which = "inference") <- inference.strategy attr(final.result, which = "event.window") <- event.window + attr(final.result, which = "inference") <- inference + if (inference == TRUE) { + attr(final.result, which = "inference.strategy") <- inference.strategy + } attr(final.result, which = "remap") <- remapping class(final.result) <- "es" @@ -244,14 +272,10 @@ returns <- unlist(list(...), recursive = FALSE) other.returns.names <- names(returns)[-match("firm.returns", names(returns))] + if (length(other.returns.names) != 0) { # check for type = "None" returns.zoo <- lapply(1:nrow(event.list), function(i) { cat("i:", i, "\n") firm.name <- event.list[i, "name"] - # :DOC: take only firms for which data is present - if (any(!firm.name %in% colnames(returns$firm.returns))) { - return(list(z.e = NULL, outcome = "unitmissing")) # phys2eventtime output object - } - ## :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. @@ -262,31 +286,50 @@ 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 <- colnames(firm.merged)[-match("firm.returns", colnames(firm.merged))] firm.returns.eventtime <- phys2eventtime(z = firm.merged, events = rbind( data.frame(name = "firm.returns", - when = event.list[i, "when"]), + when = event.list[i, "when"], + stringsAsFactors = FALSE), data.frame(name = other.returns.names, - when = event.list[i, "when"])), - width = event.window) - if (any(firm.returns.eventtime$outcomes != "success")) { + when = event.list[i, "when"], + stringsAsFactors = FALSE)), + width = event.window) + + if (any(firm.returns.eventtime$outcomes == "unitmissing")) { ## :DOC: there could be NAs in firm and other returns in the merged object - return(list(z.e = NULL, outcome = "wdatamissing")) # phys2eventtime output object + return(list(z.e = NULL, outcomes = "unitmissing")) # phys2eventtime output object } - colnames(firm.returns.eventtime$z.e) <- c("firm.returns", other.returns.names) - 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)) + if (any(firm.returns.eventtime$outcomes == "wdatamissing")) { + return(list(z.e = NULL, outcomes = "wdatamissing")) # phys2eventtime output object } + 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 + } + + firm.returns.eventtime$outcomes <- "success" # keep one value + + colnames(firm.returns.eventtime$z.e) <- c("firm.returns", other.returns.names) + ## :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) <- 1:nrow(event.list) - names(returns.zoo) <- event.list[, "name"] + } else { + returns.zoo <- phys2eventtime(z = returns$firm.returns, + events = event.list, + width = event.window) + } + return(returns.zoo) } @@ -317,10 +360,13 @@ print.es(object, ...) } +## XXX: needs fixing for non-inference objects plot.es <- function(x, xlab = NULL, ylab = NULL, ...){ - if (NCOL(x$result) < 3) { - cat("Error: No confidence bands available to plot.\n") - return(invisible(NULL)) + if (!attributes(x)$inference) { + if (NCOL(x$result) < 3) { + cat("Error: No confidence bands available to plot.\n") + return(invisible(NULL)) + } } big <- max(abs(x$result)) hilo <- c(-big,big) Modified: pkg/R/phys2eventtime.R =================================================================== --- pkg/R/phys2eventtime.R 2014-11-15 11:37:06 UTC (rev 384) +++ pkg/R/phys2eventtime.R 2014-11-15 14:15:31 UTC (rev 385) @@ -18,6 +18,9 @@ if (!any(class(events$when) %in% c("POSIXt", "Date"))) { stop("events$when should be one of 'Date' or 'date-time' classes.") } + if (!is.character(events$name)) { + stop("events$name should a character class.") + } answer <- lapply(1:nrow(events), function(i) timeshift(events[i, ], z)) outcomes <- sapply(answer, function(x) x$outcome) From noreply at r-forge.r-project.org Sat Nov 15 15:22:10 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 15 Nov 2014 15:22:10 +0100 (CET) Subject: [Eventstudies-commits] r386 - pkg/R Message-ID: <20141115142210.336911873C0@r-forge.r-project.org> Author: chiraganand Date: 2014-11-15 15:22:09 +0100 (Sat, 15 Nov 2014) New Revision: 386 Modified: pkg/R/eventstudy.R Log: Fixed handling of univariate series. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-15 14:15:31 UTC (rev 385) +++ pkg/R/eventstudy.R 2014-11-15 14:22:09 UTC (rev 386) @@ -212,11 +212,11 @@ if (is.null(outputModel)) { return(NULL) - } else if(NCOL(outputModel) == 1) { # XXX: needs checking and fixing + } 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") - attr(outputModel, which = "dim") <- c(1 , 1) + attr(outputModel, which = "dim") <- c(length(outputModel) , 1) attr(outputModel, which = "dimnames") <- list(NULL, event.number) if (inference == TRUE) { warning("No inference strategy for single successful event.","\n") From noreply at r-forge.r-project.org Tue Nov 18 12:30:23 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 18 Nov 2014 12:30:23 +0100 (CET) Subject: [Eventstudies-commits] r387 - pkg/R Message-ID: <20141118113023.1F59A186CF0@r-forge.r-project.org> Author: chiraganand Date: 2014-11-18 12:30:22 +0100 (Tue, 18 Nov 2014) New Revision: 387 Modified: pkg/R/eventstudy.R pkg/R/marketModel.R Log: New market model function, introduces resid argument for returning residuals. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-15 14:22:09 UTC (rev 386) +++ pkg/R/eventstudy.R 2014-11-18 11:30:22 UTC (rev 387) @@ -92,7 +92,7 @@ return(NULL) } - abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients[1] - + abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients["(Intercept)"] - (model$exposures["market.returns"] * firm$z.e[event.period, "market.returns"]) for (i in 2:length(model$exposures)) { # 2: not market returns @@ -134,10 +134,10 @@ } estimation.period <- attributes(firm)[["estimation.period"]] model <- marketModel(firm$z.e[estimation.period, "firm.returns"], - firm$z.e[estimation.period, "market.returns"]) + firm$z.e[estimation.period, "market.returns"],resid = FALSE) - 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$z.e[event.period, "firm.returns"] - model$coefficients["(Intercept)"] - + (model$coefficients["market.returns"] * firm$z.e[event.period, "market.returns"]) return(abnormal.returns) }) @@ -334,15 +334,6 @@ } -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 ######################### Modified: pkg/R/marketModel.R =================================================================== --- pkg/R/marketModel.R 2014-11-15 14:22:09 UTC (rev 386) +++ pkg/R/marketModel.R 2014-11-18 11:30:22 UTC (rev 387) @@ -1,7 +1,32 @@ -marketModel <- function(firm.returns, market.returns) { +marketModel <- function(firm.returns, market.returns,resid=TRUE) { returns <- merge(firm.returns, market.returns, all = FALSE, fill = NA) market.returns <- returns$market.returns returns <- returns[, -match("market.returns", colnames(returns))] - reg <- lm(returns ~ market.returns, na.action = na.exclude) - return(reg) + if(NCOL(returns)==1){ ## Output for a single firm + reg <- lm(returns ~ market.returns, na.action = na.exclude) #:DOC: na.exclude + if(resid==TRUE){ ## MM-residuals for a single firm + resid <- returns - predict(reg) + return(resid) + }else{ ## Model estimates for a single firm + return(reg) + } + }else{ ## Multi-firm case + reg <- list() + resids <- list() + if(resid==TRUE){ ## Residuals for the multi-firm case + for(i in 1:ncol(returns)){ + reg[[i]] <- lm(returns[,i] ~ market.returns, na.action = na.exclude) + resids[[i]] <- returns[,i]-predict(reg[[i]]) + } + names(resids) <- colnames(returns) + resid <- do.call("merge",resids) + return(resid) + }else{ ## Model estimates for the multi-firm case + for(i in 1:ncol(returns)){ + reg[[i]] <- lm(returns[,i] ~ market.returns, na.action = na.exclude) + } + names(reg) <- colnames(returns) + return(reg) + } + } } From noreply at r-forge.r-project.org Tue Nov 18 12:41:07 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 18 Nov 2014 12:41:07 +0100 (CET) Subject: [Eventstudies-commits] r388 - pkg/inst/tests Message-ID: <20141118114107.39FB018753B@r-forge.r-project.org> Author: chiraganand Date: 2014-11-18 12:41:06 +0100 (Tue, 18 Nov 2014) New Revision: 388 Added: pkg/inst/tests/tests.txt Log: Added file covering the package functions for testing purposes. Added: pkg/inst/tests/tests.txt =================================================================== --- pkg/inst/tests/tests.txt (rev 0) +++ pkg/inst/tests/tests.txt 2014-11-18 11:41:06 UTC (rev 388) @@ -0,0 +1,62 @@ +## Flow +Testing functions in eventstudies package. + +1. Remap functions + 1. remap.cumsum + 1. Make the first value 0. + 2. See if its not percentage data, then divide by 100. + 3. Cumulate by summing. + 2. remap.cumprod + 1. Make the first value 0. + 2. Check for is.returns and is.pc, and compute the returns or + percentage. + 3. Cumulate by multiplication. +2. Inference procedures + 1. inference.bootstrap + 2. inference.wilcox +3. Models + 1. lmAMM + 2. marketModel + 3. excessReturn + 4. None (will be tested as part of eventstudy()) +4. phys2eventtime() + 1. Checking for class of arguments. + 2. Conversion to event time for each event. + 3. Filter out any non-successful events. + 4. Check for no successful outcomes, return NULL. + 5. Assign colnames of successful events. + 6. Assign attributes. + 7. Check for missing data (NAs), and change the outcomes based on that. + 8. Check if only successful outcomes are being returned inside "z.e". + 9. Return list of event time data.frame and list of events found. +5. Aggregator function: eventstudy + Steps: + 1. prepare.returns(): for (model != "None") and (number of returns > 1) + - Merge all the returns (firm.returns, currency, and/or market) + into one 'zoo' object. + - Convert the merged object for each event separately to event + time. + - Store the outcomes as attributes of the event time object. + - Return a 'list' of event time objects for each event. + 2. prepare.returns(): for (model = "None") and (number of returns = 1) + - Convert the whole zoo object 'firm.returns' to event time. + - Returns this object as a whole. + 3. Check whether all the outcomes are not "success". + 4. If model is not "None", run the model program for each object in + the returned list, and return the series index only within the + event window. + 5. If model is None, then directly return the series within the + event window. + 6. Check for any NULL values. + 7. Handle univariate output: convert to a single column zoo object. + 8. Perform remapping if asked by the user. + 9. Perform inference if asked by the user. + 10. Assign attributes to the final object. +6. Utility functions + 1. print.es + 2. plot.es + 3. summary.es +7. ees functionality + 1. eesInference + 2. eesDates + 3. eesSummary From noreply at r-forge.r-project.org Tue Nov 18 12:57:14 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 18 Nov 2014 12:57:14 +0100 (CET) Subject: [Eventstudies-commits] r389 - pkg/R Message-ID: <20141118115714.7C21B1844B3@r-forge.r-project.org> Author: chiraganand Date: 2014-11-18 12:57:14 +0100 (Tue, 18 Nov 2014) New Revision: 389 Modified: pkg/R/marketModel.R Log: Code formatting changes. Modified: pkg/R/marketModel.R =================================================================== --- pkg/R/marketModel.R 2014-11-18 11:41:06 UTC (rev 388) +++ pkg/R/marketModel.R 2014-11-18 11:57:14 UTC (rev 389) @@ -1,28 +1,28 @@ -marketModel <- function(firm.returns, market.returns,resid=TRUE) { +marketModel <- function(firm.returns, market.returns,resid = TRUE) { returns <- merge(firm.returns, market.returns, all = FALSE, fill = NA) market.returns <- returns$market.returns returns <- returns[, -match("market.returns", colnames(returns))] - if(NCOL(returns)==1){ ## Output for a single firm + if (NCOL(returns) == 1) { # Output for a single firm reg <- lm(returns ~ market.returns, na.action = na.exclude) #:DOC: na.exclude - if(resid==TRUE){ ## MM-residuals for a single firm + if (resid == TRUE) { ## MM-residuals for a single firm resid <- returns - predict(reg) return(resid) - }else{ ## Model estimates for a single firm + } else { ## Model estimates for a single firm return(reg) } - }else{ ## Multi-firm case + } else { ## Multi-firm case reg <- list() resids <- list() - if(resid==TRUE){ ## Residuals for the multi-firm case - for(i in 1:ncol(returns)){ - reg[[i]] <- lm(returns[,i] ~ market.returns, na.action = na.exclude) - resids[[i]] <- returns[,i]-predict(reg[[i]]) + if (resid == TRUE) { ## Residuals for the multi-firm case + for (i in 1:ncol(returns)) { + reg[[i]] <- lm(returns[, i] ~ market.returns, na.action = na.exclude) + resids[[i]] <- returns[, i] - predict(reg[[i]]) } names(resids) <- colnames(returns) - resid <- do.call("merge",resids) + resid <- do.call("merge", resids) return(resid) - }else{ ## Model estimates for the multi-firm case - for(i in 1:ncol(returns)){ + } else { ## Model estimates for the multi-firm case + for (i in 1:ncol(returns)) { reg[[i]] <- lm(returns[,i] ~ market.returns, na.action = na.exclude) } names(reg) <- colnames(returns) From noreply at r-forge.r-project.org Fri Nov 21 08:01:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 21 Nov 2014 08:01:33 +0100 (CET) Subject: [Eventstudies-commits] r390 - in pkg: R man Message-ID: <20141121070133.E1F13184BBA@r-forge.r-project.org> Author: chiraganand Date: 2014-11-21 08:01:33 +0100 (Fri, 21 Nov 2014) New Revision: 390 Modified: pkg/R/marketModel.R pkg/man/marketModel.Rd Log: Changed argument name to residuals, since resid is a function already. Cleaned up the code. Modified: pkg/R/marketModel.R =================================================================== --- pkg/R/marketModel.R 2014-11-18 11:57:14 UTC (rev 389) +++ pkg/R/marketModel.R 2014-11-21 07:01:33 UTC (rev 390) @@ -1,32 +1,50 @@ -marketModel <- function(firm.returns, market.returns,resid = TRUE) { +marketModel <- function(firm.returns, market.returns, residuals = TRUE) { returns <- merge(firm.returns, market.returns, all = FALSE, fill = NA) - market.returns <- returns$market.returns - returns <- returns[, -match("market.returns", colnames(returns))] - if (NCOL(returns) == 1) { # Output for a single firm - reg <- lm(returns ~ market.returns, na.action = na.exclude) #:DOC: na.exclude - if (resid == TRUE) { ## MM-residuals for a single firm - resid <- returns - predict(reg) - return(resid) - } else { ## Model estimates for a single firm - return(reg) + + 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], + na.action = na.exclude) # :DOC: na.exclude: NAs can + # be seen in prediction + + if (residuals == TRUE) { + resid <- returns[, firms.name] - predict(reg) + result <- resid + } else { + result <- reg } - } else { ## Multi-firm case + # Multiple firms + } else reg <- list() resids <- list() - if (resid == TRUE) { ## Residuals for the multi-firm case - for (i in 1:ncol(returns)) { - reg[[i]] <- lm(returns[, i] ~ market.returns, na.action = na.exclude) - resids[[i]] <- returns[, i] - predict(reg[[i]]) - } - names(resids) <- colnames(returns) - resid <- do.call("merge", resids) - return(resid) - } else { ## Model estimates for the multi-firm case - for (i in 1:ncol(returns)) { - reg[[i]] <- lm(returns[,i] ~ market.returns, na.action = na.exclude) - } - names(reg) <- colnames(returns) - return(reg) + + ## :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) + + if (residuals == TRUE) { + resids[[i]] <- returns[, firms.name[i]] - predict(reg[[i]]) } } + names(reg) <- firms.name + + if (residuals == TRUE) { + names(resids) <- firms.name + resids <- do.call("merge", resids) + result <- resids + } else { + result <- reg + } + + return(result) } Modified: pkg/man/marketModel.Rd =================================================================== --- pkg/man/marketModel.Rd 2014-11-18 11:57:14 UTC (rev 389) +++ pkg/man/marketModel.Rd 2014-11-21 07:01:33 UTC (rev 390) @@ -14,6 +14,9 @@ otherwise) with firm returns.} \item{market.returns}{a \pkg{zoo} time series of market index returns.} + + \item {resid}{a \sQuote{logical} indicating whether to return + residuals or \sQuote{lm} object.} } \value{Residual returns unexplained by market index returns.} @@ -25,7 +28,8 @@ data("OtherReturns") mm.result <- marketModel(firm.returns = StockPriceReturns, - market.returns = OtherReturns$NiftyIndex) + market.returns = OtherReturns$NiftyIndex, + residuals = TRUE) comparison <- merge(MarketResidual = mm.result$Infosys, Infosys = StockPriceReturns$Infosys, From noreply at r-forge.r-project.org Fri Nov 21 08:36:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 21 Nov 2014 08:36:09 +0100 (CET) Subject: [Eventstudies-commits] r391 - pkg/man Message-ID: <20141121073609.ED0341872B3@r-forge.r-project.org> Author: chiraganand Date: 2014-11-21 08:36:09 +0100 (Fri, 21 Nov 2014) New Revision: 391 Modified: pkg/man/marketModel.Rd Log: Removed extra space. Modified: pkg/man/marketModel.Rd =================================================================== --- pkg/man/marketModel.Rd 2014-11-21 07:01:33 UTC (rev 390) +++ pkg/man/marketModel.Rd 2014-11-21 07:36:09 UTC (rev 391) @@ -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{resid}{a \sQuote{logical} indicating whether to return residuals or \sQuote{lm} object.} } From noreply at r-forge.r-project.org Sat Nov 22 14:33:47 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 22 Nov 2014 14:33:47 +0100 (CET) Subject: [Eventstudies-commits] r392 - in pkg: R man Message-ID: <20141122133347.8C7CD183E0A@r-forge.r-project.org> 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.} } From noreply at r-forge.r-project.org Sat Nov 22 14:34:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 22 Nov 2014 14:34:46 +0100 (CET) Subject: [Eventstudies-commits] r393 - pkg/data Message-ID: <20141122133446.F33EC1848D1@r-forge.r-project.org> Author: chiraganand Date: 2014-11-22 14:34:46 +0100 (Sat, 22 Nov 2014) New Revision: 393 Modified: pkg/data/OtherReturns.rda Log: Removed last row to make it similar to firm returns data. Modified: pkg/data/OtherReturns.rda =================================================================== (Binary files differ) From noreply at r-forge.r-project.org Sat Nov 22 14:35:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 22 Nov 2014 14:35:33 +0100 (CET) Subject: [Eventstudies-commits] r394 - pkg/man Message-ID: <20141122133534.0AF60183FA6@r-forge.r-project.org> Author: chiraganand Date: 2014-11-22 14:35:33 +0100 (Sat, 22 Nov 2014) New Revision: 394 Modified: pkg/man/eventstudy.Rd Log: Removed artificial event dates from lmAMM example. Modified: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd 2014-11-22 13:34:46 UTC (rev 393) +++ pkg/man/eventstudy.Rd 2014-11-22 13:35:33 UTC (rev 394) @@ -253,10 +253,6 @@ plot(es) # Event study using Augmented Market Model -events <- data.frame(name = c("Infosys", "TCS"), - when = as.Date(c("2012-04-01", "2012-06-01")), - stringsAsFactors = FALSE) - es <- eventstudy(firm.returns = StockPriceReturns, event.list = SplitDates, event.window = 7, From noreply at r-forge.r-project.org Sun Nov 23 11:22:37 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 23 Nov 2014 11:22:37 +0100 (CET) Subject: [Eventstudies-commits] r395 - pkg/R Message-ID: <20141123102237.2A41D18735E@r-forge.r-project.org> Author: chiraganand Date: 2014-11-23 11:22:36 +0100 (Sun, 23 Nov 2014) New Revision: 395 Modified: pkg/R/eventstudy.R Log: Fixed calculation of excess returns. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-22 13:35:33 UTC (rev 394) +++ pkg/R/eventstudy.R 2014-11-23 10:22:36 UTC (rev 395) @@ -193,8 +193,7 @@ model <- excessReturn(firm$z.e[estimation.period, "firm.returns"], firm$z.e[estimation.period, "market.returns"]) - abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients[1] - - (model$coefficients[2] * firm$z.e[event.period, "market.returns"]) + abnormal.returns <- model return(abnormal.returns) }) From noreply at r-forge.r-project.org Mon Nov 24 07:24:19 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 24 Nov 2014 07:24:19 +0100 (CET) Subject: [Eventstudies-commits] r396 - pkg/R Message-ID: <20141124062419.1BF00187418@r-forge.r-project.org> Author: chiraganand Date: 2014-11-24 07:24:18 +0100 (Mon, 24 Nov 2014) New Revision: 396 Modified: pkg/R/eventstudy.R pkg/R/excessReturn.R Log: Fixed running of excess return function from eventstudy, removed old comments. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-23 10:22:36 UTC (rev 395) +++ pkg/R/eventstudy.R 2014-11-24 06:24:18 UTC (rev 396) @@ -190,11 +190,10 @@ return(NULL) } estimation.period <- attributes(firm)[["estimation.period"]] - model <- excessReturn(firm$z.e[estimation.period, "firm.returns"], - firm$z.e[estimation.period, "market.returns"]) + model <- excessReturn(firm$z.e[event.period, "firm.returns"], + firm$z.e[event.period, "market.returns"]) abnormal.returns <- model - return(abnormal.returns) }) Modified: pkg/R/excessReturn.R =================================================================== --- pkg/R/excessReturn.R 2014-11-23 10:22:36 UTC (rev 395) +++ pkg/R/excessReturn.R 2014-11-24 06:24:18 UTC (rev 396) @@ -1,15 +1,3 @@ -############### -# Excess return -############### -# Argument: -## FIXME: data.object?? -# 1. data.object: This is a time series object with firm return and market return -# 2. market.name: It is the market (index) column name in the data object -# Output: -# Value: Excess market return - -excessReturn <- function(firm.returns, market.returns){ - ## Getting market return - ma.ret <- firm.returns - market.returns - return(ma.ret) +excessReturn <- function(firm.returns, market.returns) { + return(firm.returns - market.returns) } From noreply at r-forge.r-project.org Fri Nov 28 11:38:32 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 28 Nov 2014 11:38:32 +0100 (CET) Subject: [Eventstudies-commits] r397 - pkg/R Message-ID: <20141128103832.B0BAA186C26@r-forge.r-project.org> Author: chiraganand Date: 2014-11-28 11:38:32 +0100 (Fri, 28 Nov 2014) New Revision: 397 Modified: pkg/R/marketModel.R Log: Merge firm returns and market returns before calling lm, removing it had caused a bug where lm wouldn't return a proper zoo object in the residuals series. Modified: pkg/R/marketModel.R =================================================================== --- pkg/R/marketModel.R 2014-11-24 06:24:18 UTC (rev 396) +++ pkg/R/marketModel.R 2014-11-28 10:38:32 UTC (rev 397) @@ -3,7 +3,8 @@ # Single firm if (NCOL(firm.returns) == 1) { - reg <- lm(firm.returns ~ market.returns, + merged.object <- merge.zoo(firm.returns, market.returns, all = TRUE) #:DOC + reg <- lm(firm.returns ~ market.returns, data = merged.object, na.action = na.exclude) # :DOC: na.exclude: NAs can # be seen in prediction @@ -22,7 +23,9 @@ ## 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, + merged.object <- merge.zoo(firm.returns[, i], market.returns, all = TRUE) + colnames(merged.object)[i] <- "firm.returns" + reg[[i]] <- lm(firm.returns ~ market.returns, data = merged.object, na.action = na.exclude) if (residuals == TRUE) { From noreply at r-forge.r-project.org Fri Nov 28 12:27:18 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 28 Nov 2014 12:27:18 +0100 (CET) Subject: [Eventstudies-commits] r398 - pkg/R Message-ID: <20141128112719.025871865A8@r-forge.r-project.org> Author: chiraganand Date: 2014-11-28 12:27:18 +0100 (Fri, 28 Nov 2014) New Revision: 398 Modified: pkg/R/eventstudy.R Log: Return model residuals as an attribute to the final object. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-28 10:38:32 UTC (rev 397) +++ pkg/R/eventstudy.R 2014-11-28 11:27:18 UTC (rev 398) @@ -98,6 +98,7 @@ abnormal.returns <- abnormal.returns - (model$exposures[i] * firm$z.e[event.period, names.nonfirmreturns[i - 1]]) } + attr(abnormal.returns, "residuals") <- model$residuals return(abnormal.returns) }) @@ -112,7 +113,8 @@ warning("lmAMM() returned NULL\n") outputModel <- NULL } else { - outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) + outputResiduals <- lapply(outputModel, function(x) attributes(x)[["residuals"]]) + outputModel <- do.call(merge.zoo, outputModel) } } } ## end AMM @@ -147,6 +149,7 @@ abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients["(Intercept)"] - (model$coefficients["market.returns"] * firm$z.e[event.period, "market.returns"]) + attr(abnormal.returns, "residuals") <- model$residuals return(abnormal.returns) }) @@ -160,7 +163,8 @@ warning("marketModel() returned NULL") outputModel <- NULL } else { - outputModel <- do.call(merge.zoo, outputModel[!sapply(outputModel, is.null)]) + outputResiduals <- lapply(outputModel, function(x) attributes(x)[["residuals"]]) + outputModel <- do.call(merge.zoo, outputModel) } } @@ -231,7 +235,7 @@ } ## end None - if (is.null(outputModel)) { + if (is.null(outputModel)) { #:DOC final.result <- list(result = NULL, outcomes = as.character(outcomes)) class(final.result) <- "es" @@ -276,6 +280,9 @@ final.result <- list(result = outputModel, outcomes = as.character(outcomes)) + if (exists("outputResiduals")) { # :DOC + attr(final.result, which = "model.residuals") <- outputResiduals + } attr(final.result, which = "event.window") <- event.window attr(final.result, which = "inference") <- inference if (inference == TRUE) { From noreply at r-forge.r-project.org Sun Nov 30 08:24:49 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 30 Nov 2014 08:24:49 +0100 (CET) Subject: [Eventstudies-commits] r399 - pkg/R Message-ID: <20141130072449.F0F38184306@r-forge.r-project.org> Author: chiraganand Date: 2014-11-30 08:24:49 +0100 (Sun, 30 Nov 2014) New Revision: 399 Modified: pkg/R/eventstudy.R Log: Do na.locf on the data before sending for lmAMM, since it created an invalid zoo object. Did the same for other models to keep things consistent. Will be removed in the future. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-11-28 11:27:18 UTC (rev 398) +++ pkg/R/eventstudy.R 2014-11-30 07:24:49 UTC (rev 399) @@ -74,8 +74,8 @@ 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] + args.makeX$market.returns <- na.locf(firm$z.e[estimation.period, "market.returns"]) #XXX REMOVE + args.makeX$others <- na.locf(firm$z.e[estimation.period, names.nonfirmreturns]) regressors <- do.call(makeX, args.makeX) args.lmAMM <- list() @@ -83,7 +83,7 @@ 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$firm.returns <- na.locf(firm$z.e[estimation.period, "firm.returns"]) #XXX REMOVE na.locf(), its just done to get a regular residuals series. args.lmAMM$X <- regressors model <- do.call(lmAMM, args.lmAMM) @@ -142,8 +142,8 @@ 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(na.locf(firm$z.e[estimation.period, "firm.returns"]), #XXX: remove na.locf + na.locf(firm$z.e[estimation.period, "market.returns"]), #XXX: remove na.locf residuals = FALSE) abnormal.returns <- firm$z.e[event.period, "firm.returns"] - model$coefficients["(Intercept)"] - @@ -194,8 +194,8 @@ return(NULL) } estimation.period <- attributes(firm)[["estimation.period"]] - model <- excessReturn(firm$z.e[event.period, "firm.returns"], - firm$z.e[event.period, "market.returns"]) + model <- excessReturn(na.locf(firm$z.e[event.period, "firm.returns"]), #XXX: remove na.locf + na.locf(firm$z.e[event.period, "market.returns"])) #XXX: remove na.locf abnormal.returns <- model return(abnormal.returns)