Exploracão dos dados do Twitter (17/03/2020 a 26/03/2020)
Tarssio
3/26/2020
1 Contexto
São analisados, a seguir, cerca de 650 mil tuítes referentes as seguintes palavras chaves: “corona”, “coronavirus”, “covid19”, “covid”, “cloroquina” e “quarentena”.
Neste breve documento, busca-se analisar a distribuição acumulada do instante da primeira publicação dos usuários dadas as palavras chaves supracitadas. Metodologia encontrada no artigo: “The COVID-19 Social Media Infodemic” (Cinelli et al., 2020).
2 Distribuiçoes e determinação da taxa de crescimento da “infodemia”:
2.1 Distribuição para todos as publicações obtidas pela API:
tbl_acc <- tbl_ajuste %>%
distinct(screen_name, .keep_all = TRUE) %>%
group_by(time) %>%
summarise(n = n()) %>%
mutate(n = cumsum(n)) %>%
mutate(t = as.numeric((time - min(time))/3600)+ 1)
tbl_acc %>%
ggplot(aes(x = t, y = n)) +
geom_line() +
labs(x = "Tempo em horas a partir do dia 17/03/2020",
y = "Quantidade de novos perfis") +
theme_minimal()
Um parâmetro importante ao se analisar a “infodemia” diz respeito ao \(R_o\) que se refere a possibilidade de observação deste fenomeno.
Obs: Podemos comparar estas taxas com a da propagação dos casos registrados no país.
A fim de obter o parâmetro \(R_o\) será utilizada a seguinte equação:
\[ I = [\frac{R_o}{(1+d)^t}]^t \]
Onde: I: representa a distribuição acumulada de usuários publicando pela primeira vez até determinado horário; t: representa o tempo; d é um termo que leva em conta o amortecimento da transmissão da informação ao longo do tempo.
exp_ <- function(t, R, d){
(R/((1+d)^t))^t
}
aux <- nls2(n ~ exp_(t, R, d), data = tbl_acc, start = list(R = 1000, d = 0.05),
trace = F,
control = nls.control(maxiter = 1000, minFactor=2^-12))
Ro <- summary(aux)[["coefficients"]][1,1]
d <- summary(aux)[["coefficients"]][1,2]
p1 <- tbl_acc %>%
mutate(stat = predict(aux,tbl_acc)) %>%
ggplot() +
geom_line(aes(x = t, y = n, col = "black")) +
geom_line(aes(x = t, y = stat, col = "red")) +
ggplot2::annotate("text", label = paste0("Ro =", "", round(Ro,3)),
x = 60, y = 0.7*max(tbl_acc$n)) +
scale_color_manual(values = c("black", "red"),
labels = c("Observado", "Modelado")) +
labs(col = "", title = "Ajuste exponencial para todas publicações coletadas") +
theme_bw()
p1
2.2 Distribuição para publicacões únicas, excluindo retweets, obtidas pela API:
tbl_acc <- tbl_ajuste %>%
filter(is_retweet == FALSE) %>%
distinct(screen_name, .keep_all = TRUE) %>%
group_by(time) %>%
summarise(n = n()) %>%
mutate(n = cumsum(n)) %>%
mutate(t = as.numeric((time - min(time))/3600)+ 1)
tbl_acc %>%
ggplot(aes(x = t, y = n)) +
geom_line() +
labs(x = "Tempo em horas a partir do dia 17/03/2020",
y = "Quantidade de novos perfis") +
theme_minimal()
Os números totais para publicações, excluindo os retweets, são significativamente menores. Porém, observa-se o mesmo comportamento que ao se contemplar todas informações, porém com uma taxa inferior.
aux <- nls2(n ~ exp_(t, R, d), data = tbl_acc, start = list(R = 100, d = 0.05),
trace = F,
control = nls.control(maxiter = 1000, minFactor=2^-12))
Ro <- summary(aux)[["coefficients"]][1,1]
d <- summary(aux)[["coefficients"]][1,2]
p2 <- tbl_acc %>%
mutate(stat = predict(aux,tbl_acc)) %>%
ggplot() +
geom_line(aes(x = t, y = n, col = "black")) +
geom_line(aes(x = t, y = stat, col = "red")) +
ggplot2::annotate("text", label = paste0("Ro =", "", round(Ro,3)),
x = 60, y = 0.7*max(tbl_acc$n)) +
scale_color_manual(values = c("black", "red"),
labels = c("Observado", "Modelado")) +
labs(col = "", title = "Ajuste exponencial excluindo republicações") +
theme_bw()
p2
2.3 Comparando as duas abordagens
Percebe-se que ambos apontam para uma região bem próxima de Ro, que representa a taxa de crescimento, se diferenciando pelo retardamento do crescimento desta informação. Interessante observar, também, que a proximidade entre a taxa de crescimento encontrada tanto para a totalidade das publicações como para aquelas que não são republicações validam uma metodologia pautada apenas na última.
Sendo \(R_o\) maior que 1, observa-se que o aparecimento de novos usuários publicando sobre o tema em destaque ainda é crescente. Uma sugestão é esperar mais uma semana e ver qual o comportamento nesta semana.
Além disto, estes valores podem estar contaminados por perfis falsos, desinformações e fake news. Por isto, também, é necessário que planejemos uma estratégia para classificar em informação e desinformações e entender a taxa de crescimento de ambas.
3 Testando algumas redes:
3.1 Ajustes Iniciais (ver code):
# Filtrando apenas não replicações
word_ajuste <- tbl_ajuste %>%
filter(is_retweet == FALSE)
text <- word_ajuste$text %>%
tolower() %>%
as.tibble() %>%
mutate(value = stri_trans_general(value, "Latin-ASCII"))## Warning: `as.tibble()` is deprecated, use `as_tibble()` (but mind the new semantics).
## This warning is displayed once per session.# Removendo palavras de não interesse
nowords <- c("sei", "to", "sobre", "ja", "ta", "vai", "nao", "📈", "🤦♀",
"tendo", "poucos", "obg", "desses", "tudo", 'vdd', "
mil", "so", "pra", "tudo", "n", "q", "vou", "ter", "pq", "tds",
"+", "la", "fez", "vcs", "pro", "etc", "nada", "oq",
"voce", "ver", "vc", 'ficar', "toda")
# Centro das redes:
word <- c("@minsaude", "@who", "@UN", "@ABRASCO",
"@lhmandetta", "@anvisa_oficial")
# Função de ajuste dos usuários ligados aos usuários acima:
# toks_news <- tokens(text$value, remove_punct = TRUE)
#
# toks_news <- tokens_select(toks_news, pattern = stopwords('pt'),
# selection = 'remove')
#
# toks_news <- tokens_select(toks_news, pattern = nowords,
# selection = 'remove')
load(file = "token.RData")
f_chi2 <- function(x) {
toks_keep <- tokens_keep(toks_news, pattern = word[x], window = 50)
toks_nokeep <- tokens_remove(toks_news, pattern = word[x], window = 50)
# dfm
dfmat_keep <- dfm(toks_keep)
dfmat_nokeep <- dfm(toks_nokeep)
# t-test
tstat_key_keep <- textstat_keyness(rbind(dfmat_keep, dfmat_nokeep),
seq_len(ndoc(dfmat_keep)))
tstat_key_keep_subset <- tstat_key_keep[tstat_key_keep$n_target > 1, ]
aux <- tstat_key_keep_subset %>%
filter(str_detect(feature, "@")) %>%
head(15) %>%
mutate(id = word[x])
}3.2 Grafo:
data_graph <- 1:length(word) %>%
map(f_chi2)
df <- data_graph %>% {
tibble(
feature = unlist(map(., "feature")),
id = unlist(map(., "id")),
chi2 = unlist(map(., "chi2")),
n_ref = unlist(map(., "n_target"))
)}
# mutate edges and nodes
grafico_pal <- df %>%
mutate(type = id) %>%
as_tbl_graph() %>%
ggraph("kk") +
geom_edge_link(aes(col = type), show.legend = FALSE) +
geom_node_point(color = "black", fill = "white", size = 4) +
geom_node_text(aes(label = name), repel = TRUE,
size= 4, color="black") +
theme_void()
grafico_pal
Agora é preciso entender o padrão destes twitters. Vou gerar um txt com os perfís, é importante (se quisermos estudar estas interações) que tracemos uma estratégia para entender o que este cenário da rede significa, uma vez que há muitos anônimos entre os perfis.
Algumas outras observações:
1 - Fifa e who: https://nacoesunidas.org/fifa-e-oms-se-unem-para-combater-o-coronavirus/
2 - Antonio Guterres: https://valor.globo.com/mundo/noticia/2020/03/26/nao-estamos-ganhando-a-guerra-contra-o-virus-diz-secretario-da-onu.ghtml
3 - Dr Tedros: https://www.who.int/antimicrobial-resistance/interagency-coordination-group/dg_who_bio/en/
Mas ao chegar no Brasil, tem todo tipo de perfil.
4 Primeiro Ajuste:
4.1 Passando para escala diária:
4.1.1 Contando todas publicaçoes captadas pela API:
tbl_ajuste <- tbl %>%
mutate(time = lubridate::ymd_hms(created_at, tz = "America/Bahia")) %>%
mutate(time = lubridate::round_date(created_at, unit = "day")) %>%
select(-created_at)
tbl_acc <- tbl_ajuste %>%
distinct(screen_name, .keep_all = TRUE) %>%
group_by(time) %>%
summarise(n = n()) %>%
mutate(n = cumsum(n)) %>%
mutate(t = as.numeric((time - min(time))/(3600*24))+ 1)
tbl_acc %>%
ggplot(aes(x = t, y = n)) +
geom_line() +
labs(x = "Tempo em dias a partir do dia 17/03/2020",
y = "Quantidade de novos perfis") +
theme_minimal()
4.1.1.1 Determinando Ro
exp_ <- function(t, R, d){
(R/((1+d)^t))^t
}
aux <- nls2(n ~ exp_(t, R, d), data = tbl_acc, start = list(R = 1000, d = 0.05),
trace = F,
control = nls.control(maxiter = 5000, minFactor=2^-12))
Ro <- summary(aux)[["coefficients"]][1,1]
d <- summary(aux)[["coefficients"]][1,2]
p4 <- tbl_acc %>%
mutate(stat = predict(aux,tbl_acc)) %>%
ggplot() +
geom_line(aes(x = t, y = n, col = "black")) +
geom_line(aes(x = t, y = stat, col = "red")) +
ggplot2::annotate("text", label = paste0("Ro =", "", round(Ro,3)),
x = 3, y = 0.7*max(tbl_acc$n)) +
scale_color_manual(values = c("black", "red"),
labels = c("Observado", "Modelado")) +
labs(col = "", title = "Ajuste exponencial para todas publicações coletadas") +
theme_bw()
p4
4.1.2 Para publicações únicas:
tbl_ajuste <- tbl %>%
mutate(time = lubridate::ymd_hms(created_at, tz = "America/Bahia")) %>%
mutate(time = lubridate::round_date(created_at, unit = "day")) %>%
select(-created_at)
tbl_acc <- tbl_ajuste %>%
filter(is_retweet == FALSE) %>%
distinct(screen_name, .keep_all = TRUE) %>%
group_by(time) %>%
summarise(n = n()) %>%
mutate(n = cumsum(n)) %>%
mutate(t = as.numeric((time - min(time))/(3600*24))+ 1)
tbl_acc %>%
ggplot(aes(x = t, y = n)) +
geom_line() +
labs(x = "Tempo em horas a partir do dia 17/03/2020",
y = "Quantidade de novos perfis") +
theme_minimal()
4.1.2.1 Determinado o Ro
exp_ <- function(t, R, d){
(R/((1+d)^t))^t
}
aux <- nls2(n ~ exp_(t, R, d), data = tbl_acc, start = list(R = 1000, d = 0.05),
trace = F,
control = nls.control(maxiter = 5000, minFactor=2^-12))
Ro <- summary(aux)[["coefficients"]][1,1]
d <- summary(aux)[["coefficients"]][1,2]
p5 <- tbl_acc %>%
mutate(stat = predict(aux,tbl_acc)) %>%
ggplot() +
geom_line(aes(x = t, y = n, col = "black")) +
geom_line(aes(x = t, y = stat, col = "red")) +
ggplot2::annotate("text", label = paste0("Ro =", "", round(Ro,3)),
x = 3, y = 0.7*max(tbl_acc$n)) +
scale_color_manual(values = c("black", "red"),
labels = c("Observado", "Modelado")) +
labs(col = "", title = "Ajuste exponencial para todas publicações coletadas") +
theme_bw()
p5
Os valores de Ro se tornam bastante diferentes quando utilizamos esta escala, atigindo valores de alta magnitude como 50 e 14 para, respectivamente, todas publicações captadas pela API e apenas publicações unicas.
É interessante que, apesar de solicitar 1 milhão de publicações, divididas em 5 palavras chaves, recebemos 650 mil, porém as publicações estão entre os dias 22 e 26.