[Eventstudies-commits] r78 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 16 07:33:30 CEST 2013
Author: chiraganand
Date: 2013-07-16 07:33:30 +0200 (Tue, 16 Jul 2013)
New Revision: 78
Removed:
pkg/R/firmExposures.R
pkg/R/makeX.R
pkg/R/manyfirmsAMM.R
pkg/R/onefirmAMM.R
Log:
Removing unnecessary files, functions are already inside AMM.R.
Deleted: pkg/R/firmExposures.R
===================================================================
--- pkg/R/firmExposures.R 2013-07-16 05:18:48 UTC (rev 77)
+++ pkg/R/firmExposures.R 2013-07-16 05:33:30 UTC (rev 78)
@@ -1,73 +0,0 @@
-###############################################
-# Estimating one firm's exposure in one period.
-###############################################
-firmExposures <- function(rj, X, nlags=NA, verbose=FALSE) {
- do.ols <- function(nlags) {
- tmp <- cbind(rj, X[,1]) # Assume 1st is stock index, and no lags are required there.
- labels <- c("rj","rM1")
- if (NCOL(X) > 1) {
- for (i in 2:NCOL(X)) {
- for (j in 0:nlags) {
- tmp <- cbind(tmp, lag(X[,i], -j))
- labels <- c(labels, paste(colnames(X)[i], j, sep="."))
- }
- }
- }
- tmp <- na.omit(tmp)
- if (nrow(tmp) < 30) { # refuse to do the work.
- return(NULL) # returns out of do.ols() only
- }
-
- colnames(tmp) <- labels # So the OLS results will look nice
- lm(rj ~ ., data=as.data.frame(tmp))
- }
-
- if (is.na(nlags)) {
- if (verbose) {cat("Trying to find the best lag structure...\n")}
- bestlag <- 0
- bestm <- NULL
- bestAIC <- Inf
- for (trylag in 0:min(10,log10(length(rj)))) {
- thism <- do.ols(trylag)
- thisAIC <- AIC(thism, k=log(length(thism$fitted.values)))
- if (verbose) {cat(trylag, " lags, SBC = ", thisAIC, "\n")}
- if (thisAIC < bestAIC) {
- bestlag <- trylag
- bestAIC <- thisAIC
- bestm <- thism
- }
- }
- nlags <- bestlag
- m <- bestm
- } else {
- m <- do.ols(nlags)
- if (is.null(m)) {return(NULL)}
- }
- # In either event, you endup holding an "m" here.
- if (verbose) {cat("\n\nThe OLS:\n"); print(summary(m))}
-
- # Compute a series of exposure measures, and their standard errors.
- beta <- m$coefficients
- Sigma <- vcovHAC(m)
- # First the rM1
- exposures <- beta[2] # no lags for rM1
- s.exposures <- sqrt(Sigma[2,2])
- # From here on, there's a block of 1+nlags coeffs for each
- # of the non-rM1 regressors.
- if (NCOL(X) > 1) {
- for (i in 2:NCOL(X)) {
- n.block1 <- 2 + ((i-2)*(1+nlags)) # Just 2 for the 1st case.
- n.block2 <- length(beta) - n.block1 - (1 + nlags)
- w <- c(rep(0, n.block1), rep(1, 1+nlags), rep(0, n.block2))
- exposures <- c(exposures, w %*% beta)
- s.exposures <- c(s.exposures, sqrt(w %*% Sigma %*% w))
- }
- }
- names(exposures) <- names(s.exposures) <- colnames(X)
- results <- list(exposures=exposures,
- s.exposures=s.exposures, nlags=nlags,
- lm.res=m)
- class(results) <- "amm"
- results
-}
-
Deleted: pkg/R/makeX.R
===================================================================
--- pkg/R/makeX.R 2013-07-16 05:18:48 UTC (rev 77)
+++ pkg/R/makeX.R 2013-07-16 05:33:30 UTC (rev 78)
@@ -1,54 +0,0 @@
-
-###############################################################
-# A function that calls do.one.piece, and works through several
-# different periods to provide the right RHS matrix.
-###############################################################
-source('AMM.R')
-makeX <- function(rM1, others,
- switch.to.innov=rep(TRUE, NCOL(others)),
- rM1purge=TRUE,
- nlags=5,
- dates=NULL,
- verbose=TRUE) {
- if (verbose) {cat("0. Checking args\n")}
- stopifnot(all.equal(index(rM1), index(others)),
- length(switch.to.innov)==NCOL(others))
- if (!is.null(dates)) {
- stopifnot(class(dates) == "Date")
- }
- if (verbose) {cat("1. Checking dates.\n")}
- if (is.null(dates)) {
- dates <- c(start(rM1),end(rM1))
- }
- if(head(dates,1)!=head(index(rM1),1)){
- stop("Start date provided and the start date of the dataset do not match \n")
- }
- if(tail(dates,1)!=tail(index(rM1),1)){
- stop("End date provided and the end date of the dataset do not match \n")
- }
- if (verbose) {cat("2. Run through all the pieces --\n")}
- for (i in 1:(length(dates)-1)) {
- t1 <- dates[i]
- t2 <- dates[i+1]
- if (i != (length(dates)-1)) {t2 <- t2 -1}
- if (verbose) {
- cat(" Focusing down from date = ", as.character(t1), " to ", as.character(t2), "\n")
- }
- tmp.rM1 <- window(rM1, start=t1, end=t2)
- tmp.others <- window(others, start=t1, end=t2)
- a <- do.one.piece(tmp.rM1, tmp.others, switch.to.innov, rM1purge, nlags, verbose)
- if (i > 1) {
- res.rM1 <- c(res.rM1, a$rM1.purged)
- res.innov <- rbind(res.innov, a$innov)
- } else {
- res.rM1 <- a$rM1.purged
- res.innov <- a$innov
- }
- }
- if (verbose) {cat("2. Make a clean X and send it back --\n")}
- X <- cbind(res.rM1, res.innov)
- if (NCOL(res.innov) == 1) {colnames(X) <- c("rM1","z")}
- else {colnames(X) <- c("rM1", colnames(res.innov))}
- X
-}
-
Deleted: pkg/R/manyfirmsAMM.R
===================================================================
--- pkg/R/manyfirmsAMM.R 2013-07-16 05:18:48 UTC (rev 77)
+++ pkg/R/manyfirmsAMM.R 2013-07-16 05:33:30 UTC (rev 78)
@@ -1,58 +0,0 @@
-
-########################
-# Many firms AMM
-########################
-source('AMM.R')
-manyfirmsAMM <-function(regressand,regressors,
- lags,dates=NULL, periodnames=NULL,verbose=FALSE){
- if(is.null(dates)){
- dates=c(start(regressors),end(regressors))
- periodnames="Full"
- }
- nperiods <- length(periodnames)
- if(length(dates) != (nperiods+1)){
- cat("Mistake in length of dates versus length of periods.\n")
- return(NULL)
- }
- nfirms <- ncol(regressand)
-
- # Let's get "exposure' and 'sds'. Setting up structures:-
-
- exposures <- matrix(NA,nrow=nfirms,ncol=nperiods*ncol(regressors))
- rownames(exposures) <- colnames(regressand)
- tmp <- NULL
- for(i in 1:length(periodnames)){
- for(j in 1:ncol(regressors)){
- tmp <- c(tmp, paste(colnames(regressors)[j],
- periodnames[i],sep="."))
- }
- }
- colnames(exposures) <- tmp
- sds <- exposures
- colnames(sds) <- paste("sd",colnames(exposures),sep=".")
-
- # Setup a list structure for an OLS that failed
- empty <- list(exposures=rep(NA,ncol(regressors)),
- s.exposures=rep(NA,ncol(regressors)))
-
- for(i in 1:ncol(regressand)){
- cat("Doing",colnames(regressand)[i])
- if (verbose) {cat ("Doing", colnames(regressand)[i])}
- rj <- regressand[,i]
- dataset <- cbind(rj, regressors) # This is the full time-series
- this.exp <- this.sds <- NULL
- for(j in 1:nperiods){ # now we chop it up
- t1 <- dates[j]
- t2 <- dates[j+1]
- # if (j != nperiods) {t2 <- t2-1} # I don't know why I wrote this now :-( But this created problems.
- this <- window(dataset,start=t1, end=t2)
- fe <- firmExposures(this[,1],this[,-1],nlags=lags,verbose)
- if(is.null(fe)) {fe <- empty}
- this.exp <- c(this.exp, fe$exposures)
- this.sds <- c(this.sds, fe$s.exposures)
- }
- exposures[i,] <- this.exp
- sds[i,] <- this.sds
- }
- list(exposures=exposures, sds=sds, sig=exposures/sds)
-}
Deleted: pkg/R/onefirmAMM.R
===================================================================
--- pkg/R/onefirmAMM.R 2013-07-16 05:18:48 UTC (rev 77)
+++ pkg/R/onefirmAMM.R 2013-07-16 05:33:30 UTC (rev 78)
@@ -1,31 +0,0 @@
-#######################
-# AMM for one firm
-#######################
-source('AMM.R')
-onefirmAMM <- function(rj,X,nlags=NA,verbose=FALSE,dates=NULL){
- exposures <- data.frame(matrix(NA,ncol=ncol(X),nrow=(length(dates)-1)))
- colnames(exposures) <- colnames(X)
- sds <- exposures
- periodnames <- NULL
-
- if(is.null(dates)){
- res <- firmExposures(rj,X=rhs,verbose=verbose,nlags=nlags)
- exposures <- res$exposure
- sds <- res$s.exposure
- }else{
- for(i in 1:(length(dates)-1)){
- tmp <- window(rj,start=dates[i],end=dates[i+1])
- rhs <- window(X,start=dates[i],end=dates[i+1])
- res <- firmExposures(rj=tmp,
- X=rhs,
- verbose=verbose,
- nlags=nlags)
- exposures[i,] <- res$exposure
- periodnames <- c(periodnames,paste(dates[i],dates[i+1],sep=" TO "))
- sds[i,] <- res$s.exposure
- }
- rownames(exposures) <- rownames(sds) <- periodnames
- }
- rval <- list(exposures=exposures,sds=sds)
- return(rval)
-}
More information about the Eventstudies-commits
mailing list