Capítulo 8 Programando com o R

Você chegou ao fim da versão online do livro Análise de Dados Financeiros e Econômicos com o R, terceira edição. O conteúdo integral da obra pode ser adquirido na loja da Amazon como ebook ou livro impresso. A compra do livro é uma ótima maneira de suportar este e outros projetos do autor.

8.1 Criando Funções

8.2 Utilizando Loops (comando for)

8.3 Execuções Condicionais (`if`, `else`, `switch`)

8.4 Utilizando as Funções da Família `apply`

8.4.1 Função `lapply`

8.4.2 Função `sapply`

8.4.3 Função `tapply`

8.4.4 Função `mapply`

8.4.5 Função `apply`

8.5 Utilizando Pacote `purrr`

8.5.1 Função `purrr::map`

8.5.2 Função `purrr::safely`

8.5.3 Função `purrr::pmap`

8.6 Manipulação de Dados com `dplyr`

8.6.1 Operações de Grupo com `dplyr`

8.6.2 Operações de Grupo Complexas com `dplyr`

8.7 Exercícios

Q.1

Crie uma função chamada say_my_name que tome como entrada um nome de pessoa e mostre na tela o texto Your name is …. Dentro do escopo da função, utilize comentários para descrever o propósito da função, suas entradas e saídas.

say_my_name <- function(name_in) {
  # Print a single name in the prompt
  #
  # ARGS: name_in - Name to be printed
  #
  # RETURNS: TRUE, if sucessfull
  
  my_msg <- paste0('Your name is ', name_in)
  
  message(my_msg)
  
  # invisible will omit output if function is called without definition of output
  return(invisible(TRUE))
}

# testing
say_my_name('Marcelo')

Q.2

Implemente um teste para os objetos de entrada, de forma que, quando o nome de entrada não for da classe character, um erro é retornado ao usuário. Teste sua nova função e verifique se a mesma está funcionando conforme esperado.

say_my_name <- function(name_in) {
  # Prints a single name in the prompt
  #
  # ARGS: name_in - Name to be printed
  # RETURNS: TRUE, if sucessfull
  
  # check inputs
  if (class(name_in) != 'character') {
    stop('Class of input name_in is ', class(name_in), 
         ' and not character!')
  }
  
  if (length(name_in) > 1) {
    stop('Input name_in has length ', length(name_in), 
         ' and not 1 (this function only works for one name)!')
  }
  
  
  
  my_msg <- paste0('Your name is ', name_in, '.')
  
  message(my_msg)
  
  # invisible makes sure the fct doesnt return anything if not output is set
  return(invisible(TRUE))
}

# testing Ok
say_my_name('Marcelo')

# testing vector
say_my_name(c('Richard', 'Michael'))

# testing class
say_my_name(1)

Q.3

Crie um vetor com cinco nomes quaisquer, chamado my_names. Utilizando um loop, aplique função say_my_name para cada elemento de my_names.

say_my_name <- function(name_in) {
  # Prints a single name in the prompt
  #
  # ARGS: name_in - Name to be printed
  # RETURNS: TRUE, if sucessfull
  
  # check inputs
  if (class(name_in) != 'character') {
    stop('Class of input name_in is ', class(name_in), 
         ' and not character!')
  }
  
  if (length(name_in) > 1) {
    stop('Input name_in has length ', length(name_in), 
         ' and not 1 (this function only works for one name)!')
  }
  
  
  
  my_msg <- paste0('Your name is ', name_in, '\n')
  
  message(my_msg)
  
  # invisible makes sure the fct doesnt return anything if not output is set
  return(invisible(TRUE))
}

my_names <- c('Marcelo', 'Ricardo', 'Tarcizio')

for (i_names in my_names) {
  say_my_name(i_names)
}

Q.4

No banco de dados do Brasil.IO ²⁴ encontrarás uma tabela com nomes e gêneros derivados de uma das pesquisas do IBGE. Importe os dados do arquivo para R e, usando um loop, aplique a função say_my_name a 15 nomes aleatórios do banco de dados. Dica: neste caso, você pode baixar os dados direto do link usando readr::read_csv(LINK).

say_my_name <- function(name_in) {
  # Prints a single name in the prompt
  #
  # ARGS: name_in - Name to be printed
  # RETURNS: TRUE, if sucessfull
  
  # check inputs
  if (class(name_in) != 'character') {
    stop('Class of input name_in is ', class(name_in), 
         ' and not character!')
  }
  
  if (length(name_in) > 1) {
    stop('Input name_in has length ', length(name_in), 
         ' and not 1 (this function only works for one name)!')
  }
  
  
  
  my_msg <- paste0('Your name is ', name_in, '.')
  
  message(my_msg)
  
  # invisible makes sure the fct doesnt return anything if not output is set
  return(invisible(TRUE))
}

library(tidyverse)

# get CURRENT url from https://data.chhs.ca.gov/dataset/most-popular-baby-names-2005-current
my_url <- 'https://data.brasil.io/dataset/genero-nomes/grupos.csv.gz'

df_names <- read_csv(my_url, col_types = cols())

my_names <- sample(df_names$name, 15)

for (i_name in my_names) {
  
  say_my_name(i_name)
}

Q.5

Refaça o exercício anterior utilizando comandos sapply ou purrr::map.

say_my_name <- function(name_in) {
  # Prints a single name in the prompt
  #
  # ARGS: name_in - Name to be printed
  # RETURNS: TRUE, if sucessfull
  
  # check inputs
  if (class(name_in) != 'character') {
    stop('Class of input name_in is ', class(name_in), 
         ' and not character!')
  }
  
  if (length(name_in) > 1) {
    stop('Input name_in has length ', length(name_in), 
         ' and not 1 (this function only works for one name)!')
  }
    
  my_msg <- paste0('Your name is ', name_in, '\n')
  
  message(my_msg)
  
  # invisible makes sure the fct doesnt return anything if not output is set
  return(invisible(TRUE))
}

