R/package.r

In MichelMeyer/package: Download security price data and financial statements from firms negotiated on BVMF&Bovespa

# Internal functions:
get.files <- function(link) {
  
  if( ! dir.exists(tempdir())) # Yes, some times occurs erros because of the inexistence of this directory
    dir.create(tempdir(), showWarnings = F)
  if( ! dir.exists(paste0(tempdir(),"\\omni")))
    dir.create(paste0(tempdir(),"\\omni"))
  
  if(file.exists(paste0(tempdir(), "\\omni\\", link))) {
    file <- readRDS(file = paste0(tempdir(), "\\omni\\", link))
    
  } else {
    links <- data.frame(
      dicionariocompleto = "https://dl.dropboxusercontent.com/s/8gsf6ja9t62kk0l/dicionariocompleto?dl=0",
      dicionariobruto = "https://dl.dropboxusercontent.com/s/i54k1uitkc1y142/dicionariobruto?dl=0",
      linkseventos = "https://dl.dropboxusercontent.com/s/a6kwhqdydqwsz5w/linkseventos?dl=0",
      linkscotacoes = "https://dl.dropboxusercontent.com/s/ru0zwcygx75ou01/linkscotacoes?dl=0",
      linksbalancos = "https://dl.dropboxusercontent.com/s/fvmsv492b83kcdz/linksbalancos?dl=0",
      codbdi = "https://dl.dropboxusercontent.com/s/4ifs6ywn5spvd7y/codbdit?dl=0",
      stringsAsFactors = F
    )
    
    download.file(links[link][[1]], destfile = paste0(tempdir(), "\\omni\\", link), quiet = T, mode = "wb")
    file <- readRDS(file = paste0(tempdir(), "\\omni\\", link))
  }
  
  return(file)
}
get.shares <- function(Shares, envir = NULL) {
  
  if( ! is.null(envir)) {
    prog.bar <- get("prog.bar", envir = envir)
    progresso <- get("progresso", envir = envir)
    shares <- get("shares", envir = envir)
  }
  if( ! exists("sharelinks"))
    sharelinks <- get.files("linkscotacoes")
  teste <- lapply(Shares, function(share) {
    if(exists("prog.bar")) {
      if(share == shares[[1]]) cat("Progress of download: \n")
      x <- c(which(shares == share) - (1 : 0)) / length(shares)
      cat(paste(progresso[prog.bar >= x[1] & prog.bar < x[2]], collapse = ""))
      if(share == tail(shares, 1)) cat("100%\n")
    }
    x <- sharelinks[sharelinks$PAPEL == share, "LINK"]
    if(length(x) == 0) {
      return("This share is misspecified or does not exist.")
    } else {
      
      t <- NULL
      while( ! is.data.frame(t)) {
        dest <- paste0(tempdir(), "\\omni\\", share)
        if(file.exists(dest)) {
          tfile <- file.info(dest)$mtime
          tupdate <- strsplit(as.character(Sys.time()), " ")[[1]][1]
          tupdate <- as.POSIXct(paste(tupdate, "22:00:00"))
          if(tfile <= tupdate & Sys.time() >= tupdate) {
            x <- paste0("https://dl.dropboxusercontent.com/s/",
                        x, "/", share, "?dl=0")
            download.file(x, destfile = dest, mode = "wb", quiet = T) 
          }
          rm(tfile, tupdate)
        } else {  
          x <- paste0("https://dl.dropboxusercontent.com/s/", x, "/", share, "?dl=0")
          download.file(x, destfile = dest, mode = "wb", quiet = T)
        }
        t <- try(x <- readRDS(dest), silent = T)
        if(class(t) == "try-error") unlink(dest)
      }
      rm(t)
      
      names(x)[8 : 17] <- c("Open", "High", "Low", "Mean", "Close",
                            "Bid", "Ask", "TotNeg", "QuaTot", "Volume")
      
      x$DATAPREG <- as.Date(as.character(x$DATAPREG), "%Y%m%d")
      x$DATVEN <- as.Date(as.character(x$DATVEN), "%Y%m%d")
      x$QuaTot <- as.numeric(x$QuaTot)
      
      if(length(unique(x[, "CODBDI"])) > 1 & any(duplicated(x[, "DATAPREG"])))
        x <- x[x[, "CODBDI"] %in%
                 names(sort(table(x[, "CODBDI"]), decreasing = T))[[1]], ]
      
      return(x)
    }
  })
  
  return(teste)
}
get.fin.stat <- function(firms, quarter = NULL) {
  
  if( ifelse(is.null(quarter), F, quarter != "all") & length(firms) > 1) {
    quarter <<- quarter <- NULL
    warning("Argument quarter is not applied when there is more than one code.")
  }
  
  dicionario <- get.files("dicionariobruto")
  sharelinks <- get.files("linkscotacoes")
  dic2 <- get.files("linkseventos")
  balancos <- get.files("linksbalancos")
  
  if("all" %in% firms) {
    firms <- c(firms[firms != "all"], unique(dicionario[, 1]))
    firms <- firms[order(as.numeric(firms))]
  }
  
  if(all(firms %in% 3)) {
    warning("The CVM code 3 is a example, This firm actually does not exists.")
    return(NULL)
  } else {
    firms <- firms[firms != 3]
  }
  
  envir <- NULL
  if(length(firms) > 20) {
    
    cat("It can take a while.\n")
    
    progresso <- 0 : 10
    div <- 6
    envir <- environment()
    
    progresso <- paste(paste0("", progresso * (100 / max(progresso)), "% "),
                       collapse = paste0(rep("| ", div), collapse = ""))
    progresso <- strsplit(progresso, " ")[[1]]
    prog.bar <- (1 : length(progresso)) / length(progresso)
    prog.bar <- prog.bar - min(prog.bar)
    prog.bar <- prog.bar / max(prog.bar)
  }
  
  fin.stat <- lapply(firms, function(firm) {
    if( ! is.null(envir)) {
      prog.bar <- get("prog.bar", envir = envir)
      progresso <- get("progresso", envir = envir)
    }
    if(exists("prog.bar")) {
      x <- c(which(firms == firm) - (1 : 0)) / length(firms)
      cat(paste(progresso[prog.bar >= x[1] & prog.bar < x[2]], collapse = ""))
      if(firm == tail(firms, 1)) cat("100%\n")
    }
    if ( ! exists("especificacao")) {
      if (nchar(firm) <= 6) {
        if ( ! any ( ! (strsplit(as.character(firm), "")[[1]] %in% 0:9))) {
          especificacao <- "CodigoCvm"
        }
      }
    }
    if ( ! exists("especificacao")) {
      x <- which(strsplit(firm, "")[[1]] %in% c(".", "/", "-"))
      if (length(x) > 0){
        if ( ! any ( ! diff(x)  == c(4, 4, 5))) {
          if(any( ! strsplit(firm, "")[[1]][setdiff(1 : nchar(firm), x)] %in% c(0:9))) {
            stop("There are some invalid characters in the input.")
          } else {
            especificacao <- "NumeroCnpjCompanhiaAberta"
          }
        }
      }
      rm(x)
    }
    if ( ! exists("especificacao")) {
      if (firm %in% dicionario[,"NomeRazaoSocial"])
        especificacao <- "NomeRazaoSocial"
    }
    if ( ! exists("especificacao")) {
      if(all(strsplit(substr(firm, 1, 4), "")[[1]] %in% LETTERS))
        if (substr(firm, 1, 4) %in% dicionario[, "codNeg"]){
          firm <- substr(firm, 1, 4)
          especificacao <- "codNeg"
        }
    }
    if ( ! exists("especificacao")) {
      return("We do not found the balance sheets of the selected firm.")
    } else {
      if (especificacao == "CodigoCvm") {
        x <- which(dicionario[, especificacao] == as.numeric(firm))
        x <- max(x)
      } else {
        x <- which(dicionario[, especificacao] == firm)
        x <- max(x)
        firm <- dicionario[x, "CodigoCvm"]  
      }
      nome <- paste(dicionario[x, "codNeg"], sep=".")
      if (nome == "NA" | is.na(nome))
        nome <- paste("CVM", dicionario[x, "CodigoCvm"], sep=".")
      dest <- paste0(tempdir(), "\\omni\\", firm)
      x <- NULL
      if(file.exists(dest)) {
        tfile <- file.info(dest)$mtime
        tupdate <- strsplit(as.character(Sys.time()), " ")[[1]][1]
        tupdate <- as.POSIXct(paste(tupdate, "22:00:00"))
        if(tfile <= tupdate & Sys.time() >= tupdate) {
          link <- paste0("https://dl.dropboxusercontent.com/s/",
                         balancos[balancos$EMPRESA == firm, ]$LINK, "/", firm, "?dl=0")
          download.file(link, destfile = dest, mode = "wb", quiet = T)
        }
        rm(tfile, tupdate)
      } else {  
        link <- paste0("https://dl.dropboxusercontent.com/s/",
                       balancos[balancos$EMPRESA == firm, ]$LINK, "/", firm, "?dl=0")
        download.file(link, destfile = dest, mode = "wb", quiet = T)
      }
      try(x <- readRDS(dest), silent = T)
      if(is.null(x))
        if( ! system(paste("ping", "www.dropbox.com"), show.output.on.console = F)) {  
          link <- paste0("https://dl.dropboxusercontent.com/s/",
                         balancos[balancos$EMPRESA == firm, ]$LINK, "/", firm, "?dl=0")
          download.file(link, destfile = dest, mode = "wb", quiet = T)
          try(x <- readRDS(dest), silent = T)
        } else {
          warning("Problems in the connection!")
          return(NULL)
        }
      
      if( ! is.null(quarter)) {
        
        x <- x[, which(colnames(x) == "V1") : ncol(x)]
        
        unico <- ifelse(length(quarter) == 1 & quarter != "all", T, F)
        
        if(any(quarter %in% "all"))
          quarter <- substr(x[, "V6"], 1, 7) [-(1:3)]
        quarter <- quarter[quarter %in% substr(x[, "V6"], 1, 7)]
        
        if(any(substr(x[, "V6"], 1, 7) %in% quarter)) {       
          
          x <- lapply(quarter, function(quarter.t) {
            x <- x[c(1 : 3, which(substr(x[, "V6"], 1, 7) == quarter.t)), ]
            pos <- unique(which(x[4 : nrow(x), ] != "", arr.ind = T)[, 2])
            x <- x[, as.numeric(pos)]
            x <- t(x)
            
            rownames(x) <- NULL
            colnames(x) <- c("kind of information", "id of account", "name of account", rep("Value", ncol(x) - 3))
            x[x[, 1] == "-", 1] <- "firm's basic information"
            x[x[, 1] == "1", 1] <- "Individual Result"
            x[x[, 1] == "2", 1] <- "Consolidated Result"
            return(x)
          })
          
          names(x) <- quarter
          
          if(unico)
            x <- x[[1]]
          
        } else {
          
          x <- substr(x[ - c(1 : 3), "V6"], 1, 7)
          print("This specified quarter isn't in our data")
          print("Currently the quarters available are the periods below:")
          print(paste(paste(head(x, 4), collapse = ", "), "...",
                      paste(tail(x, 4), collapse = ", "), sep = ", "))
          
          rm(x)
          return(invisible(NULL))
          break
        }
        
      } else {
        x <- x[, 1 : (which(colnames(x) == "V1") - 1)]
        x <- x[1 : (nrow(x) - 3), ]
      }
      
      return(x)
    }
  })
  names(fin.stat) <- firms
  return(fin.stat)
}

