Exercício 3 - Visualização de Dados

Author

Matheus Salles

Resolução opção 5

Utilizando os dados do projeto portal, iremos comparar o peso médio e o peso dos juvenis entre os diferentes gêneros de roedores presentes na tabela.

Carregando os dados:

library(tidyverse)
library(ggtext)
library(gridExtra)
library(ggsci)

roedores <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2023/2023-05-02/species.csv")
str(roedores)
spc_tbl_ [21 x 15] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ species       : chr [1:21] "BA" "PB" "PH" "PI" ...
 $ scientificname: chr [1:21] "Baiomys taylori" "Chaetodipus baileyi" "Chaetodipus hispidus" "Chaetodipus intermedius" ...
 $ taxa          : chr [1:21] "Rodent" "Rodent" "Rodent" "Rodent" ...
 $ commonname    : chr [1:21] "Northern pygmy mouse" "Bailey's pocket mouse" "Hispid pocket mouse" "Rock pocket mouse" ...
 $ censustarget  : num [1:21] 1 1 1 1 1 1 1 1 1 1 ...
 $ unidentified  : num [1:21] 0 0 0 0 0 0 0 0 0 0 ...
 $ rodent        : num [1:21] 1 1 1 1 1 1 1 1 1 1 ...
 $ granivore     : num [1:21] 1 1 1 1 1 1 1 1 0 0 ...
 $ minhfl        : num [1:21] 6 16 21 18 11 21 15 39 21 12 ...
 $ meanhfl       : num [1:21] 13.3 26 25.1 22 21.5 ...
 $ maxhfl        : num [1:21] 15 47 28 24 27 50 64 58 42 39 ...
 $ minwgt        : num [1:21] 6 10 18 10 4 13 12 12 30 7 ...
 $ meanwgt       : num [1:21] 9.45 31.87 30.72 17.47 17.62 ...
 $ maxwgt        : num [1:21] 18 79 48 28 42 66 85 190 280 56 ...
 $ juvwgt        : num [1:21] NA 19 24 10 11.7 ...
 - attr(*, "spec")=
  .. cols(
  ..   species = col_character(),
  ..   scientificname = col_character(),
  ..   taxa = col_character(),
  ..   commonname = col_character(),
  ..   censustarget = col_double(),
  ..   unidentified = col_double(),
  ..   rodent = col_double(),
  ..   granivore = col_double(),
  ..   minhfl = col_double(),
  ..   meanhfl = col_double(),
  ..   maxhfl = col_double(),
  ..   minwgt = col_double(),
  ..   meanwgt = col_double(),
  ..   maxwgt = col_double(),
  ..   juvwgt = col_double()
  .. )
 - attr(*, "problems")=<externalptr> 
ls(roedores)
 [1] "censustarget"   "commonname"     "granivore"      "juvwgt"        
 [5] "maxhfl"         "maxwgt"         "meanhfl"        "meanwgt"       
 [9] "minhfl"         "minwgt"         "rodent"         "scientificname"
[13] "species"        "taxa"           "unidentified"

Selecionando apenas as nossas variáveis de interesse: scientificname, meanwgt e juvwgt

roedores_subset <- select(roedores, -c(censustarget, commonname, granivore,
                                       maxhfl, maxwgt, meanhfl, minhfl, minwgt,
                                       rodent, species, taxa, unidentified))
str(roedores_subset)
tibble [21 x 3] (S3: tbl_df/tbl/data.frame)
 $ scientificname: chr [1:21] "Baiomys taylori" "Chaetodipus baileyi" "Chaetodipus hispidus" "Chaetodipus intermedius" ...
 $ meanwgt       : num [1:21] 9.45 31.87 30.72 17.47 17.62 ...
 $ juvwgt        : num [1:21] NA 19 24 10 11.7 ...

Separando a coluna “scientificname” em duas, uma para gênero e outra para epíteto específico

roedores_subset_gender <- roedores_subset %>% separate(scientificname, into = c("Gênero", "Epíteto específico"), sep = " ") %>% 
  select(-"Epíteto específico")

roedores_subset_gender$Gênero <- as.factor(roedores_subset_gender$Gênero)

