inst/ps/Lawyers/functions.R

##########################################################################################
################################### Functions used in replic #############################
##########################################################################################

# split.and.paste combines the both commands paste() and strsplit() from R base package, by first applying 
# strsplit() and than paste(). The function takes in as arguments a single character String, aswell as
# a splitting and a concatenating argument, all of type character. 
# The function also can handle string adjustments to the splitted string, before applying the concatenate argument.

split.and.paste <- function(string, splitby = " ", concatenate = " + ", front=NULL, back=NULL) {
  
  splitting <- strsplit(string, split = splitby, fixed = T)[[1]]
  # Before collapsing delete empty strings, which are presumably generated by accident.
  splitting <- splitting[which((nchar(splitting) != 0))]
  
  # Case determination, if something should be added in front of or at the back of each string, before strings get collapsed
  
  if(is.null(front) & is.null(back)) {
    
    string.out <- paste(splitting, collapse = concatenate)
    return(string.out)
    
  } else if(!is.null(front) & is.null(back)) {
    
    string.out <- paste(paste(front, splitting, sep=""), collapse = concatenate)
    return(string.out)
    
  } else if(is.null(front) & !is.null(back)) {
    
    string.out <- paste(paste(splitting, back, sep=""), collapse = concatenate)
    return(string.out)
    
  } else {
    
    string.out <- paste(paste(front, splitting, back, sep=""), collapse = concatenate)
    return(string.out)
    
  }
  
}

# Example for split.and.paste
split.and.paste(c("a.b.c.d"), ".", " comes ", front=c("first ", " second ", " third ", " fourth "), back=" now ")

# How to count words in a single character String
str1 <- "How many words are in this sentence"
sapply(strsplit(str1, " "), length)
### This function builds the formula argument for the felm function. 
# The scheme for the felm function is: dv ~ iv | fe | iv | cl.
# It takes single character Vectors with the respective variables as Input.
# The Output is an object of class "formula" which can be consigned to the felm (or lm) model.
# If no fe are specified, the function returns the ordinary lm formula.

felm.form <- function(dep.var, ind.vars, feffects=NULL, iv=F, endogen=NULL, instruments=NULL, cluster=NULL) {
  
  # String manipulation for independent variables
  ind.vars.out <- split.and.paste(ind.vars)
  
  # Case Determination: Fixed Effects
  if(!is.null(feffects)) {
    
    fe.out <- split.and.paste(feffects)
    fe   <- paste(paste(dep.var, ind.vars.out, sep="~"), fe.out, sep = " | ")
    
    # Case Determination: IV and Cluster  
    if(iv==T & !is.null(cluster)) {
      
      endogen.out <- split.and.paste(endogen, concatenate =  " | ")
      instruments.out <- split.and.paste(instruments)
      iv.out <- paste("(", paste(endogen.out, instruments.out, sep = " ~ "),")")
      cluster.out <- split.and.paste(cluster)
      fe.iv <- paste(fe, iv.out, sep= " | ")
      fe.iv.cluster <- paste(fe.iv, cluster.out, sep = " | ")
      fe.iv.cluster.formula <- as.formula(fe.iv.cluster)
      return(fe.iv.cluster.formula)
      
      # Case Determination: IV but no Cluster  
    } else if(iv==T & is.null(cluster)) {
      
      endogen.out <- split.and.paste(endogen, concatenate = " | ")
      instruments.out <- split.and.paste(instruments)
      iv.out <- paste("(", paste(endogen.out, instruments.out, sep = " ~ "),")")
      fe.iv <- paste(fe, iv.out, sep= " | ")
      fe.iv.formula <- as.formula(fe.iv)
      return(fe.iv.formula)
      
      # Case Determination: No IV but Cluster  
    } else if(iv==F & !is.null(cluster)) {
      
      cluster.out <- split.and.paste(cluster)
      fe.cluster <- paste(paste(fe, 0, sep = " | "), cluster.out, sep = " | ")
      fe.cluster.formula <- as.formula(fe.cluster)
      return(fe.cluster.formula)
      
      # Case Determination: No IV and No Cluster  
    } else {
      fe.formula <- as.formula(fe)
      return(fe.formula)
    }
    
    # Case Determination: Ordinary lm  
  } else {
    lm.formula    <-  as.formula(paste(dep.var, ind.vars.out, sep="~"))
    return(lm.formula)
  }
  
}

### Example from felm.form
felm.form(dep.var = "a", ind.vars= "b c d", feffects = "e f", iv = T, endogen= " g h", instruments= "i j", cluster = "k l")



# This function helps to get the desired Estimates after a verbose Regression Analysis with many Regression Runs,
# that are safed in a multiple List-structure.
# The functions uses the following arguments:
# - models: A list of list structure, with structure - models$modelx$coefficients - where each model run is stored as a list object of
# models, and is a list itself, where for example the coefficients or standard errors can be accessed through further subsetting
# - select.models: If not all all models stored in "models" should be used (default), a subsample can be specified via "select.models"
# - searching: Specifies which model output should be gleaned from the models, default is coefficients and clustered standard errors.
# "Searching" is eligible for regular expressions.
# - position: Specifies which Element should be extracted after reaching the end-of-lists object (which is mostly of class numeric).
# Nevertheless the user should pay attention to the class of the object he desires to get, since an unthoughtful use could lead to 
# inadvertent results. 
# - withSe: Is an option to output a single vector, with the second element of "searching" being displayed in paranthesis, which might be
# a desired output for coefficients along with standard errors.

getEstimates <- function(models, select.models=T, searching=c("^coef", "cse"),  position=1, withSE=T) {
  
  # Check if models countains a list
  if(!is.list(models)) stop("Error: Is Your models argument really a list (of regressions)?")
  
  # Automatically adjust position argument to the length of searching
  if(length(position) != length(searching)) {
    position <- rep(position, length(searching))
  }
  
  # Selecting the relevant list elements
  selecting <- models[select.models]
  
  # Get an ancillary model.name (we need it later)
  model.name <- names(selecting)[1]
  
  # Determine how many items to extract
  number <- length(searching)
  
  # Extract Estimates
  df <- NULL
  
  for(n in 1:number) {
    
   # print(n)
    out <- paste0("estimate",n)  
    match <- grep(searching[n], names(selecting[[model.name]]), value = T)
    firstapply <- lapply(selecting, `[[`,  match)
    secondapply <- lapply(firstapply, `[`, position[n])
    
   # print(secondapply)
    
    assign(out, round(unlist(secondapply), 5))
    df <- rbind(df, eval(parse(text=out)))
    #print(df)
  }
  
  if(withSE) {
    back <- paste0(estimate1, " (", estimate2, ")")
  } else {
    back <- df
  }
  return(back)
  
}
KendamaQQ/LawyersLemon documentation built on July 20, 2020, 9 p.m.