# Please share and comment if you find this work useful.
# Done and published also in LinkedIn @Eralda Gjika Dhamo
# Faculty of Natural Science, University of Tirana, Albania
# Time series graphical analyse in R
# Email: eralda.dhamo@fshn.edu.al
#
# These functions are used and help you in graphical presentation oftime series and also dataframe
#
#
# Packages necessary to work with graphics presentation and import dataset
library(readxl)
library(httr)
#create the URL where the dataset is stored with automatic updates every day
url <- paste("https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-",format(Sys.time(), "%Y-%m-%d"), ".xlsx", sep = "")
#download the dataset from the website to a local temporary file
GET(url, authenticate(":", ":", type="ntlm"), write_disk(tf <- tempfile(fileext = ".xlsx")))
## Response [https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-2020-04-19.xlsx]
## Date: 2020-04-19 15:07
## Status: 200
## Content-Type: application/vnd.openxmlformats-officedocument.spreadsheetml.sheet
## Size: 510 kB
## <ON DISK> C:\Users\CRS\AppData\Local\Temp\RtmpI7Nh7r\file7e01f812ea8.xlsx
#read the Dataset sheet into "R"
COVID_19<- read_excel(tf)# save the dataset to work with
# Graphic Packages
library(ggplot2)
library(gganimate)
library(quantmod)
## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
## Loading required package: TTR
## Version 0.4-0 included new data defaults. See ?getSymbols.
library(directlabels)
library(hrbrthemes)
## NOTE: Either Arial Narrow or Roboto Condensed fonts are required to use these themes.
## Please use hrbrthemes::import_roboto_condensed() to install Roboto Condensed and
## if Arial Narrow is not on your system, please see http://bit.ly/arialnarrow
library(viridis)
## Loading required package: viridisLite
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:xts':
##
## first, last
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(dbplyr)
##
## Attaching package: 'dbplyr'
## The following objects are masked from 'package:dplyr':
##
## ident, sql
library(gifski)
library(corrplot)
## corrplot 0.84 loaded
library(RColorBrewer)
devtools::install_github('thomasp85/gganimate')
## Skipping install of 'gganimate' from a github remote, the SHA1 (c5665eca) has not changed since last install.
## Use `force = TRUE` to force installation
#
# Graphic 1
# Situation of new cases in some of the EU countries
lista<-c("Italy", "Spain", "France","Switzerland","Germany","United_Kingdom")
europa.1<-filter(COVID_19,COVID_19$countriesAndTerritories %in% lista)
europa.1
## # A tibble: 666 x 10
## dateRep day month year cases deaths countriesAndTer~
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 2020-04-19 00:00:00 19 4 2020 2569 642 France
## 2 2020-04-18 00:00:00 18 4 2020 405 761 France
## 3 2020-04-17 00:00:00 17 4 2020 2641 753 France
## 4 2020-04-16 00:00:00 16 4 2020 2633 1438 France
## 5 2020-04-15 00:00:00 15 4 2020 5497 762 France
## 6 2020-04-14 00:00:00 14 4 2020 2673 574 France
## 7 2020-04-13 00:00:00 13 4 2020 1613 561 France
## 8 2020-04-12 00:00:00 12 4 2020 3114 635 France
## 9 2020-04-11 00:00:00 11 4 2020 4342 987 France
## 10 2020-04-10 00:00:00 10 4 2020 4286 1341 France
## # ... with 656 more rows, and 3 more variables: geoId <chr>,
## # countryterritoryCode <chr>, popData2018 <dbl>
p.01<-ggplot(europa.1,
aes(europa.1$dateRep,europa.1$cases, group=europa.1$countriesAndTerritories, color=factor(europa.1$countriesAndTerritories))
) +
geom_line(lwd=1) +
geom_point() +
xlab("Date")+
ylab("New cases") +
scale_color_brewer(palette="Dark2") +
ggtitle("Evolution by day period, 31 Dec-19 April") +
geom_dl(aes(label =europa.1$countriesAndTerritories), method = list(dl.trans(x = x - 1.2), "last.points"))+
theme(legend.position="top")
p.01

# Graphic 2
# Graphicpresentation for each continent
p.01 + facet_wrap(~europa.1$countriesAndTerritories)

# Graphic 3
# Dynamic graph showing the evolution of new cases
p.01 + transition_reveal(europa.1$dateRep)

