gpetrini/Cecon
Funções e rotinas para uso interno Cecon/Unicamp

Package index
Search the gpetrini/Cecon package
Functions
21
Source code
20
Man pages
20
Home
/
GitHub
/
gpetrini/Cecon
/

In gpetrini/Cecon: Funções e rotinas para uso interno Cecon/Unicamp 

knitr::opts_chunk$set(echo = TRUE)

Carregando pacotes

##### Carregando pacotes -------
library(ggplot2) # Gráficos
library(ggthemes) # Temas ggplot
library(plotly) # Plots dinâmicos
library(astsa) # Arima; Série de desemprego (unemp)
library(purrr)  # importa %>%
library(xts) # Objeto zoo e xts
library(lubridate) # Para eixos
library(readxl) # Lida melhor com excel
library(RColorBrewer) # Consultar
library(lattice) # Plots
library(grid) # Consultar
library(gridExtra) # Consultar
library(gtable) # Consultar
library(magick) # Para ler imagem. ATENÇÂO INSTALAÇÂO
library(rmarkdown) # Make cool dynamic documents [Necessário?]
library(knitr) # Run R Code Chunks [Necessário?]
library(DT) # Interactive HTML tables
library(d3heatmap) # biblioteca para construir heatmaps
library(colorRamps)# Ajuda com heatmaps e cores
# Pacotes para dados brasileiros -----------------------
library(BETS)
library(rbcb) # Banco Central
library(ecoseries) #BC ipeadata e SIDRA
library(ribge) # IBGE
# Pacotes para dados internacionais -----------------------
library(imfr) #para pegar series do site do FMI

Séries

Tratamento

Correção de data

ajuste_xts <- function(dados,
                       col_data = 1,
                       col_dados = 2,
                       remover_NA = FALSE){
    if ("xts" %in% class(dados) 
        | "zoo" %in% class(dados)) {
        message("Série está em xts/zoo, função ajuste_xts não necessária")
    if (sum(is.na(dados)) != 0 & remover_NA == FALSE) {
        message("Séries contém NAs, use remover_NA = TRUE", call. = FALSE)
    }    
    if (remover_NA == FALSE) {
        xts(x = coredata(dados),
        order.by = as.Date(index(dados)))
    } else {
        sem_NA <- !is.na(coredata(dados))
        xts(x = coredata(dados[sem_NA]),
        order.by = as.Date(index(dados[sem_NA])))
    }
    } else if ("ts" %in% class(dados)) {
        dados <- as.xts(dados)
    }
        else {
    if (sum(is.na(dados)) != 0 & remover_NA == FALSE) {
        message("Séries contém NAs, use remover_NA = TRUE", call. = FALSE)
    }
    if (remover_NA == TRUE) {
        teste_NA <- !(is.na(dados[, col_dados]))
        dados_sNA <- dados[teste_NA,]
        proxy <- as.data.frame(dados_sNA)
        proxy_data <- as.Date(proxy[, col_data], origin = proxy[1, col_data])
        xts(x = proxy[, col_dados],
        order.by = proxy_data)
    } else{
     proxy <- as.data.frame(dados)
     proxy_data <- as.Date(proxy[ , col_data], origin = proxy[1,col_data])
     xts(x = proxy[, col_dados],
        order.by = proxy_data)   
    }
        }
}

Exemplo:

dado_excel <- read_xlsx("../../Brutos/ativ_econ.xlsx", sheet = "IBCBr")
dado_excel_ajustado <- ajuste_xts(dado_excel)
head(dado_excel_ajustado, n = 13)
dado_excel_sNA <- ajuste_xts(dado_excel, remover_NA = TRUE)
head(dado_excel_sNA)
class(dado_excel_sNA)
head(ajuste_xts(dado_excel_sNA))

Atenção:

IPEADATA

clean_ipeadata <- function(dado_ipea) {
  dado_desl <- unlist(dado_ipea)
  valor <- dado_desl[((length(dado_desl)/2) + 1):length(dado_desl)]
  data_ipea <- dado_desl[1:(length(dado_desl)/2)]
  data_clean <- as.Date(data_ipea)
  xts_name <- deparse((substitute(dado_ipea)))
  xts(x = valor, order.by = data_clean)
}

Exemplo:

[EM ABERTO]

Atenção:

Exportar dados

exportar_dados <- function(dados,
                           pasta = "../Tratados", # Se não estiver na mesma pasta, "../Pasta"
                           formato = ".RData") {
    nome_dado <- deparse(substitute(dados)) 
    nome_arquivo <- paste0(nome_dado,formato)
    caminho <- file.path(pasta, nome_arquivo)
     saveRDS(dados,
             file = caminho)
    }

