Using the SEC header (SGML) files, I then identify filings of interest (e.g., 8-K filings with Item 2.02 information within 7 days of a quarterly reporting date per Compustat). What I’ve then done is to download these complete submissions to a folder on my computer (/edgar/data/) and then extract the files (e.g., PDFs, JPEGs) embedded in these complete submissions into a folder that is indexed using Recoll (based on Xapian) for fast full-text searches of the underlying files (this is on Linux, other solutions likely exist for Mac OS X or Windows). Here is some code that I used to extract the component files. This mostly works (the Excel files don’t seem to work either using this or the SEC links directly), but I’m sure there’s a better way to do this, however.

Note that, with the exception of putting the complete submission files in a different location, I try to retain the directory structure of the SEC website. My reason for putting the complete submissions in a separate location is to prevent Recoll from indexing meaningless binary data embedded in these files.

# Go through local copies of SEC text filings and extract the component
# documents from each filing
extract.filings <- function(file) {
    require(XML)
    if (is.na(file)) return(NA)
    
    # Parse the file as an XML file containing multiple documents
    webpage <- readLines(file.path("/edgar/data/", file)) #  encoding="Latin-1")
    
    file.name <- gsub("<FILENAME>","", 
                      grep("<FILENAME>.*$", webpage,  perl=TRUE, value=TRUE))
   
    if (length(file.name)==0) { return(NA) }
    
    partial.file.dir <- gsub("-(\\d{2})-(\\d{6})\\.txt$", "\\1\\2", file, perl=TRUE)
    file.dir <- file.path(directory, partial.file.dir)
       
    dir.create(file.dir, showWarnings=FALSE)
    
    file.name <- unique(file.path(file.dir, file.name))
    start.line <- grep("<DOCUMENT>.*$", webpage,  perl=TRUE) 
    end.line <- grep("</DOCUMENT>.*$", webpage,  perl=TRUE)     
    
    get.ext <- function(path) { gsub(".*\\.(.*?)$", "\\1", path) }
    
    for (i in 1:length(file.name)) {
         if(file.exists(file.name[i])) {
             next
         }
        
        if (get.ext(file.name[i])=="txt") {
            temp <- webpage[start.line[i]:end.line[i]]
            writeLines(temp, con=file.name[i])
        }
        
        if (get.ext(file.name[i])=="pdf") {
            temp <- webpage[start.line[i]:end.line[i]]
            pdf.start <- grep("^<PDF>", temp,  perl=TRUE) +1
            pdf.end <- grep("^</PDF>", temp,  perl=TRUE) -1  
            t <- tempfile()
            writeLines(temp[pdf.start:pdf.end], con=t)
            print(paste("uudecode -o", file.name[i], t))
            system(paste("uudecode -o", file.name[i], t))
            unlink(t)
        }
        
        if (get.ext(file.name[i]) %in% c("js", "css", "paper", "xsd")) {
            temp <- webpage[start.line[i]:end.line[i]]
            pdf.start <- grep("^<TEXT>", temp,  perl=TRUE) +1
            pdf.end <- grep("^</TEXT>", temp,  perl=TRUE) -1  
            t <- tempfile()
            writeLines(temp[pdf.start:pdf.end], con=file.name[i])
            unlink(t)
        }
        
        if (get.ext(file.name[i]) %in% c("zip", "xls", "jpg", "gif")) {
            temp <- webpage[start.line[i]:end.line[i]]
            pdf.start <- grep("^begin", temp,  perl=TRUE)
            pdf.end <- grep("^end", temp,  perl=TRUE)  
            t <- tempfile()
            writeLines(temp[pdf.start:pdf.end], con=t)
            print(paste("uudecode -o", file.name[i], t))
            system(paste("uudecode -o", file.name[i], t))
            unlink(t)
        }
    }
    return(partial.file.dir) 
}

# Get data from internet, read into R
zipped_data <- "Perm_FY_2006_TEXT.zip"
download.file("http://www.flcdatacenter.com/download/Perm_FY2006_TEXT.zip",
              destfile=zipped_data)
raw_data <- unzip(zipped_data)
all2006 <- read.csv(raw_data, as.is=TRUE, header=TRUE)
unlink(raw_data); rm(raw_data)

# A little data-cleaning
all2006 <- within(all2006, {
  Wage_Offered_From <- as.numeric(gsub("\\$","", Wage_Offered_From))
  Prevailing_Wage_Amount <- as.numeric(gsub("\\$","", Prevailing_Wage_Amount))
  rat <- Wage_Offered_From/Prevailing_Wage_Amount
})

# Some more data-cleaning (per p.108)
all2006 <- subset(all2006, 
                  Wage_Per=="Year" &              # Exclude hourly-wagers
                    Wage_Offered_From > 20000 &   # Exclude weird cases
                    Prevailing_Wage_Amount > 200) # Exclude hourly prv wages

