From noreply at r-forge.r-project.org Wed Oct 8 00:39:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 8 Oct 2014 00:39:09 +0200 (CEST) Subject: [Eventstudies-commits] r369 - pkg/R Message-ID: <20141007223909.B78EA183DC4@r-forge.r-project.org> Author: chiraganand Date: 2014-10-08 00:39:09 +0200 (Wed, 08 Oct 2014) New Revision: 369 Modified: pkg/R/phys2eventtime.R Log: Moved timeshift out of main phys2eventtime function. Modified: pkg/R/phys2eventtime.R =================================================================== --- pkg/R/phys2eventtime.R 2014-08-02 10:26:52 UTC (rev 368) +++ pkg/R/phys2eventtime.R 2014-10-07 22:39:09 UTC (rev 369) @@ -12,36 +12,13 @@ # A vector of these outcomes is returned. phys2eventtime <- function(z, events, width=10) { - ## Ensuring class of event matrix - events$name <- as.character(events$name) - if(is.factor(events$when)) { - stop("The column 'when' cannot be a factor. Cannot proceed with data manipulation.") - } - - ## z: physical time matrix. Check dimensions of "z" if (is.null(ncol(z))) { - stop(paste(deparse("z"), "should be of class zoo/xts with at least one column.")) + stop(paste("'z' should be of class zoo/xts with at least one column. Use '[' with drop = FALSE")) } - timeshift <- function(x) { - firm.present <- match(x["name"], colnames(z), nomatch = -1) != -1 - if (!firm.present) { - return(list(result=NULL, outcome="unitmissing")) - } - ## Take previous date if exact data is not found. - location <- findInterval(as.Date(x["when"]), index(z[, x["name"]])) - if ((location <= 1) | (location >= length(index(z)))) { - return(list(result=NULL, outcome="wrongspan")) - } - remapped <- zoo(as.numeric(z[,x["name"]]), order.by=(-location+1):(length(z[,x["name"]])-location)) - return(list(result=remapped, outcome="success")) - } - - answer <- apply(events, 1, timeshift) #this thing loops on num events - answer <- unlist(answer, recursive = FALSE) - rownums <- grep("outcome", names(answer)) - outcomes <- as.character(do.call("c", answer[rownums])) - z.e <- do.call("cbind", answer[rownums[which(answer[rownums] == "success")] - 1]) + answer <- lapply(1:nrow(events), function(i) timeshift(events[i, ], z)) + outcomes <- sapply(answer, function(x) x$outcome) + z.e <- do.call(cbind, lapply(answer[outcomes == "success"], function(x) x$result)) ## If no successful outcome, return NULL to z.e. if (length(z.e) == 0) { @@ -72,3 +49,20 @@ stopifnot(sum(outcomes=="success") == NCOL(z.e)) list(z.e=z.e, outcomes=factor(outcomes)) } + +timeshift <- function(x, z) { + firm.present <- x[, "name"] %in% colnames(z) + if (!firm.present) { + return(list(result=NULL, outcome="unitmissing")) + } + + ## Take previous date if exact data is not found. + location <- findInterval(x[, "when"], index(z[, x[, "name"]])) + if ((location <= 1) | (location >= length(index(z)))) { + return(list(result=NULL, outcome="wrongspan")) + } + + remapped <- zoo(as.numeric(z[, x[, "name"]]), + order.by = (-location + 1):(length(z[, x[, "name"]]) - location)) + return(list(result = remapped, outcome = "success")) +} From noreply at r-forge.r-project.org Wed Oct 8 00:40:11 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 8 Oct 2014 00:40:11 +0200 (CEST) Subject: [Eventstudies-commits] r370 - pkg/man Message-ID: <20141007224011.8B20F186104@r-forge.r-project.org> Author: chiraganand Date: 2014-10-08 00:40:11 +0200 (Wed, 08 Oct 2014) New Revision: 370 Modified: pkg/man/phys2eventtime.Rd Log: Added information about date time class of events when column and a note on usage of findInterval. Modified: pkg/man/phys2eventtime.Rd =================================================================== --- pkg/man/phys2eventtime.Rd 2014-10-07 22:39:09 UTC (rev 369) +++ pkg/man/phys2eventtime.Rd 2014-10-07 22:40:11 UTC (rev 370) @@ -31,14 +31,13 @@ \dQuote{events} object contains two columns: \dQuote{name} consists of names of the event, and \dQuote{when} is the - respective event identifier. For instance, if \sQuote{z} is a matrix - of class \pkg{xts} with 10 stocks over 300 days, the names of stocks - in \sQuote{z} is the superset of names for the event and the time - period (i.e., 300 days) will be the superset for defining event dates. + respective event time. \dQuote{when} should be one of + \sQuote{date-time} or \sQuote{Date} classes. + If an event date does not lie within this period, the function approximates to the nearest previous date using - \code{\link{findInterval}}. Note that findInterval assumes the index - of \sQuote{z} is non-decreasing. + \code{\link{findInterval}}. Note that \sQuote{findInterval} assumes the + index of \sQuote{z} is non-decreasing. The argument \dQuote{width} provides the user with an option to define successful events as those that have data within a window around the From noreply at r-forge.r-project.org Wed Oct 8 00:45:59 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 8 Oct 2014 00:45:59 +0200 (CEST) Subject: [Eventstudies-commits] r371 - in pkg: R man Message-ID: <20141007224559.24B2B1851B4@r-forge.r-project.org> Author: chiraganand Date: 2014-10-08 00:45:58 +0200 (Wed, 08 Oct 2014) New Revision: 371 Modified: pkg/R/eventstudy.R pkg/man/eventstudy.Rd Log: Return NULL if output from any model is NULL. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-10-07 22:40:11 UTC (rev 370) +++ pkg/R/eventstudy.R 2014-10-07 22:45:58 UTC (rev 371) @@ -18,7 +18,7 @@ } if (type != "None" && is.null(model.args)) { - stop("model.args cannot be NULL when type is not None.") + stop("model.args cannot be NULL when 'type' is not 'None'.") } if (is.levels == TRUE) { @@ -81,11 +81,19 @@ ## marketResidual if (type == "marketResidual") { outputModel <- marketResidual(firm.returns, model.args$market.returns) + if (is.null(outputModel)) { + cat("Error: marketResidual() returned NULL\n") + return(NULL) + } } ## excessReturn if (type == "excessReturn") { outputModel <- excessReturn(firm.returns, model.args$market.returns) + if (is.null(outputModel)) { + cat("Error: excessReturn() returned NULL\n") + return(NULL) + } } ### Converting index outputModel to Date Modified: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd 2014-10-07 22:40:11 UTC (rev 370) +++ pkg/man/eventstudy.Rd 2014-10-07 22:45:58 UTC (rev 371) @@ -158,7 +158,8 @@ \value{ A list with class attribute \dQuote{es} holding the following - elements: + elements, or \sQuote{NULL} if output from a model function is + \sQuote{NULL}: \itemize{ \item{\dQuote{eventstudy.output}:}{ From noreply at r-forge.r-project.org Wed Oct 8 00:55:24 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 8 Oct 2014 00:55:24 +0200 (CEST) Subject: [Eventstudies-commits] r372 - pkg/inst/tests Message-ID: <20141007225524.4E2621879B9@r-forge.r-project.org> Author: chiraganand Date: 2014-10-08 00:55:23 +0200 (Wed, 08 Oct 2014) New Revision: 372 Modified: pkg/inst/tests/test_eventstudy.R Log: Fixed test case to use Date class in eventlist. Modified: pkg/inst/tests/test_eventstudy.R =================================================================== --- pkg/inst/tests/test_eventstudy.R 2014-10-07 22:45:58 UTC (rev 371) +++ pkg/inst/tests/test_eventstudy.R 2014-10-07 22:55:23 UTC (rev 372) @@ -60,7 +60,7 @@ ## Check the previous date cat("\nTesting handling of missing data on event date: ") -eventdate <- "2004-01-10" +eventdate <- as.Date("2004-01-10") eventdate_output <- "2004-01-09" eventslist <- data.frame(name = "ITC", when = eventdate, stringsAsFactors = FALSE) From noreply at r-forge.r-project.org Wed Oct 8 01:24:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 8 Oct 2014 01:24:09 +0200 (CEST) Subject: [Eventstudies-commits] r373 - pkg/inst/tests Message-ID: <20141007232409.787591876A4@r-forge.r-project.org> Author: chiraganand Date: 2014-10-08 01:24:09 +0200 (Wed, 08 Oct 2014) New Revision: 373 Modified: pkg/inst/tests/test_interfaces.R Log: Fixed test case to use Date class in eventlist. Modified: pkg/inst/tests/test_interfaces.R =================================================================== --- pkg/inst/tests/test_interfaces.R 2014-10-07 22:55:23 UTC (rev 372) +++ pkg/inst/tests/test_interfaces.R 2014-10-07 23:24:09 UTC (rev 373) @@ -14,7 +14,7 @@ expected_outcomes <- c("success", "success") test_events <- data.frame(name = "ONGC", - when = c("2011-08-01", "2010-05-14"), + when = as.Date(c("2011-08-01", "2010-05-14")), stringsAsFactors = FALSE) test_returns<- StockPriceReturns[complete.cases(StockPriceReturns$ONGC), "ONGC", drop = FALSE] From noreply at r-forge.r-project.org Wed Oct 8 01:29:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 8 Oct 2014 01:29:58 +0200 (CEST) Subject: [Eventstudies-commits] r374 - pkg/man Message-ID: <20141007232959.12809187782@r-forge.r-project.org> Author: chiraganand Date: 2014-10-08 01:29:58 +0200 (Wed, 08 Oct 2014) New Revision: 374 Modified: pkg/man/phys2eventtime.Rd Log: Added more description on date-time class of event list and timeseries object. Modified: pkg/man/phys2eventtime.Rd =================================================================== --- pkg/man/phys2eventtime.Rd 2014-10-07 23:24:09 UTC (rev 373) +++ pkg/man/phys2eventtime.Rd 2014-10-07 23:29:58 UTC (rev 374) @@ -31,8 +31,9 @@ \dQuote{events} object contains two columns: \dQuote{name} consists of names of the event, and \dQuote{when} is the - respective event time. \dQuote{when} should be one of - \sQuote{date-time} or \sQuote{Date} classes. + respective event time. \sQuote{class} of \sQuote{index} of \dQuote{z} + and \dQuote{when} should be same and one of the \sQuote{date-time} or + \sQuote{Date} classes. If an event date does not lie within this period, the function approximates to the nearest previous date using From noreply at r-forge.r-project.org Thu Oct 9 03:12:51 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 9 Oct 2014 03:12:51 +0200 (CEST) Subject: [Eventstudies-commits] r375 - pkg/R Message-ID: <20141009011252.5CE2C1875A8@r-forge.r-project.org> Author: chiraganand Date: 2014-10-09 03:12:51 +0200 (Thu, 09 Oct 2014) New Revision: 375 Modified: pkg/R/phys2eventtime.R Log: Added condition to check date-time class column inside events list. Modified: pkg/R/phys2eventtime.R =================================================================== --- pkg/R/phys2eventtime.R 2014-10-07 23:29:58 UTC (rev 374) +++ pkg/R/phys2eventtime.R 2014-10-09 01:12:51 UTC (rev 375) @@ -15,6 +15,9 @@ if (is.null(ncol(z))) { stop(paste("'z' should be of class zoo/xts with at least one column. Use '[' with drop = FALSE")) } + if (!any(class(events$when) %in% c("POSIXt", "Date"))) { + stop("events$when should be one of 'Date' or 'date-time' classes.") + } 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 Thu Oct 9 03:13:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 9 Oct 2014 03:13:33 +0200 (CEST) Subject: [Eventstudies-commits] r376 - / pkg/man Message-ID: <20141009011333.920031875CA@r-forge.r-project.org> Author: chiraganand Date: 2014-10-09 03:13:33 +0200 (Thu, 09 Oct 2014) New Revision: 376 Modified: pkg/man/eventstudy.Rd todo.org Log: Fixed example, one other small modification. Modified: pkg/man/eventstudy.Rd =================================================================== --- pkg/man/eventstudy.Rd 2014-10-09 01:12:51 UTC (rev 375) +++ pkg/man/eventstudy.Rd 2014-10-09 01:13:33 UTC (rev 376) @@ -126,8 +126,8 @@ \dQuote{type} argument. See section on \sQuote{Model arguments} for more details. - \code{\link{phys2eventtime}} is called with \sQuote{width} set to - zero when called from this function. + Note: \code{\link{phys2eventtime}} is called with \sQuote{width} set + to 0 when called from this function. } \section{\bold{Model arguments}}{ @@ -177,7 +177,7 @@ \item{success: shows the successful use of event date.} \item{wdatamissing: appears when width data is missing around the event. This will not appear when this function is used since the - argument \sQuote{width} in \code{\link{phys2eventtime}} is set to zero.} + argument \sQuote{width} in \code{\link{phys2eventtime}} is set to 0.} \item{wrongspan: if event date falls outside the range of physical date.} \item{unitmissing: when the unit (firm name) is missing in the event list.} } @@ -254,7 +254,7 @@ # Event study using Augmented Market Model events <- data.frame(name = c("Infosys", "TCS"), - when = c("2012-04-01", "2012-06-01"), + when = as.Date(c("2012-04-01", "2012-06-01")), stringsAsFactors = FALSE) es <- eventstudy(firm.returns = StockPriceReturns, Modified: todo.org =================================================================== --- todo.org 2014-10-09 01:12:51 UTC (rev 375) +++ todo.org 2014-10-09 01:13:33 UTC (rev 376) @@ -47,3 +47,285 @@ * plot.es - "Event study plot capabilities" email on 30th April. + +* Ajay's comments +** On the eesPlot code + data.frmt2 <- data.use[which(data.use$cluster.pattern != 0), ] + + Can we please have better variable names. + + hilo1 <- c(-big, big) + plot.es.graph.both(es.good.normal, es.bad.normal, es.good.purged, + es.bad.purged, width, titlestring, ylab) + + Can we please have better names than hilo1. And, you are making it and + not using it. + +** Feedback on eesPlot + Why do we have eesPlot? + + When I look at the name, I think "Okay, this is a plot function, and + why is this not just an S3 plot method". When I see the first one line + description on the man page my opinion is confirmed. + + Then I look deeper and it is absolutely not a plot function! It is a + function which figures out a list of events, then runs an event study, + and then does a customised plot. + + We should not have such functions. + + We should ask the user to run ees() and then run eventstudy() and then + use the plot method. + + Perhaps we should ask the user to do: + + es.lefttail <- eventstudies(left tail) + es.righttail <- eventstudies(right tail) + plot(mfrow=c(2,1)) + plot(es.lefttail, type="blah") + plot(es.righttail, type="blah") + + On an unrelated note, I found it disturbing that the code for + eesPlot() does not use ees(). This violates the principle of code + reuse. Perhaps we should have the framework where x<-ees() just makes + lists of interesting events and then summary(x) generates all those + descriptive tables about number of events and run length and so on. + + Why is the example saying " ## Generating event study plots (using + modified event study methodology)". It looks gauche. + + There is one spelling mistake in the man page but I've forgotten where + it is. + +** Feedback on eventstudies::ees + 1. The entire concept of what we're doing is critically connected + to the choice of the event window!!! + + The function and the documentation of the function is silent about + this and that's completely wrong. + + Our concept of what's a clean unclustered event is : clean within a + stated event window. We never say this. And, it's bad software + engineering to hardcode this to a number. This must be an argument to + the function. + + 2. The title of the function and the first para of the function are + quite lame. They say: + + "This function generates summary statistics for identification and + analysis of extreme events.". This mostly leaves me in the dark + about what's going on. + + "Tail (Rare) events are often the object of interest in finance. + These events are defined as those that have a low probability of + occurrence. This function identifies such events based on + prob.value mentioned by the user and generates summary + statistics about the events. If ???prob.value??? is 2.5%, events + below + 2.5% (lower tail) and above 97.5% (upper tail) of the + distribution + are identified as extreme events." This makes the function seem + like a massive waste of time. Using R we can trivially find the + upper tail observations - no new function is required here. If I + read this paragraph I would completely lose interest in the + package; I would think these lame developers are taking trivial + one/two lines of R code and encoding it as a function with a new + name - why would I never bother to learn their new API. + + The entire value added of the code lies in identifying clean + unclustered events, stabbing into messy situations by trying to fuse + clustered events under certain conditions, and walking away from + places where fusing can't be done. None of that is advertised in the + man page. The word 'fuse' does not occur anywhere on the man page! + + 3. When I run the example I get a huge messy structure that's no + fun. Why not have: + str(output, max.level=2) + which is more comprehensible. + + 4. Look at + + library(eventstudies) + data(EESData) + ## Input S&P 500 as the univariate series + input <- EESData$sp500 + ## Constructing summary statistics for 5% tail values (5% on both + sides) + output <- ees(input, prob.value = 5) + str(output) + + It looks nicer and more readable as: + + library(eventstudies) + data(EESData) + r <- ees(EESData$sp500, prob.value = 5) + str(r, max.level=2) + + 5. Choose a consistent style. Is there going to be a + library(eventstudies) in front of all the examples? This was not + there with the others. Why is it here? + + 6. Why are we saying " To convert number to words, code uses + function ???numbers2words?? by + John Fox and ???deprintize?? function by Miron Kursa.". We are + using thousands of functions by others but is this a big deal? + + 7. In + + $data$Clustered + event.series cluster.pattern + 2000-03-16 2.524452 3 + 2003-03-17 3.904668 2 + + Perhaps the word `runlength' is universally understood instead of + cluster.pattern + + The word `event.series' is incomprehensible to me. + + 8. In : + + > output$upper.tail$extreme.event.distribution + unclstr used.clstr removed.clstr tot.clstr tot tot.used + upper 65 5 32 37 102 70 + + The column names are horrible. + + Pick a more rational sequencing where this process unfolds from + left to right. + + This table is the heart of the functionality of what's being done and + it isn't explained at all in the man page. + + The man page should say that the researcher might like to only + study clean unclustered events - in which case he should run with + xxx. If he wishes to use the methodology of fusing adjacent events + as done in PSS, then additionally we are able to salvage the events + xxx. + + + 9. The run length table should be defined as a table showing a + column which is the run length and a column which is the number + of events which are a run of that length. + + 10. Just confirming: In a package vignette we're going to be able + to reproduce some key results from the tables of PSS using this + function? + + 11. Wouldn't it be neat to draw something graphical with + abline(v=xxx, lty=2) where all the extreme events are shown on + a picture? With a different colour for fused and for rejected + events. + +** Feedback on eventstudies package + + First batch. + + - At many places the phrase `eventstudy' is being used when what's + required is `event study'. + + - When I say ?AMMData iqt is riddled with mistakes!!!! The man page + has four sentences and has more than 1 error per sentence. + + 1. The first few words read: "The data series is a daily time-series + zoo object. The sample range for the data is from 2012-02-01 to + 2014-01-31." Why should this be the top priority? + + 2. The two sentences after this, which add up to the full man page, + contain one grammatical error each. + + 3. Nowhere in the man page is the unit mentioned (per cent). + + 4. The dataset contains call.money.rate and that's inconsistent with + the man page. + + 5. The example says library(zoo) which is not required. + +Why do we need a special data object named AMMData? Can we not just +have one single example dataset with daily returns data for firms, +that is used for the examples involving both event studies and AMM? + +If you had to have this in the package (which I doubt), a better +example is: + + data(AMMData) + str(AMMData) + tail(AMMData) + summary(AMMData) + +We in India use too many abbreviations. Let's stick to the phrase +`augmented market model' instead of overusing the phrase AMM. + + +*** When I say ?EESData I see a section `Format' which is not in ?AMMData. + + The facts on this man page should say that this is a dataset for + the purpose of demonstrating the EES functionality (no + abbreviations please), and for replicating the results of the PSS + paper. It should explain what the data is (daily returns measured + in per cent). + + - Why is the example here different from the example for AMMData? + +*** The dataset INR introduces a new word `sample' which was not used in the previous two. + Can we please have extreme maniacal consistency in all these? + As pointed out above, there is duplication between INR being here and + it being in AMMData. + +*** It is truly wrong to have a MMData data object!! + Nothing prevents you from estimating an MM using the data for an AMM. + Can we please be more intelligent about all this. + +** Collated + - bad variable names + - eesPlot: make it S3 function + - Do: ees(), eventstudy(), plot() + - summary.ees() + - ees(): event window in the API and the man pages (language + information) + - Remove comments from examples, plus cleaning + - Example consistency: remove library() calls from examples + - Remove unneeded references + - ees(): output colnames, output table format (+sequencing) + - ees(): reproducibility of PSS in the vignette + - plot.ees() + - Spell check + - Use "event study" instead of "eventstudy" + - Man pages: AMMData: grammatical errors, language, units, + consistent sections, call.money.rate + - EESData: say about PSS + - Avoid abbreviations + - Get rid of MMData, INR dataset + - lmAMM example + - phys2eventtime example + - Spell check + +* New comments +** eventstudy() + # - outcome.unit and event.when need to be changed + # - put MM example before AMM + # - fix the vignette code and the code formatting + # - make the args to the es function return as attribs + - one series in eventstudy.Rd + # - mention about summary and plot in eventstudy.Rd + # - Fix the AMM example, make it simpler + # - Make the currency dates same as StockPriceReturns + - Check for this condition: lmAMM(): less than 30 observations: NULL + - XXX: nlags in timeseriesAMM() + - Estimation period: document the period of data which we are taking + up to the start of the event window (2 years for daily data) + - TODO: A set of rules for taking the estimation period for + different frequencies. + +** lmAMM() + # - TODO: Put in AMM comparison results into the eventstudy vignette. + - TODO: Document step by step procedure of using AMM to do eventstudy(). + # - Put 0 in place of NA in the data objects (stock returns and + # currency returns). + +** What should be done in the future: + a. Event study with economic data (e.g. country) which is not returns + data. No cumulation. + + b. Thorough explanation of AMM. + + c. Extreme events. + From noreply at r-forge.r-project.org Wed Oct 15 01:49:10 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 15 Oct 2014 01:49:10 +0200 (CEST) Subject: [Eventstudies-commits] r377 - pkg/inst/tests Message-ID: <20141014234910.742A5186D91@r-forge.r-project.org> Author: chiraganand Date: 2014-10-15 01:49:09 +0200 (Wed, 15 Oct 2014) New Revision: 377 Modified: pkg/inst/tests/test_eventstudy.R pkg/inst/tests/test_interfaces.R Log: Added a test case to check for time-based classes for phys2eventtime, fixed other test cases to comply to this. Modified: pkg/inst/tests/test_eventstudy.R =================================================================== --- pkg/inst/tests/test_eventstudy.R 2014-10-09 01:13:33 UTC (rev 376) +++ pkg/inst/tests/test_eventstudy.R 2014-10-14 23:49:09 UTC (rev 377) @@ -67,4 +67,12 @@ a <- phys2eventtime(p, eventslist, width = 2) expect_that(as.numeric(a$z.e["0",]), equals(as.numeric(p$ITC[as.Date(eventdate_output), ]))) + + +## events$when should be a time-based class +cat("\nTesting class of events$when: ") +eventdate <- "2004-01-09" +eventslist <- data.frame(name = "ITC", when = eventdate, + stringsAsFactors = FALSE) +expect_error(a <- phys2eventtime(p, eventslist, width = 2), regexp = "events\\$when.*class.*$") }) Modified: pkg/inst/tests/test_interfaces.R =================================================================== --- pkg/inst/tests/test_interfaces.R 2014-10-09 01:13:33 UTC (rev 376) +++ pkg/inst/tests/test_interfaces.R 2014-10-14 23:49:09 UTC (rev 377) @@ -35,7 +35,7 @@ expected_outcomes <- c("success", "success") test_events <- data.frame(name = "ONGC", - when = c("2011-08-01", "2010-05-14"), + when = as.Date(c("2011-08-01", "2010-05-14")), stringsAsFactors = FALSE) test_returns<- StockPriceReturns[complete.cases(StockPriceReturns$ONGC), "ONGC", drop = FALSE] @@ -56,7 +56,7 @@ expected_outcomes <- c("success", "success") test_events <- data.frame(name = "ONGC", - when = c("2011-08-01", "2010-05-14"), + when = as.Date(c("2011-08-01", "2010-05-14")), stringsAsFactors = FALSE) test_returns<- StockPriceReturns[complete.cases(StockPriceReturns$ONGC), "ONGC", drop = FALSE] @@ -79,7 +79,7 @@ expected_outcomes <- c("success", "success") test_events <- data.frame(name = "ONGC", - when = c("2011-08-01", "2010-05-14"), + when = as.Date(c("2011-08-01", "2010-05-14")), stringsAsFactors = FALSE) test_returns<- StockPriceReturns[complete.cases(StockPriceReturns$ONGC), "ONGC", drop = FALSE] @@ -97,7 +97,7 @@ ### Remapping cat("\nChecking remapping: ") test_events <- data.frame(name = "ONGC", - when = c("2011-08-01", "2010-05-14"), + when = as.Date(c("2011-08-01", "2010-05-14")), stringsAsFactors = FALSE) test_returns <- StockPriceReturns[complete.cases(StockPriceReturns$ONGC), "ONGC", drop = FALSE] From noreply at r-forge.r-project.org Sat Oct 18 15:14:33 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sat, 18 Oct 2014 15:14:33 +0200 (CEST) Subject: [Eventstudies-commits] r378 - pkg/R Message-ID: <20141018131433.7DE2E185D2E@r-forge.r-project.org> Author: chiraganand Date: 2014-10-18 15:14:32 +0200 (Sat, 18 Oct 2014) New Revision: 378 Added: pkg/R/marketModel.R Removed: pkg/R/marketResidual.R Modified: pkg/R/eventstudy.R pkg/R/phys2eventtime.R Log: Changed the marketResiduals function to return full lm object, changed it's name to marketModel. Fixed eventstudy() to convert main data to event time first and then compute estimation period and abnormal returns correctly. phys2eventtime now also returns a list of exact event times found by it. Modified: pkg/R/eventstudy.R =================================================================== --- pkg/R/eventstudy.R 2014-10-14 23:49:09 UTC (rev 377) +++ pkg/R/eventstudy.R 2014-10-18 13:14:32 UTC (rev 378) @@ -29,9 +29,13 @@ if (is.null(ncol(firm.returns))) { stop("firm.returns should be a zoo series with at least one column. Use '[' with 'drop = FALSE'.") } - # store firm names for later use - firmNames <- colnames(firm.returns) + stopifnot(!is.null(remap)) + + # compute estimation and event period + ## :DOC: event period starts from event time + 1 + event.period <- as.character((-event.window + 1):event.window) #XXX + ### Run models ## AMM if (type == "lmAMM") { @@ -78,16 +82,58 @@ } } ## end AMM - ## marketResidual - if (type == "marketResidual") { - outputModel <- marketResidual(firm.returns, model.args$market.returns) - if (is.null(outputModel)) { - cat("Error: marketResidual() returned NULL\n") - return(NULL) - } - } +### 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)) - ## excessReturn + 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] + + model <- marketModel(firm.returns.eventtime$z.e[estimation.period, col], + market.returns.eventtime$z.e[estimation.period, ]) + + 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) + }) + + if (is.null(outputModel)) { + cat("Error: marketModel() returned NULL\n") + return(NULL) + } + + if (length(outputModel) != 1) { + outputModel <- do.call(cbind, outputModel) + names(outputModel) <- colnames(firm.returns.eventtime$z.e) + } + } ## END else + } ## END marketModel + + +### excessReturn if (type == "excessReturn") { outputModel <- excessReturn(firm.returns, model.args$market.returns) if (is.null(outputModel)) { @@ -95,53 +141,28 @@ return(NULL) } } - -### Converting index outputModel to Date - index(outputModel) <- as.Date(index(outputModel)) - -### Convert to event frame - ## change the dimensions if there is only one firm - if (is.null(ncol(outputModel))) { - attr(outputModel, "dim") <- c(length(outputModel), 1) - attr(outputModel, "dimnames") <- list(NULL, firmNames) - colnames(outputModel) <- firmNames - } - es <- phys2eventtime(z = outputModel, events=event.list, width=0) - if (is.null(es$z.e) || length(es$z.e) == 0) { - es.w <- NULL - cn.names <- character(length = 0) - } else { - es.w <- window(es$z.e, start = -event.window, end = event.window) - # Adding column names to event output - cn.names <- event.list[which(es$outcomes=="success"),1] + 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 = "dimnames") <- list(NULL, event.number) + if (inference == TRUE) { + warning("No inference strategy for single successful event.","\n") + inference <- FALSE + } } - ## replace NAs with 0 as it's returns now - es.w <- na.fill(es.w, 0) - if(length(cn.names)==1){ - cat("Event date exists only for",cn.names,"\n") - if (inference == TRUE) { - warning("No inference strategy for one column","\n") - inference <- FALSE - } - } else if (length(cn.names) == 0) { - ## skip everything - to.remap = FALSE - inference = FALSE - } else { - colnames(es.w) <- cn.names - } - ### 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, + 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(es.w) + reindex = remap.event.reindex(outputModel) ) } @@ -157,12 +178,12 @@ } } else { ## Providing event frame as default output - result <- es.w + result <- outputModel } if(to.remap==TRUE){remapping <- remap} else {remapping <- "none"} final.result <- list(result = result, - outcomes = as.character(es$outcomes)) + outcomes = as.character(outcomes)) attr(final.result, which = "inference") <- inference.strategy attr(final.result, which = "event.window") <- event.window @@ -172,6 +193,35 @@ return(final.result) } +## return values: +## 1. other.returns: data.frame +## 2. firm.returns.eventtime: data.frame +## 3. outcomes: vector +## 4. estimation.period: vector +prepare.returns <- function(event.list, event.window, ...) { + returns <- unlist(list(...), recursive = FALSE) + + ## :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))) + + 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()) + + 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()) + + ## :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()) +} + ######################### ## Functions for class es ######################### Copied: pkg/R/marketModel.R (from rev 374, pkg/R/marketResidual.R) =================================================================== --- pkg/R/marketModel.R (rev 0) +++ pkg/R/marketModel.R 2014-10-18 13:14:32 UTC (rev 378) @@ -0,0 +1,7 @@ +marketModel <- function(firm.returns, market.returns) { + 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) +} Deleted: pkg/R/marketResidual.R =================================================================== --- pkg/R/marketResidual.R 2014-10-14 23:49:09 UTC (rev 377) +++ pkg/R/marketResidual.R 2014-10-18 13:14:32 UTC (rev 378) @@ -1,51 +0,0 @@ -######################### -# Market model adjustment -######################### -## Argument: -## 1. firm.returns: Firm returns of which market residual is to computed -## 2. market.returns: Market Index returns -## Output: -## 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) - if (length(fulldata) == 0) { - warning("no common window found"); - return(NULL) - } - ## 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 <- lapply(firm.returns, function(i) - { - mm.residual(y=i,x=market.returns) - }) - names(result) <- colnames(firm.returns) - chk <- which(do.call("c",lapply(result,is.null))==TRUE) - if(length(chk)!=0){ - result <- result[-chk] - } - result <- do.call("merge.zoo", result) - } else { - result <- mm.residual(y=firm.returns,x=market.returns) - } - return(result) -} - Modified: pkg/R/phys2eventtime.R =================================================================== --- pkg/R/phys2eventtime.R 2014-10-14 23:49:09 UTC (rev 377) +++ pkg/R/phys2eventtime.R 2014-10-18 13:14:32 UTC (rev 378) @@ -29,6 +29,9 @@ } colnames(z.e) <- which(outcomes == "success") + ## :DOC + events.attrib <- do.call(c, lapply(answer[outcomes == "success"], function(x) x$event)) + ## class(events.attrib) <- class(events$when) ## Information verification within 'width' ## :: Will not be executed with width = 0 @@ -46,11 +49,13 @@ } if (any(outcomes == "wdatamissing")) { z.e <- z.e[, -badcolumns] + events.attrib <- events.attrib[-badcolumns] } } + ## Double check stopifnot(sum(outcomes=="success") == NCOL(z.e)) - list(z.e=z.e, outcomes=factor(outcomes)) + list(z.e=z.e, outcomes=factor(outcomes), events = events.attrib) # :DOC: events.attrib } timeshift <- function(x, z) { @@ -67,5 +72,5 @@ remapped <- zoo(as.numeric(z[, x[, "name"]]), order.by = (-location + 1):(length(z[, x[, "name"]]) - location)) - return(list(result = remapped, outcome = "success")) + return(list(result = remapped, outcome = "success", event = index(z)[location])) } From noreply at r-forge.r-project.org Sun Oct 26 15:46:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 26 Oct 2014 15:46:31 +0100 (CET) Subject: [Eventstudies-commits] r379 - pkg/R Message-ID: <20141026144631.DB80F1877B2@r-forge.r-project.org> Author: chiraganand Date: 2014-10-26 15:46:31 +0100 (Sun, 26 Oct 2014) New Revision: 379 Modified: pkg/R/phys2eventtime.R Log: Return NULL if there are no columns left after checking for NAs inside the width. Modified: pkg/R/phys2eventtime.R =================================================================== --- pkg/R/phys2eventtime.R 2014-10-18 13:14:32 UTC (rev 378) +++ pkg/R/phys2eventtime.R 2014-10-26 14:46:31 UTC (rev 379) @@ -53,6 +53,10 @@ } } + if (NCOL(z.e) == 0) { + return(list(z.e = NULL, outcomes = factor(outcomes))) + } + ## Double check stopifnot(sum(outcomes=="success") == NCOL(z.e)) list(z.e=z.e, outcomes=factor(outcomes), events = events.attrib) # :DOC: events.attrib From noreply at r-forge.r-project.org Mon Oct 27 06:33:59 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 27 Oct 2014 06:33:59 +0100 (CET) Subject: [Eventstudies-commits] r380 - pkg/R Message-ID: <20141027053400.1117C187319@r-forge.r-project.org> Author: chiraganand Date: 2014-10-27 06:33:59 +0100 (Mon, 27 Oct 2014) New Revision: 380 Modified: pkg/R/phys2eventtime.R Log: Moved checking of zero columns only if the width is greater than 0. Modified: pkg/R/phys2eventtime.R =================================================================== --- pkg/R/phys2eventtime.R 2014-10-26 14:46:31 UTC (rev 379) +++ pkg/R/phys2eventtime.R 2014-10-27 05:33:59 UTC (rev 380) @@ -51,12 +51,11 @@ z.e <- z.e[, -badcolumns] events.attrib <- events.attrib[-badcolumns] } + if (NCOL(z.e) == 0) { + return(list(z.e = NULL, outcomes = factor(outcomes))) + } } - if (NCOL(z.e) == 0) { - return(list(z.e = NULL, outcomes = factor(outcomes))) - } - ## Double check stopifnot(sum(outcomes=="success") == NCOL(z.e)) list(z.e=z.e, outcomes=factor(outcomes), events = events.attrib) # :DOC: events.attrib From noreply at r-forge.r-project.org Mon Oct 27 06:35:55 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 27 Oct 2014 06:35:55 +0100 (CET) Subject: [Eventstudies-commits] r381 - in pkg: . R Message-ID: <20141027053555.7825C187319@r-forge.r-project.org> 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 #########################