FPCC2 - Laboratório 2 p2 - Correlação em estimativas e tempo
Ítalo Pereira de Brito.
25/04/2022
climas = read_csv(here::here("data/clima_cg_jp-semanal.csv"),
col_types = "cTdddddd")
glimpse(climas)## Rows: 2,748
## Columns: 8
## $ cidade <chr> "Campina Grande", "Campina Grande", "Campina Grande", "Campina ~
## $ semana <dttm> 1992-12-27, 1993-01-03, 1993-01-10, 1993-01-31, 1993-02-07, 19~
## $ tmedia <dbl> 26.13333, 26.11905, 25.76667, 25.74000, 26.31429, 26.28571, 26.~
## $ tmax <dbl> 30.4, 32.4, 32.2, 32.0, 32.7, 32.7, 32.3, 32.3, 32.1, 31.2, 32.~
## $ tmin <dbl> 20.7, 19.3, 19.7, 19.9, 19.6, 20.0, 20.4, 21.2, 19.0, 19.0, 19.~
## $ chuva <dbl> 0.0, 0.0, 0.0, 0.4, 0.3, 0.0, 4.9, 0.0, 0.0, 6.1, 0.4, 1.2, 0.0~
## $ mes <dbl> 12, 1, 1, 1, 2, 2, 2, 2, 10, 11, 11, 11, 11, 12, 12, 12, 12, 1,~
## $ ano <dbl> 1992, 1993, 1993, 1993, 1993, 1993, 1993, 1993, 1993, 1993, 199~Questões
1 - Descreva a relação entre a temperatura de uma semana e a temperatura da semana passada nas 2 cidades.
Acrescentando uma nova coluna chamada de “temp_anterior” que conterá o valor TMAX da semana anterior.
data_q_1 <- climas %>% mutate(temp_anterior = lag(tmedia, n = 1))
data_q_1## # A tibble: 2,748 x 9
## cidade semana tmedia tmax tmin chuva mes ano temp_anterior
## <chr> <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Campi~ 1992-12-27 00:00:00 26.1 30.4 20.7 0 12 1992 NA
## 2 Campi~ 1993-01-03 00:00:00 26.1 32.4 19.3 0 1 1993 26.1
## 3 Campi~ 1993-01-10 00:00:00 25.8 32.2 19.7 0 1 1993 26.1
## 4 Campi~ 1993-01-31 00:00:00 25.7 32 19.9 0.4 1 1993 25.8
## 5 Campi~ 1993-02-07 00:00:00 26.3 32.7 19.6 0.3 2 1993 25.7
## 6 Campi~ 1993-02-14 00:00:00 26.3 32.7 20 0 2 1993 26.3
## 7 Campi~ 1993-02-21 00:00:00 26.5 32.3 20.4 4.9 2 1993 26.3
## 8 Campi~ 1993-02-28 00:00:00 26.6 32.3 21.2 0 2 1993 26.5
## 9 Campi~ 1993-10-31 00:00:00 25.8 32.1 19 0 10 1993 26.6
## 10 Campi~ 1993-11-07 00:00:00 25.2 31.2 19 6.1 11 1993 25.8
## # ... with 2,738 more rowsA colunua temp_anterior, na primeira linha, recebeu NA devido não ter um valor de referência anterior a ele.
Vamos verificar o gráfico de dispersão entre a relação da temperatura média da semana e
a temperatura média da semana anterior a ela.
data_q_1 %>%
filter(!is.na(temp_anterior)) %>%
ggplot(aes(tmedia, temp_anterior, color=cidade)) +
geom_jitter(size=1.5, alpha=.1, color='darkblue') +
geom_smooth(method = "lm", se = F, ) +
facet_wrap(~cidade, ncol=1) +
labs(title="Gráfico 1\nRelação entre a temperatura da semana e da \nsemana anterior", x="\nTemperatura Média Corrente (ºC)", y="Temperatura Média Anterior(ºC)\n", color="Cidades") + theme(plot.title=element_text(hjust=0.5), plot.subtitle=element_text(hjust=0.5), text=element_text(size=16))## `geom_smooth()` using formula 'y ~ x'
Olhando para o gráfico 1, da para perceber uma correlação linear positiva entre as variáveis “TMEDIA” e “TEMP_ANTERIOR”.
A seguir a correlação entre as variáveis temp_anterior e tmedia.
data_q_1 %>%
filter(!is.na(temp_anterior)) %>%
group_by(cidade) %>%
summarise(pearson=cor(tmedia, temp_anterior, method='pearson'),
spearman=cor(tmedia, temp_anterior, method='spearman'),
kendall=cor(tmedia, temp_anterior, method='kendall'))## # A tibble: 2 x 4
## cidade pearson spearman kendall
## <chr> <dbl> <dbl> <dbl>
## 1 Campina Grande 0.880 0.856 0.669
## 2 João Pessoa 0.859 0.860 0.683A seguir o gráfico de dispersão(Scatterplot) da correlação.
size1=3
alpha1=.2
data_q_1 %>%
filter(!is.na(temp_anterior)) %>%
group_by(cidade) %>%
summarise(pearson=cor(tmedia, temp_anterior, method='pearson'),
spearman=cor(tmedia, temp_anterior, method='spearman'),
kendall=cor(tmedia, temp_anterior, method='kendall')) %>%
ggplot(aes(y=cidade)) +
geom_point(aes(pearson, color='violet'), size=size1, alpha=alpha1) +
geom_point(aes(spearman, color='orange'), size=size1, alpha=alpha1) +
geom_point(aes(kendall, color='blue'), size=size1, alpha=alpha1) +
scale_x_continuous(breaks=seq(-1,0,1), limits=c(-1,1)) +
scale_colour_manual(name='Correlações',
values=c('violet'='violet','orange'='orange','blue'='blue'),
labels=c('Pearson','Spearman','Kendall')) +
labs(title="Gráfico 2\nCorrelação entre Temperatura média \nda Semana e da Semana anterior", x="\nCorrelação", y="Cidade\n") +
theme(plot.title=element_text(hjust=0.5), plot.subtitle=element_text(hjust=0.5), text=element_text(size=14))
A tabela e o gráfico 2 mostram uma forte correlação positiva para os métodos de pearson e spearman, e para kendall, correlação moderada. Embora isso não signifique uma causalidade, a correlação positiva indica uma possível relação diretamente proporcional entre as duas variáveis.
2 - Descreva a relação entre temperatura e chuvas nas semanas em que choveu nas 2 cidades.
Pré-processamento dos dados para identificar período em que chuveu nas cidades de Campina Grande e João Pessoa.
# Filtrando período chuvoso
periodo_chuvoso_cg <- data_q_1 %>% filter(cidade=="Campina Grande", chuva > 0)
periodo_chuvoso_jp <- data_q_1 %>% filter(cidade=="João Pessoa", chuva > 0)
# Selecionando a intersecção do período chuvoso entre as cidades de cg e jp.
chuva_em_cg_e_jp <- inner_join(periodo_chuvoso_jp, periodo_chuvoso_cg, by = "semana", suffix=c('.jp', '.cg'))
# Seperando os dados.
chuva_em_jp_interscao_periodo <- chuva_em_cg_e_jp %>% select(cidade.jp, semana, tmax.jp, tmedia.jp, tmin.jp,chuva.jp, mes.jp,ano.jp, temp_anterior.jp)
chuva_em_cg_interscao_periodo <- chuva_em_cg_e_jp %>% select(cidade.cg, semana, tmax.cg, tmedia.cg, tmin.cg, chuva.cg, mes.cg, ano.cg, temp_anterior.cg)
# Renomenado colunas
chuva_em_jp_interscao_periodo <- rename(chuva_em_jp_interscao_periodo, c("cidade"="cidade.jp", "semana" = "semana","tmax"="tmax.jp","tmedia"="tmedia.jp", "tmin"="tmin.jp","chuva"="chuva.jp","mes"="mes.jp","ano"="ano.jp","temp_anterior"="temp_anterior.jp"))
chuva_em_cg_interscao_periodo <- rename(chuva_em_cg_interscao_periodo, c("cidade"="cidade.cg", "semana" = "semana","tmax"="tmax.cg","tmedia"="tmedia.cg", "tmin"="tmin.cg","chuva"="chuva.cg","mes"="mes.cg","ano"="ano.cg","temp_anterior"="temp_anterior.cg"))
# Unindo os dados
periodo_que_chuveu_em_cg_e_jp <- chuva_em_jp_interscao_periodo %>% bind_rows(chuva_em_cg_interscao_periodo)
periodo_que_chuveu_em_cg_e_jp## # A tibble: 1,920 x 9
## cidade semana tmax tmedia tmin chuva mes ano temp_anterior
## <chr> <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 João ~ 1993-01-31 00:00:00 30.6 27.4 23.6 3.6 1 1993 28.1
## 2 João ~ 1993-02-07 00:00:00 30.8 28.1 22.8 0.4 2 1993 27.4
## 3 João ~ 1993-11-07 00:00:00 31 27.8 25 9.2 11 1993 28.1
## 4 João ~ 1993-11-14 00:00:00 30.3 27.9 25.2 0.4 11 1993 27.8
## 5 João ~ 1993-11-21 00:00:00 30.4 27.9 24 14.2 11 1993 27.9
## 6 João ~ 1993-12-05 00:00:00 31.2 28.2 25.4 0.5 12 1993 28.0
## 7 João ~ 1993-12-19 00:00:00 31 28.6 23.1 8.9 12 1993 28.2
## 8 João ~ 1993-12-26 00:00:00 31.2 28.5 24.4 6.8 12 1993 28.6
## 9 João ~ 1994-01-02 00:00:00 31 28.2 23.8 36.3 1 1994 28.5
## 10 João ~ 1994-01-09 00:00:00 30.8 28.2 23.2 7.1 1 1994 28.2
## # ... with 1,910 more rowsAgora temos a interseção temporal onde ocorreu pancadas de chuva em campina grande e joão pessoa.
Vamos analisar a dispersão dos dados.
periodo_que_chuveu_em_cg_e_jp %>%
ggplot(aes(y=tmedia, chuva, color=cidade)) +
geom_rug() +
facet_wrap(~cidade, ncol=2) +
geom_smooth(method = "lm", se = F, ) +
geom_point(size=1.5, alpha=.1) +
labs(title="Gráfico 3\nRelação entre Temperatura Média\ne Chuva nas Cidades\n", y="Temperatura Média (ºC)\n", x="\nChuva (mm)", color="Cidade") +
theme(plot.title=element_text(hjust=0.5), plot.subtitle=element_text(hjust=0.5), text=element_text(size=13))## `geom_smooth()` using formula 'y ~ x'
O gráfico 3 mostra uma correlação negativa entre a temperatura média e vol. chuva para as duas cidades, ou seja, existe uma tendência para temperatura média mais baixa em períodos com volume de chuva maior.
A seguir a correlação entre as variáveis temp_anterior e chuva
periodo_que_chuveu_em_cg_e_jp %>%
group_by(cidade) %>%
summarise(pearson=cor(tmedia, chuva, method='pearson'),
spearman=cor(tmedia, chuva, method='spearman'),
kendall=cor(tmedia, chuva, method='kendall'))## # A tibble: 2 x 4
## cidade pearson spearman kendall
## <chr> <dbl> <dbl> <dbl>
## 1 Campina Grande -0.331 -0.443 -0.301
## 2 João Pessoa -0.419 -0.456 -0.309Vemos uma correlação negativa fraca ou moderada/fraca entre as TMEDIA e CHUVA nas cidades de jp e cg.
A seguir o gráfico de distribuição do volume de chuvas em relação ao aumento de temperatura.
periodo_que_chuveu_em_cg_e_jp %>%
ggplot(aes(chuva, tmedia)) +
geom_boxplot(color='black') +
facet_wrap(~cidade, ncol=2) +
geom_jitter(color='brown', height=.2, size=2, alpha=.1) +
scale_y_discrete(labels=wrap_format(1)) +
labs(title="Gráfico 4\nDistribuição do Volume de Chuva", x="\nVolume de chuva (mm)", y="Temp. média (ºC)\n") +
theme(plot.title=element_text(hjust=0.5), plot.subtitle=element_text(hjust=0.5), text=element_text(size=16))## Warning: Continuous y aesthetic -- did you forget aes(group=...)?
De acordo com os dados explorados, em 75% das semanas que chovem em Jp, o volume de chuva fica abaixo de aproximadamente 52mm, no entanto temos alguns valores maiores chegando até prox. de 300mm. Enquanto que Cg em 75% das semanas que chovem, possuem chuvas com volume inferior a 25mm, ou seja, uma diferença de quase o dobro em relação a Jp.
Bonus - Compare a relação que você encontrou na 1a questão com a relação entre a temperatura de uma semana e a de 8 semanas antes e com a de 1 ano (52 semanas) antes.
Acrescentando uma nova coluna chamada de “temp_anterior”, “temp_anterior_8”, “temp_anterior_1_ano”
data_q_1 <- climas %>% mutate(temp_anterior= lag(tmedia, n = 1), temp_anterior_8 = lag(tmedia, n = 8), temp_anterior_1_ano = lag(tmedia, n = 52))
data_q_1## # A tibble: 2,748 x 11
## cidade semana tmedia tmax tmin chuva mes ano temp_anterior
## <chr> <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Campi~ 1992-12-27 00:00:00 26.1 30.4 20.7 0 12 1992 NA
## 2 Campi~ 1993-01-03 00:00:00 26.1 32.4 19.3 0 1 1993 26.1
## 3 Campi~ 1993-01-10 00:00:00 25.8 32.2 19.7 0 1 1993 26.1
## 4 Campi~ 1993-01-31 00:00:00 25.7 32 19.9 0.4 1 1993 25.8
## 5 Campi~ 1993-02-07 00:00:00 26.3 32.7 19.6 0.3 2 1993 25.7
## 6 Campi~ 1993-02-14 00:00:00 26.3 32.7 20 0 2 1993 26.3
## 7 Campi~ 1993-02-21 00:00:00 26.5 32.3 20.4 4.9 2 1993 26.3
## 8 Campi~ 1993-02-28 00:00:00 26.6 32.3 21.2 0 2 1993 26.5
## 9 Campi~ 1993-10-31 00:00:00 25.8 32.1 19 0 10 1993 26.6
## 10 Campi~ 1993-11-07 00:00:00 25.2 31.2 19 6.1 11 1993 25.8
## # ... with 2,738 more rows, and 2 more variables: temp_anterior_8 <dbl>,
## # temp_anterior_1_ano <dbl>data_q_1 %>%
filter(!is.na(temp_anterior_1_ano)) %>%
ggplot(aes(x=tmedia, y=temp_anterior_1_ano)) +
geom_jitter(size=1.5, alpha=.1, color='darkblue') +
geom_smooth(method = "lm", se = F, ) +
facet_wrap(~cidade, ncol=1) +
labs(title="Gráfico 5\n 1 ano atrás", x="\nTemperatura Média Corrente (ºC)", y="Temperatura Média 1 ano antes(ºC)\n", color="Cidades") + theme(plot.title=element_text(hjust=0.5), plot.subtitle=element_text(hjust=0.5), text=element_text(size=16))## `geom_smooth()` using formula 'y ~ x'
data_q_1 %>%
filter(!is.na(temp_anterior_8)) %>%
ggplot(aes(x=tmedia, y=temp_anterior_8)) +
geom_jitter(size=1.5, alpha=.1, color='darkblue') +
geom_smooth(method = "lm", se = F, ) +
facet_wrap(~cidade, ncol=1) +
labs(title="Gráfico 6\n8 semanas atrás", x="\nTemperatura Média Corrente (ºC)", y="Temperatura Média 8 semanas antes(ºC)\n", color="Cidades") + theme(plot.title=element_text(hjust=0.5), plot.subtitle=element_text(hjust=0.5), text=element_text(size=16))## `geom_smooth()` using formula 'y ~ x'
data_q_1 %>%
filter(!is.na(temp_anterior)) %>%
ggplot(aes(x=tmedia, y=temp_anterior)) +
geom_jitter(size=1.5, alpha=.1, color='darkblue') +
geom_smooth(method = "lm", se = F, ) +
facet_wrap(~cidade, ncol=1) +
labs(title="Gráfico 7\n1 semanas atrás", x="\nTemperatura Média Corrente (ºC)", y="Temperatura Média 1 semana atrás(ºC)\n", color="Cidades") + theme(plot.title=element_text(hjust=0.5), plot.subtitle=element_text(hjust=0.5), text=element_text(size=16))## `geom_smooth()` using formula 'y ~ x'
data_q_1 %>%
filter(!is.na(temp_anterior_1_ano)) %>%
group_by(cidade) %>%
summarise(pearson=cor(tmedia, temp_anterior_1_ano, method='pearson'),
spearman=cor(tmedia, temp_anterior_1_ano, method='spearman'),
kendall=cor(tmedia, temp_anterior_1_ano, method='kendall'))## # A tibble: 2 x 4
## cidade pearson spearman kendall
## <chr> <dbl> <dbl> <dbl>
## 1 Campina Grande 0.669 0.626 0.445
## 2 João Pessoa 0.627 0.678 0.499data_q_1 %>%
filter(!is.na(temp_anterior_8)) %>%
group_by(cidade) %>%
summarise(pearson=cor(tmedia, temp_anterior_8, method='pearson'),
spearman=cor(tmedia, temp_anterior_8, method='spearman'),
kendall=cor(tmedia, temp_anterior_8, method='kendall'))## # A tibble: 2 x 4
## cidade pearson spearman kendall
## <chr> <dbl> <dbl> <dbl>
## 1 Campina Grande 0.422 0.422 0.281
## 2 João Pessoa 0.383 0.411 0.286data_q_1 %>%
filter(!is.na(temp_anterior)) %>%
group_by(cidade) %>%
summarise(pearson=cor(tmedia, temp_anterior, method='pearson'),
spearman=cor(tmedia, temp_anterior, method='spearman'),
kendall=cor(tmedia, temp_anterior, method='kendall'))## # A tibble: 2 x 4
## cidade pearson spearman kendall
## <chr> <dbl> <dbl> <dbl>
## 1 Campina Grande 0.880 0.856 0.669
## 2 João Pessoa 0.859 0.860 0.683