# Subsetting as on p.109 (I changed the code, as the code given in the book
# behaves strangely for me)
se2006 <- subset(all2006, grepl("Software Engineer", Prevailing_Wage_Job_Title))
prg2006 <- subset(all2006, grepl("Programmer", Prevailing_Wage_Job_Title))
ee2006 <- subset(all2006, grepl("Electronics Engineer", Prevailing_Wage_Job_Title))

medrat <- function(dataframe) {
  return(median(dataframe$rat, na.rm=TRUE))
}

makecorp <- function(corpname) {
  return(subset(all2006, Employer_Name == corpname))
}

corplist <- c("MICROSOFT CORPORATION", "ms", 
              "INTEL CORPORATION", "intel",
              "SUN MICROSYSTEMS, INC.", "sun",
              "GOOGLE INC.", "google")

for (i in 1:(length(corplist)/2)) {
  corp <- corplist[2*i-1]
  newdtf <- paste(corplist[2*i], "2006", sep="")
  assign(newdtf, makecorp(corp), pos=.GlobalEnv)
}

One example that is hard to get the full value of without the underlying data is the extended example using data on the pronunciation of Chinese characters in Cantonese and Mandarin at the end of Chapter 5. Here is some code to pull together data that can be used for that example.

# Get the raw data from Matloff's website
chinese.raw <- readLines(paste("http://www.cs.ucdavis.edu/~matloff",
                               "matloff/public_html/145/Handouts/R2", 
                               "CanManB5.utf8", sep="/"))
save(file="chinese.raw.Rdata", chinese.raw )

# Create a tab-delimited version of the raw data
chinese <- sub(" ", "\t", chinese.raw)
chinese <- sub(" ", "\t", chinese)
chinese <- sub(" ", "\t", chinese)

# Function to split the data into fields and turn into a data frame
process.row <- function(string) {    
    temp <- unlist(strsplit(string, "\t"))
    return(data.frame(char=temp[1], Can=temp[2], Man=temp[3], Eng=temp[4], 
                      stringsAsFactors=FALSE))
}

# Create a data frame from the raw data
chinese.list <- lapply(chinese, process.row)
chinese.data <- do.call("rbind", chinese.list)
names(chinese.data)[1] <- "Ch char"

# Fix some cases with multiple Chinese pronunciations (I implicitly
# assume these are Cantonese pronunciations)
to.fix <- grep("^[[:alpha:]]+\\d", chinese.data$Eng, perl=TRUE)
chinese.data$Man[to.fix] <-
  gsub("^([[:alpha:]]+\\d) (.*)", "\\1", chinese.data$Eng[to.fix], perl=TRUE)
chinese.data$Eng[to.fix] <-
  gsub("^([[:alpha:]]+\\d) (.*)", "\\2", chinese.data$Eng[to.fix], perl=TRUE)

# Make two datasets: one for Cantonese, the other for Mandarin
can8 <- subset(chinese.data, select=c("Ch char", "Can"))
man8 <- subset(chinese.data, select=c("Ch char", "Man"))

# Ditch unneeded variables and save data to feed into the Chapter 5 example
rm(chinese.list, chinese, chinese.raw, chinese.data)
save(can8, man8, file="chinese.Rdata")

Here is some code (closely based on that in the book) that uses this data.

load("chinese.Rdata")

# merges data for 2 fangyans
merge2fy <- function(fy1, fy2) {
  outdf <- merge(fy1, fy2)

  # Separate tone from sound, and create new columns
  for (fy in list(fy1, fy2)) {
    # saplout will be a matrix, init cons in row 1, remainders in row
    # 2 and tones in row 3
    saplout <- sapply((fy[[2]]), sepsoundtone)
    
    # convert it to a data frame
    tmpdf <- data.frame(fy[, 1], t(saplout), row.names=NULL,
                        stringsAsFactors=FALSE)
    
    # Add names to the columns
    consname <- paste(names(fy)[[2]], " cons", sep="")
    restname <- paste(names(fy)[[2]], " sound", sep="")
    tonename <- paste(names(fy)[[2]], " tone", sep="")
    names(tmpdf) <- c("Ch char", consname, restname, tonename)
    
    # Need to use merge, not cbind(), dues to possibly different
    # ordering of fy, outdf
    outdf <- merge(outdf, tmpdf)
  }
  return(outdf)
}