Exemplo:

exportar_dados(dado_excel_ajustado, 
               pasta = "./Temp/")

Operações

Média Móvel

OBS: Para gráficos, usar ggplot

MM12m <- function(x) {
                y <- c(1:(length(x)))                        #cria variavel y to tamanho da serie inserida
                      for(i in 1:(length(x)-11)) {         #para i vezes menos 12 
                            y[i+11]<-mean(x[(i+0):(i+11)]) #faz média de 12 passos
                      }
                y[1:12]<-NA                                #coloca NA nas primeiras 12 entradas
                return(y)                                  #dá como retorno a série media movel 12 meses
}

Exemplo:

unemp_MM12m <- MM12m(unemp)
plot.ts(unemp_MM12m)

Sugestões de mudanças:

Média Móvel Geral

OBS: Para gráficos, usar ggplot

media_movel <- function(dados,
                        digitos = 2, 
                        meses = 12,
                        tabela = FALSE) {
    if ("ts" %in% class(dados)) { # Inicia checagem
            dados <- as.xts(dados)
    }
    else if ("tbl_df" %in% class(dados) |
            "tbl" %in% class(dados)) {
        stop("Usar ajuste_xts", call. = FALSE)
            }
    else if ("xts" %in% class(dados) |
            "zoo" %in% class(dados)) {
        dados <- dados
    }
    else  {
        stop("Usar ajuste_xts", call. = FALSE)
    } # Inicia operacao
    y <- c(1:(length(dados)))  #cria variavel y to tamanho da serie inserida
    for (i in 1:(length(dados) - (meses - 1))) { #para i vezes menos meses 
        y[i + (meses - 1)] <- mean(dados[(i + 0):(i + (meses - 1))]) #faz média de meses passos
        }
    y[1:meses] <- NA   #coloca NA nas primeiras 12 entradas
    if (tabela == FALSE) {
        mm_xts <-  xts(x = y,
                    order.by = as.Date(index(dados)))
        return(mm_xts)
    } else {
        mm_xts <-  xts(x = y,
                    order.by = as.Date(index(dados)))
        Tabela_mm <- merge.xts(x = dados,
                           y = mm_xts)
        # serie <- deparse(substitute(dados)) # TODO
        # colnames(Tabela_mm) <- c(as.character(serie), "Media_Movel")
    return(Tabela_mm)
    }
}
unemp_media12 <- media_movel(unemp)
head(unemp_media12)
unemp_media12T <- media_movel(unemp, tabela = TRUE)
head(unemp_media12T, n = 13)
unemp_media4 <- media_movel(unemp, meses = 4)
head(unemp_media4)

Atenção:

Taxa acumulada

# tx_acum <- function(dados,
#                         digitos = 2, 
#                         meses = 12,
#                         tabela = FALSE) {
#     if ("ts" %in% class(dados)) { # Inicio checagem
#             dados <- as.xts(dados)
#     }
#     else if ("tbl_df" %in% class(dados) |
#             "tbl" %in% class(dados)) {
#         stop("Usar ajuste_xts", call. = FALSE)
#             }
#     else if ("xts" %in% class(dados) |
#             "zoo" %in% class(dados)) {
#         dados <- dados
#     }
#     else  {
#         stop("Usar ajuste_xts", call. = FALSE)
#     } # Inicio Operacao
#     m <- c(1:(length(dados)))    #cria variavel m to tamanho da serie inserida
#     for (i in 1:(length(dados) - (meses - 1))) {#para o total tamanho de x vezes, menos 12
#         k <- 1  #cria a var K iterada para chegar na serie m
#             for (j in 0:(meses - 1)) { #meses vezes para se taxa anualizada 
#                 k <- k * (1 + dados[i - j + (meses - 1)]/100) #faz multiplica??o de 12 passos para cada posi??o i
#                 }
#             k <- (k - 1)*100#retira 1 finalmente para ficar em valor porcentual
#     }
#     m[i + (meses - 1)] <- k
#     m[1:(meses - 1)] <- NA           #coloca NA nas primeiras 12 entradas
#     return(m)       
#         if (tabela == FALSE) { # Inicio tabela
#         acum_xts <-  xts(x = k,
#                     order.by = as.Date(index(dados)))
#         return(acum_xts)
#     } else {
#     acum_xts <-  xts(x = k,
#                     order.by = as.Date(index(dados)))
#     Tabela_accum <- merge.xts(x = dados,
#                               y = acum_xts)
#     return(Tabela_accum)
#     }
# }
# teste_acum <- tx_acum(UnempRate) # TODO

