Data is from the Johns Hopkins Data Set, until March 16, 2020

library(tidyverse)

## ── Attaching packages ────────────────────────────────── tidyverse 1.3.0 ──

## ✔ ggplot2 3.2.1     ✔ dplyr   0.8.3
## ✔ tibble  2.1.3     ✔ stringr 1.4.0
## ✔ tidyr   1.0.0     ✔ forcats 0.4.0
## ✔ purrr   0.3.3

## ── Conflicts ───────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following object is masked from 'package:base':
## 
##     date

data_confirmed <- confirmed %>%
  select(-c(`Province/State`, Lat, Long)) %>%
  rename(Country = `Country/Region`) %>%
  group_by(Country) %>%
  summarize_at(vars(-group_cols()), sum, na.rm = TRUE) %>%
  pivot_longer(-Country, names_to = "Date", values_to = "Confirmed")

data_deaths <- deaths %>%
  select(-c(`Province/State`, Lat, Long)) %>%
  rename(Country = `Country/Region`) %>%
  group_by(Country) %>%
  summarize_at(vars(-group_cols()), sum, na.rm = TRUE) %>%
  pivot_longer(-Country, names_to = "Date", values_to = "Deaths")

data_recovered <- recovered %>%
  select(-c(`Province/State`, Lat, Long)) %>%
  rename(Country = `Country/Region`) %>%
  group_by(Country) %>%
  summarize_at(vars(-group_cols()), sum, na.rm = TRUE) %>%
  pivot_longer(-Country, names_to = "Date", values_to = "Recovered")

data_recovered$Date<-as.Date(data_recovered$Date,format = "%m/%d/%y")

data_deaths$Date<-as.Date(data_deaths$Date,format = "%m/%d/%y")

data_confirmed$Date<-as.Date(data_confirmed$Date,format = "%m/%d/%y")

Estimating Mortality Rates

Try Deaths/Deaths+Recovered ## China

China_proportion[length(China_proportion)]

## [1] 4.522896

The rate in China is 4.522896%.

South Korea

#S Korea
Korea_confirmed <- filter(data_confirmed, Country=="Korea, South")
Korea_deaths <- filter(data_deaths, Country=="Korea, South")
Korea_recovered <- filter(data_recovered, Country=="Korea, South")
plot(Korea_confirmed$Confirmed~Korea_confirmed$Date, col="red",
     main = "Korea Confirmed Cases (Red), Deaths (Blue), Recovered (Green)",
     xlab= "Time", ylab = "Count", type = "o")
points(Korea_deaths$Deaths~Korea_deaths$Date, col="blue", type = "o")
points(Korea_recovered$Recovered~Korea_recovered$Date, col="green", type = "o")

Korea_proportion <- Korea_deaths$Deaths/(Korea_deaths$Deaths+Korea_recovered$Recovered)*100
plot(Korea_proportion~Korea_deaths$Date, col="red",
     main = "Korea Deaths/Deaths+Recovered",
     xlab= "Time", ylab = "Percentage", type = "o")

Korea_proportion[length(Korea_proportion)]

## [1] 6.188119

The rate in Korea is 6.18819%

Italy

#Italy 
Italy_confirmed <- filter(data_confirmed, Country=="Italy")
Italy_deaths <- filter(data_deaths, Country=="Italy")
Italy_recovered <- filter(data_recovered, Country=="Italy")
plot(Italy_confirmed$Confirmed~Italy_confirmed$Date, col="red",
     main = "Italy Confirmed Cases (Red), Deaths (Blue), Recovered (Green)",
     xlab= "Time", ylab = "Count", type = "o")
points(Italy_deaths$Deaths~Italy_deaths$Date, col="blue", type = "o")
points(Italy_recovered$Recovered~Italy_recovered$Date, col="green", type = "o")