# Separates romanized pronunciation pronun into initial consonant, if any
# the remaninder of the sound, and the tone, if any
sepsoundtone <- function(pronun) {
  nchr <- nchar(pronun)
  vowels <- c("a", "e", "i", "o", "u")
  
  # How many initial consononants?
  numcons <- 0
  for (i in 1:nchr) {
    ltr <- substr(pronun, i, i)
    if (!ltr %in% vowels) numcons <- numcons + 1 else break
  }
  cons <- if (numcons > 0) substr(pronun, 1, numcons) else NA
  tone <- substr(pronun, nchr, nchr)
  numtones <- 1 - as.integer(tone %in% letters) # TRUE is 1, FALSE is 0
  if (numtones == 0) tone <- NA
  therest <- substr(pronun, numcons+1, nchr - numtones)
  return(c(cons, therest, tone))
}

system.time(canman8 <- merge2fy(can8, man8))

Here is an alternative way to tackle the same problem (seems to produce the same results, though I didn’t check this carefully) using regular expressions. This is an illustration that the Perl motto that “there’s more than one way to do it” applies to R too.

load("chinese.Rdata")

# merges data for 2 fangyans
merge2fy <- function(fy1, fy2) {
  outdf <- merge(fy1, fy2)
  
  # Separate tone from sound, and create new columns
  for (fy in list(fy1, fy2)) {
    
    # Matching on pronunciation requires this step to prevent
    # duplicate matches.
    # (Perhaps save some time by only processing unique pronunciations.)
    pronun <- unique(fy[[2]])
    
    # Regular expression separates romanized pronunciation pronun into initial 
    # consonant, if any; the remainder of the sound, if any; and the tone, if any
    
    # tmpdf will be a matrix, init cons in column 2, remainders in column
    # 3 and tones in column 4
    # Three components to the match:
    #   - String at the beginning that does not contain vowels or digits
    #   - String beginning with a vowel, followed by letters
    #   - String consisting of a single digit
    matches <- regexec("^([^aeiou0-9]*)([aeiou]\\D*)?(\\d)?$", pronun)
    tmpdf <- do.call("rbind", regmatches(pronun, matches))
    
    # convert it to a data frame
    tmpdf <- as.data.frame(tmpdf, stringsAsFactors=FALSE)
    
    # Add names to the columns
    names(tmpdf) <- 
      paste(names(fy)[[2]], c("", " cons", " sound", " tone"), sep="")
    
    # Need to use merge, not cbind(), dues to possibly different
    # ordering of fy, outdf
    outdf <- merge(outdf, tmpdf, all.x=TRUE)
  }
  return(outdf)
}

system.time(canman8 <- merge2fy(can8, man8))

# Tests of R function using Mitchell Petersen's test-data

# Read the data             
test <- read.table(
      url(paste("http://www.kellogg.northwestern.edu/",
            "faculty/petersen/htm/papers/se/",
            "test_data.txt",sep="")),
    col.names=c("firmid", "year", "x", "y"))

# Create a silly instrument (x plus noise)
test <- within(test, z <- x + rnorm(length(x), mean=0, sd=sd(x)/3))

# The fitted model
library(AER)
fm <- ivreg(y ~ x | z, data=test)

# Tests
library(sandwich); library(lmtest)
coeftest(fm)                                    # OLS
coeftest(fm, vcov=vcovHC(fm, type="HC0"))       # White
source("~/Dropbox/AGL/Code/R/cluster2.R")
coeftest.cluster(test,fm, cluster1="firmid")    # Clustered by firm
coeftest.cluster(test,fm, cluster1="year")      # Clustered by year
coeftest.cluster(test,fm, cluster1="firmid",
                          cluster2="year")      # Clustered by firm and year

# Save the data to a Stata file for comparison
library(foreign)
write.dta(dataframe=test, file="~/Dropbox/WRDS/petersen.dta")

Here’s the output

> test <- within(test, z <- x + rnorm(length(x), mean=0, sd=sd(x)/3))
Error in within(test, z <- x + rnorm(length(x), mean = 0, sd = sd(x)/3)) : 
  object 'test' not found
> test <- read.table(
+       url(paste("http://www.kellogg.northwestern.edu/",
+             "faculty/petersen/htm/papers/se/",
+             "test_data.txt",sep="")),
+     col.names=c("firmid", "year", "x", "y"))
> 
> test <- within(test, z <- x + rnorm(length(x), mean=0, sd=sd(x)/3))
> fm <- ivreg(y ~ x | z, data=test)
Error: could not find function "ivreg"
> library(AER)
Loading required package: car
Loading required package: MASS
Loading required package: nnet
Loading required package: survival
Loading required package: splines
Loading required package: Formula
Loading required package: lmtest
Loading required package: zoo

Attaching package: ‘zoo’

The following object(s) are masked from ‘package:base’:

    as.Date, as.Date.numeric

Loading required package: sandwich
Loading required package: strucchange
> fm <- ivreg(y ~ x | z, data=test)
> library(sandwich); library(lmtest)
> coeftest(fm)                                    # OLS

t test of coefficients:

            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 0.029685   0.028359  1.0468   0.2953    
x           1.033802   0.030142 34.2982   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