Gráficos

Plotar gráficos

Template simples

grafico_padrao <- function(dado_xts, 
                           tipo_grafico = geom_line(size = 1), 
                           titulo = NULL,
                           fonte = NULL,
                           x_titulo = NULL, 
                           y_titulo = NULL,
                           tema = theme_classic(), 
                           quebra_data = "1 year",
                           label_data = "%Y",
                           pontos = 0){
  dado_xts <- as.xts(dado_xts)
  ggplot(data = dado_xts,
         aes(
           x = as.Date(index(dado_xts)),
           y = coredata(dado_xts))) +
    tipo_grafico + 
    labs(x = x_titulo,
         y = y_titulo,
         title = titulo,
         caption = paste0("Fonte: ", fonte)) + 
    tema + 
    theme(panel.border = element_blank(), 
          axis.line = element_line(colour = "black", 
                                   size = 0.7), 
          axis.text.x = element_text(angle = 90, 
                                     hjust = 0, 
                                     vjust = 0.5, 
                                     size = 14),
          axis.text.y = element_text(angle = 0, 
                                     hjust = 0, 
                                     vjust = 0.5, 
                                     size = 14),
          text = element_text(size = 10,
                            family = "TT Times New Roman")) +
    scale_x_date(date_breaks = quebra_data, date_labels = label_data) +
    geom_point(size = pontos)
}

Exemplo:

Plot_Simples <- grafico_padrao(unemp)
Plot_Simples
Plot_Formatado <- grafico_padrao(dado_xts = unemp, 
                                 titulo = "Desemprego nos EUA (1947-1980)", 
                                 x_titulo = "Ano", 
                                 y_titulo = "Desempregados (mil)", 
                                 quebra_data = "5 years", 
                                 label_data = "%Y", 
                                 tema = theme_economist_white(), 
                                 fonte = "Pacote astsa")
Plot_Formatado

Sugestões de mudança:

Logo

O logo do cecon será salvo em um objeto para agilizar a compilação:

#logo_cecon <- image_read("http://i.imgur.com/2e3FQaz.png")
#logo_cecon

add_logo <- function(grafico = last_plot()){
    grafico  %>% 
        ggplotly() %>%  
        layout(images = list(list(source = "http://i.imgur.com/2e3FQaz.png", 
                                  xref = "paper", 
                                  yref = "paper", 
                                  x= 0.02, 
                                  y= 1, 
                                  sizex = 0.25, 
                                  sizey = 0.25, 
                                  opacity = 0.5))) %>%
    config(displayModeBar = TRUE)
}

Exemplo:

teste <- grafico_padrao(unemp)
teste_logo <- add_logo(teste)
teste_logo

Atenção:

Gráfico CECON

grafico_cecon <- function(dado_xts, 
                          logo = TRUE,
                          FUN = grafico_padrao){
    grafico <- dado_xts %>% FUN()
    if (logo == TRUE) {
        grafico_logo <- grafico %>%  add_logo()
        return(grafico_logo)

        # if (is.null(transform) == FALSE ) {
        #     grafico_logo %>% add_fun(transform)
        # }
        # 
        # else {
        #     return(grafico_logo)
        # }

    } else {
        return(grafico)
    }
}

Exemplo:

grafico_cecon(unemp)

Sugestões de mudanças:

Gráfico rápido

Ideia é gerar um gráfico pronto para uso a partir de dados brutos e em poucas linhas de código. A implementação é pensada nas rotinas não focadas na geração de gráficos. No momento, só é possível plotar uma série por vez.

grafico_rapido <- function(dado,
                           remover_NA = FALSE){
    grafico <- dado %>% 
        ajuste_xts(remover_NA = remover_NA) %>% 
        grafico_padrao %>% 
        add_logo
    return(grafico)           }

Exemplo:

grafico_rapido(dado_excel, remover_NA = TRUE)
#grafico_rapido(unemp_media12T) # Adicionar para mais de uma série

Exportar gráficos

Salvar gráfico

salvar_grafico <- function(grafico, 
                           pasta = "./Graficos", 
                           formato = ".png"){
  nome_grafico <- deparse(substitute(grafico))
  salvar_nome <- paste0(Sys.Date(),"_",nome_grafico,formato)
  ggsave(file.path(pasta, salvar_nome))
}

Exemplo:

Consultar pasta Temp

salvar_grafico(grafico = Plot_Formatado, 
               pasta = 'Temp')

Sugestão de modificações:

Análises (Gerar textos)

Positivo/Negativo

Cria uma função que retorna texto "positivo" "negativo" dependendo se acima ou abaixo de z