Italy_proportion <- Italy_deaths$Deaths/(Italy_deaths$Deaths+Italy_recovered$Recovered)*100
plot(Italy_proportion~Italy_deaths$Date, col="red",
     main = "Italy Deaths/Deaths+Recovered",
     xlab= "Time", ylab = "Percentage", type = "o")

Italy_proportion[length(Italy_proportion)]

## [1] 43.97799

The rate in Italy is 43.97799%.

Spain

Spain_confirmed <- filter(data_confirmed, Country=="Spain")
Spain_deaths <- filter(data_deaths, Country=="Spain")
Spain_recovered <- filter(data_recovered, Country=="Spain")
plot(Spain_confirmed$Confirmed~Spain_confirmed$Date, col="red",
     main = "Spain Confirmed Cases (Red), Deaths (Blue), Recovered (Green)",
     xlab= "Time", ylab = "Count", type = "o")
points(Spain_deaths$Deaths~Spain_deaths$Date, col="blue", type = "o")
points(Spain_recovered$Recovered~Spain_recovered$Date, col="green", type = "o")

Spain_proportion <- Spain_deaths$Deaths/(Spain_deaths$Deaths+Spain_recovered$Recovered)*100
plot(Spain_proportion~Spain_deaths$Date, col="red",
     main = "Spain Deaths/Deaths+Recovered",
     xlab= "Time", ylab = "Percentage", type = "o")

Spain_proportion[length(Spain_proportion)]

## [1] 39.22018

The rate in Spain is 39.22018%

France

France_confirmed <- filter(data_confirmed, Country=="France")
France_deaths <- filter(data_deaths, Country=="France")
France_recovered <- filter(data_recovered, Country=="France")
plot(France_confirmed$Confirmed~Spain_confirmed$Date, col="red",
     main = "France Confirmed Cases (Red), Deaths (Blue), Recovered (Green)",
     xlab= "Time", ylab = "Count", type = "o")
points(France_deaths$Deaths~France_deaths$Date, col="blue", type = "o")
points(France_recovered$Recovered~France_recovered$Date, col="green", type = "o")

France_proportion <- France_deaths$Deaths/(France_deaths$Deaths+France_recovered$Recovered)*100
plot(France_proportion~France_deaths$Date, col="red",
     main = "France Deaths/Deaths+Recovered",
     xlab= "Time", ylab = "Percentage", type = "o")

France_proportion[length(France_proportion)]

## [1] 92.5

All in one graph

plot(China_proportion~China_deaths$Date, col="red",
     main = "Deaths/Deaths+Recovered",
     xlab= "Time", ylab = "Percentage", type = "o")
points(Italy_proportion~Italy_deaths$Date, col="green", type ="o")
points(Korea_proportion~Korea_deaths$Date, col="orange", type ="o")
points(Spain_proportion~Spain_deaths$Date, col="blue", type ="o")
legend("bottomleft", legend=c("China", "Italy", "South Korea", "Spain"),
       col=c("red", "green", "orange", "blue"),lty=1:1, cex=0.8)

WorldWide

worldwide_confirmed <- colSums(confirmed[,5:length(confirmed)])
worldwide_deaths <- colSums(deaths[,5:length(deaths)])
worldwide_recovered <- colSums(recovered[,5:length(recovered)])

worldwide_deaths<-worldwide_deaths[5:length(worldwide_deaths)]

WW_proportion <- worldwide_deaths/(worldwide_deaths+worldwide_recovered)*100

## Warning in worldwide_deaths + worldwide_recovered: longer object length is
## not a multiple of shorter object length

## Warning in worldwide_deaths/(worldwide_deaths + worldwide_recovered):
## longer object length is not a multiple of shorter object length

dates <- as.Date(colnames(recovered),format = "%m/%d/%y")
plot(WW_proportion~dates[5:length(dates)], col="red",
     main = "Worldwide Deaths/Deaths+Recovered",
     xlab= "Time", ylab = "Percentage", type = "o")

WW_proportion[length(WW_proportion)]

##   3/16/20 
## 0.1700311

COVID-19

Joshua Paik