#==================================================================================================================================================== 

# AULA 04
# MATERIA: ECONOMETRIA II
# PROFESSOR: DANIEL DOMINGUES DOS SANTOS
# MONITOR: DIEGO MENEZES
# R - VERSAO UTILIZADA: 3.4.0 (2017-04-21)

# SCRIPT: repositorio de funcoes

#====================================================================================================================================================


# LATIN CHARACTER CONVERSION ------------------------------------------------------------------------------------------------------------------------

LatinCharacterConversion <- function(x, FROM_enc = "UTF-8", TO_enc = "ASCII//TRANSLIT") {
  
  # CONVERTS LATIN CHARACTERS IN NON-SPATIAL OBJECTS
  #
  # ARGS
  #   x:        non-spatial object containing string characters
  #   FROM_enc: object's current encoding
  #   TO_enc:   object's target encoding
  #
  # RETURNS
  #   object in which strings with special characters have been replaced by strings with non-special characters
  #
  # OBS
  #   use (utils::head(iconvlist(), n = 500)) for list of available encodings
  
  for (i in 1:ncol(x)) {
    if (is.factor(x[, i])) {
      if (is.character(levels(x[, i]))) {  # if string is factor, recovers special characters from character levels
        x[, i] <- iconv(x[, i], from = FROM_enc, to = TO_enc)
      }
      x[, i] <- as.factor(x[, i])  # restores factor class
    }
    else if (is.character(x[, i])) {
      x[, i] <- iconv(x[, i], from = FROM_enc, to = TO_enc)
    }
  }
  return(x)
}


# BLANK SPACES --------------------------------------------------------------------------------------------------------------------------------------

StringTrim <- function(string) {
  # REMOVES LEADING/TRAILING AND DUPLICATE BLANK SPACES IN CHARACTER STRING
  #
  # ARGS
  #   string: character string
  #
  # RETURNS
  #   edited character string
  
  output <- gsub(pattern = "^\\s+|\\s+$", replacement = "",  x = string)  # removes leading/trailing blank spaces
  output <- gsub(pattern = "\\s+",        replacement = " ", x = output)  # removes duplicate blank spaces
  
  return(output)
}


# CAPITALIZATION ------------------------------------------------------------------------------------------------------------------------------------

SimpleCap <- function(string) {
  # CAPITALIZES ANY STRING, REGARDLESS OF WORD COUNT
  #
  # ARGS
  #   string: character string
  #
  # RETURNS
  #   capitalized character string
  
  s <- strsplit(string, " ")[[1]]
  paste(toupper(substring(s, 1,1)), substring(s, 2), sep="", collapse=" ")
}


# DESTRING FUNCTION ---------------------------------------------------------------------------------------------------------------------------------

Destring <- function(dataframe) {
  
  # DESTRING FUNCTION (AS IN STATA) - returns numeric variable when possible, and character when as.numeric function output is all NA
  #
  # ARGS
  #   DATA FRAME (usually factor variables)
  #
  # RETURNS
  #   DATA FRAME - ONLY CHARACTER OR NUMERIC VARIABLES
  
  df.1    <- data.frame(lapply(dataframe, as.character), stringsAsFactors=FALSE)
  df.2    <- data.frame(lapply(df.1, as.numeric))
  
  names   <- names(dataframe)
  
  for (i in seq_along(names)) {
    if (sum(is.na(df.2[,i]))==length(df.2[,1])) {
      df.2[,i] <- df.1[,i]
    }
  }
  return(df.2)
}


# PACKAGES -------------------------------------------------------------------------------------------------------------------------------------------

CallLibraries <- function(packages) {
  
  # INSTALLS AND LOADS MULTIPLE PACKAGES
  #
  # ARGS
  #   packages: character vector containg names of libraries to be called
  #
  # RETURNS
  #   installed and loaded library packages
  
  mapply(x = packages, MoreArgs = list(y = row.names(installed.packages())), function(x,y) {
    if (any(x %in% y)) {
      library(x, character.only = T)
    } else {
      install.packages(x)
      library(x, character.only = T)
      paste("installed:", x)
    }
    paste("called:", x)
  })
}


# DATA FRAMES ---------------------------------------------------------------------------------------------------------------------------------------

MissingIdColumns <- function(dataframe) {
  
  # IDENTIFIES COLUMNS CONTAINING MISSING DATA IN DATA FRAME
  #
  # ARGS
  #   dataframe: non-spatial DataFrame object
  # 
  # RETURNS
  #   column name for columns with at least one NA
  
  colnames(dataframe)[unlist(lapply(dataframe, function(x) any(is.na(x))))]
}


# END OF SCRIPT -------------------------------------------------------------------------------------------------------------------------------------