# Connect to PostgreSQL database
library(RPostgreSQL)
drv <- dbDriver("PostgreSQL")
pg <- dbConnect(drv, dbname = "crsp")
# Pull in votes from ISS Voting Analytics
rs <- dbGetQuery(pg, "DROP TABLE IF EXISTS destagger.votes")
rs <- dbGetQuery(pg, "
CREATE TABLE destagger.votes AS
SELECT * FROM issvoting.compvotes
WHERE itemdesc ILIKE '%declassify %' OR issagendaitemid IN ('M0215', 'S0201')
ORDER BY issagendaitemid")
# Add PERMNO and GVKEY to the table (match to CUSIP)
rs <- dbGetQuery(pg,
"ALTER TABLE destagger.votes ADD COLUMN gvkey character(6)")
rs <- dbGetQuery(pg,
"ALTER TABLE destagger.votes ADD COLUMN permno integer")
rs <- dbGetQuery(pg,
"UPDATE destagger.votes AS a SET gvkey =
(SELECT gvkey FROM destagger.gvkeys AS b
WHERE b.cusip=a.cusip)")
rs <- dbGetQuery(pg,
"UPDATE destagger.votes AS a SET permno =
(SELECT DISTINCT permno FROM crsp.stocknames AS b
WHERE b.ncusip=substr(a.cusip,1,8))")
# Pull data into R
declassify <- dbGetQuery(pg, "SELECT * FROM destagger.votes")
# Get returns around meeting dates
dropbox.path <- path.expand("~/Dropbox/research/AGL/")
source(paste(dropbox.path,"Code/R/getEventReturns.R",sep=""))
ret_data <- getEventReturns(declassify$permno, declassify$meetingdate,
days.before=0, days.after=1)
## Initializing database connection... 0.00 seconds
## Preparing data for upload to database... 0.00 seconds
## Writing list of PERMNOs and event dates to database...0.12 seconds
## Identifying relevant trading dates... 0.18 seconds
## Compounding raw returns... 7.84 seconds
## Compounding value-weighted market returns... 0.06 seconds
## Compounding size-decile market returns... 0.06 seconds
ret_data$row.names <- NULL
ret_data <- unique(ret_data) # Drop duplicates (multiple votes at a single meeting)
# Put return data back in the database
rs <- dbWriteTable(pg, c("destagger", "ret_data"), ret_data,
overwrite=TRUE, row.names=FALSE)
# Get data including a measure of shareholder support relative to "base"
# (e.g., shares outstanding) specified for each vote.
declassify <- dbGetQuery(pg, "SELECT *,
CASE WHEN base='Outstanding' AND outstandingshares>0 THEN votedfor/outstandingshares
WHEN base='F+A' AND votedfor+votedagainst>0
THEN votedfor/(votedfor+votedagainst)
WHEN base='F+A+AB' AND votedfor+votedagainst+votedabstain>0
THEN votedfor/(votedfor+votedagainst+votedabstain)
END AS percent_for
FROM destagger.votes AS a
LEFT JOIN destagger.ret_data AS b
USING (permno)
WHERE a.meetingdate=b.event_date AND result IN ('Fail', 'Pass')")
There are 765 votes on declassification in the sample, with 18.43% being rejections by shareholders. Here they are by year.
## Descriptive statistics
declassify$year <- format(declassify$meetingdate, "%Y")
with(declassify, table(year, result))
## result
## year Fail Pass
## 2001 19 32
## 2002 18 33
## 2003 13 58
## 2004 8 70
## 2005 11 83
## 2006 10 99
## 2007 13 65
## 2008 20 108
## 2009 29 76
The votes are fairly well dispersed around the cutoff.
Note that these are only shareholder-sponsored votes.
# Produce a histogram of (SVT - allowable cap)
library(ggplot2)
qplot(percent_for - voterequirements,
data=subset(declassify,
percent_for <1 & percent_for > 0.01 & sponsor !="Management"),
binwidth=.01,
main="Histogram: Shareholder support minus vote requirement",
xlab="Shareholder support minus vote requirement")
But there's virtually no response by the market to the result of the vote.
qplot(percent_for - voterequirements, ret_mkt,
data=subset(declassify,
percent_for <1 & percent_for > 0.01 & sponsor !="Management"),
main="Market-adjusted Stock Returns: Days (0,1) Around Meeting Dates",
xlab="Shareholder support minus vote requirement")
source("http://iangow.me/~iangow/rd_opt_bw.R")
### (4) Calculate the treatment effect and standard errors.
rd_data <- subset(declassify, subset = percent_for < 1 & percent_for >
0.01 & sponsor != "Management", select = c(ret_mkt, percent_for, voterequirements))
rd_data$x <- rd_data$percent_for - rd_data$voterequirements
rd_data$y <- rd_data$ret_mkt
# First, get bandwidth
h <- with(rd_data, rd_opt_bw(y, x, c = 0))
X <- rd_data$percent_for - rd_data$voterequirements
c <- 0
## Weights based on triangular kernel
wgts <- with(rd_data, (1 - abs(X - c)/h) * (abs(X - c) <= h))
local.lm <- lm(y ~ (x >= c) * x, weights = wgts, data = rd_data)
rd.est <- coef(local.lm)[[2]]
sd.est <- sqrt(vcov(local.lm)[2, 2])
## Output
out <- c(h, rd.est, sd.est, rd.est/sd.est)
names(out) <- c("Optimal Bandwidth", "RD Estimate", "Standard Error",
"t-statistic")
print(out)
## Optimal Bandwidth RD Estimate Standard Error t-statistic
## 0.187689 0.002056 0.007844 0.262074
# A function to estimate local linear regression around a point (x_i)
# using bandwidth h, the triangular kernel and limiting observations to
# those on the same side of the cutoff c. In some sense, this is purely
# visual, as the IK bandwidth is optimized for x \in [c-h, c+h] and other
# data are not involved.
ll <- function(x_i, y, x, h, c) {
wgts <- (1 - abs(x - x_i)/h) * (abs(x - x_i) <= h) * (sign(x_i - c) == sign(x -
c) | x_i == c)
lm.fitted <- lm(y ~ x, weights = wgts)
if (sum(wgts > 0) > 10) {
# Require 10 observations around x_i
return(predict(lm.fitted, newdata = data.frame(x = x_i)))
} else {
return(NA)
}
}
# Add the fitted value to the dataset
library(parallel)
rd_data$y_fitted <- with(rd_data, unlist(mclapply(X, ll, y, X, h,
c, mc.cores = 8)))
# Make a plot
library(ggplot2)
ggplot(rd_data, aes(x)) + geom_point(aes(y = y, color = x > c)) +
geom_line(aes(y = y_fitted, color = x > c))