> coeftest(fm, vcov=vcovHC(fm, type="HC0"))       # White

t test of coefficients:

            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 0.029685   0.028354  1.0469   0.2952    
x           1.033802   0.029851 34.6326   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

> coeftest.cluster(test,fm, cluster1="firmid")    # Clustered by firm
Error: could not find function "coeftest.cluster"
> coeftest.cluster(test,fm, cluster1="year")      # Clustered by year
Error: could not find function "coeftest.cluster"
> source("~/Dropbox/AGL/Code/R/cluster2.R")
> coeftest.cluster(test,fm, cluster1="firmid")    # Clustered by firm

t test of coefficients:

            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 0.029685   0.067011   0.443   0.6578    
x           1.033802   0.051423  20.104   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

> coeftest.cluster(test,fm, cluster1="year")      # Clustered by year

t test of coefficients:

            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 0.029685   0.023395  1.2688   0.2046    
x           1.033802   0.036246 28.5219   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

> coeftest.cluster(test,fm, cluster1="firmid",
+                           cluster2="year")      # Clustered by firm and year

t test of coefficients:

            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 0.029685   0.065065  0.4562   0.6482    
x           1.033802   0.055377 18.6684   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 

> library(foreign)
> write.dta(dataframe=test, file="~/Dropbox/WRDS/petersen.dta")

Now, compare with Stata. First, I use the in-built ivreg routine, then I consider the ivreg2 routine available here.
It seems that the R routine produces identical estimates of standard errors to Stata’s ivreg routine, which only handles one-way clustering, but both produce different estimates from the ivreg2 routine. My guess is that it’s some differences in the degrees-of-freedom correction used; the numbers are fairly close.

. use "~/Dropbox/WRDS/petersen.dta"
(Written by R.              )

. ivreg y (x=z)

Instrumental variables (2SLS) regression

      Source |       SS       df       MS              Number of obs =    5000
-------------+------------------------------           F(  1,  4998) = 1176.37
       Model |  5270.65875     1  5270.65875           Prob > F      =  0.0000
    Residual |  20097.6441  4998  4.02113727           R-squared     =  0.2078
-------------+------------------------------           Adj R-squared =  0.2076
       Total |  25368.3028  4999   5.0746755           Root MSE      =  2.0053

------------------------------------------------------------------------------
           y |      Coef.   Std. Err.      t    P>|t|     [95% Conf. Interval]
-------------+----------------------------------------------------------------
           x |   1.033802   .0301416    34.30   0.000     .9747116    1.092893
       _cons |   .0296853   .0283594     1.05   0.295    -.0259115    .0852821
------------------------------------------------------------------------------
Instrumented:  x
Instruments:   z
------------------------------------------------------------------------------

. ivreg y (x=z), cluster(firmid)

Instrumental variables (2SLS) regression               Number of obs =    5000
                                                       F(  1,   499) =  404.17
                                                       Prob > F      =  0.0000
                                                       R-squared     =  0.2078
                                                       Root MSE      =  2.0053

                               (Std. Err. adjusted for 500 clusters in firmid)
------------------------------------------------------------------------------
             |               Robust
           y |      Coef.   Std. Err.      t    P>|t|     [95% Conf. Interval]
-------------+----------------------------------------------------------------
           x |   1.033802   .0514227    20.10   0.000     .9327707    1.134834
       _cons |   .0296853   .0670107     0.44   0.658    -.1019726    .1613431
------------------------------------------------------------------------------
Instrumented:  x
Instruments:   z
------------------------------------------------------------------------------

. ivreg y (x=z), cluster(year)

Instrumental variables (2SLS) regression               Number of obs =    5000
                                                       F(  1,     9) =  813.50
                                                       Prob > F      =  0.0000
                                                       R-squared     =  0.2078
                                                       Root MSE      =  2.0053

                                  (Std. Err. adjusted for 10 clusters in year)
------------------------------------------------------------------------------
             |               Robust
           y |      Coef.   Std. Err.      t    P>|t|     [95% Conf. Interval]
-------------+----------------------------------------------------------------
           x |   1.033802   .0362459    28.52   0.000     .9518085    1.115796
       _cons |   .0296853   .0233954     1.27   0.236    -.0232389    .0826094
------------------------------------------------------------------------------
Instrumented:  x
Instruments:   z
------------------------------------------------------------------------------

. ivreg2 y (x=z), cluster(year)

IV (2SLS) estimation
--------------------

Estimates efficient for homoskedasticity only
Statistics robust to heteroskedasticity and clustering on year

Number of clusters (year) =         10                Number of obs =     5000
                                                      F(  1,     9) =   813.50
                                                      Prob > F      =   0.0000
Total (centered) SS     =  25368.30284                Centered R2   =   0.2078
Total (uncentered) SS   =  25374.51146                Uncentered R2 =   0.2080
Residual SS             =  20097.64409                Root MSE      =    2.005