FazTexto.Cortes1 <- function(x, # Série a ser analisada
                             z, # fronteira
                             y){ # Se feminino, y=1. Se masculino, y=2.
  if (x >= z & y == 1) {k <- "positiva"}
  if (x >= z & y == 2) {k <- "positivo"}
  if (x < z & y == 1) {k <- "negativa"}
  if (x < z & y == 2) {k <- "negativo"}
  return(k)
}

Exemplo:

[EM ABERTO]

Sugestões de mudança:

Níveis bom/ruim

Cria uma função que retorna texto "muito ruim", "ruim", "bom", "muito bom".

FazTexto.Cortes3 <- function(x, # Séria a ser analisada
                             y, # Corte 1
                             z, # Corte 2
                             w # Corte 3
                             ){
  k <- "muito ruim"
  if (x > y) {k <- "ruim"}
  if (x > z) {k <- "bom"}
  if (x > w) {k <- "muito bom"}
  return(k)
}

Exemplo:

[EM ABERTO]

Sugestões de mudanças:

Dúvidas:

Último Valor

Cria uma função que retorna o ultimo valor de uma série x.

FazTexto.UltimoValor <- function(x, # Série a ser analisada
                                 digitos = 2){

    k <- format(round(x[length(x)], 
                      digits = digitos), 
                big.mark = ".", 
                decimal.mark = ",") 
  return(k)
}

Exemplo:

Sugestões de mudanças:

Mudanças:

12 meses anteriores

Cria uma função que retorna o valor 12 meses anteriores de uma série mensal x:

FazTexto.Valor12mAntes <- function(x, # Série a ser analisada
                                   digitos = 2){
  k <- format(round(x[length(x) - 11],
                    digits = digitos), 
              big.mark = ".", 
              decimal.mark = ",") 
  return(k)
}

Exemplo:

Mudanças:

Sugestões:

m meses anteriores

Expande função 12 meses anteriores para qualquer número (12 padrão):

FazTexto.ValorMesAntes <- function(x, # Série a ser analisada
                                   digitos = 2,
                                   meses = 12){
  k <- format(round(x[length(x) -  (meses - 1)],
                    digits = digitos), 
              big.mark = ".", 
              decimal.mark = ",") 
  return(k)
}

Exemplo:

Variação absoluta (p.p.) 12 meses

Cria uma função que retorna a variação absoluta (em pontos percentuais se ja for uma série percental) de uma série no ultimo ano:

FazTexto.Var12m.Abs <- function(x, # Série a ser analisada
                                digitos = 2){
  k <- format(round(x[length(x)] - x[length(x) - 11], #subtrai o ultimo valor da série x de 12 meses anteriores
              digits = digitos), 
              big.mark = ".", 
              decimal.mark = ",") 
  return(k)
}

Exemplo:

Mudanças:

Sugestões de mudanças:

Variação absoluta (p.p.) 24 meses

Cria uma função que retorna a variação em pontos percentuais de uma série no ultimos dois anos:

FazTexto.Var24m.Abs <- function(x,y){#x é a séria a ser análisada, y o número de digitos da saida
  k=format(round(x[length(x)]-x[length(x)-23],digits = y), big.mark=".", decimal.mark=",") #subtrai o ultimo valor da série x de 24 meses anteriores
  return(k)
}

Variação absoluta (p.p.) n meses

FazTexto.VarMes.Abs <- function(x, # Série a ser analisada
                                digitos = 2, 
                                meses = 12){
  k <- format(round(x[length(x)] - x[length(x) - (meses - 1)], #subtrai o ultimo valor da série x de meses meses anteriores
              digits = digitos), 
              big.mark = ".", 
              decimal.mark = ",") 
  return(k)
}

Exemplo:

Variação percentual 12 meses

Cria uma função que retorna a variação percentuais de uma série no ultimo ano

FazTexto.Var12m.porc <- function(x, # Série a ser analisada
                                 digitos = 2){
  k <- format(round((((x[length(x)]/x[length(x) - 11]) - 1)*100), #divide o ultimo valor da série x de 12 meses anteriores
                    digits = digitos), 
              big.mark = ".", 
              decimal.mark = ",") 
  return(k)
}

Exemplo:

Mudanças:

Sugestões de mudanças:

Variação percentual 24 meses

Cria uma função que retorna a variação percentuais de uma série nos ultimos 2 anoa

FazTexto.Var24m.porc <- function(x,y){#x é a séria a ser análisada, y o número de digitos da saida
  k=format(round((((x[length(x)]/x[length(x)-23])-1)*100),digits = y), big.mark=".", decimal.mark=",") #divide o ultimo valor da série x de 24 meses anteriores
  return(k)
}

