vectorize functions

[lecy]

We need to make sure functions are vectorized, not using loops if at all possible. Loops are 10x slower.

For example, compare the readability and speed of clean date functions implemented like this:

date.words <- 
c( "JANUARY","JAN","FEBRUARY","FEB",
   "MARCH","MAR","APRIL","APR","MAY",
   "JUNE","JUN","JULY","JUL","AUGUST","AUG",
   "SEPTEMBER","SEPT","SEP","OCTOBER","OCT",
   "NOVEMBER","NOV","DECEMBER","DEC", "PARTIAL YEAR", "PARTIAL YR",
   "PART YEAR", "PART-YEAR", "YR", "YEAR",
   "PART YR","MO", "MOS", "MONTH", "MONTHS" )


identify_date <- function(TitleTxt)
{

  #mm/dd/yyyy format
  format1 <- grepl( "\\d+/\\d+(/\\d+)*\\b", TitleTxt )
  
  #mm-dd-yyyy format
  format2 <- grepl( "\\d+-\\d+(-\\d+)*\\b", TitleTxt )
  
  #date strings
  date <- paste0( "\\b", date.words, "\\b", collapse="|" )
  format3 <- grepl( date, TitleTxt )

  has.date <- format1 | format2 | format3
  
  return( has.date ) 
}



remove_date <- function( TitleTxt )
{

  #mm/dd/yyyy format
  TitleTxt <- gsub( "\\d+/\\d+(/\\d+)*\\b", "", TitleTxt )
  
  #mm-dd-yyyy format
  TitleTxt <- gsub( "\\d+-\\d+(-\\d+)*\\b", "", TitleTxt )
  
  #date strings
  date <- paste0( "\\b", date.words, "\\b", collapse="|" )
  TitleTxt <- gsub( date, "", TitleTxt )

  #remove miscellaneous digits still lying around
  TitleTxt <- gsub("\\d[A-Z]*\\s", " ", TitleTxt)
  TitleTxt <- gsub("\\d", " ", TitleTxt)
  
  #remove starting and leading spaces and excess spacing
  TitleTxt <- gsub("^\\s* | \\s*$", "", TitleTxt)
  TitleTxt <- gsub( "\\s{2,}", " ", TitleTxt)
  
  return(TitleTxt)
}



clean_dates <- function( comp.data )
{
  title <- convert_ordinal( comp.data$TitleTxt )
  has.date <- identify_date( title )
  title <- remove_date( title )
  
  # 1 if date was removed from title, 0 otherwise
  comp.data$Date.Code <- ifelse( has.date, 1, 0 )
  comp.data$TitleTxt <- title 
  
  return( comp.data )
}

Versus the current versions:

identify_date <- function(TitleTxt){

  #mm/dd/yyyy format
  k <- stringr::str_extract_all(TitleTxt,"\\d+/\\d+(/\\d+)*\\b")[[1]][1]
  if(!is.na(k)) {
    # print(k)
    return(TRUE)
  }
  
  #mm-dd-yyyy format
  k <- stringr::str_extract_all(TitleTxt,"\\d+-\\d+(-\\d+)*\\b")[[1]][1]
  if(!is.na(k)) {
    # print(k)
    return(TRUE)
  }
  
  #months
  month.words <- c("JANUARY","JAN","FEBRUARY","FEB",
                   "MARCH","MAR","APRIL","APR","MAY",
                   "JUNE","JUN","JULY","JUL","AUGUST","AUG",
                   "SEPTEMBER","SEPT","SEP","OCTOBER","OCT",
                   "NOVEMBER","NOV","DECEMBER","DEC", "PARTIAL YEAR", "PARTIAL YR",
                   "PART YEAR", "PART-YEAR", "YR", "YEAR",
                   "PART YR","MO", "MOS", "MONTH", "MONTHS")
  for(word in month.words){
    month <- paste0("\\b",word,"\\b")
    if(grepl(month, TitleTxt)) {
      # print(month)
      return(TRUE)
    }
  }
  return(FALSE)
}