library(tidyverse)
library(purrr)

# get CURRENT url from https://data.chhs.ca.gov/dataset/most-popular-baby-names-2005-current
my_url <- 'https://data.brasil.io/dataset/genero-nomes/grupos.csv.gz'

df_names <- read_csv(my_url, col_types = cols())

# using sapply
vec_out <- sapply(sample(df_names$name, 15),
                  say_my_name)
glimpse(vec_out)

# using purrr
l_out <- map(sample(df_names$name, 15),
             say_my_name)
glimpse(vec_out)

Q.6

Use o pacote BatchGetSymbols para baixar dados do índice SP500 ('^GSPC'), Ibovespa ('^BVSP'), FTSE ('^FSTE') e Nikkei 225 ('^N225') de '2010-01-01' até a data atual. Com os dados importados, use um loop para calcular o retorno médio, máximo e mínimo de cada índice durante o período analisado. Salve todos os resultados em uma tabela única e a mostre no prompt do R.

library(BatchGetSymbols)

indexes <- c('^BVSP', '^GSPC', '^FTSE', '^N225')

df_indices <- BatchGetSymbols(tickers = indexes, 
                              first.date = '2010-01-01',
                              last.date = Sys.Date())[[2]]

tab <- tibble()
for (index in indexes) {
  
  temp_df <- df_indices %>%
    filter(ticker == index)
  
  avg_ret <- mean(temp_df$ret.adjusted.prices, 
                  na.rm = TRUE)
  max_ret <- max(temp_df$ret.adjusted.prices, 
                 na.rm = TRUE)
  min_ret <- min(temp_df$ret.adjusted.prices, 
                 na.rm = TRUE)
  
  # save result
  tab <- bind_rows(tab, tibble(index = index,
                               mean_ret = avg_ret, 
                               max_ret = max_ret, 
                               min_ret = min_ret))
  
}

print(tab)

Q.7

Refaça o exercício anterior utilizando as funções group_by e summarise, ambas do pacote dplyr.

library(BatchGetSymbols)

indexes <- c('^BVSP', '^GSPC', '^FTSE', '^N225')

df_indices <- BatchGetSymbols(tickers = indexes, 
                              first.date = '2010-01-01',
                              last.date = Sys.Date())[[2]]

tab_tidy <- df_indices %>%
  group_by(ticker) %>%
  summarise(mean_ret = mean(ret.adjusted.prices, na.rm = TRUE),
            max_ret = max(ret.adjusted.prices, na.rm = TRUE),
            min_ret = min(ret.adjusted.prices, na.rm = TRUE))

print(tab_tidy)

Q.8

No site do Rstudio CRAN logs ²⁵ você encontrará dados sobre as estatísticas de download para a distribuição de base de R na seção Daily R downloads. Usando suas habilidades de programação, importe todos os dados disponíveis entre 2020-01-01 e 2020-01-15 e agregue-os em uma única tabela. Qual país apresenta a maior contagem de downloads do R?

Resposta:

A solução é US. Para chegar no resultado anterior, deves executar o código abaixo. Para isso, abra um novo script no RStudio (Control+shift+N), copie e cole o código, e rode o script inteiro apertando Control+Shift+Enter ou por linha com Control+Enter.

# set function that will download the files
read_cranlogs_files <- function(date_in) {
  # Reads log files from http://cran-logs.rstudio.com/
  #
  # ARGS: date_in - date of log data
  require(tidyverse)
  require(lubridate)
  
  url_dl <- paste0('http://cran-logs.rstudio.com/', year(date_in), '/',
                   date_in, '-r.csv.gz')
  
  cat('\nReading ', url_dl)
  
  df <- read_csv(url_dl, col_types = cols())
  
  return(df)
}

# find out the availabe dates in url
library(rvest)
library(lubridate)

available_links <- read_html('http://cran-logs.rstudio.com/') %>%
  html_nodes(css = 'a') %>%
  html_attr('href')

# only keep links for R download (those with -r.csv.gz pattern)
idx <- str_detect(available_links, '-r.csv.gz')
r_links <- available_links[idx]

# find out dates 
dates_dls <- ymd(basename(r_links))
max_date <- max(dates_dls)

first_date <- as.Date('2020-01-01')
last_date <- as.Date('2020-01-15')

my_dates <- seq(first_date, 
                last_date, 
                by = '1 day')

library(purrr) 
library(tidyverse)

l_out <- map(my_dates, 
             safely(read_cranlogs_files, 
                    otherwise = tibble())) # return empty tibble in case of error

df_cranlogs <- bind_rows(map(l_out, 'result'))

# solution 
my_sol <- names(sort(table(df_cranlogs$country), 
               decreasing = TRUE)[1])

7 As Classes Básicas de Objetos

9 Estruturando e Limpando Dados

Capítulo 8 Programando com o R

8.1 Criando Funções

8.2 Utilizando Loops (comando for)

8.3 Execuções Condicionais (if, else, switch)

8.4 Utilizando as Funções da Família apply

8.4.1 Função lapply

8.4.2 Função sapply

8.4.3 Função tapply

8.4.4 Função mapply

8.4.5 Função apply

8.5 Utilizando Pacote purrr

8.5.1 Função purrr::map

8.5.2 Função purrr::safely

8.5.3 Função purrr::pmap

8.6 Manipulação de Dados com dplyr

8.6.1 Operações de Grupo com dplyr

8.6.2 Operações de Grupo Complexas com dplyr