# Graphic 4
# Situation and evolution of new cases in some of the western Balkan countries
lista.1<-c("Albania", "Kosovo", "Greece","North_Macedonia","Montenegro","Serbia","Bosnia_Herzegovina")
europa.2<-filter(COVID_19,COVID_19$countriesAndTerritories %in% lista.1)
europa.2
## # A tibble: 362 x 10
## dateRep day month year cases deaths countriesAndTer~
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 2020-04-19 00:00:00 19 4 2020 9 0 Albania
## 2 2020-04-18 00:00:00 18 4 2020 21 0 Albania
## 3 2020-04-17 00:00:00 17 4 2020 24 1 Albania
## 4 2020-04-16 00:00:00 16 4 2020 19 1 Albania
## 5 2020-04-15 00:00:00 15 4 2020 8 1 Albania
## 6 2020-04-14 00:00:00 14 4 2020 21 0 Albania
## 7 2020-04-13 00:00:00 13 4 2020 13 0 Albania
## 8 2020-04-12 00:00:00 12 4 2020 17 0 Albania
## 9 2020-04-11 00:00:00 11 4 2020 7 0 Albania
## 10 2020-04-10 00:00:00 10 4 2020 9 1 Albania
## # ... with 352 more rows, and 3 more variables: geoId <chr>,
## # countryterritoryCode <chr>, popData2018 <dbl>
p.02<-ggplot(europa.2,
aes(europa.2$dateRep,europa.2$cases, group=europa.2$countriesAndTerritories, color=factor(europa.2$countriesAndTerritories))
) +
geom_line(lwd=1) +
geom_point() +
xlab("Date")+
ylab("New cases") +
scale_color_brewer(palette="Dark2") +
ggtitle("Evolution by day period, 31 Dec-19 April") +
geom_dl(aes(label =europa.2$countriesAndTerritories), method = list(dl.trans(x = x - 1.2), "last.points"))+
theme(legend.position="top")
p.02

#..
# Graphic 4.1
# Situation and evolution of deaths in some of the western Balkan countries
lista.1<-c("Albania", "Kosovo", "Greece","North_Macedonia","Montenegro","Serbia","Bosnia_Herzegovina")
europa.2<-filter(COVID_19,COVID_19$countriesAndTerritories %in% lista.1)
europa.2
## # A tibble: 362 x 10
## dateRep day month year cases deaths countriesAndTer~
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 2020-04-19 00:00:00 19 4 2020 9 0 Albania
## 2 2020-04-18 00:00:00 18 4 2020 21 0 Albania
## 3 2020-04-17 00:00:00 17 4 2020 24 1 Albania
## 4 2020-04-16 00:00:00 16 4 2020 19 1 Albania
## 5 2020-04-15 00:00:00 15 4 2020 8 1 Albania
## 6 2020-04-14 00:00:00 14 4 2020 21 0 Albania
## 7 2020-04-13 00:00:00 13 4 2020 13 0 Albania
## 8 2020-04-12 00:00:00 12 4 2020 17 0 Albania
## 9 2020-04-11 00:00:00 11 4 2020 7 0 Albania
## 10 2020-04-10 00:00:00 10 4 2020 9 1 Albania
## # ... with 352 more rows, and 3 more variables: geoId <chr>,
## # countryterritoryCode <chr>, popData2018 <dbl>
p.02<-ggplot(europa.2,
aes(europa.2$dateRep,europa.2$deaths, group=europa.2$countriesAndTerritories, color=factor(europa.2$countriesAndTerritories))
) +
geom_line(lwd=1) +
geom_point() +
xlab("Date")+
ylab("Deaths") +
scale_color_brewer(palette="Dark2") +
ggtitle("Evolution by day period, 31 Dec-19 April") +
geom_dl(aes(label =europa.2$countriesAndTerritories), method = list(dl.trans(x = x - 1.2), "last.points"))+
theme(legend.position="top")
p.02

#
# Graphic 4.2
# Graphic presentation for each continent
p.02 + facet_wrap(~europa.2$countriesAndTerritories)

# Graphic 4.3
# Dynamic graph showing the evolution of new cases
p.02 + transition_reveal(europa.2$dateRep)

#
# Graphic 5
# Daily deaths in some of the EU
lista<-c("Italy", "Spain", "France","Switzerland","Germany","United_Kingdom")
europa.1<-filter(COVID_19,COVID_19$countriesAndTerritories %in% lista)
europa.1
## # A tibble: 666 x 10
## dateRep day month year cases deaths countriesAndTer~
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 2020-04-19 00:00:00 19 4 2020 2569 642 France
## 2 2020-04-18 00:00:00 18 4 2020 405 761 France
## 3 2020-04-17 00:00:00 17 4 2020 2641 753 France
## 4 2020-04-16 00:00:00 16 4 2020 2633 1438 France
## 5 2020-04-15 00:00:00 15 4 2020 5497 762 France
## 6 2020-04-14 00:00:00 14 4 2020 2673 574 France
## 7 2020-04-13 00:00:00 13 4 2020 1613 561 France
## 8 2020-04-12 00:00:00 12 4 2020 3114 635 France
## 9 2020-04-11 00:00:00 11 4 2020 4342 987 France
## 10 2020-04-10 00:00:00 10 4 2020 4286 1341 France
## # ... with 656 more rows, and 3 more variables: geoId <chr>,
## # countryterritoryCode <chr>, popData2018 <dbl>
p.03<-ggplot(europa.1,
aes(europa.1$dateRep,europa.1$deaths, group=europa.1$countriesAndTerritories, color=factor(europa.1$countriesAndTerritories))
) +
geom_line(lwd=1) +
geom_point() +
xlab("Date")+
ylab("Deaths by day") +
scale_color_brewer(palette="Dark2") +
ggtitle("Evolution by day period, 31 Dec-14 April") +
geom_dl(aes(label =europa.1$countriesAndTerritories), method = list(dl.trans(x = x - 1.2), "last.points"))+
theme(legend.position="top")
p.03