------------------------------------------------------------------------------
             |               Robust
           y |      Coef.   Std. Err.      z    P>|z|     [95% Conf. Interval]
-------------+----------------------------------------------------------------
           x |   1.033802   .0343824    30.07   0.000     .9664141    1.101191
       _cons |   .0296853   .0221926     1.34   0.181    -.0138115     .073182
------------------------------------------------------------------------------
Underidentification test (Kleibergen-Paap rk LM statistic):              9.987
                                                   Chi-sq(1) P-val =    0.0016
------------------------------------------------------------------------------
Weak identification test (Cragg-Donald Wald F statistic):              4.5e+04
                         (Kleibergen-Paap rk Wald F statistic):        6.1e+04
Stock-Yogo weak ID test critical values: 10% maximal IV size             16.38
                                         15% maximal IV size              8.96
                                         20% maximal IV size              6.66
                                         25% maximal IV size              5.53
Source: Stock-Yogo (2005).  Reproduced by permission.
NB: Critical values are for Cragg-Donald F statistic and i.i.d. errors.
------------------------------------------------------------------------------
Hansen J statistic (overidentification test of all instruments):         0.000
                                                 (equation exactly identified)
------------------------------------------------------------------------------
Instrumented:         x
Excluded instruments: z
------------------------------------------------------------------------------

. ivreg2 y (x=z), cluster(firmid)

IV (2SLS) estimation
--------------------

Estimates efficient for homoskedasticity only
Statistics robust to heteroskedasticity and clustering on firmid

Number of clusters (firmid) =      500                Number of obs =     5000
                                                      F(  1,   499) =   404.17
                                                      Prob > F      =   0.0000
Total (centered) SS     =  25368.30284                Centered R2   =   0.2078
Total (uncentered) SS   =  25374.51146                Uncentered R2 =   0.2080
Residual SS             =  20097.64409                Root MSE      =    2.005

------------------------------------------------------------------------------
             |               Robust
           y |      Coef.   Std. Err.      z    P>|z|     [95% Conf. Interval]
-------------+----------------------------------------------------------------
           x |   1.033802   .0513661    20.13   0.000     .9331267    1.134478
       _cons |   .0296853   .0669369     0.44   0.657    -.1015087    .1608792
------------------------------------------------------------------------------
Underidentification test (Kleibergen-Paap rk LM statistic):            308.025
                                                   Chi-sq(1) P-val =    0.0000
------------------------------------------------------------------------------
Weak identification test (Cragg-Donald Wald F statistic):              4.5e+04
                         (Kleibergen-Paap rk Wald F statistic):        3.2e+04
Stock-Yogo weak ID test critical values: 10% maximal IV size             16.38
                                         15% maximal IV size              8.96
                                         20% maximal IV size              6.66
                                         25% maximal IV size              5.53
Source: Stock-Yogo (2005).  Reproduced by permission.
NB: Critical values are for Cragg-Donald F statistic and i.i.d. errors.
------------------------------------------------------------------------------
Hansen J statistic (overidentification test of all instruments):         0.000
                                                 (equation exactly identified)
------------------------------------------------------------------------------
Instrumented:         x
Excluded instruments: z
------------------------------------------------------------------------------

. ivreg2 y (x=z), cluster(firmid fyear)
variable fyear not found
in option cluster()
r(111);

. ivreg2 y (x=z), cluster(firmid year)

IV (2SLS) estimation
--------------------

Estimates efficient for homoskedasticity only
Statistics robust to heteroskedasticity and clustering on firmid and year

Number of clusters (firmid) =      500                Number of obs =     5000
Number of clusters (year) =         10                F(  1,     9) =   328.27
                                                      Prob > F      =   0.0000
Total (centered) SS     =  25368.30284                Centered R2   =   0.2078
Total (uncentered) SS   =  25374.51146                Uncentered R2 =   0.2080
Residual SS             =  20097.64409                Root MSE      =    2.005

------------------------------------------------------------------------------
             |               Robust
           y |      Coef.   Std. Err.      z    P>|z|     [95% Conf. Interval]
-------------+----------------------------------------------------------------
           x |   1.033802   .0541255    19.10   0.000     .9277184    1.139886
       _cons |   .0296853   .0645686     0.46   0.646     -.096867    .1562375
------------------------------------------------------------------------------
Underidentification test (Kleibergen-Paap rk LM statistic):              9.731
                                                   Chi-sq(1) P-val =    0.0018
------------------------------------------------------------------------------
Weak identification test (Cragg-Donald Wald F statistic):              4.5e+04
                         (Kleibergen-Paap rk Wald F statistic):        4.0e+04
Stock-Yogo weak ID test critical values: 10% maximal IV size             16.38
                                         15% maximal IV size              8.96
                                         20% maximal IV size              6.66
                                         25% maximal IV size              5.53