# Package principal functions:

getPrices <- function(shares,
                      info = "simplified", value = "Close", fill = NA) {
  if (missingArg(shares)) {
    warning ("You have to specify at list a share.")
  } else {
    
    if( ! info %in% c("full", "simplified", "single")) {
      print("verify if you wrote correctly the paramenter 'info'")
      return(NULL)
    }
    
    sharelinks <- get.files("linkscotacoes")
    quiet = F
    if("all" %in% shares)
      shares <- c(shares[shares != "all"], sharelinks[, 1])
    if(any( ! shares %in% sharelinks[, 1]))
      codbdi = get.files("codbdi")
    if(any(shares %in% "shares"))
      shares <- c(shares[ ! shares %in% "shares"],
                  strsplit(codbdi[codbdi[, 1] ==  2, 3], " ")[[1]])
    if(any(shares %in% "insolvency"))
      shares <- c(shares[ ! shares %in% "insolvency"],
                  strsplit(codbdi[codbdi[, 1] ==  6, 3], " ")[[1]])
    if(any(shares %in% "rights and receipts"))
      shares <- c(shares[ ! shares %in% "rights and receipts"],
                  strsplit(codbdi[codbdi[, 1] == 10, 3], " ")[[1]])
    if(any(shares %in% "real estate funds"))
      shares <- c(shares[ ! shares %in% "real estate funds"],
                  strsplit(codbdi[codbdi[, 1] == 12, 3], " ")[[1]])
    if(any(shares %in% "debentures"))
      shares <- c(shares[ ! shares %in% "debentures"],
                  strsplit(codbdi[codbdi[, 1] %in% c(14, 66, 68, 83), 3], " ")[[1]])
    if(any(shares %in% "private bonus"))
      shares <- c(shares[ ! shares %in% "private bonus"],
                  strsplit(codbdi[codbdi[, 1] == 22, 3], " ")[[1]])
    if(any(shares %in% "options"))
      shares <- c(shares[ ! shares %in% "options"],
                  strsplit(codbdi[codbdi[, 1] %in% c(32, 33, 38, 42, 74, 75, 78,
                                                     82), 3], " ")[[1]])
    if(any(shares %in% "auctions"))
      shares <- c(shares[ ! shares %in% "auctions"],
                  strsplit(codbdi[codbdi[, 1] %in% c(46, 48, 50, 51, 52, 53, 54,
                                                     56), 3], " ")[[1]])
    if(any(shares %in% "forward market"))
      shares <- c(shares[ ! shares %in% "forward market"],
                  strsplit(codbdi[codbdi[, 1] == 62, 3], " ")[[1]])
    if(any(shares %in% "futures"))
      shares <- c(shares[ ! shares %in% "futures"],
                  strsplit(codbdi[codbdi[, 1] %in% c(70, 71), 3], " ")[[1]])
    if(any(shares %in% "fractionary"))
      shares <- c(shares[ ! shares %in% "fractionary"],
                  strsplit(codbdi[codbdi[, 1] == 96, 3], " ")[[1]])
    shares <- sort(unique(shares))
    envir <- NULL
    if(quiet == F & length(shares) > 20) {
      cat("It can take a while.\n")
      envir <- environment()
      progresso <- 0 : 10
      div <- 6
      progresso <- paste(paste0("", progresso * (100 / max(progresso)), "% "),
                         collapse = paste0(rep("| ", div), collapse = ""))
      progresso <- strsplit(progresso, " ")[[1]]
      prog.bar <- (1 : length(progresso)) / length(progresso)
      prog.bar <- prog.bar - min(prog.bar)
      prog.bar <- prog.bar / max(prog.bar)
    }
    teste <- get.shares(shares, envir)
    if(info == "single")
      for(i in seq_along(teste))
        if(is.data.frame(teste[[i]]))
          if(any(duplicated(teste[[i]][, "DATAPREG"]))) {
            warning("Some of the assets belongs to the forward market or they have a duplicated date.
                    Due this the output is goind to be a data.frame.")
            info <- "simplified"
            break
          }
    names(teste) <- shares
    x = misspecified = NULL
    if(info == "single") {
      for(i in seq_along(teste)) {    
        if(exists("prog.bar")) {
          if(names(teste)[1] == shares[[1]]) cat("Progress of aggregation: \n")
          P <- c(which(shares == names(teste)[1]) - (1 : 0)) / length(shares)
          cat(paste(progresso[prog.bar >= P[1] & prog.bar < P[2]], collapse = ""))
          if(names(teste)[1] == tail(shares, 1)) cat("100%\n")
        }
        if(is.null(dim(teste[[1]]))) {
          misspecified <- c(misspecified, names(teste)[1])
        } else {
          share <- teste[[1]]
          if(value %in% colnames(share)) {
            share <- xts::xts(share[, value], order.by = as.Date(share$DATAPREG))
          } else {
            warning(paste("The parameter value was misspecified. One of these must be selected:",
                          paste(colnames(share)[ - 2], collapse = ", ") ))
            return()
          }
          if(is.na(fill) | fill == "last") {
            x <- cbind(x, share)
          } else {
            if(is.null(x)) {
              x <- share
            } else {
              t <- as.Date(intersect(zoo::index(x), zoo::index(share)))
              x <- cbind(x[t, ], share[t, ])
              rm(t)
            }
          }
          colnames(x)[ncol(x)] <- shares[[i]]
          rm(share)
        }
        teste <- teste[ - 1]
      }
      if( ! is.na(fill))
        if(fill == "last") {
          for(i in colnames(x)) {
            t <- which(is.na(x[, i]))
            t.1 <- c(which((t[-1] - t[ - length(t)] > 1)), length(t)) + 1     
            for(j in seq_along(t.1))
              if(t[max(t.1[j - 1], 1)] - 1 != 0)
                if(value %in% c("TotNeg", "QuaTot", "Volume")) {
                  x[t[max(t.1[j - 1], 1)] : t[t.1[j] - 1], i] <- 0
                } else {
                  x[t[max(t.1[j - 1], 1)] : t[t.1[j] - 1], i] <- x[t[max(t.1[j - 1], 1)] - 1, i]
                }
          }
        }
      
      
    }
    if(info %in% c("full", "simplified")) {
      for(i in seq_along(teste)) {
        if(exists("prog.bar")) {
          if(names(teste)[1] == shares[[1]]) cat("Progress of aggregation: \n")
          P <- c(which(shares == names(teste)[1]) - (1 : 0)) / length(shares)
          cat(paste(progresso[prog.bar >= P[1] & prog.bar < P[2]], collapse = ""))
          if(names(teste)[1] == tail(shares, 1)) cat("100%\n")
        }
        if(is.null(dim(teste[[1]]))) { 
          misspecified <- c(misspecified, shares[[i]])
        } else {
          share <- teste[[1]]
          share <- cbind(NegCode = share[, "CODNEG"], Date = share[, "DATAPREG"],
                         DeadLine = share[, "PRAZOT"], ExpirDate = share[, "DATVEN"],
                         share[, - which(colnames(share) %in%
                                           c("CODNEG", "DATAPREG", "PRAZOT", "DATVEN"))])
          rownames(share) <- NULL
          x <- rbind(x, share)
          rm(share)
        }
        teste <- teste[ - 1]
      }  
      if(info == "simplified") {
        complete <- 
          which(colnames(x) %in% c("NegCode", "Date", "NOMRES", "ESPECI",
                                   "Open", "Close", "High", "Low", "Mean", "Bid", "Ask",
                                   "Return", "QuaTot"))
        
        complete <- sort(unique(c(complete, which(unlist(lapply(names(x), function(i)
          length(unique(x[, i])) != 1))))))
        
        x <- x[, complete]
      }
    }
    
    rm(teste)
    
    if( ! quiet) {
      misspecified <- unique(misspecified)
      
      if( ! is.null(misspecified)) {
        if(length(misspecified) > 1) {
          miss <- paste(misspecified[ - length(misspecified)], collapse = ", ")
          miss <- paste(miss, misspecified[length(misspecified)], sep = " and ")
        } else {
          miss <- misspecified
        }
        
        
        i = sum(1, length(misspecified) > 1)
        miss <- paste(miss, c("is", "are")[i], "misspecified or",
                      c("this share does", "these shares do")[i], "not exist.")
        warning(miss)
        rm(i, miss)
      }
    }
    rm(misspecified)
    
    return(x)
  }
  
}

getAdjPrices <- function(shares,
                         by = "all", subscription = "rational",
                         info = "simplified", value = "Return", fill = NA) {
  dicionario <- get.files("dicionariobruto")
  sharelinks <- get.files("linkscotacoes")
  dic2 <- get.files("linkseventos")
  
  if( ! info %in% c("full", "simplified", "single")) {
    print("verify if you wrote correctly the paramenter 'info'")
    return(NULL)
  }
  
  if("all" %in% shares) {
    shares <- c(shares[shares != "all"], sharelinks[, 1])
    shares <- shares[substr(shares, 5, 999) %in% 3 : 8]
    shares <- 
      shares[substr(shares, 1, 4) %in%
               unique(unlist(apply(as.matrix(dicionario[dicionario[, 1] %in%
                                                 dic2[, 1], 5 : 8]), 2, unique)))]
    shares <- sort(unique(shares))
  }
  
  quiet <- F
  
  if( ! value %in%
      c("Date", "NegCode", "CODBDI", "NegCode",
        "TPMERC", "NOMRES", "ESPECI", "PRAZOT", 
        "Open", "High", "Low", "Mean", "Close",
        "Bid", "Ask", "Return", "TotNeg", "QuaTot", "Volume",
        "PREEXE", "INDOPC", "DATVEN", "PTOEXE", "CODISI")) {
    warning(paste("The parameter value was misspecified. One of these must be selected:",
                  paste(colnames(share)[ - 2], collapse = ", ") ))
    return(NULL)
  }
  
  envir <- NULL
  if(quiet == F & length(shares) > 10) {
    
    cat("It can take a while.\n")
    envir <- environment()
    progresso <- 0 : 10
    div <- 6
    
    progresso <- paste(paste0("", progresso * (100 / max(progresso)), "% "),
                       collapse = paste0(rep("| ", div), collapse = ""))
    progresso <- strsplit(progresso, " ")[[1]]
    prog.bar <- (1 : length(progresso)) / length(progresso)
    prog.bar <- prog.bar - min(prog.bar)
    prog.bar <- prog.bar / max(prog.bar)
  }
  
  teste <- lapply(shares, function(share) {
    
    matriz.ajuste <- which(dicionario[, c("codNeg", "LIVRE", "LIVRE.1", "LIVRE.2")] ==
                             substr(share, 1, 4), arr.ind = T)[, 1]
    matriz.ajuste <- unique(dicionario[matriz.ajuste, "CodigoCvm"])
    
    if(length(matriz.ajuste) == 0) {
      return(NULL)
      break
    }
    if( ! as.numeric(substr(share, 5, 5)) %in% 3 : 8) {
      return(NULL)
      break
    }
    
    if(length(matriz.ajuste) > 1)
      stop("VERIFICAR FUNCAO DE CORRECAO DOS RETORNOS")
    
    if(length(dic2[dic2$EMPRESA == matriz.ajuste, "LINK"]) == 0) {
      return(NULL)
      break
    }
    
    dist <- paste0(tempdir(), "\\omni\\m", matriz.ajuste)
    if( ! file.exists(dist)) {
      link <- paste0("https://dl.dropboxusercontent.com/s/", 
                     dic2[dic2$EMPRESA == matriz.ajuste, "LINK"], "/",
                     matriz.ajuste, "?dl=0")
      download.file(link, dist,
                    mode = "wb", quiet = T)
      rm(link)
    }
    matriz.ajuste <- readRDS(dist)
    rm(dist)
    tipo <- c("fator.ON",  "fator.PN",  "fator.PNA",
              "fator.PNB", "fator.PNC", "fator.PND")
    if( length(intersect(tipo[as.numeric(substr(share, 5, 5)) - 2], colnames(matriz.ajuste))) == 0 ) {
      return("We don't have the adjusted values for the chosen share or the chosen share does not exist")
      break
    }
    
    matriz.ajuste <- matriz.ajuste[, c("data", "evento",
                                       tipo[as.numeric(substr(share, 5, 5)) - 2])]
    
    matriz.ajuste[, "data"] <- as.Date(matriz.ajuste[, "data"])
    colnames(matriz.ajuste)[3] <- "fator"
    
    if(any(by %in% "all")) {
      by <- c("Dividend", "Interest", "Bonus shares", "Subscription Right",
               "Spinoff", "Return of Capital")
    }
    if(any(by %in% "Dividend")) {
      by <- c(by, "Dividendo", "Dividendo mensal", "DIVIDENDO")
    }
    if(any(by %in% "Interest")) {
      by <- c(by, "Juros", "Juros mensal", "JRS CAP PROPRIO")
    }
    if(any(by %in% "Bonus shares")) {
      by <- c(by, "Bonificacao")
    }
    if(any(by %in% "Subscription Right")) {
      by <- c(by, "Subscricao")
    }
    if(any(by %in% "Spinoff")) {
      by <- c(by, "Cisao")
    }
    if(any(by %in% "Return of Capital")) {
      by <- c(by, "Restituicao de capital", "REST CAP DIN")
    }
    
    if("Subscription Right" %in% by) {
      x <- which(matriz.ajuste[, "evento"] == "Subscricao")
      if(subscription == "rational") {
        x <- x[matriz.ajuste[x, "fator"] < 1]
        if(length(x) > 0)
          matriz.ajuste <- matriz.ajuste[ - x, ]
      }
      if(subscription == "neverbuy") {
        if(length(x) > 0)
        matriz.ajuste <- matriz.ajuste[ - x, ]
      }
      rm(x)
    }
    
    share <- get.shares(share, envir = envir)[[1]]
    
    if( ! is.null(share) & ! is.character(share)) {
      colnames(share)[c(1, 3)] <- c("Date", "NegCode")
      base <- as.matrix(share[, c("Date", "NegCode")])
      share <- xts::as.xts(share[, - 1], order.by = as.Date(share[, "Date"]))
      
      if(nrow(matriz.ajuste) > 0)
        matriz.ajuste[which(regexec("Cisao", matriz.ajuste[, "evento"]) != "-1"), "evento"] <- "Cisao"
      x <- substr(matriz.ajuste[, "evento"], 1, 22) %in% by
      if(any(x)) {
        x <- matriz.ajuste[x, ]
        x <- t(data.frame(lapply(unique(x[, "data"]), function(z) {
          cisao <- ((1 / (1 - sum(1 - (1 / (x[x[, "data"] %in% z &
                                                x[, "evento"] == "Cisao", "fator"]))))) - 1)
          comum <- (as.numeric(x[x[, "data"] %in% z & x[, "evento"] != "Cisao", "fator"]) - 1)
          z <- t(data.frame(data = z, fator = sum(cisao, comum) + 1, stringsAsFactors = F))
          return(z)
        }), stringsAsFactors = F))
        rownames(x) <- NULL
        x <- as.data.frame(x, stringsAsFactors = F)
        x[, "data"] <- as.Date(x[, "data"])
        x[, "fator"] <- as.numeric(x[, "fator"])
      } else {
        x <- NULL
      }
      
      matriz.ajuste <- rbind(x, matriz.ajuste[matriz.ajuste[, "evento"] %in%
                                                c("alt.fator.cot", "Grupamento", "Desdobramento",
                                                  "bonificacao ou desdobramento"), c("data", "fator")])
      rm(x)
      
      matriz.ajuste <- 
        matriz.ajuste[matriz.ajuste[, "data"] <= max(zoo::index(share)) &
                        matriz.ajuste[, "data"] >= min(zoo::index(share)), ]
      
      x <- c("Open", "Close", "High", "Low", "Mean", "Bid", "Ask", "Volume")
      
      for(i in 1 : nrow(matriz.ajuste)) {
        p <- zoo::index(share) <= matriz.ajuste[i, "data"]    
        share[p, x] <- as.numeric(share[p, x]) / as.numeric(matriz.ajuste[i, "fator"])
      }
      share[, "Volume"] <- as.numeric(share[, "Volume"]) * as.numeric(share[, "FATCOT"])
      share <- share[, - which(colnames(share) == "FATCOT")]
      share <- cbind(data.frame(share[, 1 : 13], stringsAsFactors = F), 
                     Return = as.numeric(c(NA, as.numeric(share[ - 1, "Close"]) /
                                               as.numeric(share[ - nrow(share), "Close"]))),
                     data.frame(share[, 14 : ncol(share)], stringsAsFactors = F))
      share <- cbind(base, share)
      for(i in c(x, "CODBDI", "TPMERC", "Return", "TotNeg", "QuaTot", "PREEXE")) {
        share[, i] <- as.numeric(share[, i])
      }
      
      return(share)
      
    } else {
      
      return("We don't have the adjusted values for the chosen share or the chosen share does not exist")
      
    }
    
  })
  
  if(info == "single")
    for(i in seq_along(teste))
      if(is.data.frame(teste[[i]]))
        if(any(duplicated(teste[[i]][, "Date"]))) {
          warning("Some of the assets belongs to the forward market or they have a duplicated date.
                  Due this the output is goind to be a data.frame.")
          info <- "simplified"
          break
        }
  
  names(teste) <- shares
  if(length(teste) == 0)
    teste <- NULL
  x = misspecified = NULL
  
  if( ! (is.null(unlist(teste)))) {
    if(info == "single") {
      for(i in seq_along(teste)) {
        if(exists("prog.bar")) {
          if(names(teste)[1] == shares[[1]]) cat("Progress of aggregation: \n")
          P <- c(which(shares == names(teste)[1]) - (1 : 0)) / length(shares)
          cat(paste(progresso[prog.bar >= P[1] & prog.bar < P[2]], collapse = ""))
          if(names(teste)[1] == tail(shares, 1)) cat("100%\n")
        }
        if(is.null(dim(teste[[1]]))) {
          misspecified <- c(misspecified, names(teste)[1])
        } else {
          share <- teste[[1]]
          
          if(value %in% colnames(share)) {
            share <- xts::xts(share[, value], order.by = as.Date(share$Date))
          } else {
            warning(paste("The parameter value was misspecified. One of these must be selected:",
                          paste(colnames(share)[ - 2], collapse = ", ") ))
            return()
          }
          
          x <- cbind(x, share)
          colnames(x)[ncol(x)] <- shares[[i]]
          rm(share)
        }
        
        teste <- teste[ - 1]
      }
      
      if( ! is.na(fill)) {
        if(fill == "last") {
          for(i in colnames(x)) {
            if(value == "Return") {
              t <- is.na(x[, i])
              t.1 <- which( ! t)
              if(length(t.1) == 0) next
              t.1 <- c(head(t.1, 1), tail(t.1, 1))
              t <- which(t)
              t <- t[t > t.1[1] & t < t.1[2]]
              x[t, i] <- 1
            } else {
              t <- which(is.na(x[, i]))
              if(length(t) != 0) {
                t.1 <- c(which((t[-1] - t[ - length(t)] > 1)), length(t)) + 1
                
                for(j in seq_along(t.1))
                  if(t[max(t.1[j - 1], 1)] - 1 != 0)
                    if(value %in% c("TotNeg", "QuaTot", "Volume")) {
                      x[t[max(t.1[j - 1], 1)] : t[t.1[j] - 1], i] <- 0
                    } else {
                      x[t[max(t.1[j - 1], 1)] : t[t.1[j] - 1], i] <- x[t[max(t.1[j - 1], 1)] - 1, i]
                    }
              }
            }
          }
        }
        if(fill == "drop") {
          if(value == "Return") {
            na <- apply(x, 1, function(i) any(is.na(i)))
            if( ! all(na))
              x <- x[min(which( ! na)) : max(which( ! na)), ]
            na <- apply(x, 1, function(i) any(is.na(i)))
            if(nrow(x[ ! na, ]) > 0) {
              na <- sort(which(na), decreasing = T)
              for(i in na) {
                x[i + 1, ] <- apply(x[i : (i + 1)], 2, function(j) prod(as.numeric(j), na.rm = T))
                x <- x[ - i, ]
              }
              rm(i)
            } else {
              x <- x[ ! na, ]
            }
            
          } else {
            na <- apply(x, 1, function(i) any(is.na(i)))
            x <- x[ ! na, ]
          }
          rm(na)
        }
      }
    }
    if(info %in% c("full", "simplified")) {
      for(i in seq_along(teste)) {
        
        if(exists("prog.bar")) {
          if(names(teste)[1] == shares[[1]]) cat("Progress of aggregation: \n")
          P <- c(which(shares == names(teste)[1]) - (1 : 0)) / length(shares)
          cat(paste(progresso[prog.bar >= P[1] & prog.bar < P[2]], collapse = ""))
          if(names(teste)[1] == tail(shares, 1)) cat("100%\n")
        }
        if(is.null(dim(teste[[1]]))) { 
          misspecified <- c(misspecified, shares[[i]])
        } else {
          share <- teste[[1]]
          share <- cbind(NegCode = share[, "NegCode"], Date = share[, "Date"],
                         DeadLine = share[, "PRAZOT"], ExpirDate = share[, "DATVEN"],
                         share[, - which(colnames(share) %in%
                                           c("NegCode", "Date", "PRAZOT", "DATVEN"))])
          rownames(share) <- NULL
          x <- rbind(x, share)
          rm(share)
        }
        teste <- teste[ - 1]
      }  
      if(info == "simplified") {
        complete <- 
          which(colnames(x) %in% c("NegCode", "Date", "NOMRES", "ESPECI",
                                   "Open", "Close", "High", "Low", "Mean", "Bid", "Ask",
                                   "Return", "QuaTot"))
        
        complete <- sort(unique(c(complete, which(unlist(lapply(names(x), function(i)
          length(unique(x[, i])) != 1))))))
        
        x <- x[, complete]
      }
    }
  }
  
  rm(teste)
  misspecified <- unique(misspecified)
  
  if( ! quiet) {
    
    if( ! is.null(misspecified)) {
      if(length(misspecified) > 1) {
        miss <- paste(misspecified[ - length(misspecified)], collapse = ", ")
        miss <- paste(miss, misspecified[length(misspecified)], sep = " and ")
      } else {
        miss <- misspecified
      }
      
      i = sum(1, length(misspecified) > 1)
      miss <- paste(miss, c("is", "are")[i], "misspecified or we don't have the adjusted price or even",
                    c("this share does", "these shares do")[i], "not exist.")
      warning(miss)
      rm(i, miss)
    }
  }
  
  rm(misspecified)
  
  return(x)
}

getFinancialStatements <- function(firms, quarter = NULL) {
  if (missingArg(firms)) {
    warning ("You need to chose at list a firm.")
  } else {
    if( ! is.null(quarter))
      if(any(quarter %in% "all"))
      quarter <- NULL
    teste <- get.fin.stat(firms, quarter)
    x = misspecified = NULL
    for(i in seq_along(teste)) {
      if(is.null(dim(teste[[i]]))){
        misspecified <- c(misspecified, firms[[i]])
      } else {
        x <- rbind(x, teste[[i]])
      }
    }
    if(is.null(quarter))
      x <- x[, c(3, 6, 1 : 2, 4 : 5, 7 : ncol(x))]
    misspecified <- unique(misspecified)
    if( ! is.null(misspecified)) {
      if(length(misspecified) > 1) {
        miss <- paste(misspecified[ - length(misspecified)], collapse = ", ")
        miss <- paste(miss, misspecified[length(misspecified)], sep = " and ")
      } else {
        miss <- misspecified
      }
      i = sum(1, length(misspecified) > 1)
      miss <- paste(miss, c("is", "are")[i], "misspecified or",
                    c("this firm does", "these firms do")[i], "not exist.")
      warning(miss)
      rm(i, miss)
    }
    rm(misspecified)
    return(x)
  }
}

getBalanceSheet <- function(firms, quarter = NULL) {
  
  if (missingArg(firms)) {
    warning ("You need to chose at list a firm.")
  } else {
    if( ! is.null(quarter))
      if(any(quarter %in% "all"))
        quarter <- NULL
      
    FIRMS <- get.fin.stat(firms, quarter)
    
    x = misspecified = NULL
    for(i in seq_along(FIRMS)) {
      if(is.null(dim(FIRMS[[i]]))) {
        misspecified <- c(misspecified, firms[[i]])
      } else {
        FIRM <- FIRMS[[i]]
        if(is.null(quarter)) {
          col <- gsub(".individual|.consolidado", "", names(FIRM))
          p1 <- which(col == "ativo.total")
          p2 <- which(col == "resultado")
          x <- rbind(x, FIRM[, c("CodigoCvm", "DataReferenciaDocumento",
                                 names(FIRM)[c(p1[[1]] : (p2[[1]] - 1), p1[[2]] : (p2[[2]] - 1))])])
          rm(p1, p2, FIRM, col)
        } else {
          x <- FIRM[c(which(FIRM[, "name of account"] %in% c("CodigoCvm", "DataReferenciaDocumento")),
                      which(substr(FIRM[, "id of account"], 1, 1) %in% c(1, 2))), ]
        }
      }
    }
    
    if(is.null(quarter)) {
      x[, "CodigoCvm"] <- as.numeric(x[, "CodigoCvm"])
      x[, "DataReferenciaDocumento"] <- as.Date(x[, "DataReferenciaDocumento"])
      x[, 3 : ncol(x)] <- as.numeric(as.matrix(x[, 3 : ncol(x)]))
      x <- x[, unlist(apply(x, 2, function(i) ! all(is.na(i))))]
    }
    
    misspecified <- unique(misspecified)
    
    if( ! is.null(misspecified)) {
      if(length(misspecified) > 1) {
        miss <- paste(misspecified[ - length(misspecified)], collapse = ", ")
        miss <- paste(miss, misspecified[length(misspecified)], sep = " and ")
      } else {
        miss <- misspecified
      }
      
      
      i = sum(1, length(misspecified) > 1)
      miss <- paste(miss, c("is", "are")[i], "misspecified or",
                    c("this firm does", "these firms do")[i], "not exist.")
      warning(miss)
      rm(i, miss)
    }
    rm(misspecified)
    
    return(x)
  }
}

getIncomeStatements <- function(firms, quarter = NULL, adjust = F) {
  if (missingArg(firms)) {
    warning ("You need to chose at list a firm.")
  } else {
    FIRMS <- get.fin.stat(firms, quarter)
    
    x = misspecified = NULL
    for(i in seq_along(FIRMS)) {
      if(is.null(dim(FIRMS[[i]]))) {
        misspecified <- c(misspecified, firms[[i]])
      } else {
        FIRM <- FIRMS[[i]]
        if(is.null(quarter)) {
          col <- gsub(".individual|.consolidado", "", names(FIRM))
          p1 <- which(col == "resultado")
          p2 <- which(col == "resultado.abrangente")
          x <- rbind(x, FIRM[, c("CodigoCvm", "DataReferenciaDocumento", "TipoDemonstracaoFinanceira",
                                 names(FIRM)[c(p1[[1]] : (p2[[1]] - 1), p1[[2]] : (p2[[2]] - 1))])])
          rm(p1, p2, FIRM, col)
        } else {
          x <- FIRM[c(which(FIRM[, "name of account"] %in% c("CodigoCvm", "DataReferenciaDocumento", "TipoDemonstracaoFinanceira")),
                      which(substr(FIRM[, "id of account"], 1, 1) %in% 3)), ]
        }
      }
    }
    rm(FIRMS)
    
    if(is.null(quarter)) {
      x[, "CodigoCvm"] <- as.numeric(x[, "CodigoCvm"])
      x[, "DataReferenciaDocumento"] <- as.Date(x[, "DataReferenciaDocumento"])
      x[, 4 : ncol(x)] <- as.numeric(as.matrix(x[, 4 : ncol(x)]))
      x <- x[, unlist(apply(x, 2, function(i) ! all(is.na(i))))]
      
      if(adjust) {
        quarters <- paste(sort(rep(1997 : as.numeric(substr(Sys.time(), 1, 4)), 4)),
                          c("03", "06", "09", "12"), sep = "-")
        x <- lapply(unique(x[, "CodigoCvm"]), function(i) return(x[x[, "CodigoCvm"] == i, ]))
        x <- lapply(x, function(i) {
            for(l in 1 : nrow(i)) {
              if(i[l, "TipoDemonstracaoFinanceira"] == "ITR") {
                i[l, "TipoDemonstracaoFinanceira"] <- T
                next
              }
              q <- quarters %in% substr(i[l, "DataReferenciaDocumento"], 1, 7)
              f <- unlist(lapply(quarters[which(q) - c(3 : 1)], function(p) {
                f <- which(substr(i[, "DataReferenciaDocumento"], 1, 7) == p)
                if(length(f) == 0) {
                  return(NULL)
                } else {
                  return(max(f))
                }
              }))
              if(length(f) < 3) {
                i[l, "TipoDemonstracaoFinanceira"] <- F
                next
              } else {
                i[l, 4 : ncol(i)] <- i[l, 4 : ncol(i)] - colSums(i[f, 4 : ncol(i)])
                i[l, "TipoDemonstracaoFinanceira"] <- T
              }
            }
            rm(q, l, f)
            return(i)
          })
        FIRMS <- x
        x <- NULL
        for(i in seq_along(FIRMS))
          x <- rbind(x, FIRMS[[i]])
        x <- x[(x[, "TipoDemonstracaoFinanceira"]) == TRUE, c(1 : 2, 4 : ncol(x))]
        rm(quarters, FIRMS)
      }
      
    }
    
    misspecified <- unique(misspecified)
    
    if( ! is.null(misspecified)) {
      if(length(misspecified) > 1) {
        miss <- paste(misspecified[ - length(misspecified)], collapse = ", ")
        miss <- paste(miss, misspecified[length(misspecified)], sep = " and ")
      } else {
        miss <- misspecified
      }
      
      
      i = sum(1, length(misspecified) > 1)
      miss <- paste(miss, c("is", "are")[i], "misspecified or",
                    c("this firm does", "these firms do")[i], "not exist.")
      warning(miss)
      rm(i, miss)
    }
    rm(misspecified)
    
    return(x)
  }
}

info.search <- function(info = "", ...) {
  TratCarLatins <- function(painel) {
    
    classe <- class(painel)
    
    if(any(classe %in% "data.table")) {
      setDF(painel)
    } else {
      painel <- data.frame(painel, stringsAsFactors = F)
    }
    
    caracteres <- c("[ç]", "c",
                    "[ñ]", "n",
                    "[áàãâ]", "a",
                    "[éèê]", "e",
                    "[íìî]", "i",
                    "[óòõô]", "o",
                    "[úùû]", "u")
    caracteres <- c(caracteres, toupper(caracteres))
    caracteres <- matrix(caracteres, ncol = 2, byrow = T)
    
    
    colunas <- which(unlist(lapply( seq_along(painel[1, ]), function(i) {
      return(class(painel[, i]) == "character")
    })))
    
    if((dim(painel)[2]) == 1) {
      
      for(j in seq_along(caracteres[, 1])) {
        painel[, 1] <- gsub(caracteres[j, 1], caracteres[j, 2], painel[, 1])
      }
      
    } else {
      
      painel[colunas] <- apply(painel[, colunas], 2, function(i) {
        for(j in seq_along(caracteres[, 1])) {
          i <- gsub(caracteres[j, 1], caracteres[j, 2], i)
        }
        return(i)
      })
    }
    
    i <- colnames(painel)
    for(j in seq_along(caracteres[, 1])) {
      i <- gsub(caracteres[j, 1], caracteres[j, 2], i)
    }
    colnames(painel) <- i
    
    if( ! any(classe %in% c("matrix", "data.table", "data.frame", "character")))
      stop("classe não encontrada")
    
    if(any(classe %in% "character"))
      if(dim(painel)[2] == 1) {
        painel <- painel[, 1]
      } else {
        painel <- as.character(painel)
      }
    if(any(classe %in% "matrix"))
      painel <- as.matrix(painel)
    if(any(classe %in% "data.table"))
      setDT(painel)
    
    return(painel)
  }
  info <- TratCarLatins(info)
  info <- toupper(info)
  if("silent" %in% names(list(...))) {
    silent <- list(...)$silent
  } else {
    silent <- FALSE
  }
  dicionario <- get.files("dicionariocompleto")
  if(all(strsplit(as.character(info), "")[[1]] %in% as.character(0:9))) {
    x <- grep(info, dicionario$CodigoCvm)
  } else {
    x <- c(unlist(lapply( 2 : 3, function(j) grep(info, dicionario[, j]))),
           grep(substr(info, 1, 4), dicionario[, 4]))
  }
  if(length(x) == 0) {
    return(NULL)
    break
  }
  x <- sort(table(x), decreasing = T)
  dicionario <- dicionario[as.numeric(names(x)), ]
  x <- apply(dicionario, 1, function(dic) {
    x <- strsplit(strsplit(dic["INFORMACOES"], ";")[[1]], " = ")    
    parte1 <- cbind(CVMCode = dic["CodigoCvm"],
                    CNPJ = paste0(strsplit(dic["CNPJ"], ";")[[1]], collapse = ""),
                    SocialName = tail(strsplit(dic["RazaoSocial"], "; ")[[1]], 1),
                    NegotiationCode = paste(unlist(lapply(1 : length(x), function(j) x[[j]][1])),
                                            collapse = " "))
    parte2 <- cbind("Used Social Names" = strsplit(dic["RazaoSocial"], "; ")[[1]])
    parte <- lapply(x, function(j) {
      j.1 <- matrix(strsplit(j[2], " ")[[1]], ncol = 3, byrow = T)
      j.1[, 1] <- paste0(j[1], j.1[, 1])
      j.1 <- data.frame(j.1, stringsAsFactors = F)
      names(j.1) <- c("share-derivative", "FirstTimeNegociated", "LastTimeNegociated")
      return(j.1)
    })
    
    parte3 <- NULL
    for(j in seq_along(parte)) {
      parte3 <- rbind(parte3, parte[[j]])
    }
    
    parte <- list(parte1, parte2, parte3)
    
    names(parte) <- c("Information", "Names", "Share")
    
    return(parte)
    
  })
  names(x) <- unlist(lapply(seq_along(x), function(i) strsplit(x[[i]][[1]][4], " ")[[1]][[1]]))
  painel <- NULL
  for(i in seq_along(x))
    painel <- rbind(painel, x[[i]][[1]])
  
  rownames(painel) <- NULL
  painel <- data.frame(painel, stringsAsFactors = F)
  
  painel$CVMCode <- as.numeric(painel$CVMCode)
  
  x <- (c(list(painel), x))
  
  names(x)[1] <- "summary"
  
  if( ! silent)
    print(x$summary)
  
  return(invisible(x))
  
}

codeMatching <- function(info = NULL, info.class = "CVMCode") {
  if(is.null(info) |
     ! (info.class %in% c("CVMCode", "CNPJ", "SocialName", "NegotiationCode", "NegCode"))) {
    if(is.null(info)) {
      warning("You need to provide some information.")
    } else {
      warning("info.class misspecified.")
    }
  } else {
    if(info.class == "NegCode") 
      info.class <- "NegotiationCode"
    if(info.class == "NegotiationCode")
      info <- substr(info, 1, 4)
    data <- info.search(info, silent = T)
    x <- grepl(info, data$summary[, info.class])
    if( ! any(x)) {
      warning("Verify if the info is spelled correctly")
      return(NULL)
    }
    x <- substr(data$summary[x, "NegotiationCode"], 1, 4)
    x <- sort(x)
    data <- lapply(x, function(i) {
      dataCut <- data[[i]]
      CVMCode <- dataCut[[1]][[1]]
      dataCut <- dataCut[[3]]
      dataCut[, 1] <- substr(dataCut[, 1], 1, 4)
      dataCut <- lapply(unique(dataCut[, 1]), function(j) {
        cutondatacut <- dataCut[dataCut[, 1] == j, ] # \o/
        return(c(j, min(cutondatacut[, 2]), max(cutondatacut[, 3])))
      })
      dataCut <- cbind(CVMCode, t(data.frame(dataCut)))
      colnames(dataCut) <- c("CVMCode", "NegCode", "from", "to")
      if(nrow(dataCut) != 1) {
        dataCut <- data.frame(dataCut[order(dataCut[, "from"]), ], stringsAsFactors = F)
      } else {
        dataCut <- as.data.frame(dataCut)
      }
      dataCut[, "from"] <- as.Date(as.matrix(dataCut[, "from"]), "%Y%m%d")
      dataCut[,   "to"] <- as.Date(as.matrix(dataCut[,   "to"]), "%Y%m%d")
      rownames(dataCut) <- NULL
      
      return(dataCut)
    })
    x <- NULL
    for(i in seq_along(data)) {
      x <- rbind(x, data[[i]])
    }
    x[, "CVMCode"] <- as.numeric(as.matrix(x[, "CVMCode"]))
    x[, "NegCode"] <- as.matrix(x[, "NegCode"])
    
    return(x)
  }
}