# Graphic 6
# Graphic for daily deaths by continent
p.03 + facet_wrap(~europa.1$countriesAndTerritories)

# Graphic 7
# Dynamic graph
p.03 + transition_reveal(europa.1$dateRep)

#
# Graphic 8
# Daily deaths in some of the world countries
lista.4<-c("Italy", "Spain", "France","China","Iran","Canada","Germany","United_Kingdom","United_States_of_America")
world<-filter(COVID_19,COVID_19$countriesAndTerritories %in% lista.4)
world
## # A tibble: 999 x 10
## dateRep day month year cases deaths countriesAndTer~
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 2020-04-19 00:00:00 19 4 2020 1469 158 Canada
## 2 2020-04-18 00:00:00 18 4 2020 1791 116 Canada
## 3 2020-04-17 00:00:00 17 4 2020 1717 183 Canada
## 4 2020-04-16 00:00:00 16 4 2020 1318 107 Canada
## 5 2020-04-15 00:00:00 15 4 2020 1383 123 Canada
## 6 2020-04-14 00:00:00 14 4 2020 1298 63 Canada
## 7 2020-04-13 00:00:00 13 4 2020 1064 64 Canada
## 8 2020-04-12 00:00:00 12 4 2020 1168 84 Canada
## 9 2020-04-11 00:00:00 11 4 2020 1385 60 Canada
## 10 2020-04-10 00:00:00 10 4 2020 1474 74 Canada
## # ... with 989 more rows, and 3 more variables: geoId <chr>,
## # countryterritoryCode <chr>, popData2018 <dbl>
p.04<-ggplot(world,
aes(world$dateRep,world$deaths, group=world$countriesAndTerritories, color=factor(world$countriesAndTerritories))
) +
geom_line(lwd=1) +
geom_point() +
xlab("Date")+
ylab("Deaths by day") +
scale_color_brewer(palette="Paired") +
ggtitle("Evolution by day period, 31 Dec-19 April") +
geom_dl(aes(label =world$countriesAndTerritories), method = list(dl.trans(x = x - 1.2), "last.points"))+
theme(legend.position="top")
p.04

# Graphic 9
# Graphic for daily deaths by country
p.04 + facet_wrap(~world$countriesAndTerritories)

# Graphic 10
# Dynamic graph
p.04 + transition_reveal(world$dateRep)

#
#
# Graphic 11
# Daily cases in some of the world countries
lista.5<-c("Italy", "Spain", "France","China","Iran","Canada","Germany","United_Kingdom","United_States_of_America")
world.1<-filter(COVID_19,COVID_19$countriesAndTerritories %in% lista.5)
world.1
## # A tibble: 999 x 10
## dateRep day month year cases deaths countriesAndTer~
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 2020-04-19 00:00:00 19 4 2020 1469 158 Canada
## 2 2020-04-18 00:00:00 18 4 2020 1791 116 Canada
## 3 2020-04-17 00:00:00 17 4 2020 1717 183 Canada
## 4 2020-04-16 00:00:00 16 4 2020 1318 107 Canada
## 5 2020-04-15 00:00:00 15 4 2020 1383 123 Canada
## 6 2020-04-14 00:00:00 14 4 2020 1298 63 Canada
## 7 2020-04-13 00:00:00 13 4 2020 1064 64 Canada
## 8 2020-04-12 00:00:00 12 4 2020 1168 84 Canada
## 9 2020-04-11 00:00:00 11 4 2020 1385 60 Canada
## 10 2020-04-10 00:00:00 10 4 2020 1474 74 Canada
## # ... with 989 more rows, and 3 more variables: geoId <chr>,
## # countryterritoryCode <chr>, popData2018 <dbl>
p.05<-ggplot(world.1,
aes(world.1$dateRep,world.1$cases, group=world$countriesAndTerritories, color=factor(world$countriesAndTerritories))
) +
geom_line(lwd=1) +
geom_point() +
xlab("Date")+
ylab("New cases by day") +
scale_color_brewer(palette="Paired") +
ggtitle("Evolution by day period, 31 Dec-19 April") +
geom_dl(aes(label =world.1$countriesAndTerritories), method = list(dl.trans(x = x - 1.2), "last.points"))+
theme(legend.position="top")
p.05

# Graphic 12
# Graphic for daily deaths by country
p.05 + facet_wrap(~world.1$countriesAndTerritories)

# Graphic 13
# Dynamic graph
p.05 + transition_reveal(world.1$dateRep)

#
#
# Thanks for your comment, likes and share!
# Keep update ...
# E.Gjika (Dhamo)