Source: Stock-Yogo (2005).  Reproduced by permission.
NB: Critical values are for Cragg-Donald F statistic and i.i.d. errors.
------------------------------------------------------------------------------
Hansen J statistic (overidentification test of all instruments):         0.000
                                                 (equation exactly identified)
------------------------------------------------------------------------------
Instrumented:         x
Excluded instruments: z
------------------------------------------------------------------------------

# A function to jumble a vector with no chance of
# returning the original vector
vector_jumble <- function(vector) {
    
    # Create an initial sample
    jumble <- sample(vector)
   
    # Keep going until the jumbled vector differs from the original
    while(identical(vector,jumble)) {
        jumble <- sample(vector)
    }
    return(jumble)
}

# A function to jumble a word
word_jumble <- function(word) {
    
    # Split word into individuanl letters
    j <- unlist(strsplit(word,""))
    
    # If there are only three or fewer letters (i.e., only one middle letter), 
    # there is nothing to do. Otherwise, jumble the middle letters.
    if (length(j) < 4) {
        return(word)
    } else {
        first <- 1
        middle <- 2:(length(j)-1)
        last <- length(j)
        return(paste(j[c(first, vector_jumble(middle), last)], collapse=""))    
    }
}

# A function to jumble a sentence
sentence_jumble <- function(sentence) {
    # Initialize a variable that will store the jumbled sentence
    y <- NULL
    
    # Break the sentence into words (separated by spaces)
    x <- unlist(strsplit(sentence, " "))
    
    # Jumble each word in the sentence
    for (i in x) {
        y <- paste(y,word_jumble(i))
    }
    
    # Return the result, after deleting leading spaces
    return(gsub("^[ ]+","",y, perl=TRUE))
}
   
# A test sentence
a <- "The quick brown fox jumps over the lazy dog"
sentence_jumble(a)

Some sample output

> sentence_jumble(a)
[1] "The qicuk bworn fox jpmus oevr the lzay dog"


Here is an illustration of a feature recently added to PL/R. This is meant to represent a “panel” of ten-year time series for 100 firms numbered 1 through 100.

DROP TABLE IF EXISTS test_data;

CREATE TABLE test_data (
  fyear integer,
  firm float8,
  eps float8
);

INSERT INTO test_data
SELECT (b.f + 1) % 10 + 2000 AS fyear,
	floor((b.f+1)/10) + 50 AS firm,
       f::float8/100 + random()/10 AS eps
FROM generate_series(-500,499,1) b(f);

I then run the following queries. The SQL version takes 115ms on my
hardware, the PL/R version 1528ms (this is pretty unscientific, as I don’t
require 9 years of data for the SQL version); so there’s a potential tradeoff between performance and the flexibility of R.
The good news is that most of the 1528ms is R cranking away on the regression; if I replace the $BODY$ of
the function with “return(1)”, the time comes down to 97ms for the PL/R
version. So standard approaches to speeding up on the R side would seem
to apply. (I used “float8” for the types, but didn’t notice a performance
effect.)

CREATE OR REPLACE
FUNCTION r_regr_slope(float8, float8)
RETURNS float8 AS
$BODY$
  slope <- NA
  y <- farg1
  x <- farg2
  if (fnumrows==9) try (slope <- lm(y ~ x)$coefficients[2])
  return(slope)
$BODY$
LANGUAGE plr WINDOW;

SELECT *,
  regr_slope(eps, lag_eps) OVER w AS slope
FROM (SELECT firm, fyear, eps,
  lag(eps) OVER (ORDER BY firm, fyear) AS lag_eps
FROM test_data) AS a
WHERE eps IS NOT NULL
WINDOW w AS (ORDER BY firm, fyear ROWS 8 PRECEDING);

SELECT *, r_regr_slope(eps, lag_eps) OVER w AS slope_R
FROM (SELECT firm, fyear, eps,
  lag(eps) OVER (ORDER BY firm, fyear) AS lag_eps
FROM test_data) AS a
WHERE eps IS NOT NULL
WINDOW w AS (ORDER BY firm, fyear ROWS 8 PRECEDING);

get_sgml_file <- function(path) {
    
    # The name of the local file to be created and the remote file from which
    # it will be created.
    directory <- "/home/iangow/Documents/WRDS/filings/the_filings"
    local_filename <- gsub("^edgar\\/data(.*)\\.txt$", 
                          paste(directory,"\\1",".hdr.sgml",sep=""), 
                          path, perl=TRUE)
    remote_filename <- gsub("\\.txt$", ".hdr.sgml", path, perl=TRUE)                        
    
    # Only download the file if we don't already have a local copy
    if (!file.exists(local_filename)) {
        
        ftp <- paste("http://www.sec.gov/Archives",
                     dirname(path),
                     gsub("-|(.txt$)","",basename(path),perl=TRUE),
                     basename(remote_filename), sep="/") 
        dir.create(dirname(local_filename), showWarnings=FALSE)
        try(download.file(url=ftp, destfile=local_filename) )
    }                      
    
    # Return the local filename if the file exists
    if (file.exists(local_filename)) { 
        return(local_filename) 
    } else { return(NA) } 
}

