R Notebook

This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Cmd+Shift+Enter.

rm(list=ls())
library(dplyr)
library(ggplot2)
library(tidyverse)
library(kableExtra)

setwd("~/Documents/DiDa 325/final project/Mortality Rate- final project dataset")
big_data <- read.csv("adult_mortality_rate.csv")
qatar_data <- read.csv("qatar_dataset.csv")
bulgaria_data <- read.csv("bulgaria_dataset.csv")

options(scipen = 999) 

View(big_data)

data_highest <- big_data %>% 
  select("Countries")

bulgaria_data <- na.omit(bulgaria_data)
View(bulgaria_data)

bulgaria_data1 <- bulgaria_data %>%
  select(c(-Indicator.Code, -X)) 

filtered_bulgaria <- bulgaria_data1 %>% 
  select(X2021, Country.Name, Indicator.Name)
View(filtered_bulgaria)

bulgaria_pivot <- filtered_bulgaria %>% 
  pivot_longer(-c(Country.Name, Indicator.Name), names_to = "Year", values_to= "Count")
View(bulgaria_pivot)

wide_data <- bulgaria_data1 %>% 
  select(c(X2021, Country.Name, Indicator.Name))

#Change the data names to make it nice once we reshape it
colnames(wide_data) <- c("Year", "Country", "Indicator")

View(wide_data)

long_data <- wide_data %>% 
  pivot_longer(-Year, names_to = "Gender", values_to = "Majors")

head(long_data)

#What if I wanted to go from long to wide data? Here's what that looks like, for your reference:

wide_data1 <- long_data %>% 
  pivot_wider(names_from = Gender, values_from = Majors)
View(wide_data1)

library(cowplot)

a <- ggplot(bulgaria_pivot)+
  geom_point(aes(x = Indicator.Name, y = Count, color = Year))+
  geom_smooth(method = "lm", aes(x = Indicator.Name, y = Count))+ 
  theme_minimal()+
  labs(title = "Segregation vs Inequality")

b <- ggplot(bulgaria_pivot)+
  geom_point(aes(x = Year, y = Count, color = Year))+
  geom_smooth(method = "lm", aes(x = Year, y = Count))+
  theme_minimal()+
  labs(title = "Segregation vs Crime Rates")

c <- ggplot(bulgaria_pivot)+
  geom_point(aes(x = Country.Name, y = Count, color = Year))+
  geom_smooth(method = "lm", aes(x = Country.Name, y = Count))+
  theme_minimal()+
  labs(title = "Segregation vs College Education")

plot_grid(a, b, c, nrow = 1)

bul_pivot_18 <- bulgaria_data %>%
  select(X2018, Indicator.Name)%>%
  pivot_wider(names_from = Indicator.Name,values_from = X2018) %>%
  mutate(year = 2018)

bul_pivot_19 <- bulgaria_data %>%
  select(X2019, Indicator.Name)%>%
  pivot_wider(names_from = Indicator.Name,values_from = X2019) %>%
  mutate(year = 2019)

bul_pivot_20 <- bulgaria_data %>%
  select(X2020, Indicator.Name)%>%
  pivot_wider(names_from = Indicator.Name,values_from = X2020) %>%
  mutate(year = 2020)

bul_pivot_21 <- bulgaria_data %>%
  select(X2021, Indicator.Name)%>%
  pivot_wider(names_from = Indicator.Name,values_from = X2021) %>%
  mutate(year = 2021)

bul_pivot_22 <- bulgaria_data %>%
  select(X2022, Indicator.Name)%>%
  pivot_wider(names_from = Indicator.Name,values_from = X2022) %>%
  mutate(year = 2022)

allyears <- bind_rows(bul_pivot_18,bul_pivot_19,bul_pivot_20,bul_pivot_21,bul_pivot_22)

allyears <- allyears %>%
  select(year, everything())

View(allyears)

#remove pesky spaces that make ggplot unusable
allyears <- rename_with(allyears, ~ tolower(gsub(" ", "_", .x, fixed = TRUE)))

ggplot(data = allyears, aes(x = year, y = urban_population)) +
  geom_line() +
  geom_point() +
  theme_minimal() +
  labs(title = "Urban Population Over Time", x = "Year", y = "Urban Population") +
  ylim(0, NA) 

NA
NA

mean1 <- allyears %>% summarise(across(everything(), mean)) 
sd1 <- allyears %>% summarise(across(everything(), sd))
min1 <- allyears %>% summarise(across(everything(), min))
max1 <- allyears %>% summarise(across(everything(), max))

#put together into a table using rbind()

table <- rbind(mean1, sd1, min1, max1)
View(table)

rownames(table) <- c("Mean", "Standard Deviation", "Minimum", "Maximum")

table <- t(table)

table <- table %>% 
  as.data.frame %>% 
  mutate_if(is.numeric, round, digits=2)

table

rm(list=ls())
bulgaria <- read.csv("bulgaria.csv")
options(scipen = 999) 
bulgaria <- na.omit(bulgaria)
View(bulgaria)

