Yellow Fever Outbreak in Mali
Bertha Kembabazi
2024-06-10
data <- read_excel("C:/Users/bertha.kembabazi/OneDrive/WHO/analytics/VPD test/SIT_REP/inputs/yelow_fever_ mali.xlsx")
data <- as.data.frame(data)
head(data)## Num_ordre Age (month) Age (year) Sex Occupation Village Health area
## 1 1 NA 3 M <NA> <NA> <NA>
## 2 2 NA 17 M Berger Korolègué Goulia
## 3 3 NA 33 M Cultivateur Kouroulamini Manankoro
## 4 4 NA 30 M Cultivateur Banankélé Mafélè
## 5 5 NA 6 F <NA> <NA> <NA>
## 6 6 NA 22 F Menagère Simi Manankoro
## District of notification District of residence Region of notification
## 1 Bougouni Bougouni Sikasso
## 2 Bougouni Minignan (RCI) Sikasso
## 3 Bougouni Inconu Sikasso
## 4 Bougouni Bougouni Sikasso
## 5 Commune V Commune V Bamako
## 6 Bougouni Minignan Sikasso
## Country of residence Date of onset Date de consultation Fever Jaundice
## 1 <NA> 2019-12-03 2019-12-09 <NA> <NA>
## 2 RCI 2019-11-04 2019-11-09 Oui Oui
## 3 RCI 2019-09-17 2019-09-21 Oui Oui
## 4 Mali 2019-11-12 2019-11-17 N/A N/A
## 5 Mali 2019-12-13 2019-12-16 <NA> <NA>
## 6 RCI 2019-11-10 2019-11-15 N/A N/A
## Sample taken Sampling date Date sent to Lab Status Date of death
## 1 <NA> 2019-12-09 NA Suspected <NA>
## 2 Oui 2019-11-11 NA Confirmed <NA>
## 3 Non <NA> NA Suspected N/A
## 4 Non <NA> NA Probable <NA>
## 5 <NA> 2019-12-16 NA Suspected <NA>
## 6 Non <NA> NA Probable 43784
## Immunization status Lab result Outcome Final calssification
## 1 <NA> Négatif Alive Not a case
## 2 Vaccinated <NA> Dead Confirmed
## 3 Not vaccinated Négatif Alive Not a case
## 4 Not vaccinated Non applicabe Dead Probable
## 5 <NA> Négatif Alive Not a case
## 6 Not vaccinated Non applicabe Dead Probable#data cleaning#
#convert date column types
#combine month and years age columns
#standardise categorical values
#missing values
cleandata <- data %>%
# Convert date columns to Date type
mutate(`Date de consultation` = as.Date(`Sampling date`, format="%Y-%m-%d"),
`Date sent to Lab` = as.Date(`Date sent to Lab`, format="%Y-%m-%d"),
`Date of death` = as.Date(`Date of death`, format="%Y-%m-%d")) %>%
# Create a combined age column in years
mutate(
Age = `Age (year)` + floor(ifelse(is.na(`Age (month)`), 0, `Age (month)` / 12))
) %>%
# Standardize categorical variables
mutate(Sex = as.factor(Sex),
Classification = as.factor(`Final calssification`),
Outcome = as.factor(Outcome)) %>%
# Handle missing values
mutate(Age = ifelse(is.na(Age), median(Age, na.rm = TRUE), Age),
`District of residence` = ifelse(is.na(`District of residence`), "Unknown", `District of residence`),
Classification = ifelse(is.na(Classification), "Unknown", Classification),
Outcome = ifelse(is.na(Outcome), "Unknown", Outcome))
# Determine the maximum "Date de consultation"
max_date <- max(cleandata$`Date de consultation`, na.rm = TRUE)
maxepiweek <- epi_week(max_date)## Warning: `data_frame()` was deprecated in tibble 1.1.0.
## ℹ Please use `tibble()` instead.
## ℹ The deprecated feature was likely used in the epical package.
## Please report the issue to the authors.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.#add column that calculates epi week and epi year
cleandata <- cleandata %>%
mutate(
epi_week = epical::epi_week(`Date de consultation`)
)
latest_epi_week <- max(cleandata$epi_week, na.rm = TRUE)
# Calculate highlights
# Calculate the latest epi-week
latest_epi_week <- max(cleandata$epi_week, na.rm = TRUE)
colnames(cleandata)## [1] "Num_ordre" "Age (month)"
## [3] "Age (year)" "Sex"
## [5] "Occupation" "Village"
## [7] "Health area" "District of notification"
## [9] "District of residence" "Region of notification"
## [11] "Country of residence" "Date of onset"
## [13] "Date de consultation" "Fever"
## [15] "Jaundice" "Sample taken"
## [17] "Sampling date" "Date sent to Lab"
## [19] "Status" "Date of death"
## [21] "Immunization status" "Lab result"
## [23] "Outcome" "Final calssification"
## [25] "Age" "Classification"
## [27] "epi_week"# Calculate highlights for the latest epi-week
new_cases <- cleandata %>% dplyr::filter(epi_week$epi_week == 1) %>% nrow()
confirmed_cases <- cleandata %>% dplyr::filter (cleandata$`Final calssification` == "Confirmed") %>% nrow()
deaths <- cleandata %>% dplyr::filter( Outcome == "Dead") %>% nrow()
cumulative_cases <- nrow(cleandata)
probable_cases <- nrow(cleandata %>% filter(Classification == "Probable"))
suspected_cases <- nrow(cleandata %>% filter(Classification == "Suspected"))
cumulative_deaths <- deaths
case_fatality_rate <- (deaths / cumulative_cases) * 100
latest_epi_week <- 1
colnames(cleandata) <- make.names(colnames(cleandata), unique = TRUE)#Situation Report N°4: Epi-week N°‘r maxepiweek’
- Highlights There were 1 new cases reported during epi-week 1, including 5 confirmed cases and 0 deaths.
Since the beginning of the outbreak, there have been a cumulative total of 48 cases, including 5 confirmed cases, 0 probable cases, and 0 suspected cases.
There have been a cumulative total of 0 deaths, resulting in a case fatality rate of 0
2.Situation update
#Table summarizing the number of cases (confirmed, probable, and suspected) by District of residence: Cumulative and last epi-week. Please use the final classification variable.
#Comments the results in 1-3 sentences. (10 marks)
#cummulative cases
cumulative_summary <- cleandata %>%
group_by(District.of.residence, Final.calssification) %>%
summarise(Count = n(), .groups = 'drop') %>%
spread(Final.calssification, Count, fill = 0) %>%
rename(Cumulative_Confirmed = Confirmed,
Cumulative_Probable = Probable,
Cumulative_Suspected = Suspected)
# Cases by District and Final Classification for the last epi-week
weekly_summary <- cleandata %>%
filter(epi_week$epi_week == 1) %>%
group_by(District.of.residence, Final.calssification) %>%
summarise(Count = n(), .groups = 'drop') %>%
spread(Final.calssification, Count, fill = 0)
# Combine the cumulative and weekly summaries
final_summary <- cumulative_summary %>%
full_join(weekly_summary, by = "District.of.residence") %>%
replace(is.na(.), 0)
# Display the final summary table
kable(final_summary, caption = "Summary of Cases by District of Residence: Cumulative and Last Epi-week")| District.of.residence | Cumulative_Confirmed | Not a case | Cumulative_Probable | Cumulative_Suspected | Suspected |
|---|---|---|---|---|---|
| Bougouni | 1 | 7 | 2 | 6 | 0 |
| Commune V | 0 | 2 | 0 | 1 | 0 |
| Douentza | 0 | 1 | 0 | 0 | 0 |
| Inconu | 0 | 1 | 0 | 0 | 0 |
| Kadiolo | 0 | 0 | 0 | 1 | 0 |
| Kalaban coro | 0 | 0 | 0 | 2 | 0 |
| Kangaba | 0 | 0 | 0 | 1 | 0 |
| Kati | 1 | 0 | 0 | 0 | 0 |
| Kayes | 0 | 1 | 0 | 0 | 0 |
| Kignan | 0 | 0 | 0 | 1 | 0 |
| Kolondiéba | 0 | 0 | 0 | 1 | 0 |
| Minignan | 1 | 0 | 1 | 2 | 0 |
| Minignan (RCI) | 1 | 0 | 0 | 0 | 0 |
| Ouelessebougou | 0 | 0 | 0 | 2 | 0 |
| Ouélessebougou | 0 | 0 | 0 | 2 | 0 |
| Sefeto | 0 | 0 | 0 | 1 | 0 |
| Selingue | 1 | 0 | 0 | 0 | 0 |
| Sofeto | 0 | 0 | 0 | 2 | 0 |
| Tombouctou | 0 | 0 | 0 | 5 | 0 |
| Yelimane | 0 | 0 | 0 | 1 | 1 |
#b) Distribution of all cases by classification (confirmed, probable, and suspected) using final classification and by outcome (alive, dead, total) – all in one bar graph (please display labels).
#Comments the results in 1-3 sentences. (15 marks)
# Summarize the data by classification and outcome
classification_outcome_summary <- cleandata %>%
group_by(Final.calssification, Outcome) %>%
summarise(Count = n(), .groups = 'drop')
# Convert Outcome to a factor to ensure proper ordering in the plot
classification_outcome_summary$Outcome <- factor(classification_outcome_summary$Outcome, levels = c("Alive", "Dead", "Total"))
# Create a bar graph
ggplot(classification_outcome_summary, aes(x = Final.calssification, y = Count, fill = Outcome)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Distribution of Cases by Classification and Outcome",
x = "Classification",
y = "Number of Cases",
fill = "Outcome") +
geom_text(aes(label = Count), position = position_dodge(width = 0.9), vjust = -0.5) +
theme_minimal()
#c) Bar graph showing the distribution of cases by epi-week of symptoms onset and classification.
#Please show the labels.
#Please use the facet function to generate the same graph for each district.
#Comments the results in 1-3 sentences. (15 marks)
# Create the bar graph
ggplot(cleandata, aes(x = epi_week$epi_week, fill = Final.calssification)) +
geom_bar(position = "dodge") +
labs(title = "Distribution of Cases by Epi-week of Symptoms Onset and Classification",
x = "Epi-week of Symptoms Onset",
y = "Number of Cases",
fill = "Classification") +
facet_wrap(~ District.of.residence) +
geom_text(stat = 'count', aes(label = ..count..), position = position_dodge(width = 0.9), vjust = -0.5) +
theme_minimal()## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 15 rows containing non-finite outside the scale range (`stat_count()`).
## Removed 15 rows containing non-finite outside the scale range (`stat_count()`).
#d) Age pyramid (distribution of cases by age group and gender) – Please use the following age groups: <5, 5-14,15-24, 25+.
#Please note that ages are provided by month and year in the dataset.
#Comments the results in 1-3 sentences. (15 marks)
#Summarize the data by age group and gender
age_gender_summary <- cleandata %>%
group_by(Age, Sex) %>%
summarise(Count = n(), .groups = 'drop')
# Create the age pyramid
ggplot(age_gender_summary, aes(x = Age, y = ifelse(Sex == "M", -Count, Count), fill = Sex)) +
geom_bar(stat = "identity") +
coord_flip() +
scale_y_continuous(labels = abs) +
labs(title = "Age Pyramid of Cases by Age Group and Gender",
x = "Age Group",
y = "Number of Cases",
fill = "Gender") +
geom_text(aes(label = abs(Count)), position = position_stack(vjust = 0.5)) +
theme_minimal()