str(roedores_subset_gender)
tibble [21 x 3] (S3: tbl_df/tbl/data.frame)
 $ Gênero : Factor w/ 9 levels "Baiomys","Chaetodipus",..: 1 2 2 2 2 3 3 3 4 5 ...
 $ meanwgt: num [1:21] 9.45 31.87 30.72 17.47 17.62 ...
 $ juvwgt : num [1:21] NA 19 24 10 11.7 ...

Plotando gráfico de dispersão para observar relação entre as variáveis de interesse

levels(roedores_subset_gender$Gênero)
[1] "Baiomys"         "Chaetodipus"     "Dipodomys"       "Neotoma"        
[5] "Onychomys"       "Perognathus"     "Peromyscus"      "Reithrodontomys"
[9] "Sigmodon"       
ggplot(data = roedores_subset_gender, aes(x = meanwgt, y = juvwgt,
                                          color = Gênero, size = 2)) +
  geom_point() +
  labs(x = "Média de peso dos adultos (g)", y = "Média de peso dos juvenis (g)") +
  scale_color_hue(labels = c("*Baiomys*", "*Chaetodipus*", "*Dipodomys*", "*Neotoma*", "*Onychomys*", "*Perognathus*", "*Peromyscus*", "*Reithrodontomys*", "*Sigmodon*")) +
  theme_classic() +
  guides(size = "none") +
  theme(legend.text = element_markdown())
Warning: Removed 3 rows containing missing values (`geom_point()`).

# Mesmo gráfico que o anterior, mas colocando os gêneros em itálico de uma forma diferente
dispersion_wgt <- ggplot(data = roedores_subset_gender, aes(x = meanwgt, y = juvwgt,
                                          color = Gênero, size = 2)) +
  geom_point() +
  labs(x = "Média de peso dos adultos (g)", y = "Média de peso dos juvenis (g)") +
  theme_classic() +
  guides(size = "none", colour = guide_legend(override.aes = list(size = 4))) +
  scale_x_continuous(expand = c(0,0), limits = c(0,180), breaks = seq(0,180, by = 40)) +
  theme(axis.text.x = element_text(size =14),
        axis.title.x = element_text(size = 14),
        axis.text.y = element_text(size = 14),
        axis.title.y = element_text(size = 14),
        legend.text = element_text(size=14, face="italic"),
        legend.title.align = 0,
        legend.title = element_text(size = 16, face = "bold")
        )
dispersion_wgt
Warning: Removed 3 rows containing missing values (`geom_point()`).

Plotando boxplot com gêneros no eixo horizontal

str(roedores_subset_gender)
tibble [21 x 3] (S3: tbl_df/tbl/data.frame)
 $ Gênero : Factor w/ 9 levels "Baiomys","Chaetodipus",..: 1 2 2 2 2 3 3 3 4 5 ...
 $ meanwgt: num [1:21] 9.45 31.87 30.72 17.47 17.62 ...
 $ juvwgt : num [1:21] NA 19 24 10 11.7 ...
range(roedores_subset_gender$meanwgt)
[1]   7.899749 162.534774
range(roedores_subset_gender$juvwgt, na.rm = TRUE)
[1]  5.866667 83.752212
boxplot_meanwgt <- ggplot(data = roedores_subset_gender, aes(x = Gênero, y = meanwgt, fill = Gênero)) + 
  geom_boxplot() +
  labs(y = "Média de peso dos adultos (g)") +
  theme_classic() +
  theme(legend.text = element_text(size=14, face="italic"),
        legend.position = c(0.7, 0.6),
        legend.title = element_text(size = 14, face = "bold"),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank(),
        axis.text.y = element_text(size = 14),
        axis.title.y = element_text(size = 14))
boxplot_meanwgt

boxplot_juvwgt <- ggplot(data = roedores_subset_gender, aes(x = Gênero, y = juvwgt, fill = Gênero)) + 
  geom_boxplot() +
  labs(y = "Média de peso dos juvenis (g)") +
  theme_classic() +
  theme(legend.text = element_text(size=14, face="italic"),
        legend.position = c(0.7, 0.6),
        legend.title = element_text(size = 14, face = "bold"),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank(),
        axis.text.y = element_text(size = 14),
        axis.title.y = element_text(size = 14))
boxplot_juvwgt
Warning: Removed 3 rows containing non-finite values (`stat_boxplot()`).

Plotando os quatro gráficos de uma vez só