library(cowplot)

a <- ggplot(bulgaria)+
  geom_point(aes(x = Crude.death.rate, y = Population.density, color = Year))+
  geom_smooth(method = "lm", aes(x = Crude.death.rate, y = Population.density))+ 
  theme_minimal()+
  labs(title = "")

b <- ggplot(bulgaria)+
  geom_point(aes(x = Growth.rate, y = Population.density, color = Year))+
  theme_minimal()+
  labs(title = "")

c <- ggplot(bulgaria)+
  geom_point(aes(x = Gross.reproduction.rate, y = Population.density, color = Year))+
  geom_smooth(method = "lm", aes(x = Gross.reproduction.rate, y = Population.density))+
  theme_minimal()+
  labs(title = "")

plot_grid(a, b, c, nrow = 1)

bulgaria1 <- bulgaria %>% 
  select(c("Crude.birth.rate", "Crude.death.rate", "Population.density", "Both.sexes.life.expectancy.at.birth"))
# bulgaria_number <- as.numeric(bulgaria1)

bulgaria1 <- bulgaria %>%
  mutate_all(as.numeric)

set.seed(8675309)

split <- 0.75

rows  <- nrow(bulgaria1)

train.entries <- sample(rows, rows*split)

model.train <- bulgaria1[train.entries, ]
model.valid  <- bulgaria1[-train.entries,  ]

model <- lm(Crude.birth.rate ~ Population.density + Crude.death.rate + Both.sexes.life.expectancy.at.birth, data=model.train)

summary(model)

Call:
lm(formula = Crude.birth.rate ~ Population.density + Crude.death.rate + 
    Both.sexes.life.expectancy.at.birth, data = model.train)

Residuals:
        4         3         2         8         5         6 
 0.010268  0.004276 -0.004106  0.010513  0.007743 -0.028694 

Coefficients:
                                    Estimate Std. Error t value Pr(>|t|)
(Intercept)                          72.5210   149.2597   0.486    0.675
Population.density                    0.0239     0.5021   0.048    0.966
Crude.death.rate                     -0.8517     1.1936  -0.714    0.550
Both.sexes.life.expectancy.at.birth  -0.7105     1.3279  -0.535    0.646

Residual standard error: 0.02382 on 2 degrees of freedom
Multiple R-squared:  0.9964,    Adjusted R-squared:  0.9911 
F-statistic:   187 on 3 and 2 DF,  p-value: 0.005323

model.valid <- model.valid %>%
    mutate(yhat = predict(model, newdata=model.valid)) %>%
    mutate(residual = Crude.birth.rate - yhat)

model.train <- model.train %>%
    mutate(yhat = predict(model, newdata=model.train)) %>%
    mutate(residual = Crude.birth.rate - yhat)

head(model.valid)

mean(model.valid$residual)

[1] 0.009489347

library(ggplot2)
ggplot(model.valid) +
  geom_point(aes(x=yhat, y=residual)) +
  geom_hline(aes(yintercept=0), linetype="dashed", color="red") +
  xlab("Predicted Crude Birth Rate") +
  ylab("Residual Crude Birth Rate")+
  ylim(-0.4,0.4)+
  theme_minimal()+
  labs(title = "Residual Plot for Validation Model")

bulgaria2 <- bulgaria %>% 
  select(c("Female.infant.mortality.rate", "Male.infant.mortality.rate", "Both.sexes.Infant.mortality.rate", "Year"))

bulgaria1 <- bulgaria %>%
  mutate_all(as.numeric)

bulgaria3 <- bulgaria2 %>% 
  select(c(-Year))

mean1 <- bulgaria3 %>% summarise(across(everything(), mean)) 
sd1 <- bulgaria3 %>% summarise(across(everything(), sd))
min1 <- bulgaria3 %>% summarise(across(everything(), min))
max1 <- bulgaria3 %>% summarise(across(everything(), max))

#put together into a table using rbind()

table <- rbind(mean1, sd1, min1, max1)
View(table)

rownames(table) <- c("Mean", "Standard Deviation", "Minimum", "Maximum")

table <- t(table)

table <- table %>% 
  as.data.frame %>% 
  mutate_if(is.numeric, round, digits=2)

table

table %>%
  kbl(caption = "<center><strong> Infant Mortality Rate</strong></center>", 
      format = "html") %>%
  kable_classic_2("striped", full_width = F) %>%
  row_spec(3, bold = T, color = "white", background = "chartreuse4") %>%
  row_spec(2, bold = T, color = "white", background = "royalblue") %>%
  row_spec(1, bold = T, color = "white", background = "deeppink1") %>% 
  kable_styling()

Infant Mortality Rate

	Mean	Standard Deviation	Minimum	Maximum
Female.infant.mortality.rate	7.10	0.32	6.57	7.49
Male.infant.mortality.rate	9.28	0.37	8.68	9.74
Both.sexes.Infant.mortality.rate	8.22	0.34	7.66	8.65

NA