Variação percentual n meses

Cria uma função que retorna a variação percentuais de uma série nos último n meses

FazTexto.VarMes.porc <- function(x, # Série a ser analisada
                                 digitos = 2,
                                 meses = 12){
  k <- format(round((((x[length(x)]/x[length(x) - (meses - 1)]) - 1)*100), #divide o ultimo valor da série x de meses meses anteriores
                    digits = digitos), 
              big.mark = ".", 
              decimal.mark = ",") 
  return(k)
}

Exemplo:

Taxa anualizada

Cria função para taxa anualizado (eleva a 12 potência)(ex. IPCA=2,33)

FazTexto.TaxaAnualizada <- function(x){#x é a séria a ser análisada
  k <- c(1:length(x)) 
     for (i in 0:length(x)) {         
        k[i] <- (1 + x[i]/100)^12
     }
  k <- (k - 1)*100
  return(k)
}

Exemplo:

[EM ABERTO]

Sugestões de mudança:

Dúvidas:

Acumulado 12 meses

Cria função para acumulado em 12 meses

FazTexto.Acc12m <- function(x,
                            digitos = 2){
  k <- 0
     for (i in 0:11) {         #para i vezes menos 12 
        k <- k + x[length(x) - i] #faz soma de 12 passos
     }
     k <- format(round(k, digits = digitos), 
                 big.mark = ".", 
                 decimal.mark = ",") #arredonda para y digitos
  return(k)
}

Exemplo:

Mudanças:

Sugestões de mudanças:

Acumulado m meses

Cria função para acumulado em m meses

FazTexto.AccMes <- function(x,
                            digitos = 2,
                            meses = 12){
  k <- 0
     for (i in 0:(meses - 1)) {         #para i vezes menos meses
        k <- k + x[length(x) - i] #faz soma de 12 passos
     }
     k <- format(round(k, digits = digitos), 
                 big.mark = ".", 
                 decimal.mark = ",") 
  return(k)
}

Exemplo:

Taxa acumulada 12 meses

FazTexto.TaxaAcc12m <- function(x){#x ? a s?ria a ser an?lisada
                m <- c(1:(length(x))) #cria variavel m to tamanho da serie inserida
                for (i in 1:(length(x) - 11)) { #para o total tamanho de x vezes, menos 12
                    k <- 1  #cria a var K iterada para chegar na seria m
                    for (j in 0:11) {#12 vezes para se taxa anualizada 
                        k <- k * (1 + x[(i - j) + 11]/100) #faz multiplica??o de 12 passos para cada posi??o i
                            }
                     k <- (k - 1)*100 #retira 1 finalmente para ficar em valor porcentual
                     m[i + 11] <- k
                      }
                m[1:11] <- NA   #coloca NA nas primeiras 12 entradas
                return(m)  #d? como retorno a s?rie taxa anualizada
}

Exemplo:

Taxa acumulada m meses

FazTexto.TaxaAccMeses <- function(x,
                                  meses = 12){#x ? a s?ria a ser an?lisada
                m <- c(1:(length(x))) #cria variavel m to tamanho da serie inserida
                for (i in 1:(length(x) (meses - 1))) { #para o total tamanho de x vezes, menos 12
                    k <- 1  #cria a var K iterada para chegar na seria m
                    for (j in 0:(meses - 1)) {#12 vezes para se taxa anualizada 
                        k <- k * (1 + x[(i - j) + (meses - 1)]/100) #faz multiplica??o de 12 passos para cada posi??o i
                            }
                     k <- (k - 1)*100 #retira 1 finalmente para ficar em valor porcentual
                     m[i + (meses - 1)] <- k
                      }
                m[1:(meses - 1)] <- NA   #coloca NA nas primeiras 12 entradas
                return(m)  #d? como retorno a s?rie taxa anualizada
}

Número índice

Cria função para criar número indice de uma série mensal de inflação (para usar em deflacionamentos até para a ultima data)

FazTexto.N_Indice <- function(x){#x é a séria a ser análisada
  k <- c(1:length(x)) #retorna o numero indice para deflacionar para o ultimo valor do ipca
     k[1] <- (1 + x[1]/100)
     for (i in 2:length(x)) {         
        k[i] <- (1 + x[i]/100)*k[i - 1]
     }
  k <- k[length(k)/k]
  return(k)
}

Exemplo:

[EM ABERTO]

Dúvidas:

Exportando funções

# save(object = add_logo,
#         file = "Funcoes.R")

Pendências



gpetrini/Cecon documentation built on May 16, 2019, 3:11 p.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close