dispersion_wgt2 <- ggplot(data = roedores_subset_gender, aes(x = meanwgt, y = juvwgt,
                                          color = Gênero, size = 2)) +
  geom_point() +
  labs(x = "Média de peso dos adultos (g)", y = "Média de peso dos juvenis (g)") +
  theme_classic() +
  guides(size = "none", colour = guide_legend(override.aes = list(size=8))) +
  theme(axis.text.x = element_text(size = 16),
        axis.title.x = element_text(size = 16),
        axis.text.y = element_text(size = 16),
        axis.title.y = element_text(size = 16),
        legend.text = element_text(size = 16, face="italic"),
        legend.title.align = 0,
        legend.title = element_text(size = 16, face = "bold"))
dispersion_wgt2
Warning: Removed 3 rows containing missing values (`geom_point()`).

boxplot_meanwgt2 <- ggplot(data = roedores_subset_gender, aes(x = reorder(Gênero, + meanwgt), y = meanwgt, fill = Gênero)) + 
  geom_boxplot(na.rm = TRUE) +
  labs(y = "Média de peso dos adultos (g)") +
  theme_classic() +
  theme(legend.position = "none",
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank(),
        axis.text.y = element_text(size = 16),
        axis.title.y = element_text(size = 16))
boxplot_meanwgt2

boxplot_juvwgt2 <- ggplot(data = roedores_subset_gender, aes(x = reorder(Gênero, + juvwgt), y = juvwgt, fill = Gênero)) + 
  geom_boxplot(na.rm = TRUE) +
  labs(y = "Média de peso dos juvenis (g)") +
  theme_classic() +
  theme(legend.position = "none",
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.title.x = element_blank(),
        axis.text.y = element_text(size = 16),
        axis.title.y = element_text(size = 16))

grid.arrange(dispersion_wgt2, arrangeGrob(boxplot_meanwgt2, boxplot_juvwgt2, ncol=2), nrow = 2)
Warning: Removed 3 rows containing missing values (`geom_point()`).

Agora vamos fazer um gráfico de barras agrupado

roedores_subset_gender_final <- roedores_subset_gender %>%
  pivot_longer(2:3, names_to = "age", values_to = "peso") 
str(roedores_subset_gender_final)
tibble [42 x 3] (S3: tbl_df/tbl/data.frame)
 $ Gênero: Factor w/ 9 levels "Baiomys","Chaetodipus",..: 1 1 2 2 2 2 2 2 2 2 ...
 $ age   : chr [1:42] "meanwgt" "juvwgt" "meanwgt" "juvwgt" ...
 $ peso  : num [1:42] 9.45 NA 31.87 19 30.72 ...
roedores_subset_gender_final$age <- as.factor(roedores_subset_gender_final$age)
str(roedores_subset_gender_final)
tibble [42 x 3] (S3: tbl_df/tbl/data.frame)
 $ Gênero: Factor w/ 9 levels "Baiomys","Chaetodipus",..: 1 1 2 2 2 2 2 2 2 2 ...
 $ age   : Factor w/ 2 levels "juvwgt","meanwgt": 2 1 2 1 2 1 2 1 2 1 ...
 $ peso  : num [1:42] 9.45 NA 31.87 19 30.72 ...
head(roedores_subset_gender_final)
# A tibble: 6 x 3
  Gênero      age      peso
  <fct>       <fct>   <dbl>
1 Baiomys     meanwgt  9.45
2 Baiomys     juvwgt  NA   
3 Chaetodipus meanwgt 31.9 
4 Chaetodipus juvwgt  19.0 
5 Chaetodipus meanwgt 30.7 
6 Chaetodipus juvwgt  24   
ggplot(roedores_subset_gender_final, aes(y = peso, x = reorder(Gênero, -peso), fill = age)) + 
  geom_bar(position="dodge", stat="identity", na.rm = TRUE) +
  labs(y = "Média de peso dos indivíduos (g)") +
  scale_fill_rickandmorty(name = "Grupo etário", labels = c("Juvenis", "Adultos")) +
  theme_classic() +
  theme(axis.text.x = element_text(size = 16, face = "italic"),
        axis.title.x = element_blank(),
        axis.text.y = element_text(size = 18),
        axis.title.y = element_text(size = 24),
        legend.text = element_text(size=24),
        legend.title = element_text(size = 24, face = "bold"),
        legend.position = c(0.7, 0.6))

Resolução opção 8 - Numbats

Como o avistamento de Numbats na Austrália evoluiu historicamente?