remove_date <- function(TitleTxt){

  #mm/dd/yyyy format
  k <- stringr::str_extract_all(TitleTxt,"\\d+/\\d+(/\\d+)*\\b")[[1]][1]
  if(!is.na(k)) {
    TitleTxt <- gsub(k,"",TitleTxt)
  }
  
  #mm-dd-yyyy format
  k <- stringr::str_extract_all(TitleTxt,"\\d+-\\d+(-\\d+)*\\b")[[1]][1]
  if(!is.na(k)) {
    TitleTxt <- gsub(k,"",TitleTxt)
  }
  
  #month words
  month.words <- c("JANUARY","JAN","FEBRUARY","FEB",
                   "MARCH","MAR","APRIL","APR","MAY",
                   "JUNE","JUN","JULY","JUL","AUGUST","AUG",
                   "SEPTEMBER","SEPT","SEP","OCTOBER","OCT",
                   "NOVEMBER","NOV","DECEMBER","DEC", "PARTIAL YEAR", "PARTIAL YR",
                   "PART YEAR", "PART YR","MO", "MOS", "MONTH", "MONTHS")
  for(word in month.words){
    month <- paste0("\\b",word,"\\b")
    TitleTxt <- gsub(month,"",TitleTxt)
  }
  
  #remove miscellaneous digits still lying around
  TitleTxt <- gsub("\\d[A-Z]*\\s", " ", TitleTxt)
  TitleTxt <- gsub("\\d", " ", TitleTxt)
  
  #remove starting and leading spaces and excess spacing
  TitleTxt <- gsub("^\\s* | \\s*$", "", TitleTxt)
  TitleTxt <- gsub( "\\s{2,}", " ", TitleTxt)
  
  return(TitleTxt)
  
}


clean_dates <- function(comp.data){
  comp.table <- comp.data
  
  comp.table$Date.Code <- 0
  for(i in 1:length(comp.table$TitleTxt)) {
    #asssume the table already formatted correctly
    title <- convert_ordinal(comp.table$TitleTxt[i])
    if(identify_date(title)){
      comp.table$Date.Code[i] <- 1
      comp.table$TitleTxt2[i] <- remove_date(title)
    }
    else{
      comp.table$TitleTxt2[i] <- title
    }
  }
  return(comp.table)
}

[lecy]

To be consistent with naming conventions in the efile data, we should use date.x or date.d instead of Date.Code.

[lecy]

Also note that clean_dates() is in "new-title-classifier-functions.R" instead of where you might expect it, in "clean-dates.R".

[lecy]

A good lesson on the gains from vectorization - total runtime is ~47 minutes with 42 minutes being spent on the last step because of looping over EINs.

> start_time <- Sys.time()  # benchmark runtime
> 
> tinypartvii %>% 
+   standardize_df() %>% 
+   remove_dates() %>% 
+   standardize_conj() %>% 
+   split_titles() %>% 
+   standardize_spelling() %>% 
+   gen_status_codes() -> df 
[1] "standardize df step complete"
[1] "remove dates step complete"
[1] "standardize conjunctions step complete"
[1] "split titles step completed"
[1] "standardize spelling step complete"
[1] "generate status codes step complete"
> 
> end_time1 <- Sys.time()
> 
> df %>% 
+   standardize_titles() -> df
v Reading from "title-taxonomy-map".
v Range ''title-standardization'!A:B'.
[1] "standardize titles step complete"
> 
> end_time2 <- Sys.time()
> 
> df %>%
+   categorize_titles() ->  df
v Reading from "title-taxonomy-map".
v Range ''title-taxonomy'!A:T'.
[1] "89.8% of total organizations classified with a CEO"
[1] "categorize titles step complete"
>   
> end_time3 <- Sys.time()    # runtime
> end_time3 - start_time
Time difference of 46.92949 mins
> 
> end_time1 - start_time
Time difference of 4.564219 mins
> end_time2 - end_time1  # standardize titles
Time difference of 2.371294 secs
> end_time3 - end_time2  # categorize titles 
Time difference of 42.32575 mins