Now, to test this code, I pull together announcements from First Call’s CIG (company-issued guidance) database, and then a list of 8-K filings made within the five-day window beginning with each announcement. (This takes around 50 seconds to pull together.)

# Connect to my database
library(RPostgreSQL)
drv <- dbDriver("PostgreSQL")
pg <- dbConnect(drv, db="crsp")

# Get FirstCall identifier, announcement date, and CIK for all observations on 
# the FirstCall CIG file. I can get CIK matches for almost all observations and
# there are very few (about 6) Security_IDs with more than one CIK match; 
# I guess that the correct CIK match will be arrived at by the limited time
# window used below.
dbGetQuery(pg, "DROP TABLE IF EXISTS cig_ciks")
dbGetQuery(pg,"CREATE TABLE cig_ciks AS SELECT * FROM
    (SELECT DISTINCT \"Security_ID\" AS security_id, anndate, cusip AS cusip8
        FROM fc.cig) AS a
    LEFT JOIN (SELECT DISTINCT substr(cusip, 1,8) AS cusip8, 
           (cik::integer)::text AS cik
        FROM (SELECT DISTINCT gvkey, cusip FROM comp.secm) AS b
        INNER JOIN (SELECT DISTINCT gvkey, cik FROM comp.company 
                   WHERE cik IS NOT NULL) AS c
        USING (gvkey)) AS d
    USING (cusip8)")

# Pull together a list of 8-K filings within the five-day window beginning with
# the announcement on CIG; I should be more careful here with weekends, etc.
file.list <- dbGetQuery(pg, "
    SELECT * 
    FROM cig_ciks AS a
    INNER JOIN filings.filings AS b
    USING (cik)
    WHERE b.date_filed BETWEEN a.anndate AND a.anndate + interval '4 days'
                 AND form_type='8-K'")

Now, download the SGMLs for each filing. This step takes some time: over 5 hours for the 58,000+ filings identified in the previous step. However, this is a one-off cost.

# Get the files
file.list$sgml_file <- unlist(lapply(file.list$file_name, get_sgml_file))

Now, extract the “items” associated with each filing. See here for a description of each item. Finally, scan each filing for the presence of certain kinds of items. (This probably isn’t the most efficient code, but it gets through the 58,000+ filings in 11 seconds.)

# Extract the list of items for each filing
item_scan <- function(sgml_file) {
    con <- file(sgml_file)
    items <- grep("^<ITEMS>", readLines(con=con), value=TRUE, perl=TRUE)
    close(con)
    items <- gsub("^<ITEMS>","", items, perl=TRUE)
    return(items)
}

file.list$items <- lapply(file.list$sgml_file, item_scan)

# A function to create an indicator for the presence of a given item
has_item <- function(item_list, item) {
    is.element(item, unlist(item_list))
}

# Create an indicator for the presence of Item 9.01 on each 8-K filing
file.list$has_2.02 <- unlist(lapply(file.list$items, has_item, "2.02"))
file.list$has_7.01 <- unlist(lapply(file.list$items, has_item, "7.01"))
file.list$has_9.01 <- unlist(lapply(file.list$items, has_item, "9.01"))

First, a function to download the zipped index file from the SEC website, then parse it into an R dataframe:

getSECIndexFile <- function(year, quarter) {
    
    # Download the zipped index file from the SEC website
    tf <- tempfile()
    result <- try(download.file(
        url=paste("ftp://anonymous:your_id@ftp.sec.gov/edgar/full-index/",
                  year,"/QTR", quarter, "/company.zip",sep=""),
        destfile=tf))
    
    # If we didn't encounter and error downloading the file, parse it
    # and return as a R data frame
    if (!inherits(result, "try-error")) {
        
        # Small function to remove leading and trailing spaces
        trim <- function (string) {
            gsub("^\\s*(.*?)\\s*$","\\1", string, perl=TRUE)
        }

        # Read the downloaded file
        raw.data <- readLines(con=(zz<- unz(description=tf,
                                            filename="company.idx")))
        close(zz)
        raw.data <- raw.data[11:length(raw.data)] # Remove the first 10 rows.

        # Parse the downloaded file and return the extracted data as a data frame
        company_name <- trim(substr(raw.data,1,62))
        form_type <- trim(substr(raw.data,63,74))
        cik <- trim(substr(raw.data,75,86))
        date_filed <- as.Date(substr(raw.data,87,98))
        file_name <- trim(substr(raw.data,99,150))
        rm(raw.data)
        return(data.frame(company_name, form_type, cik, date_filed, file_name))
    } else { return(NULL)} 
}

Second, a function to add the file to my database:

addIndexFileToDatabase <- function(data) {
    if (is.null(data)) return(NULL)
    library(RPostgreSQL)
    drv <- dbDriver("PostgreSQL")
    pg <- dbConnect(drv, db="crsp")
    
    rs <- dbWriteTable(pg, c("filings", "filings"), data, append=TRUE)
    dbDisconnect(pg)
    return(rs)
}   

Finally, a few lines of code to delete the filings table if it already exists, then download all the filing files from 1993 to 2011 and post them in the database.

library(RPostgreSQL)
drv <- dbDriver("PostgreSQL")
pg <- dbConnect(drv, db="crsp")
dbGetQuery(pg, "DROP TABLE IF EXISTS filings.filings")

for (year in 1993:2011) {
    for (quarter in 1:4) {
        addIndexFileToDatabase(getSECIndexFile(year, quarter))
    }
}

This picture required surprisingly little code to produce:

# Some parameters
min.year <- 1999
max.year <- 2010

# Pull data on number of filings by day of the month
library(RPostgreSQL)
drv <- dbDriver("PostgreSQL")
pg <- dbConnect(drv, db="crsp")

filing.data <- dbGetQuery(pg,paste("
    SELECT extract(year FROM date_filed) AS year_filed, 
        extract(day FROM date_filed) AS day_filed, count(*) AS num_10Ks_filed 
    FROM filings.filings 
    WHERE form_type='10-K'
        AND extract(year FROM date_filed) BETWEEN ",min.year, " AND ",max.year,
    "GROUP BY year_filed, day_filed ORDER BY year_filed, day_filed"))
filing.data$year_filed <- as.factor(filing.data$year_filed)

# Make a bar chart
library(lattice)
png(file="~/Dropbox/day_filed_10ks.png")

chart.title <- paste("Distribution of 10-K filings by day of month (",
                    min.year,"-",max.year,")", sep="")
barchart(day_filed ~ num_10ks_filed | year_filed, data=filing.data, 
         xlab="Number of 10-K filings",
         ylab="Day of month",
         main=chart.title,
        scales = list(y=list(at = seq(from=1,to=31, by=5))))
dev.off()

I did a fairly unscientific comparison with PostgreSQL. I don’t have the same hardware (the document above is from 2007), but I used my slow-as-a-wet-week-for-database-stuff two-year-old MacBook Pro (5400 RPM drive with whole-disk encryption).

Conclusion: PostgreSQL surely leaves SAS in its dust (the results posted in the source above are all in minutes). There was one query where PostgreSQL didn’t perform well, but one would actually use “window function” for that particular query (not available in MySQL or SAS, as far as I know) and then PostgreSQL is much, much faster.

CREATE TABLE test AS SELECT * FROM crsp.msf LIMIT 1000000; -- 10.6 seconds 

CREATE TABLE sub1 AS SELECT * FROM test WHERE vol=0; -- 5.5 seconds
CREATE TABLE sub2 AS SELECT * FROM test WHERE vol>0; -- 9.0 seconds

INSERT INTO sub1 SELECT * FROM sub2; -- 23.2 seconds

CREATE TABLE crop AS SELECT permno, date FROM test; -- 2.7 seconds

CREATE TABLE sort AS SELECT * FROM test ORDER BY permno, date; -- 17.6 seconds

CREATE TABLE stat AS SELECT date, avg(ret) FROM test GROUP BY date; -- 1.3 seconds

CREATE TABLE joined AS 
	SELECT a.permno, a.date, a.prc, b.prc AS lprc
	FROM test AS a 
	LEFT JOIN test AS b 
	ON a.permno=b.permno AND
		b.date BETWEEN a.date - interval '31 days' AND a.date - interval '1 day'; 
-- 259.2 seconds (higher than 182 seconds listed for SAS!)

-- Let's create an index to see what that does
CREATE INDEX test_idx ON test (permno, date); -- 3.5 seconds

CREATE TABLE joined2 AS 
	SELECT a.permno, a.date, a.prc, b.prc AS lprc
	FROM test AS a 
	LEFT JOIN test AS b 
	ON a.permno=b.permno AND
		b.date BETWEEN a.date - interval '31 days' AND a.date - interval '1 day'; 
-- 258.9 seconds (like SAS, PostgreSQL didn't use this index).

-- But you would never do that using PostgreSQL. Instead, use a window function:
CREATE TEMP TABLE joined3 AS 
	SELECT permno, date, prc, lag(prc) OVER w AS lprc 
	FROM test 
	WINDOW w AS (PARTITION BY permno ORDER BY date); -- 4.0 seconds!!!