# Baixando o conjunto de dados manualmente a partir do GitHub

numbats <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2023/2023-03-07/numbats.csv')
str(numbats)
spc_tbl_ [805 x 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ decimalLatitude : num [1:805] -37.6 -35.1 -35 -34.7 -34.6 ...
 $ decimalLongitude: num [1:805] 146 150 118 118 117 ...
 $ eventDate       : POSIXct[1:805], format: NA "2014-06-05 02:00:00" ...
 $ scientificName  : chr [1:805] "Myrmecobius fasciatus" "Myrmecobius fasciatus" "Myrmecobius fasciatus" "Myrmecobius fasciatus" ...
 $ taxonConceptID  : chr [1:805] "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" ...
 $ recordID        : chr [1:805] "73830609-3d94-461f-a833-01c0a30c5a0d" "13287c0e-034d-4f05-908b-d3b60c90813d" "1041c2af-7e1f-4344-b79c-9c04aa3a55b5" "c9804b7a-de92-42db-8912-632dc37baa38" ...
 $ dataResourceName: chr [1:805] "Queen Victoria Museum Art Gallery provider for OZCAM" "ALA species sightings and OzAtlas" "Western Australian Museum provider for OZCAM" "Western Australian Museum provider for OZCAM" ...
 $ year            : num [1:805] NA 2014 NA NA NA ...
 $ month           : chr [1:805] NA "Jun" NA NA ...
 $ wday            : chr [1:805] NA "Thu" NA NA ...
 $ hour            : num [1:805] NA 2 NA NA NA NA NA NA NA NA ...
 $ day             : Date[1:805], format: NA "2014-06-05" ...
 $ dryandra        : logi [1:805] FALSE FALSE FALSE FALSE FALSE FALSE ...
 $ prcp            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 $ tmax            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 $ tmin            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 - attr(*, "spec")=
  .. cols(
  ..   decimalLatitude = col_double(),
  ..   decimalLongitude = col_double(),
  ..   eventDate = col_datetime(format = ""),
  ..   scientificName = col_character(),
  ..   taxonConceptID = col_character(),
  ..   recordID = col_character(),
  ..   dataResourceName = col_character(),
  ..   year = col_double(),
  ..   month = col_character(),
  ..   wday = col_character(),
  ..   hour = col_double(),
  ..   day = col_date(format = ""),
  ..   dryandra = col_logical(),
  ..   prcp = col_double(),
  ..   tmax = col_double(),
  ..   tmin = col_double()
  .. )
 - attr(*, "problems")=<externalptr> 
# Transformando variável "year" em fator
numbats$year <- as.factor(numbats$year)
str(numbats)
spc_tbl_ [805 x 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ decimalLatitude : num [1:805] -37.6 -35.1 -35 -34.7 -34.6 ...
 $ decimalLongitude: num [1:805] 146 150 118 118 117 ...
 $ eventDate       : POSIXct[1:805], format: NA "2014-06-05 02:00:00" ...
 $ scientificName  : chr [1:805] "Myrmecobius fasciatus" "Myrmecobius fasciatus" "Myrmecobius fasciatus" "Myrmecobius fasciatus" ...
 $ taxonConceptID  : chr [1:805] "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" ...
 $ recordID        : chr [1:805] "73830609-3d94-461f-a833-01c0a30c5a0d" "13287c0e-034d-4f05-908b-d3b60c90813d" "1041c2af-7e1f-4344-b79c-9c04aa3a55b5" "c9804b7a-de92-42db-8912-632dc37baa38" ...
 $ dataResourceName: chr [1:805] "Queen Victoria Museum Art Gallery provider for OZCAM" "ALA species sightings and OzAtlas" "Western Australian Museum provider for OZCAM" "Western Australian Museum provider for OZCAM" ...
 $ year            : Factor w/ 25 levels "1856","1902",..: NA 16 NA NA NA NA NA NA NA NA ...
 $ month           : chr [1:805] NA "Jun" NA NA ...
 $ wday            : chr [1:805] NA "Thu" NA NA ...
 $ hour            : num [1:805] NA 2 NA NA NA NA NA NA NA NA ...
 $ day             : Date[1:805], format: NA "2014-06-05" ...
 $ dryandra        : logi [1:805] FALSE FALSE FALSE FALSE FALSE FALSE ...
 $ prcp            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 $ tmax            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 $ tmin            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 - attr(*, "spec")=
  .. cols(
  ..   decimalLatitude = col_double(),
  ..   decimalLongitude = col_double(),
  ..   eventDate = col_datetime(format = ""),
  ..   scientificName = col_character(),
  ..   taxonConceptID = col_character(),
  ..   recordID = col_character(),
  ..   dataResourceName = col_character(),
  ..   year = col_double(),
  ..   month = col_character(),
  ..   wday = col_character(),
  ..   hour = col_double(),
  ..   day = col_date(format = ""),
  ..   dryandra = col_logical(),
  ..   prcp = col_double(),
  ..   tmax = col_double(),
  ..   tmin = col_double()
  .. )
 - attr(*, "problems")=<externalptr> 
# Calculando frequência de cada ano e transformando essa informação em um data.frame
years_numbats <- as.data.frame(table(numbats$year))
head(years_numbats)
  Var1 Freq
1 1856    2
2 1902    1
3 1906    1
4 1954    1
5 1968    4
6 1969    3
str(years_numbats)
'data.frame':   25 obs. of  2 variables:
 $ Var1: Factor w/ 25 levels "1856","1902",..: 1 2 3 4 5 6 7 8 9 10 ...
 $ Freq: int  2 1 1 1 4 3 1 1 7 2 ...
# Arrumando o novo data.frame
years_numbats$Ano <- years_numbats$Var1
years_numbats <- select(years_numbats, -Var1)
years_numbats$Freq <- as.numeric(years_numbats$Freq)
str(years_numbats)
'data.frame':   25 obs. of  2 variables:
 $ Freq: num  2 1 1 1 4 3 1 1 7 2 ...
 $ Ano : Factor w/ 25 levels "1856","1902",..: 1 2 3 4 5 6 7 8 9 10 ...
mean(years_numbats$Freq)
[1] 22.08
# Gerando o gráfico
numbats_plot <- ggplot(years_numbats) +
    geom_line(aes(x = Ano, y = Freq, group = 1), colour = "black") +
    geom_point(aes(x = Ano, y = Freq), shape=21, color="black", fill="#69b3a2", size=4) +
    theme_classic() +
    ylim(0, 120) +
    labs(y = "Número de observações por ano") +
    annotate(geom = "text", x = "2014", y = 120, 
             label = "Em 2014 tivemos um pico na observação de Numbats na Austrália", size = 5, color = "red") +
    annotate(geom = "point", x= "2014", y = 113, size = 10, shape = 21, fill = "transparent", color="red") +
    theme(axis.text.x = element_text(size = 10),
          axis.title.x = element_blank(),
          axis.text.y = element_text(size = 10),
          axis.title.y = element_text(size = 14)
          )

# Plotando
numbats_plot

Agora vamos visualizar a quantidade de observações de acordo com os dias da semana e horário

numbats$wday <- as.factor(numbats$wday)
str(numbats)
spc_tbl_ [805 x 16] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ decimalLatitude : num [1:805] -37.6 -35.1 -35 -34.7 -34.6 ...
 $ decimalLongitude: num [1:805] 146 150 118 118 117 ...
 $ eventDate       : POSIXct[1:805], format: NA "2014-06-05 02:00:00" ...
 $ scientificName  : chr [1:805] "Myrmecobius fasciatus" "Myrmecobius fasciatus" "Myrmecobius fasciatus" "Myrmecobius fasciatus" ...
 $ taxonConceptID  : chr [1:805] "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" "https://biodiversity.org.au/afd/taxa/6c72d199-f0f1-44d3-8197-224a2f7cff5f" ...
 $ recordID        : chr [1:805] "73830609-3d94-461f-a833-01c0a30c5a0d" "13287c0e-034d-4f05-908b-d3b60c90813d" "1041c2af-7e1f-4344-b79c-9c04aa3a55b5" "c9804b7a-de92-42db-8912-632dc37baa38" ...
 $ dataResourceName: chr [1:805] "Queen Victoria Museum Art Gallery provider for OZCAM" "ALA species sightings and OzAtlas" "Western Australian Museum provider for OZCAM" "Western Australian Museum provider for OZCAM" ...
 $ year            : Factor w/ 25 levels "1856","1902",..: NA 16 NA NA NA NA NA NA NA NA ...
 $ month           : chr [1:805] NA "Jun" NA NA ...
 $ wday            : Factor w/ 7 levels "Fri","Mon","Sat",..: NA 5 NA NA NA NA NA NA NA NA ...
 $ hour            : num [1:805] NA 2 NA NA NA NA NA NA NA NA ...
 $ day             : Date[1:805], format: NA "2014-06-05" ...
 $ dryandra        : logi [1:805] FALSE FALSE FALSE FALSE FALSE FALSE ...
 $ prcp            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 $ tmax            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 $ tmin            : num [1:805] NA NA NA NA NA NA NA NA NA NA ...
 - attr(*, "spec")=
  .. cols(
  ..   decimalLatitude = col_double(),
  ..   decimalLongitude = col_double(),
  ..   eventDate = col_datetime(format = ""),
  ..   scientificName = col_character(),
  ..   taxonConceptID = col_character(),
  ..   recordID = col_character(),
  ..   dataResourceName = col_character(),
  ..   year = col_double(),
  ..   month = col_character(),
  ..   wday = col_character(),
  ..   hour = col_double(),
  ..   day = col_date(format = ""),
  ..   dryandra = col_logical(),
  ..   prcp = col_double(),
  ..   tmax = col_double(),
  ..   tmin = col_double()
  .. )
 - attr(*, "problems")=<externalptr> 
# Calculando frequência de observações de acordo com dia e horário e transformando essa informação em um data.frame

library(plyr)
counts <- ddply(numbats, .(numbats$wday, numbats$hour), nrow)
head(counts)
  numbats$wday numbats$hour V1
1          Fri            1  1
2          Fri            3  1
3          Fri            5  1
4          Fri            6  3
5          Fri           13 59
6          Fri           14  6
names(counts) <- c("WeekDay", "Hour", "Freq")
counts$Freq <- as.numeric(counts$Freq)
str(counts)
'data.frame':   64 obs. of  3 variables:
 $ WeekDay: Factor w/ 7 levels "Fri","Mon","Sat",..: 1 1 1 1 1 1 1 2 2 2 ...
 $ Hour   : num  1 3 5 6 13 14 20 0 5 6 ...
 $ Freq   : num  1 1 1 3 59 6 1 1 1 2 ...
# Reordenando dias da semana de forma mais lógica
levels(counts$WeekDay)
[1] "Fri" "Mon" "Sat" "Sun" "Thu" "Tue" "Wed"
counts$WeekDay <- ordered(counts$WeekDay, levels = c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"))
counts <- slice(counts, 1:63) # removendo a última linha, que não nos interessava

# Criando um tema mais amigável
theme_heatmap <- theme_classic() +               # Tema com fundo branco
  theme(panel.grid = element_blank(),            # remove as linhas de grade
        panel.border = element_blank(),          # remove as bordas ao redor do heatmap
        plot.title = element_text(face = "bold", # título em negrito
                                  size = 14,     # tamanho da fonte
                                  hjust = 0.5),  # centraliza o título
        axis.ticks = element_blank(),            # remove os tickmarks dos eixos
        axis.title.x = element_blank(),          # retira o título do eixo X
        axis.title.y = element_text(size = 12),  # ajusta o tamanho do título do eixo Y
        axis.text.y = element_text(size = 10),   # ajusta o tamanho do texto do eixo Y
        axis.text.x = element_text(size = 10),   # ajusta o tamanho do texto do eixo X
        legend.position = "none")                # retira a legenda

# Carregando biblioteca com paletas de cores dos filmes do Wes Anderson
library(wesanderson)
my_palette <- wes_palette("Moonrise3", type = "continuous")

# Criando o gráfico
gg <- ggplot(counts, mapping = aes(x = WeekDay, y = Hour, fill = Freq, na.rm = TRUE)) +
  geom_tile(colour="white") +  # Isso cria o heatmap ("colour" é o argumento que determina a cor das linhas)
  scale_fill_gradientn(colours = my_palette) +  # Espectro de cores a ser utilizado
  scale_y_reverse(breaks=c(24:0), labels=c(24:0),    # Colocando 0 no topo do eixo Y
                  expand = c(0,0)) +                 # Removendo o preenchimento ao redor do mapa de calor
  scale_x_discrete(expand = c(0,0), position = "top") +
  labs(title = "Número de observações de numbats em relação ao horário e dia da semana", y = "Horário") +
  theme_heatmap  # tema definido anteriormente

# Plotando o gráfico
print(gg)