[Eventstudies-commits] r412 - in pkg: R inst/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 31 18:39:09 CEST 2015
Author: sargam_jain
Date: 2015-03-31 18:39:09 +0200 (Tue, 31 Mar 2015)
New Revision: 412
Added:
pkg/inst/tests/test_functionality_excessReturn.R
pkg/inst/tests/test_functionality_phys2eventtime.R
pkg/inst/tests/test_userinput_excessReturn.R
pkg/inst/tests/test_userinput_phys2eventtime.R
Modified:
pkg/R/excessReturn.R
pkg/R/inference.bootstrap.R
pkg/R/phys2eventtime.R
pkg/inst/tests/test_compilation.txt
Log:
Added the test cases for 'excessReturn' and 'phys2eventtime'. Made changes in functions code to include: 1. argument class checks, 2. univariate series in zoo object, 3. equal dimension (row) of zoo objects in 'excessReturn'.
Modified: pkg/R/excessReturn.R
===================================================================
--- pkg/R/excessReturn.R 2015-03-13 11:35:11 UTC (rev 411)
+++ pkg/R/excessReturn.R 2015-03-31 16:39:09 UTC (rev 412)
@@ -1,3 +1,9 @@
excessReturn <- function(firm.returns, market.returns) {
- return(firm.returns - market.returns)
+ stopifnot(NROW(firm.returns) == NROW(market.returns))
+
+ stopifnot(class(firm.returns)=="zoo" || class(firm.returns)=="xts")
+
+ stopifnot(class(market.returns)=="zoo" || class(market.returns)=="xts")
+
+ return(firm.returns - market.returns)
}
Modified: pkg/R/inference.bootstrap.R
===================================================================
--- pkg/R/inference.bootstrap.R 2015-03-13 11:35:11 UTC (rev 411)
+++ pkg/R/inference.bootstrap.R 2015-03-31 16:39:09 UTC (rev 412)
@@ -61,7 +61,7 @@
results <- NULL
for (i in 1:ncol(b$t)) {
- results <- rbind(results, quantile(b$t[,i], prob=c(.025,.975)))
+ results <- rbind(results, quantile(b$t[,i], prob=c(.025,.975), na.rm=TRUE))
}
results <- cbind(results[,1], b$t0, results[,2])
rownames(results) <- rownames(es.w)
Modified: pkg/R/phys2eventtime.R
===================================================================
--- pkg/R/phys2eventtime.R 2015-03-13 11:35:11 UTC (rev 411)
+++ pkg/R/phys2eventtime.R 2015-03-31 16:39:09 UTC (rev 412)
@@ -12,25 +12,36 @@
# A vector of these outcomes is returned.
phys2eventtime <- function(z, events, width=10) {
- 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.")
- }
- 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)
- z.e <- do.call(cbind, lapply(answer[outcomes == "success"], function(x) x$result))
+ stopifnot(class(events)=="data.frame")
+ stopifnot(class(z)=="zoo" || class(z)=="xts")
+
+ 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.")
+ }
+ if (any(is.na(events$when))) {
+ stop("events$when should not contain NA values.")
+ }
+ if (any(is.na(events$name))) {
+ stop("events$name should not contain NA values.")
+ }
+
+ 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)
+ 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) {
- return(list(z.e = NULL, outcomes = factor(outcomes)))
+ if (length(z.e) == 0) {
+ return(list(z.e = NULL, outcomes = factor(outcomes)))
}
-
+
colnames(z.e) <- which(outcomes == "success")
## :DOC
events.attrib <- do.call(c, lapply(answer[outcomes == "success"], function(x) x$event))
Modified: pkg/inst/tests/test_compilation.txt
===================================================================
--- pkg/inst/tests/test_compilation.txt 2015-03-13 11:35:11 UTC (rev 411)
+++ pkg/inst/tests/test_compilation.txt 2015-03-31 16:39:09 UTC (rev 412)
@@ -1,7 +1,7 @@
###### Testing functions in eventstudies package #####
Tests are categorized as follows:
-I. Tests for argument inputs (context: user input)
+I. Tests for argument inputs (context: userinput)
II. Tests for functionality (context: functionality)
III. Tests for aggregate function (context: aggregate)
IV. Example from book as test case (context: example)
@@ -17,8 +17,7 @@
* zero
* +Inf
* -Inf
-> * Values greater than the no. of rows in dataframe StockPriceReturns
-> b) Check for following when zoo object with firm data and dates as index is a univariate series:
+# b) Check for following when zoo object with firm data and dates as index is a univariate series:
# If univariate series is input as vector (not matrix), then the function fails.
c) Check for following values for z (zoo object):
# Extreme values:
@@ -39,7 +38,7 @@
3. Function excessReturn
> a) Check whether: # of rows in df(firm returns) = # of rows in df(market returns)
b) Check for extreme values of no. of rows and columns i.e. 1 row or 1 col in dataset
-> c) Check for class of arguments
+
4. Function lmAMM
> a) Check for whether X is the output of makeX or not (read makeX manual)
@@ -103,20 +102,18 @@
II. TESTS FOR FUNCTIONALITY
1. Function phys2eventime
- > a) Check for list components returned by the function
+# a) Check for list components returned by the function
* Check for the structure of `z.e'. It should not be a transpose
(of the format in which it goes in inference.bootstrap())
-> b) Check for firm selected should not have NA in data for defined width
-> c) Check for class of arguments
-> d) Check for if the function handles following data discrepancies in events:
+# b) Check for firm selected should not have NA in data for defined width
+# c) Check for class of arguments
+# d) Check for if the function handles following data discrepancies in events:
* Missing dates in eventlist
* Missing firm in eventlist
-> e) When zoo object with firm data and dates as index is a univariate series,
- function must work if its a matrix of one column (i.e. only one
- observation for each firm which is corresponding to event date), or
- if it is a matrix of one column (i.e. data input is only for one
+# e) When zoo object with firm data and dates as index is a univariate series,
+ function must work if its a matrix of one column (i.e. data input is only for one
firm).
-> f) Check for only one observation in data frame, event.list
+# f) Check for only one observation in data frame, event.list
(i.e. only one firm has an observed event)
@@ -127,7 +124,8 @@
3. Function excessReturn
a) Check with small sample data whether the result is correct or not.
-
+ b) Check for class of arguments
+
4. Function lmaMM
L a) Check for class of arguments
b) Check the working and results of regression analysis manually: difficult @leave this for now
Added: pkg/inst/tests/test_functionality_excessReturn.R
===================================================================
--- pkg/inst/tests/test_functionality_excessReturn.R (rev 0)
+++ pkg/inst/tests/test_functionality_excessReturn.R 2015-03-31 16:39:09 UTC (rev 412)
@@ -0,0 +1,84 @@
+library(testthat)
+context("functionality")
+
+## 1. Test for class of arguments
+
+test <- that("functionality for excessReturn", {
+ library(eventstudies)
+ ## Data of stock prices and returns
+ test.firm <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17,
+ 35.89, 36.19, 37.1317, 36.7033, 37.7933,
+ 37.8533, 285.325, 292.6, 290.025, 286.2,
+ 290.075, 295.05, 289.325, 285.625, 293.7,
+ 298.5, 289.05, 704.5438, 708.35, 735.835,
+ 710.6, 711.65, 731.012, 727.57, 715.0187,
+ 724.2, 713.1875, 695.1812),
+ .Dim = c(11L, 3L),
+ .Dimnames = list( NULL, c("ITC",
+ "Reliance", "TCS")),
+ index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "zoo")
+ test.firm <- diff(log(test.firm))
+
+ test.firm1 <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17,
+ 35.89, 36.19, 37.1317, 36.7033, 37.7933,
+ 37.8533, 285.325, 292.6, 290.025, 286.2,
+ 290.075, 295.05, 289.325, 285.625, 293.7,
+ 298.5, 289.05, 704.5438, 708.35, 735.8375,
+ 710.625, 711.65, 731.013, 727.575, 715.01,
+ 724.2, 713.1875, 695.1812),
+ .Dim = c(11L, 3L),
+ .Dimnames = list( NULL, c("ITC", "Reliance",
+ "TCS")), index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "matrix")
+ test.firm1 <- diff(log(test.firm1))
+
+ ## Data for market prices and returns
+ test.market <- structure(c(285.546, 265.566, 290.025, 288.2,
+ 295.677, 298.990, 279.32, 286.62,
+ 296.7, 288.5, 284.05),
+ .Dim = c(11L, 1L),
+ .Dimnames = list( NULL, c("MarketIndex")),
+ index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "zoo")
+ test.market <- diff(log(test.market))
+
+ test.market1 <- structure(c(285.546, 265.566, 290.025, 288.2,
+ 295.677, 298.990, 279.32, 286.62,
+ 296.7, 288.5, 284.05),
+ .Dim = c(11L, 1L),
+ .Dimnames = list( NULL, c("MarketIndex")),
+ index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "matrix")
+ test.market1 <- diff(log(test.market1))
+
+
+ ### Testing the class of arguments
+ cat("\nTesting for class of arguments input")
+
+ er.testResult1 <- excessReturn(firm.returns = test.firm,
+ market.returns = test.market[,1])
+
+ er.testResult2 <- excessReturn(firm.returns = test.firm1,
+ market.returns = test.market1[,1])
+
+
+
+
+
Added: pkg/inst/tests/test_functionality_phys2eventtime.R
===================================================================
--- pkg/inst/tests/test_functionality_phys2eventtime.R (rev 0)
+++ pkg/inst/tests/test_functionality_phys2eventtime.R 2015-03-31 16:39:09 UTC (rev 412)
@@ -0,0 +1,139 @@
+library(testthat)
+context("functionality")
+
+# 1. Test for class of arguments
+# 2. Test for missing data in eventlist
+# a. NAs in firm names
+# b. NAs in event dates
+# 3. Testing the functionality of "phys2eventtime" for components of
+# the list returned from the function:
+# a. Elements in outcomes
+# b. Elements in z.e
+# 4. Testing that firms should not have NA for defined width of
+# phys2eventtime
+# 5. Test for only one observation in events list.
+test_that("functionality for phys2eventtime", {
+ library(eventstudies)
+
+### Data for testing ###
+
+ test.data <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17,
+ 35.89, 36.19, 37.1317, 36.7033, 37.7933,
+ 37.8533, 285.325, 292.6, 290.025, 286.2,
+ 290.075, 295.05, 289.325, 285.625, 293.7,
+ 298.5, 289.05, 704.5438, 708.35, 735.8375,
+ 710.625, 711.65, 731.0125, 727.575, 715.01,
+ 724.2, 713.1875, 695.1812),
+ .Dim = c(11L, 3L),
+ .Dimnames = list( NULL, c("ITC", "Reliance",
+ "TCS")), index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "zoo")
+
+### List of events
+
+ test.eventslist <- data.frame(name=c("ITC","Reliance","TCS",
+ "ITC","Reliance","Junk"),
+ when=as.Date(c("2004-01-02",
+ "2004-01-08", "2004-01-14",
+ "2005-01-15", "2004-01-01",
+ "2005-01-01")))
+ test.eventslist$name <- as.character(test.eventslist$name)
+
+### Test for class of arguments
+
+ cat("\nTesting for class of arguments input")
+
+ test.data1 <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17,
+ 35.89, 36.19, 37.1317, 36.7033, 37.7933,
+ 37.8533, 285.325, 292.6, 290.025, 286.2,
+ 290.075, 295.05, 289.325, 285.625, 293.7,
+ 298.5, 289.05, 704.5438, 708.35, 735.8375,
+ 710.625, 711.65, 731.013, 727.575, 715.01,
+ 724.2, 713.1875, 695.1812),
+ .Dim = c(11L, 3L),
+ .Dimnames = list( NULL, c("ITC", "Reliance",
+ "TCS")), index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "matrix")
+ test.eventslist1 <- as.matrix(test.eventslist)
+ esConvertNormal0 <- phys2eventtime(z = test.data1,
+ events = test.eventslist,
+ width = 2)
+
+ esConvertNormal0 <- phys2eventtime(z = test.data,
+ events = test.eventslist1,
+ width = 2)
+
+### Testing for missing data in eventslist
+
+ cat("\nTesting for missing dates in eventslist")
+ test.eventslist2 <- data.frame(name=c("ITC","Reliance","TCS",
+ "ITC","Reliance","Junk"),
+ when=as.Date(c("2004-01-02",
+ "2004-01-08", "2004-01-14",
+ NA, "2004-01-01",
+ "2005-01-01")))
+ test.eventslist2$name <- as.character(test.eventslist2$name)
+ esConvertNormal1 <- phys2eventtime(z = test.data,
+ events = test.eventslist2,
+ width = 2)
+
+ cat("\nTesting for missing firm names in eventlist")
+ test.eventslist2 <- data.frame(name=c("ITC",NA,"TCS",
+ "ITC","Reliance","Junk"),
+ when=as.Date(c("2004-01-02",
+ "2004-01-08", "2004-01-14",
+ "2005-01-15", "2004-01-01",
+ "2005-01-01")))
+ test.eventslist2$name <- as.character(test.eventslist2$name)
+ esConvertNormal2 <- phys2eventtime(z = test.data,
+ events = test.eventslist2,
+ width = 2)
+
+### Testing the function for outcomes
+
+ cat("\nTesting for list component: outcomes")
+ esConvertNormal3 <- phys2eventtime(z = test.data,
+ events = test.eventslist,
+ width = 10)
+ expect_that(length(esConvertNormal3$outcomes),
+ equals(nrow(test.eventslist)))
+
+ cat("\nTesting for list component: z.e")
+ analyseDate <- subset(test.eventslist,
+ test.eventslist$when >= index(test.data[1,]))
+ maxDate <- max(as.Date(analyseDate$when))
+ minDate <- min(as.Date(analyseDate$when))
+ l1 <- length(which(index(test.data) <= maxDate))
+ l2 <- length(which(index(test.data) > minDate))
+ elementsInz.e <- l1 + l2
+ if(is.null(esConvertNormal3$z.e))
+ {expect_that(nrow(esConvertNormal3$z.e), equals(NULL))
+ }else{
+ expect_that(nrow(esConvertNormal3$z.e), equals(elementsInz.e))}
+
+### Testing that firms should not have NA for defined width
+
+ cat("\nTesting for no NA values in defined width")
+ esConvertNormal4 <- phys2eventtime(z = test.data,
+ events = test.eventslist,
+ width = 2)
+ expect_that(esConvertNormal4$z.e[8:12], not(equals(NA)))
+
+
+### Testing for only one firm in eventslist
+
+ test.eventslist3 <- test.eventslist[1,]
+ cat("\nTesting for only one firm data in events list")
+ esConvertNormal7 <- phys2eventtime(z = test.data2,
+ events = test.eventslist3,
+ width = 2)
+})
+
Added: pkg/inst/tests/test_userinput_excessReturn.R
===================================================================
--- pkg/inst/tests/test_userinput_excessReturn.R (rev 0)
+++ pkg/inst/tests/test_userinput_excessReturn.R 2015-03-31 16:39:09 UTC (rev 412)
@@ -0,0 +1,67 @@
+library(testthat)
+context("userinput")
+
+## 1. Test for number of rows in dataframe of firm returns and
+## market returns should be equal.
+
+test_that("userinput for excessReturn", {
+ library(eventstudies)
+ ## Data of stock prices and returns
+ test.firm <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17,
+ 35.89, 36.19, 37.1317, 36.7033, 37.7933,
+ 37.8533, 285.325, 292.6, 290.025, 286.2,
+ 290.075, 295.05, 289.325, 285.625, 293.7,
+ 298.5, 289.05, 704.5438, 708.35, 735.835,
+ 710.6, 711.65, 731.012, 727.57, 715.0187,
+ 724.2, 713.1875, 695.1812),
+ .Dim = c(11L, 3L),
+ .Dimnames = list( NULL, c("ITC",
+ "Reliance", "TCS")),
+ index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "zoo")
+ test.firm <- diff(log(test.firm))
+
+
+ ## Data for market prices and returns
+ test.market <- structure(c(285.546, 265.566, 290.025, 288.2,
+ 295.677, 298.990, 279.32, 286.62,
+ 296.7, 288.5, 284.05),
+ .Dim = c(11L, 1L),
+ .Dimnames = list( NULL, c("MarketIndex")),
+ index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "zoo")
+ test.market <- diff(log(test.market))
+
+ ## List of events
+ test.eventslist <- data.frame(name=c("ITC","Reliance","TCS",
+ "ITC","Reliance","Junk"),
+ when=as.Date(c("2004-01-02",
+ "2004-01-08", "2004-01-14",
+ "2005-01-15", "2004-01-01",
+ "2005-01-01")))
+ test.eventslist$name <- as.character(test.eventslist$name)
+
+### Testing the function for number of rows in dataframe of
+### firm returns and market returns
+
+ cat("\n Testing for no. of rows in firm returns and market returns")
+ test.market1 <- test.market[-1,]
+ er.testResult1 <- excessReturn(firm.returns = test.firm,
+ market.returns = test.market[,1])
+
+
+ er.testResult2 <- excessReturn(firm.returns = test.firm,
+ market.returns = test.market1[,1])
+
+})
+
+
+
Added: pkg/inst/tests/test_userinput_phys2eventtime.R
===================================================================
--- pkg/inst/tests/test_userinput_phys2eventtime.R (rev 0)
+++ pkg/inst/tests/test_userinput_phys2eventtime.R 2015-03-31 16:39:09 UTC (rev 412)
@@ -0,0 +1,61 @@
+library(testthat)
+context("userinput")
+
+## 1. Test for normal values of width
+## 2. Test for univariate zoo object: matrix and not a vector
+
+
+test_that("userinput for phys2eventtime", {
+ library(eventstudies)
+## Data of Stock Prices
+test.data <- structure(c(33.16, 34.0967, 35.3683, 34.46, 34.17,
+ 35.89, 36.19, 37.1317, 36.7033, 37.7933,
+ 37.8533, 285.325, 292.6, 290.025, 286.2,
+ 290.075, 295.05, 289.325, 285.625, 293.7,
+ 298.5, 289.05, 704.5438, 708.35, 735.8375,
+ 710.625, 711.65, 731.0125, 727.575, 715.0187,
+ 724.2, 713.1875, 695.1812),
+ .Dim = c(11L, 3L),
+ .Dimnames = list( NULL, c("ITC", "Reliance",
+ "TCS")), index = structure(c(12418,
+ 12419, 12422, 12423, 12424,
+ 12425, 12426, 12429, 12430,
+ 12431, 12432),
+ class = "Date"),
+ class = "zoo")
+## List of events
+test.eventslist <- data.frame(name=c("ITC","Reliance","TCS",
+ "ITC","Reliance","Junk"),
+ when=as.Date(c("2004-01-02",
+ "2004-01-08", "2004-01-14",
+ "2005-01-15", "2004-01-01",
+ "2005-01-01")))
+test.eventslist$name <- as.character(test.eventslist$name)
+
+
+### Testing function for normal values of width
+
+ cat("\nTesting for normal input values")
+ esConvertNormal0 <- phys2eventtime(z = test.data,
+ events = test.eventslist,
+ width = 5)
+ cat("\nTesting for normal input values")
+ esConvertNormal1 <- phys2eventtime(z = test.data,
+ events = test.eventslist,
+ width = 10)
+
+### Testing for univariate zoo object: matrix and not a vector
+
+ test.data2 <- test.data[,1, drop=FALSE]
+ test.data3 <- test.data[,1]
+ cat("\nTesting for univariate zoo object")
+ esConvertNormal2 <- phys2eventtime(z = test.data2,
+ events = test.eventslist,
+ width = 2)
+
+ esConvertNormal3 <- phys2eventtime(z = test.data3,
+ events = test.eventslist,
+ width = 2)
+
+})
+
More information about the Eventstudies-commits
mailing list