---
## https://rmarkdown.rstudio.com/flexdashboard/using.html#multiple_pages
#runtime: shiny
title: "COVID-19 in Kenya"
author: "R.ic"
output:
flexdashboard::flex_dashboard:
orientation: rows
source_code: embed
vertical_layout : fill ##Specify fill to vertically re-size charts so they completely fill the page and scroll to layout charts at their natural height, scrolling the page if necessary.
---
```{r}
#--------------------Required Packages----------------------------
# we'll be using the coronavirus() package.
#The input data for this dashboard is the dataset available from the {coronavirus} R package. Make sure to download the development version of the package to have the latest data:
#install.packages("devtools")
#devtools::install_github("RamiKrispin/coronavirus")
## To get the latest stats, use the function: update_datasets()
## which will prompt you to type in n/Y to download the Dev version. A restart of the R session may also be needed to access the updated dataset
suppressPackageStartupMessages({
library(shiny)
library(tidyverse)
library(flexdashboard)
library(plotly)
library(lubridate)
library(coronavirus)
library(knitr)
library(countrycode)
library(DT)
library(rgdal)
library(viridis)
library(readxl)
library(magrittr)
library(formattable)
#library(leaflet)
#library(geojsonio)
#library(sf)
})
```
```{r}
#------------------------Slicing and dicing the data-----------
covid_set=coronavirus
#View(covid_set)
##I won't be needing the country,Lat and Long columns, for now at least.
covid_set=covid_set %>% select(-c(province,lat,long))
## we'll then be looking to widen the data, such that each incident ie Confirmed,Death and Recovered has it's own column. This will go a long way in making analysis easier.
covid_set=covid_set %>% group_by(country,date,type) %>%
summarise(total=sum(cases)) %>%
pivot_wider(names_from = type,values_from = total)%>%
# setting a column to null drops it
ungroup() %>% mutate(daily_conf=confirmed,confirmed=NULL,daily_deaths=death,death=NULL,daily_recov=recovered,recovered=NULL,daily_active=daily_conf-daily_deaths-daily_recov) %>%
group_by(country) %>% mutate(cum_conf=cumsum(daily_conf),cum_deaths=cumsum(daily_deaths),cum_recov=cumsum(daily_recov),cum_active=cum_conf-cum_deaths-cum_recov)
## I have then added a Week column to see how the cases change on a weekly bases
##?cut.Date
covid_set=covid_set %>% mutate(Week=as.Date(cut(date,breaks = "week",start.on.monday=FALSE)))
# great! Our dataset is in a desired format to permit further analysis
## My country is Kenya, so I will build the dashboard based on Kenya. Feel free to modify it.
covid_set_ke=covid_set %>% filter(country=="Kenya")
## day of first case confirmed
day=(covid_set_ke %>% ungroup() %>% filter(daily_conf>0) %>% slice(1) %>% select(date))
##
#To define a page just use a level 1 markdown header (==================).
# colors for the value boxes were obtaned from:https://material.io/design/color/the-color-system.html#tools-for-picking-colors
```
Summary
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
### Day
```{r}
day=last(covid_set$date)
valueBox(
day,
icon="far fa-calendar-plus",
color="#5C6BC0"
)
```
### Cumulative tests conducted
```{r}
library(readxl)
samples_tested <- read.csv("C:/Users/ADMIN/Desktop/Intoduction to Python for data science/R for data science/aRduino/Github stuff/covid19_ke/data/samples_tested.csv")
samples=last(samples_tested$total_samples_tested)
valueBox(
format(samples, big.mark = ","),
icon= "fas fa-vials",
color= "#ABA6BF"
)
```
### Total confirmed cases{.value-box}
```{r}
#conf=last(covid_set_ke$cum_conf)
valueBox(
value=format(last(covid_set_ke$cum_conf), big.mark = ","),
caption = paste("Total confirmed cases"),
icon = "fas fa-user-md",
color="#7B1FA2")
##",'\n','\t',"(+",last(covid_set_ke$daily_conf)," from yesterday", ")",sep = "")
```
### Total recovered cases
```{r}
recov=last(covid_set_ke$cum_recov)
recov_rate=round(100*last(covid_set_ke$cum_recov)/last(covid_set_ke$cum_conf),2)
valueBox(
cat(format(recov,big.mark = ","),"(",recov_rate,"%",")",sep=""),
icon="fas fa-heartbeat",
color="#00C853"
)
```
### Succumbed cases
```{r}
deaths=last(covid_set_ke$cum_deaths)
death_rate=round(100*last(covid_set_ke$cum_deaths)/last(covid_set_ke$cum_conf),2)
valueBox(
cat(format(deaths,big.mark = ","),"(",death_rate,"%",")",sep=""),
icon="ion-heart-half-outline",
color="#D55E00"
)
```
### Total active cases
```{r}
active=last(covid_set_ke$cum_active)
active_rate=round(100*last(covid_set_ke$cum_active)/last(covid_set_ke$cum_conf),2)
valueBox(
cat(format(active,big.mark = ","),"(",active_rate,"%",")",sep=""),
icon="fas fa-hospital",
color="#37474F"
)
#cat(recov,"(",recov_rate,"%",")",sep="")
```
Column
-----------------------------------------------------------------------
### **Total cumulative cases in: ** Kenya
```{r,fig.width=11.5, fig.height=7}
#### day of first case confirmed
day=(covid_set_ke %>% ungroup() %>% filter(daily_conf>0) %>% slice(1) %>% select(date))
theme_set(theme_light())
#?scale_color_manual
colors=c("confirmed"= "#0072B2","recovered"= "#009E73","succumbed"= "#D55E00")
fig = covid_set_ke %>% ungroup() %>% filter(date >= day$date) %>%
plot_ly(
x = ~date,
y = ~cum_conf,
type = 'scatter',
mode = 'lines+markers',
line = list(color = "#0072B2"),
marker = list(color = "#0072B2"),
name = 'confirmed'
) %>%
add_trace(
y = ~cum_recov,
type = 'scatter',
mode = 'lines+markers',
line = list(color = "#009E73"),
marker = list(color = "#009E73"),
name = 'recovered'
) %>%
add_trace(
y = ~cum_deaths,
type = 'scatter',
mode = 'lines+markers',
line = list(color = "#D55E00"),
marker = list(color = "#D55E00"),
name = 'succumbed'
) %>%
layout(
title = "",
xaxis = list(title = "Date", zeroline = FALSE),
yaxis = list(title = "Cumulative number of cases", zeroline = FALSE),
legend = list(x = 0.1, y = 0.9),
hovermode = "compared",
# enclosing the text annotations with a color-filled rectangle
shapes = list(
list(type = 'rect', fillcolor = "#7986CB", line = list(color = "#5C6BC0"), opacity = 0.7, x0 = covid_set_ke$date[58], x1 = covid_set_ke$date[66], xref = "x", y0 = 150, y1 = 250, yref = "y"),
# A straight line that touches the rectangle, to give a "flag" shape or something. Couldn't think of a better way at the time of writing this.
list(type = 'line', x0 = covid_set_ke$date[66], x1 = covid_set_ke$date[66], y0 = 0, y1 = 150, line = list(color = "#37474F", width = 1.5), opacity = 0.7),
# Adding a color-filled rectangle
list(type = 'rect', fillcolor = "#009E73", line = list(color = "#009E73"), opacity = 0.7, x0 = covid_set_ke$date[91], x1 = covid_set_ke$date[106], y0 = 300, y1= 400 ),
# Adding a straight line that touches the rectangle
list(type = 'line', x0 = covid_set_ke$date[106], x1 = covid_set_ke$date[106], y0 = 26, y1 = 300, opacity = 0.7, line = list(color = "#37474F", width = 1.5)),
# Adding a color-filled rectangle
list(type = 'rect', fillcolor = "#D55E00", line = list(color = "#D55E00"), opacity = 0.7, x0 = covid_set_ke$date[106], x1 = covid_set_ke$date[120], y0 = 950, y1 = 1060 ),
# Adding a straight line that touches the rectangle
list(type = 'line', x0 = covid_set_ke$date[120], x1 = covid_set_ke$date[120], y0 = 50, y1 = 960, line = list(color = "#37474F", width = 1.5), opacity = 0.7 )
# list(type = 'rect', fillcolor = "green", line = list(color = "#5C6BC0"), opacity = 0.8, x0 = covid_set_ke$date[70], x1 = covid_set_ke$date[90], xref = "x", y0 = 150, y1 = 250, yref = "y")
#
)
) %>%
add_annotations(
x = covid_set_ke$date[62],
y = 200,
text = paste("Start of","\n","curfew", sep = ""),
xref = "x",
yref = "y",
showarrow = FALSE
) %>%
add_annotations(
x = covid_set_ke$date[98],
y = 350,
text = paste("Lockdown in","\n", "Eastleigh and Old Town", sep=""),
showarrow = F
) %>%
add_annotations(
x = covid_set_ke$date[113],
y = 1000,
text = paste("Total confirmed cases","\n","surpass 1000", sep=""),
showarrow = F
)
fig
```
### **Distribution of cases by gender**
```{r}
library(readxl)
gender_distribution <- read.csv("C:/Users/ADMIN/Desktop/Intoduction to Python for data science/R for data science/aRduino/Github stuff/covid19_ke/data/gender_dist.csv") %>% select(-1)
#colors <- c('rgb(211,94,96)', 'rgb(128,133,133)', 'rgb(144,103,167)', 'rgb(171,104,87)', 'rgb(114,147,203)')
colors <- c('#00E676', 'rgb(114,147,203)')
# selecting the first and last column
fig_gender <- gender_distribution %>% select(c(1,ncol(gender_distribution))) %>% rename(cases = 2)
fig_gender %<>% plot_ly(
labels = ~gender,
values= ~cases,
textinfo = 'label+percent',
marker = list(colors = colors)
) %>%
add_pie(hole = 0.4)
fig_gender
```
Daily count
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
### Day
```{r}
day=last(covid_set$date)
valueBox(
day,
icon="far fa-calendar-plus",
color="#5C6BC0"
)
```
### Samples Tested in the last 24 hours
```{r}
library(readxl)
samples_tested <- read.csv("C:/Users/ADMIN/Desktop/Intoduction to Python for data science/R for data science/aRduino/Github stuff/covid19_ke/data/samples_tested.csv")
samples=last(samples_tested$samples_tested)
valueBox(
format(samples, big.mark = ","),
icon= "fas fa-vials",
color= "#ABA6BF"
)
```
### Confirmed cases for the day
```{r}
confirmed=last(covid_set_ke$daily_conf)
valueBox(
format(confirmed,big.mark = ","),
icon = "fas fa-user-md",
color="#7B1FA2"
)
```
### Recovered cases for the day
```{r}
recovered=last(covid_set_ke$daily_recov)
valueBox(
format(recovered,big.mark = ","),
icon="fas fa-heartbeat",
color="#00C853"
)
```
### Succumbed cases for the day
```{r}
succumbed=last(covid_set_ke$daily_deaths)
valueBox(
format(succumbed,big.mark = ","),
color="#D55E00"
)
```
Column { data-width=425 }
-----------------------------------------------------------------------
### **Daily confirmed cases in Kenya **
```{r}
## day of first case confirmed
day=(covid_set_ke %>% ungroup() %>% filter(daily_conf>0) %>% slice(1) %>% select(date))
## a geom_smooth should also work in this case
daily_conf=covid_set_ke %>% filter(date>=day$date) %>% mutate(daily_conf_smooth=(daily_conf+
lag(daily_conf,n=1)+
lag(daily_conf,n=2)+
lag(daily_conf,n=3)+
lag(daily_conf,n=4))/5)
daily_conf_p=daily_conf %>%
plot_ly(
x=~date,
y=~daily_conf,
type='scatter',
mode='lines',
line=list(color="purple",width=0.6),
name = "Confirmed"
) %>%
add_trace(
y=~daily_conf_smooth,
type="scatter",
mode="lines",
line=list(color="blue",width=3),
name="trendline"
) %>%
layout(
title="",
yaxis=list(
title="Daily confirmed cases",
zeroline=F),
xaxis=list(
title = "Using 5 days trailing moving average to calculate the trend line",
zeroline=F
),
legend=list(x=0.1,y=0.9)
)
daily_conf_p
```
###
```{r}
DT::datatable(covid_set_ke %>% ungroup %>% select(-c(country,Week,cum_conf,cum_deaths,cum_recov,cum_active,daily_active)) %>% rename(confirmed=daily_conf,succumbed=daily_deaths,recovered=daily_recov) %>% arrange(desc(date)) %>% slice(1:5),option=list(bpaginate=FALSE))
```
Column { data-width=425 }
-----------------------------------------------------------------------------
### **Daily recovered cases in Kenya **
```{r}
## day of first case confirmed
day=(covid_set_ke %>% ungroup() %>% filter(daily_conf>0) %>% slice(1) %>% select(date))
## a geom_smooth should also work in this case
daily_recov=covid_set_ke %>% filter(date>=day$date) %>% mutate(daily_recov_smooth=(daily_recov+
lag(daily_recov,n=1)+
lag(daily_recov,n=2)+
lag(daily_recov,n=3)+
lag(daily_recov,n=4))/5)
daily_recov_p=daily_recov %>%
plot_ly(
x=~date,
y=~daily_recov,
type='scatter',
mode='lines',
line=list(color="blue",alpha=0.1,width=0.6),
name = "Recovered"
) %>%
add_trace(
y=~daily_recov_smooth,
type="scatter",
mode="lines",
line=list(color="green",width=3),
name="trendline"
) %>%
layout(
title="",
yaxis=list(
title="Daily Recovered cases",
zeroline=F),
xaxis=list(
title = "Using 5 days trailing moving average to calculate the trend line",
zeroline=F
),
legend=list(x=0.1,y=0.9)
)
daily_recov_p
```
### **Daily succumbed cases in Kenya**
```{r}
## day of first case confirmed
day=(covid_set_ke %>% ungroup() %>% filter(daily_conf>0) %>% slice(1) %>% select(date))
## a geom_smooth should also work in this case
daily_succumbed=covid_set_ke %>% filter(date>=day$date) %>% mutate(daily_succ_smooth=(daily_deaths+
lag(daily_deaths,n=1)+
lag(daily_deaths,n=2)+
lag(daily_deaths,n=3)+
lag(daily_deaths,n=4))/5)
daily_succumbed_p=daily_succumbed %>%
plot_ly(
x=~date,
y=~daily_deaths,
type="scatter",
mode="lines",
line=list(color="blue",width=0.6),
name="Succumbed") %>%
add_trace(
y=~daily_succ_smooth,
type="scatter",
mode="lines",
line=list(color="red",width=3),
name="trendline"
) %>%
layout(
yaxis=list(
title="Daily succumbed cases",
zeroline=F
),
legend=list(x=0.1,y=0.9),
xaxis=list(
title = "Using 5 days trailing moving average to calculate the trend line",
zeroline=F
)
)
daily_succumbed_p
```
Combined the above plots using ggplot2 instead of plotly
```{r}
theme_set(theme_light())
colors=c("confirmed"="blue","succumbed"="red","recovered"="green")
## day of first case confirmed
day=(covid_set_ke %>% ungroup() %>% filter(daily_conf>0) %>% slice(1) %>% select(date))
dail=covid_set_ke %>% filter(date>=day$date) %>%
ggplot(mapping=aes(x=date))+
geom_line(aes(y=daily_conf,color="confirmed"),lwd=0.7,alpha=0.5)+
geom_smooth(aes(y=daily_conf),lwd=0.3,linetype="dashed",color="black",se=FALSE,alpha=0.5)+
geom_point(aes(x=last(covid_set_ke$date),y=last(covid_set_ke$daily_conf),color="confirmed"),alpha=0.01,size=2.2)+
geom_line(mapping=aes(y=daily_deaths,color="succumbed"),lwd=0.5,alpha=0.8)+
geom_point(aes(x=last(covid_set_ke$date),y=last(covid_set_ke$daily_deaths),color="succumbed"),alpha=0.01,size=2.2)+
geom_line(mapping = aes(y=daily_recov,color="recovered"),lwd=0.8,alpha=0.5)+
geom_point(aes(x=last(covid_set_ke$date),y=last(covid_set_ke$daily_recov),color="recovered"),alpha=0.01,size=2.2)+
# geom_line(aes(y=Confirmed),lwd=0.4,se=FALSE,alpha=0.5,linetype="dashed",color="blue")+
#geom_point(aes(x=last(sub_set_mod$Date),y=last(sub_set_mod$Confirmed)),color="blue",alpha=0.01,size=10)+
#geom_text(aes(x=last(sub_set_mod$Date),y=last(sub_set_mod$Confirmed),
#label=paste("Total Cases:",last(sub_set_mod$Confirmed)),
#alpha=1),nudge_x=-3.0,size=4,colour="black")+
#geom_text(aes(x=last(sub_set_mod$Date),y=last(sub_set_mod$Conf_dail),
#label=last(sub_set_mod$Conf_dail),
#alpha=1),size=4,colour="black"#nudge_x=-3.5,nudge_y=2,)
#)+
labs(ggtitle(""),
x="Day",
y="Number of reported cases per day",
color="Legend")+
scale_color_manual(values = colors)
#geom_text(
# label=last(sub_set_mod$Confirmed),
#x=last(sub_set_mod$Date),
#y=last(sub_set_mod$Confirmed),
#label.padding = unit(0.55, "lines"), # Rectangle size around label
#label.size = 0.35,
#color = "black",
#fill="#69b3a2"
#)
#geom_text(aes(label=Confirmed), colour="gray20", alpha=1)
#text(x=last(sub_set_mod$Date),y=last(sub_set_mod$Confirmed))
#ggplotly(dail)
```
County stats
=======================================================================
```{r}
### **Number of cases per county in Kenya**
# reading in the Kenyan shapefiles
# If reading a shapefile, the data source name (dsn= argument) is the folder (directory) where the shapefile is, and the layer is the name of the shapefile (without the .shp extension)
kenya_shp=readOGR(dsn="C:/Users/ADMIN/Desktop/Intoduction to Python for data science/R for data science/aRduino/Github stuff/covid19_ke/data/kenyan-counties",layer="County",verbose = F)
# converting the shp file to a df
kenya_df=fortify(kenya_shp) # use broom::tidy(kenya_m) since fortify may be deprecated in the future
kenya_df$id=as.integer(kenya_df$id)
kenya_ctys=read_excel("C:/Users/ADMIN/Desktop/Intoduction to Python for data science/R for data science/aRduino/Github stuff/covid19_ke/data/counties.xlsx")
kenya_ctys %<>% select(-1)
cov_ctys=read.csv("C:/Users/ADMIN/Desktop/Intoduction to Python for data science/R for data science/aRduino/Github stuff/covid19_ke/data/cov_cty.csv") %>% select(-1)
# for displaying newly confirmed cases and distinguishing them from the previous day's cases
cov_ctys_disp = cov_ctys %>% group_by(county) %>% select(c(1,ncol(cov_ctys)-1,ncol(cov_ctys))) %>% rename(cases1=2,cases2=3) %>% transmute(cases_today=cases2-cases1) %>% filter(cases_today>0)
kenya_ctys=left_join(kenya_ctys,cov_ctys,by="county") %>% gather(key="date",value = "cases",-c(1,2,3)) %>% mutate(date=substr(date,2,11)) %>% mutate(date=ymd(date))
kenya_ctys_filt=kenya_ctys %>% filter(date==max(date))
comp_df= left_join(kenya_df,kenya_ctys_filt,by="id")
comp_df %<>% select(-c(order,hole,piece,id,group)) %>%
group_by(county) %>% arrange(desc(cases)) %>%
ungroup()
# Rorder data + Add a new column with tooltip text
# with the data I had, I computed the mean coordinates per county to act as my centroid point
kenya_mean= comp_df %>% group_by(county,county_code,cases,date) %>% summarise(long=mean(long),lat=mean(lat)) %>%
mutate(tooltip=paste(
"County: ", county, "\n",
"Cases: ", cases, sep = ""
)) %>%
filter(cases>0) %>%
arrange(desc(cases))
# creating a table that shows the cases confirmed on that day and the cumulative cases
cov_ctys_disp %<>% full_join(kenya_mean,by="county") %>% select(-c(county_code,long,lat,tooltip)) %>% replace_na(list(cases_today=0)) %>% rename(total_cases=cases) %>% select(c("county","cases_today","total_cases"))
```
Row {data-width=400}
-----------------------------------------------------------------------
### Day
```{r}
day=last(covid_set$date)
valueBox(
day,
icon="far fa-calendar-plus",
color="#5C6BC0"
)
```
### Samples Tested in the last 24 hours
```{r}
library(readxl)
samples_tested <- read.csv("C:/Users/ADMIN/Desktop/Intoduction to Python for data science/R for data science/aRduino/Github stuff/covid19_ke/data/samples_tested.csv")
samples=last(samples_tested$samples_tested)
valueBox(
format(samples, big.mark = ","),
icon= "fas fa-vials",
color= "#ABA6BF"
)
```
### Confirmed cases for the day
```{r}
confirmed=last(covid_set_ke$daily_conf)
valueBox(
format(confirmed,big.mark = ","),
icon = "fas fa-user-md",
color="#7B1FA2"
)
```
### Counties with confirmed cases(out of 47)
```{r}
counties <- nrow(cov_ctys_disp)
counties_percentage <- round(100*counties/47)
valueBox(
paste0(counties, "(", counties_percentage, "%", ")"),
color = "#595775",
icon = "fas fa-map-marker-alt"
)
```
Column
--------------------------------------------------------------------
###
```{r,fig.width=12, fig.height=8}
###
# ###
# { data-width=400 }
# Now we want to add another information. The number of cases per county will be mapped to the colour and the size of the bubbles. Note that the order of county matters! It is advised to show the most important information on top (center). This can been done sorting your dataset before making the plot.
kenya_map=ggplot() +
geom_polygon(data=comp_df,aes(x=long,y=lat,group=county_code,fill=county_code),linetype="dashed",color="white",lwd=0.09,show.legend = FALSE)+
geom_point(data=kenya_mean,aes(x=long,y=lat,color=cases,size=cases,text=tooltip),alpha=0.9)+
scale_size_continuous()+
scale_color_viridis()+
coord_equal()+
theme_void()+
#ylim(-3,2)+
#xlim(20,40)
ggtitle("Number of confirmed cases per county")+
theme(legend.position = "right",plot.title = element_text(hjust = 0.5))+
## to change the color of the fill aesthetic
scale_fill_gradient(low = "#B0BEC5",high = "#B0BEC5",space="Lab")+
labs(
x="longitude",
y="latitude"
)
ggplotly(kenya_map,tooltip = "tooltip")
```
###
```{r}
#as.datatable {formattable}-Generic function to create an htmlwidget
as.datatable(formattable(cov_ctys_disp,list(
date=color_tile("white","#E0E0E0"),
cases_today=color_tile("white","#B3E5FC"),
area(col=("total_cases"))~ normalize_bar("#FFCDD2",0.2))))
```
```{r}
gender_distribution = tibble(
gender = c("Male", "Female"),
"19/05/2020" = c(569, 343)
)
write.csv(gender_distribution, "gender_dist.csv")
```
SIR Model
=======================================================================
```{r include=FALSE}
# I will try and implement a simple SIR model to predict the number of cases if no public health intervention eg quarantine, wearing of masks and social distancing had been done.
# If you are unfamiliar with the SIR model, kindly visit :https://www.statsandr.com/blog/covid-19-in-belgium/
# The basic idea behind the SIR model (Susceptible - Infectious - Recovered) of communicable disease outbreaks is that there are three groups (also called compartments) of individuals:
# S: those who are healthy but susceptible to the disease (i.e., at risk of being contaminated). At the start of the pandemic, S is the entire population since no one is immune to the virus.
# I: the infectious (and thus, infected) people
# R: individuals who were contaminated but who have either recovered or died. They are not infectious anymore.
# To model the dynamics of the outbreak we need three differential equations to describe the rates of change in each group, parameterised by:
# β, the infection rate, which controls the transition between S and I
# γ, the removal or recovery rate, which controls the transition between I and R
# Before fitting the SIR model to the data, the first step is to express these differential equations as an R function, with respect to time t.
SIR <- function(time, state, parameters) {
par <- as.list(c(state, parameters))
with(par, {
dS <- -beta * I * S/N
dI <- beta * I * S/N - gamma * I
dR <- gamma * I
list(c(dS, dI, dR))
})
}
# our first case in Kenya was at: 13 March
# put the daily cumulative incidence numbers for Kenya from
# March 13 to May 13 into a vector called Infected
sir_start_date <- "2020-03-13"
sir_end_date <- "2020-05-13"
Infected <- subset(covid_set_ke, date >= ymd(sir_start_date) & date <= ymd(sir_end_date))$cum_active
# people currently infected are equal to cum_conf - cum_succ - cum_recov
# Next we create an incrementing day vector the same length as the infected cases
Day <- 1:length(Infected)
# Next we specify the initial N, S, I and R
N <- 47564296
init <- c(
S = N - Infected[1],
I = Infected[1],
R = 0
)
# Then we need to define a function to calculate the RSS (residual sum of squares), given a set of values for β and γ.
RSS <- function(parameters) {
names(parameters) <- c("beta", "gamma")
out <<- ode(y = init, times = Day, func = SIR, parms = parameters)
fit <<- out[, 3]
sum((Infected - fit)^2)
}
# Finally, we can fit the SIR model to our data by finding the values for β and γ that minimise the residual sum of squares between the observed cumulative incidence (active cases in Kenya) and the predicted cumulative incidence (predicted by our model). We also need to check that our model has converged, as indicated by the message shown below. Start with values of 0.5 for each, and constrain them to the interval 0 to 1.0
library(deSolve)
Opt <- optim(c(0.5, 0.5),
RSS,
method = "L-BFGS-B",
lower = c(0, 0),
upper = c(1, 1)
)
# check for message
Opt$message
# Convergence is confirmed. Now we can examine the fitted values for β and γ
Opt_par <- setNames(Opt$par, c("beta", "gamma"))
Opt_par # beta:0.5524883 gamma:0.4475117
# calculate the basic reproduction number R0 which gives the average number of susceptible people who are infected by each infectious person
R0 <- as.numeric(Opt_par[1] / Opt_par[2])
R0
# An R0 of 1.23 means that, on average in Kenya, 1.23 persons are infected for each infected person.
```
Column
-----------------------------------------------------------------------
### A Naive SIR Model projection if no Public Health Interventions were enforced by the Government of Kenya.
```{r fig.width=12, fig.height=8}
# Using the SIR model to make predictions to see what would happen if the outbreak were left to run its course, without public health interventions.
# time in days for predictions
t <- 1:200
# get the fitted values from our SIR model
fitted_cumulative_incidence <- data.frame(ode(
y = init, times = t,
func = SIR, parms = Opt_par
))
# add a Date column and join the observed incidence data
fitted_cumulative_incidence <- fitted_cumulative_incidence %>%
mutate(
Date = ymd(sir_start_date) + days(t - 1),
Country = "Kenya",
I = round(I),
R = round(R),
actual_infectious_cases = c(Infected, rep("NA ", length(t) - length(Infected)))
)
# plot the data with a y-axis for better readability
colors = c("Susceptible" = "Black", "Recovered" = "#009E73", "Infectious" = "#D55E00")
theme_set(theme_light())
kenya_sir <- fitted_cumulative_incidence %>% mutate(actual_infectious_cases = as.integer(actual_infectious_cases)) %>%
ggplot(mapping = aes(x = Date))+
geom_line(aes(y = S, color = "Susceptible"))+
geom_line(aes(y = I, color = "Infectious"))+
geom_line(aes(y = R, color = "Recovered"))+
scale_y_log10(labels = scales::comma) +
geom_point(aes(y = actual_infectious_cases), color = "#5C4A72")+
ylab("Predicted Persons")+
xlab("Day")+
scale_color_manual(values = colors)
ggplotly(kenya_sir, tooltip = c("S", "I", "R", "Date")) %>% layout(hovermode = "compared")
```
### **Disclaimer**
These predictions should be taken with **a lot of caution**. They are based on very naive and **rather unrealistic assumptions** eg no public health interventions such as curfews, wearing of masks, mass testing and isolation have been implemented. They also assume a fixed reproduction number **R0**.
With these rather very naive predictions, if no public health interventions were made, the peak of the COVID-19 in Kenya is expected to be reached by around 5th August with around 918,816 infected people and about 50,000 deaths (assuming a CFR of 5.5%).
These quite alarming predictions however highlight the **importance** of the `public health interventions made by the government` and why the citizens should adhere to them. As it were, `if we continue to act normally, this disease will treat us abnormally`- C.S Mutahi Kagwe.
For more information on how to implement much more sophisticated and realistic models, kindly visit [Antoine Soetewey](https://www.statsandr.com/blog/covid-19-in-belgium/#more-sophisticated-projections) and [Tim Churches](https://timchurches.github.io/blog/posts/2020-02-18-analysing-covid-19-2019-ncov-outbreak-data-with-r-part-1/) blogs.
Africa stats
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
```{r}
##----------------------stats in Africa-------------------------
## Our data is not grouped per continentwise, so how do we know which continent our country belongs to? Well, dont fret: package countrycode will do just that.
#?countrycode()
covid_set_africa=covid_set %>% mutate(continent=countrycode(
sourcevar = country,
origin="country.name",
destination = "continent"
)) %>% group_by(country) %>% filter(continent=="Africa")
covid_set_africa_summary=covid_set_africa %>% group_by(date) %>% summarise(africa_confirmed=sum(daily_conf),africa_succumbed=sum(daily_deaths),africa_recovered=sum(daily_recov))
ordered_afrcovid_set=covid_set_africa %>%
group_by(country) %>%
summarise(total_confirmed=sum(daily_conf),total_succumbed=sum(daily_deaths),total_recovered=sum(daily_recov)) %>%
arrange(desc(total_confirmed))
```
### Day
```{r}
day=last(covid_set$date)
valueBox(
day,
icon="far fa-calendar-plus",
color="#5C6BC0"
)
```
### Confirmed cases in Africa
```{r}
confirmed=sum(covid_set_africa_summary$africa_confirmed)
valueBox(
format(confirmed,big.mark = ","),
icon = "fas fa-user-md",
color="#7B1FA2"
)
```
### Recovered cases
```{r}
recovered=sum(covid_set_africa_summary$africa_recovered)
recov_rate=round(100*(recovered)/sum(covid_set_africa_summary$africa_confirmed),2)
valueBox(
cat(format(recovered,big.mark = ","),"(",recov_rate,"%",")",sep=""),
icon="fas fa-heartbeat",
color="#00C853"
)
```
### Succumbed cases
```{r}
succumbed=sum(covid_set_africa_summary$africa_succumbed)
death_rate=round(100*(succumbed)/sum(covid_set_africa_summary$africa_confirmed),2)
valueBox(
cat(format(succumbed,big.mark = ","),"(",death_rate,"%",")",sep=""),
color="#D55E00"
)
```
Column
----------------------------------------------------------------------
### **A comparison between Kenya and some of the countries in E.Africa **
```{r,fig.width=10, fig.height=7}
## a function that defines the variable in our dataset that the animation will increment by
# accumulate_by <- function(dat, var) {
# var <- lazyeval::f_eval(var, dat)
# lvls <- plotly:::getLevels(var)
# dats <- lapply(seq_along(lvls), function(x) {
# cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
# })
# dplyr::bind_rows(dats)
# }
######################################################################
#
# this was originally in the dashboard but I have decided to replace
# it with a comparison between Kenya and other countries in East Africa
#
#######################################################################
# #?POSIXct had to convert the date to milliseconds to comply with plotly's animation requirements for dates
# covid_set_africa_summary=covid_set_africa_summary %>% mutate(Count=1:length(covid_set_ke$cum_conf),date_s=as.numeric(as.POSIXct(date,format="%Y/%m/%d"))*1000,cum_conf=cumsum(africa_confirmed),cum_succumbed=cumsum(africa_succumbed),cum_recov=cumsum(africa_recovered))
#
#
#
# #fig_africa <- covid_set_africa_summary %>% accumulate_by(~`Count`)
#
#
# fig_africa <- covid_set_africa_summary %>%
# plot_ly(
# x = ~date_s,
# y = ~cum_conf,
# #split = ~city,
# #frame = ~frame,
# type = 'scatter',
# mode = 'lines+markers',
# colors="set3",
# # color= "orange",
# line = list(color="blue"),
# marker=list(color="blue"),
# #linetype = "dashed"
# name='confirmed'
# )
# #fig_glob=fig_glob %>% add_markers(x~last(df2$Date3),
# # y~last(df2$Conf_dail),
# #type='scatter',
# # mode="markers",
# # marker=list(simplify=F))
#
#
#
# fig_africa=fig_africa %>% add_trace(
# y=~cum_succumbed,
# mode="lines+markers",
# #frame = ~frame,
# line=list(color="red"),
# marker=list(color="red"),
# name="succumbed")
#
# fig_africa=fig_africa %>% add_trace(
# y=~cum_recov,
# mode="lines+markers",
# #frame~frame,
# line=list(color="green"),
# marker=list(color="green"),
# linetype="dashed",
# name="recovered") %>% #add_annotations(x = last(covid_set_africa_summary$date), y=sum(covid_set_africa_summary$africa_confirmed)-last(covid_set_africa_summary$africa_confirmed),
# # text = last(covid_set_africa_summary$africa_confirmed),
# #xref = "x",
# #yref = "y",
# #showarrow = TRUE,
# #arrowhead = 4,
# #arrowsize = .5,
# #ax = 0,
# #ay = 0) %>%
# layout(
#
# title="",
# xaxis = list(
# type="date",
# title = "Date",
# zeroline = F
# ),
# yaxis = list(
# title = "Cumulative number of cases",
# zeroline = F
# ),
# legend=list(x=0.1,y=0.9),
# hovermode="compared")
# # )#%>% animation_opts(
# # frame = 150,
# # transition =0,
# # redraw = TRUE) %>% animation_slider(hide=FALSE)
#
#
#
# #fig_africa
# Comparing kenya with our neighbours
ke <- covid_set_africa %>% group_by(country) %>%
filter(country == "Kenya", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
br <- covid_set_africa %>% group_by(country) %>%
filter(country == "Burundi", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
eth <- covid_set_africa %>% group_by(country) %>%
filter(country == "Ethiopia", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
sm <- covid_set_africa %>% group_by(country) %>%
filter(country == "Somalia", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
ug <- covid_set_africa %>% group_by(country) %>%
filter(country == "Uganda", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
rw <- covid_set_africa %>% group_by(country) %>%
filter(country == "Rwanda", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
eg <- covid_set_africa %>% group_by(country) %>%
filter(country == "Egypt", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
sa <- covid_set_africa %>% group_by(country) %>%
filter(country == "South Africa", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
ag <- covid_set_africa %>% group_by(country) %>%
filter(country == "Algeria", date >= "2020-03-13") %>%
select(c(country,date, cum_conf))
fig_compare = plot_ly(
data = sm,
x = ~date,
y = ~cum_conf,
type = 'scatter',
mode = 'lines+markers',
# line = list(color = "#0072B2"),
# marker = list(color = "#0072B2"),
name = 'Somalia'
) %>%
add_trace(
data = ug,
y = ~cum_conf,
type = 'scatter',
mode = 'lines+markers',
# line = list(color = "#D55E00"),
# marker = list(color = "#D55E00"),
name = 'Uganda'
)%>%
add_trace(
data = rw,
y = ~cum_conf,
type = 'scatter',
mode = 'lines+markers',
# line = list(color = "#D55E00"),
# marker = list(color = "#D55E00"),
name = 'Rwanda'
)%>%
add_trace(
data = ke,
y = ~cum_conf,
type = 'scatter',
mode = 'lines+markers',
line = list(color = "black"),
marker = list(color = "black"),
name = 'Kenya'
)%>%
layout(
title = "",
xaxis = list(title = "Date", zeroline = FALSE),
yaxis = list(title = "Cumulative number of confirmed cases", zeroline = FALSE),
legend = list(x = 0.1, y = 0.9),
hovermode = "compared"
# enclosing the text annotations with a color-filled rectangle
)
fig_compare
```
###
```{r}
## this is quite a long piping operation but very easy in itself, just execute each part independently to ease understanding
afrcov_summary=covid_set_africa %>% ungroup() %>% group_by(country) %>% filter(date==last(date)) %>% select(-c(daily_active,Week,continent,cum_active,date)) %>% arrange(desc(cum_conf))%>% rename(daily_confirmed=daily_conf,daily_succumbed=daily_deaths,daily_recovered=daily_recov,total_confirmed=cum_conf,total_succumbed=cum_deaths,total_recovered=cum_recov) %>% select(c("country","total_confirmed","daily_confirmed","total_recovered","daily_recovered","total_succumbed","daily_succumbed"))
## a better approach to arranging columns is by using dplyr::relocate rather than: select(c("country","total_confirmed","daily_confirmed","total_recovered","daily_recovered","total_succumbed","daily_succumbed"))
# DT::datatable(afrcov_summary,option=list(bpaginate=FALSE))
as.datatable(formattable(afrcov_summary, lapply(1:nrow(afrcov_summary), function(row) {
area(row, col = -1) ~ color_tile("#7986CB", "#009E73")
})))
```
Global stats
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
```{r}
##------------------------world statistics-----------------------
## let's now do some world stats, such as the total count of the incidents per day and the total cumulative incidents
## let's start with the incidents per day across the world. That should be easy right, we group all the incidents and perform a sum based on each individual day and incident
covid_set_global=covid_set %>% group_by(date) %>% summarise(global_confirmed=sum(daily_conf),global_succumbed=sum(daily_deaths),global_recovered=sum(daily_recov))
## little sanity check to confirm our statistics
#succumbed=covid_set %>% filter(date=="2020-01-22") %>% select(daily_deaths) %>% filter(daily_deaths>=1)
## confirmed=covid_set %>% filter(date=="2020-01-22") %>% select(daily_conf) %>% filter(daily_conf>=1)
```
### Day
```{r}
day=last(covid_set$date)
valueBox(
day,
icon="far fa-calendar-plus",
color="#5C6BC0"
)
```
### Global confirmed cases
```{r}
confirmed=sum(covid_set_global$global_confirmed)
valueBox(
format(confirmed,big.mark = ","),
icon = "fas fa-user-md",
color="#7B1FA2"
)
```
### Recovered cases
```{r}
recovered=sum(covid_set_global$global_recovered)
recov_rate=round(100*recovered/sum(covid_set_global$global_confirmed),2)
valueBox(
cat(format(recovered,big.mark = ","),"(",recov_rate,"%",")",sep=""),
icon="fas fa-heartbeat",
color="#00C853"
)
```
### Succumbed cases
```{r}
succumbed=sum(covid_set_global$global_succumbed)
death_rate=round(100*succumbed/sum(covid_set_global$global_confirmed),2)
valueBox(
cat(format(succumbed,big.mark = ","),"(",death_rate,"%",")",sep=""),
color="#D55E00"
)
```
Row
-----------------------------------------------------------------------
### **Daily cumulative cases globally: **
```{r}
## a function that defines the variable in our dataset that the animation will increment by
# accumulate_by <- function(dat, var) {
# var <- lazyeval::f_eval(var, dat)
# lvls <- plotly:::getLevels(var)
# dats <- lapply(seq_along(lvls), function(x) {
# cbind(dat[var %in% lvls[seq(1, x)], ], frame = lvls[[x]])
# })
# dplyr::bind_rows(dats)
# }
#?POSIXct had to convert the date to milliseconds to comply with plotly's animation requirements for dates
covid_set_global=covid_set_global %>% mutate(Count=1:length(covid_set_ke$cum_conf),date_s=as.numeric(as.POSIXct(date,format="%Y/%m/%d"))*1000,cum_conf=cumsum(global_confirmed),cum_succumbed=cumsum(global_succumbed),cum_recov=cumsum(global_recovered))
## our animation will increase by Count, which is basically a day count from date 2020-01-22
fig_glob <- covid_set_global
# %>% accumulate_by(~`Count`)
fig_glob <- fig_glob %>%
plot_ly(
x = ~date_s,
y = ~cum_conf,
#split = ~city,
#frame = ~frame,
type = 'scatter',
mode = 'lines+markers',
line = list(color="blue"),
marker=list(color="blue"),
#linetype = "dashed"
name='confirmed'
)
#fig_glob=fig_glob %>% add_markers(x~last(df2$Date3),
# y~last(df2$Conf_dail),
#type='scatter',
# mode="markers",
# marker=list(simplify=F))
fig_glob=fig_glob %>% add_trace(
y=~cum_succumbed,
mode="lines+markers",
#frame = ~frame,
line = list(color="red"),
marker=list(color="red"),
name="succumbed")
fig_glob=fig_glob %>% add_trace(
y=~cum_recov,
mode="lines+markers",
# frame~frame,
line = list(color="green"),
marker=list(color="green"),
linetype="dashed",
name="recovered")%>% layout(
title="",
xaxis = list(
type="date",
title = "Date",
zeroline = F
),
yaxis = list(
title = "Cumulative number of cases",
zeroline = F
),
hovermode="compared"
)
#%>% animation_opts(
# frame = 150,
# transition =2,
# redraw = TRUE)
fig_glob
```
Protective measures
=======================================================================
Row {data-width=400}
-----------------------------------------------------------------------
### How to protect yourself and others
```{r}
#day=last(covid_set$date)
valueBox(
paste("Here are some guidelines from the WHO")
)
```
Column
-----------------------------------------------------------------------
### **Wash your hands frequently**
Regularly and thoroughly clean your hands with an alcohol-based hand rub or wash them with soap and water.
**Why?** Washing your hands with soap and water or using alcohol-based hand rub kills viruses that may be on your hands.
### **Maintain social distancing**
Maintain at least 1 metre (3 feet) distance between yourself and anyone who is coughing or sneezing.
**Why?** When someone coughs or sneezes they spray small liquid droplets from their nose or mouth which may contain virus. If you are too close, you can breathe in the droplets, including the COVID-19 virus if the person coughing has the disease.
Column
-----------------------------------------------------------------------
### **If you have fever, cough and difficulty breathing, seek medical care early**
Stay home if you feel unwell. If you have a fever, cough and difficulty breathing, seek medical attention and call in advance. Follow the directions of your local health authority.
**Why?** National and local authorities will have the most up to date information on the situation in your area. Calling in advance will allow your health care provider to quickly direct you to the right health facility. This will also protect you and help prevent spread of viruses and other infections.
### **Stay informed and follow advice given by your healthcare provider,your national and local public health authority**
Kindly visit: ***https://www.who.int/emergencies/diseases/novel-coronavirus-2019***
for more information about the Coronavirus disease (COVID-19) Pandemic.
About
=======================================================================
**The COVID-19 in Kenya Dashboard**
Last updated: `r format(max(coronavirus::coronavirus$date), '%d %B')`
This [COVID-19 in Kenya Dashboard](https://r-icntay.github.io/covid19_ke/#county-stats) seeks to provide an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic.
The dashboard mainly focuses on Kenya by visualising the total reported cases, the daily reported cases and their distribution per county.
It also visualises the total cases globally and then focuses on the cases in Africa and its respective countries.
**Data**
The input data for this dashboard is the [coronavirus R package](https://github.com/RamiKrispin/coronavirus) (dev version) by [Rami Krispin](https://twitter.com/Rami_Krispin) and the [Ministry of Health, Kenya](http://www.health.go.ke/).
The data and dashboard is refreshed on a daily bases.
The raw data is pulled from the [COVID-19 Data Repository](https://github.com/CSSEGISandData/COVID-19) by the Center for Systems Science and Engineering (CSSE) at Johns Hopkins University.
This dashboard was build with the hope that it will help everyone, especially in Kenya, to keep an eye on the outbreak.
**Contribution**
The shape files for the **county stats** tab were contributed by [Maggie Wanjiru](https://twitter.com/magwanjiru). Thank you!
The `SIR Model` tab was adapted from the works done by Tim Churches [Health Data Science blog](https://timchurches.github.io/blog/posts/2020-02-18-analysing-covid-19-2019-ncov-outbreak-data-with-r-part-1/) and Antoine Soetewey's [blog](https://www.statsandr.com/blog/covid-19-in-belgium/#more-sophisticated-projections).
**Please take care of yourself and others** by following the directives issed by the government. We will beat this!