A disseminação do COVID-19 pela visualização de países com R

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br


[Esteartigofoipublicadopelaprimeiravezem[Thisarticlewasfirstpublishedon Linguagem R – AnalyzeCore por Sergey Bryl & # 039; – dados são bonitos, dados são uma história, e gentilmente contribuiu para os R-blogueiros]. (Você pode relatar um problema sobre o conteúdo desta página aqui)


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.

A pandemia de COVID-19 ou Coronavírus tem um efeito grande e imprevisível em nossas vidas. Eu queria ver a velocidade e a propagação do vírus pelos países. E o seguinte é o que e como eu vi:

A pandemia de COVID-19 ou Coronavírus tem um efeito grande e imprevisível em nossas vidas. Eu queria ver a velocidade e a propagação do vírus pelos países. E o seguinte é o que e como eu vi:

A visualização animada concentra-se na cronologia da distribuição de vírus que começou na China e se espalhou globalmente. Para fortalecer o efeito visual, coloquei os países (top 90 de todos) do meio para baixo e top com base na data em que cada país enfrentava o máximo de casos diários da doença (grade vermelha escura).

Para uma análise mais detalhada, criei dois gráficos estacionários. O primeiro é o mesmo que o animado, mas os países são ordenados de baixo para cima.

disseminação do COVID-19 entre países

O segundo centrou-se em um dia de casos máximos e mostra quanto tempo e intensidade foram períodos anteriores e seguintes. É uma oportunidade de comparar como os diferentes países foram eficazes.

Comparação da eficácia de diferentes países em relação ao COVID-19Todos os valores de novos casos de cada país foram normalizados via normalização mín / máx e variaram de 0 a 1. A seguir está o código R com comentários que você pode usar para brincar com o conjunto de dados público:

clique para expandir o código R

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br
library(tidyverse)
library(reshape2)
library(purrrlyr)

# download dataset
df <- read_csv(url('https://covid.ourworldindata.org/data/ecdc/full_data.csv'))

# normalization function
fun_normalize <- function(x) {
        return ((x - min(x)) / (max(x) - min(x)))
}

# preprocess data
df_prep %
        filter(location != 'World') %>%
        
        group_by(location) %>%
        # remove earlier dates
        filter(date > as.Date('2020-01-15', format = '%Y-%m-%d')) %>%
        # remove coutries with less than 1000 total cases
        filter(max(total_cases) > 1000) %>%
        # replace negative values with the mean 
        mutate(new_cases = ifelse(new_cases %
        ungroup() %>%
        select(location, date, new_cases) %>%
        # prepare data for normalization
        dcast(., date ~ location, value.var = 'new_cases') %>%
        # replace NAs with 0
        dmap_at(c(2:ncol(.)), function(x) ifelse(is.na(x), 0, x)) %>%
        # normalization
        dmap_at(c(2:ncol(.)), function(x) fun_normalize(x)) %>%
        melt(., id.vars = c('date'), variable.name = 'country') %>%
        mutate(value = round(value, 6))

        
# define countries order for plots
country_ord_1 %
        group_by(country) %>%
        filter(value == 1) %>%
        ungroup() %>%
        arrange(date, country) %>%
        distinct(country) %>%
        mutate(is_odd = ifelse((row_number() - 1) %% 2 == 0, TRUE, FALSE))

country_ord_anim %
                                      filter(is_odd == TRUE) %>%
                                      arrange(desc(row_number())),
                              country_ord_1 %>%
                                      filter(is_odd == FALSE))
        
# data for animated plot
df_plot_anim %
        mutate(country = factor(country, levels = c(as.character(country_ord_anim$country)))) %>%
        group_by(country) %>%
        mutate(first_date = min(date[value >= 0.03])) %>%
        mutate(cust_label = ifelse(date >= first_date, as.character(country), '')) %>%
        ungroup()


# color palette
cols <- c('#e7f0fa','#c9e2f6', '#95cbee', '#0099dc', '#4ab04a', '#ffd73e', '#eec73a', '#e29421', '#e29421', '#f05336', '#ce472e')


# Animated Heatmap plot
p <- ggplot(df_plot_anim, aes(y = country, x = date, fill = value)) +
        theme_minimal() +
        geom_tile(color = 'white', width = .9, height = .9) +
        scale_fill_gradientn(colours = cols, limits = c(0, 1),
                             breaks = c(0, 1),
                             labels = c('0', 'max'),
                             guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
        
        geom_text(aes(x = first_date, label = cust_label), size = 3, color = '#797D7F') +
        scale_y_discrete(position = 'right') +
        coord_equal() +
        
        theme(legend.position = 'bottom',
              legend.direction = 'horizontal',
              plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
              axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
              axis.text.y = element_blank(),
              axis.title.y = element_blank(),
              panel.grid.major = element_blank(),
              panel.grid.minor = element_blank()
              ) +
        ggtitle('The spread of COVID-19 across countries: new daily cases normalized to location maximum')


# animated chart
library(gganimate)
library(gifski)

anim <- p + 
        transition_components(date) +
        ggtitle('The spread of COVID-19 across countries: new daily cases normalized to location maximum',
                subtitle = 'Date {frame_time}') +
        shadow_mark()

animate(anim,
        nframes = as.numeric(difftime(max(df_plot_anim$date), min(df_plot_anim$date), units = 'days')) + 1,
        duration = 12,
        fps = 12,
        width = 1000,
        height = 840,
        start_pause = 5,
        end_pause = 25,
        renderer = gifski_renderer())
anim_save('covid-19.gif')



# Heatmap plot 1
df_plot_1 %
        mutate(country = factor(country, levels = c(as.character(country_ord_1$country)))) %>%
        group_by(country) %>%
        mutate(first_date = min(date[value >= 0.03])) %>%
        ungroup()

ggplot(df_plot_1, aes(y = country, x = date, fill = value)) +
        theme_minimal() +
        geom_tile(color = 'white', width = .9, height = .9) +
        scale_fill_gradientn(colours = cols, limits = c(0, 1),
                             breaks = c(0, 1),
                             labels = c('0', 'max'),
                             guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
        
        geom_text(aes(x = first_date, label = country), size = 3, color = '#797D7F') +
        scale_y_discrete(position = 'right') +
        coord_equal() +
        
        theme(legend.position = 'bottom',
              legend.direction = 'horizontal',
              plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
              axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
              axis.text.y = element_text(size = 6, hjust = .5, vjust = .5, face = 'plain'),
              panel.grid.major = element_blank(),
              panel.grid.minor = element_blank()
        ) +
        ggtitle('The spread of COVID-19 across countries: new daily cases normalized to location maximum')


# Heatmap plot 2
df_plot_2 %
        group_by(country) %>%
        filter(date >= min(date[value > 0])) %>%
        arrange(date, .by_group = TRUE) %>%
        mutate(centr_day = min(row_number()[value == 1]),
               n_day = row_number() - centr_day) %>%
        ungroup()

country_ord_2 %
        group_by(country) %>%
        filter(date >= min(date[value == 1])) %>%
        summarise(value = sum(value)) %>%
        ungroup() %>%
        arrange(value, country) %>%
        distinct(country)

df_plot_2 %
        mutate(country = factor(country, levels = c(as.character(country_ord_2$country)))) %>%
        group_by(country) %>%
        mutate(first_date = min(n_day[value >= 0.01])) %>%
        ungroup()



# Heatmap plot 2
ggplot(df_plot_2, aes(y = country, x = n_day, fill = value)) +
        theme_minimal() +
        geom_tile(color = 'white', width = .9, height = .9) +
        scale_fill_gradientn(colours = cols, limits = c(0, 1),
                             breaks = c(0, 1),
                             labels = c('0', 'max'),
                             guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10)) +
        
        geom_text(aes(x = first_date, label = country), size = 3, color = '#797D7F') +
        coord_equal() +
        
        theme(legend.position = 'bottom',
              legend.direction = 'horizontal',
              plot.title = element_text(size = 20, face = 'bold', vjust = 2, hjust = 0.5),
              axis.text.x = element_text(size = 8, hjust = .5, vjust = .5, face = 'plain'),
              #axis.text.y = element_text(size = 6, hjust = .5, vjust = .5, face = 'plain'),
              axis.text.y = element_blank(),
              axis.title.y = element_blank(),
              panel.grid.major = element_blank(),
              panel.grid.minor = element_blank()
        ) +
        ggtitle('Comparison of different countries effectiveness against COVID-19 
                (new daily cases normalized to location maximum and data centered on a day with maximum new cases)')

O post A disseminação do COVID-19 na visualização de países com R apareceu pela primeira vez no AnalyzeCore por Sergey Bryl & # 039; - dados são bonitos, dados são uma história.

var vglnk = {key: '949efb41171ac6ec1bf7f206d57e90b8'};

(função (d, t) {
var s = d.createElement
s.src = '//cdn.viglink.com/api/vglnk.js';
var r = d.getElementsByTagName
} (documento, 'script'));

Para Deixe um comentário para o autor, siga o link e comente no blog: Linguagem R - AnalyzeCore por Sergey Bryl & # 039; - dados são bonitos, dados são uma história.

R-bloggers.com oferece atualizações diárias por email sobre notícias e tutoriais do R sobre o aprendizado do R e muitos outros tópicos. Clique aqui se você deseja publicar ou encontrar um emprego em ciência da dados / R.


Deseja compartilhar seu conteúdo com R-blogueiros? clique aqui se você tiver um blog ou aqui se não tiver.



cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br
Leia Também  Forter Nomeado Líder em Prevenção de Fraudes no Comércio Eletrônico no Relatório Radar Frost & Sullivan 2020