MATH2349 Semester 2, 2019

Assignment 3

Required packages

library(readr) # Useful for reading data
library(car) # Useful to qqplot
library(dplyr)  # Useful for data maipulation
library(tidyr) # Useful for tidying data
library(Hmisc) # Useful for utility operation
library(ggplot2) # Useful for creating plots
library(outliers) # Useful to handle outliers
library(knitr) # Useful for creating nice tables
library(lubridate) # Useful for date/time
library(forecast) # Userful for analysing time series data
library(naniar) # Userful for Handling data 
rm(list=ls()) # Cleaning environment
# getwd()
setwd("D:/Studies/MS/Sem1/Data Preprocessing (MATH2349)/Assignment/Assignment3") # Set userdirectory

Executive Summary

Aim of the assignment is, collecting two different datasets, merging, understanding and analysiing dataset, perform data processing concepts like correct datatype conversion. Further checking tidy principles on dataset and coverting data into tidy form using various method if it doesn’t satisfy. Next is to scan and handle missing values and outliers, And exclude or replace with appropriate values if it is necessary to do which helps to nearly accurate analysis. After applying tidy principle and handling inapproriate values, check for normality of data and applying any trasnformation to convert into normalized form. These task will help us to prepare data for any statisitcal analysis or reporting.

Data

We are using demographic and population health data(around 3141 US counties) to perform data preprocessing task.But we will focus on county data to perform task.

Datasource: https://data.world/data-society/health-status-indicators https://catalog.data.gov/dataset/community-health-status-indicators-chsi-to-combat-obesity-heart-disease-and-cancer#sec-dates

Dataset1: Demographic contains county/population count by age group and total Dataset2: Vulnerable population data by various category like unemployed, depression, Drug user for particular time span(2001-2003, 1999-2003, 1994-2003)

Both dataset has State_FIPS_Code, Country_FIPS_Code which helps to identify state and county developed by National Bureau of Standards. Some measure column contains any of these values -9999, -2222, -222, -2 which represent NA/Not available/ No details. All measures are calculated based on average.

dataset1 <- read.csv("demographic.csv",stringsAsFactors = FALSE)
dataset2 <- read.csv("vulnerablepopulation.csv",stringsAsFactors = FALSE)

Understand

Dataset1 (Dempographic Population by Age) :

• Snapshot and data strcture of demographic data

# Data Structure of dataset1
dataset_1 <- dataset1 %>%  select(-c("CHSI_State_Name", "Strata_ID_Number"))
head(dataset_1)

str(dataset_1)

'data.frame':   3141 obs. of  8 variables:
 $ State_FIPS_Code : int  1 1 1 1 1 1 1 1 1 1 ...
 $ County_FIPS_Code: int  1 3 5 7 9 11 13 15 17 19 ...
 $ CHSI_County_Name: chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Abbr : chr  "AL" "AL" "AL" "AL" ...
 $ Age_19_Under    : num  26.9 23.5 24.3 24.6 24.5 24.7 25.6 24.1 24.8 21.9 ...
 $ Age_19_64       : num  62.3 60.3 62.5 63.3 62.1 63.2 58.5 61.6 59.5 61.4 ...
 $ Age_65_84       : num  9.8 14.5 11.6 10.9 12.1 10 13.6 12.7 13.5 15.2 ...
 $ Age_85_and_Over : num  0.9 1.8 1.6 1.2 1.3 2.2 2.4 1.5 2.2 1.4 ...

• Total Observations: 3141, TOtal Variables: 8
• State_FIPS_Code : int(2) State Code
• County_FIPS_Code : int(2) County Code
• CHSI_County_Name : chr Country Name
• CHSI_State_Abbr : chr County Abbreviation
• Age_19_Under : num population count with age < 19
• Age_19_64 : num population count with age >= 19 and <=64
• Age_65_84 : num population count with age >= 65 and <=84
  
• Age_85_and_Over : num population count with age >= 85

Dataset2 (Vulnerable Population) :

• Snapshot and data structure of demographic data

# Data Structure of dataset1
dataset_2 <- dataset2 %>%  select(-c("CHSI_State_Name", "Strata_ID_Number"))
head(dataset_2)

str(dataset_2)

'data.frame':   3141 obs. of  10 variables:
 $ State_FIPS_Code  : int  1 1 1 1 1 1 1 1 1 1 ...
 $ County_FIPS_Code : int  1 3 5 7 9 11 13 15 17 19 ...
 $ CHSI_County_Name : chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Abbr  : chr  "AL" "AL" "AL" "AL" ...
 $ No_HS_Diploma    : int  6690 20254 6729 5355 11181 2848 4363 19546 8718 6398 ...
 $ Unemployed       : int  774 2533 569 358 819 327 537 2182 849 464 ...
 $ Sev_Work_Disabled: int  1727 4933 1302 900 2217 448 976 5722 1470 1154 ...
 $ Major_Depression : int  2680 9354 1618 1218 3164 626 1164 6400 2005 1436 ...
 $ Recent_Drug_Use  : int  2394 7753 1403 1034 2675 565 1029 5545 1647 1140 ...
 $ EH_Time_Span     : chr  "1999-2003" "2001-2003" "1999-2003" "1994-2003" ...

• Total Observations: 3141, TOtal Variables: 10
• State_FIPS_Code : int(2) State Code
• County_FIPS_Code : int(2) County Code
• CHSI_County_Name : chr Country Name
• CHSI_State_Abbr : chr County Abbreviation
• No_HS_Diploma : int No high school diploma
• Unemployed : int unemployed count
• Sev_Work_Disabled : int severely work disabled
• Major_Depression : int major depression
• Recent_Drug_Use : int recent drug users(last month)
• EH_Time_Span : chr time span

Joining datasets

• Merging both dataset by State_FIPS_Code, County_FIPS_Code and create combine dataset
• Snapshot of new dataset

# Joining dataset1 with dataset2 based in State_FIPS_Code
dataset <- left_join(dataset1, dataset2,by=c("State_FIPS_Code","County_FIPS_Code"))
head(dataset)

• data strcture of new dataset

str(dataset)

'data.frame':   3141 obs. of  20 variables:
 $ State_FIPS_Code   : int  1 1 1 1 1 1 1 1 1 1 ...
 $ County_FIPS_Code  : int  1 3 5 7 9 11 13 15 17 19 ...
 $ CHSI_County_Name.x: chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Name.x : chr  "Alabama" "Alabama" "Alabama" "Alabama" ...
 $ CHSI_State_Abbr.x : chr  "AL" "AL" "AL" "AL" ...
 $ Strata_ID_Number.x: int  29 16 51 42 28 75 76 6 50 64 ...
 $ Age_19_Under      : num  26.9 23.5 24.3 24.6 24.5 24.7 25.6 24.1 24.8 21.9 ...
 $ Age_19_64         : num  62.3 60.3 62.5 63.3 62.1 63.2 58.5 61.6 59.5 61.4 ...
 $ Age_65_84         : num  9.8 14.5 11.6 10.9 12.1 10 13.6 12.7 13.5 15.2 ...
 $ Age_85_and_Over   : num  0.9 1.8 1.6 1.2 1.3 2.2 2.4 1.5 2.2 1.4 ...
 $ CHSI_County_Name.y: chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Name.y : chr  "Alabama" "Alabama" "Alabama" "Alabama" ...
 $ CHSI_State_Abbr.y : chr  "AL" "AL" "AL" "AL" ...
 $ Strata_ID_Number.y: int  29 16 51 42 28 75 76 6 50 64 ...
 $ No_HS_Diploma     : int  6690 20254 6729 5355 11181 2848 4363 19546 8718 6398 ...
 $ Unemployed        : int  774 2533 569 358 819 327 537 2182 849 464 ...
 $ Sev_Work_Disabled : int  1727 4933 1302 900 2217 448 976 5722 1470 1154 ...
 $ Major_Depression  : int  2680 9354 1618 1218 3164 626 1164 6400 2005 1436 ...
 $ Recent_Drug_Use   : int  2394 7753 1403 1034 2675 565 1029 5545 1647 1140 ...
 $ EH_Time_Span      : chr  "1999-2003" "2001-2003" "1999-2003" "1994-2003" ...

• Variable suffix with .x belongs to dataset1 and with .y belongs to dataset2.

Tidy & Manipulate Data I

• Current dataset contains Age category as variables which we need to reshape.
• Also Vulnerable Category as variables which also needs to be reshape

# reshape age category
dataset_t1 <- dataset %>% gather(c("Age_19_Under","Age_19_64","Age_65_84","Age_85_and_Over"),key="Age",value="Age_Population")
# reshape Vulnerable Category
dataset_t2 <- dataset_t1 %>%  gather(c("No_HS_Diploma","Unemployed","Sev_Work_Disabled","Major_Depression","Recent_Drug_Use"),key="Vulnerable_Category", value="Vulnerable_Population") 
str(dataset_t2)

'data.frame':   62820 obs. of  15 variables:
 $ State_FIPS_Code      : int  1 1 1 1 1 1 1 1 1 1 ...
 $ County_FIPS_Code     : int  1 3 5 7 9 11 13 15 17 19 ...
 $ CHSI_County_Name.x   : chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Name.x    : chr  "Alabama" "Alabama" "Alabama" "Alabama" ...
 $ CHSI_State_Abbr.x    : chr  "AL" "AL" "AL" "AL" ...
 $ Strata_ID_Number.x   : int  29 16 51 42 28 75 76 6 50 64 ...
 $ CHSI_County_Name.y   : chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Name.y    : chr  "Alabama" "Alabama" "Alabama" "Alabama" ...
 $ CHSI_State_Abbr.y    : chr  "AL" "AL" "AL" "AL" ...
 $ Strata_ID_Number.y   : int  29 16 51 42 28 75 76 6 50 64 ...
 $ EH_Time_Span         : chr  "1999-2003" "2001-2003" "1999-2003" "1994-2003" ...
 $ Age                  : chr  "Age_19_Under" "Age_19_Under" "Age_19_Under" "Age_19_Under" ...
 $ Age_Population       : num  26.9 23.5 24.3 24.6 24.5 24.7 25.6 24.1 24.8 21.9 ...
 $ Vulnerable_Category  : chr  "No_HS_Diploma" "No_HS_Diploma" "No_HS_Diploma" "No_HS_Diploma" ...
 $ Vulnerable_Population: int  6690 20254 6729 5355 11181 2848 4363 19546 8718 6398 ...

• Factoring Age and Vulnerable category

# Factoring Age and Vulnerable Category
Age_cat <- c("Age_19_Under","Age_19_64","Age_65_84","Age_85_and_Over")
Age_Cat_labels <- c("<19","19-64","65-84","85+")
vulnerable_cat <- c("No_HS_Diploma","Unemployed","Sev_Work_Disabled","Major_Depression","Recent_Drug_Use")

dataset_t2 <- mutate(dataset_t2 
                        ,Age_Cat=factor(Age,levels=Age_cat, labels=Age_Cat_labels,ordered = TRUE)
                        ,Vulnerable_Cat=factor(Vulnerable_Category,levels=vulnerable_cat)
                       ) %>% select(-c("Age","Vulnerable_Category"))

• Summary of Age Categorywise Population

summary(dataset_t2$Age_Population)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  0.100   5.175  19.600  25.000  47.300  83.300 

• Summary of Vulnerable Population

summary(dataset_t2$Vulnerable_Population)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
      1     500    1298    5646    3881 1872316     148 

Tidy & Manipulate Data II

• Dataset has EH_Time_Span which contains 2 years(separated by “-”) start and end year of reporting data. So, separate will create two new variable(“Start_Year”,“End_Year”).

dataset_t3 <- dataset_t2 %>% separate(EH_Time_Span, into=c("Start_Year","End_Year"),sep="-")
str(dataset_t3)

'data.frame':   62820 obs. of  16 variables:
 $ State_FIPS_Code      : int  1 1 1 1 1 1 1 1 1 1 ...
 $ County_FIPS_Code     : int  1 3 5 7 9 11 13 15 17 19 ...
 $ CHSI_County_Name.x   : chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Name.x    : chr  "Alabama" "Alabama" "Alabama" "Alabama" ...
 $ CHSI_State_Abbr.x    : chr  "AL" "AL" "AL" "AL" ...
 $ Strata_ID_Number.x   : int  29 16 51 42 28 75 76 6 50 64 ...
 $ CHSI_County_Name.y   : chr  "Autauga" "Baldwin" "Barbour" "Bibb" ...
 $ CHSI_State_Name.y    : chr  "Alabama" "Alabama" "Alabama" "Alabama" ...
 $ CHSI_State_Abbr.y    : chr  "AL" "AL" "AL" "AL" ...
 $ Strata_ID_Number.y   : int  29 16 51 42 28 75 76 6 50 64 ...
 $ Start_Year           : chr  "1999" "2001" "1999" "1994" ...
 $ End_Year             : chr  "2003" "2003" "2003" "2003" ...
 $ Age_Population       : num  26.9 23.5 24.3 24.6 24.5 24.7 25.6 24.1 24.8 21.9 ...
 $ Vulnerable_Population: int  6690 20254 6729 5355 11181 2848 4363 19546 8718 6398 ...
 $ Age_Cat              : Ord.factor w/ 4 levels "<19"<"19-64"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ Vulnerable_Cat       : Factor w/ 5 levels "No_HS_Diploma",..: 1 1 1 1 1 1 1 1 1 1 ...

Scan I

• Data contains values like -9999, -2222, -222, -2 which represent NA/Not available/ No details.
• First step, find missing values by variables

# Finding Missing values
colSums(is.na(dataset_t3))

      State_FIPS_Code      County_FIPS_Code    CHSI_County_Name.x     CHSI_State_Name.x 
                    0                     0                     0                     0 
    CHSI_State_Abbr.x    Strata_ID_Number.x    CHSI_County_Name.y     CHSI_State_Name.y 
                    0                     0                     0                     0 
    CHSI_State_Abbr.y    Strata_ID_Number.y            Start_Year              End_Year 
                    0                     0                     0                     0 
       Age_Population Vulnerable_Population               Age_Cat        Vulnerable_Cat 
                    0                   148                     0                     0 

# total missing values
sum(is.na(dataset_t3))

[1] 148

• Missing data is very less compare to total no of observation, so we can omit them. And Other reason is, If we replace the with mean or median of individual variable, it can lead to wrong result.

# Omitting missing values
dataset_t4 <- na.omit(dataset_t3)
sum(is.na(dataset_t4))

[1] 0

• Check for special values Inf,-Inf, NaN in Age_Population

# Total NaN values in Age_Population
sum(is.nan(dataset_t4$Age_Population))

[1] 0

# Total Inf/-Inf values in Age_Population
sum(is.infinite(dataset_t4$Age_Population))

[1] 0

• Check for special values Inf,-Inf, NaN in Vulnerable_Population

# Total NaN values in Vulnerable_Population
sum(is.nan(dataset_t4$Vulnerable_Population))

[1] 0

# Total Inf/-Inf values in Vulnerable_Population
sum(is.infinite(dataset_t4$Vulnerable_Population))

[1] 0

Scan II

• Scanning outliers for Age_Population and Vulnerable_Population using z-score>3 and boxplot method.

# Z-Score for Age Population
z.scores_age <- dataset_t4$Age_Population %>% scores(type="z")
length (which( abs(z.scores_age) >3 ))

[1] 0

• Age Population has no value which has z.score>3. It means Age population has no outliers.

# Boxplot for Age Population
boxplot(dataset_t4$Age_Population, main = "BoxPlot of Age Population", ylab = "Population")

• By studying z.score and boxplot, we can conculde Age_Population has no outliers.

# Z-Score for Vulnerable Population
z.scores_vul <- dataset_t4$Vulnerable_Population %>% scores(type="z")
length (which( abs(z.scores_vul) >3 ))

[1] 448

• Identify outliers by boxplot

# Boxplot for Vulnerable Population
boxplot(dataset_t4$Vulnerable_Population, main = "BoxPlot of Vulnerable Population", ylab = "Population")

• As per z.score and boxplot, Vulnerable Population has ~448 outlier. We can handle those using capping function and result will not have much affect.

# Capping function to replace the outlier value with 1st and 3rd Quantilies.
cap <- function(x){quantiles <- quantile(x,c(0.05,0.25,0.75,0.95))
  x[x < quantiles[2] - 1.5*IQR(x)] <- quantiles[1]
  x[x > quantiles[3] + 1.5*IQR(x)] <- quantiles[4]
  x
}
# Replace Outlier values using capping function
dataset_t4$Vulnerable_Population[is.na(dataset_t4$Vulnerable_Population) != TRUE] <-
dataset_t4$Vulnerable_Population[is.na(dataset_t4$Vulnerable_Population) != TRUE] %>% cap()
# After capping boxplot
boxplot(dataset_t4$Vulnerable_Population, main = "BoxPlot of Vulnerable Population", ylab = "Population")

• After capping of outlier, z.score check for Vulnerable_Population and count Z.Score>3 is zero. it means Vulnerable_Population has no outliers.

# Z-Score for Vulnerable Population
z.scores_vul <- dataset_t4$Vulnerable_Population %>% scores(type="z")
length (which( abs(z.scores_vul) >3 ))

[1] 0

Transform

• Transforming Age Population data

hist(dataset_t4$Age_Population, main="Histogram for Age Population", xlab="Mean of Age population")
abline(v = mean(dataset_t4$Age_Population), col="red", lwd=3, lty=2)

• Histogram of Age Population show, it is not normalize data. But Age group is multi variate variable so it can’t be converted into normalize data. Even if we apply normalize technique, result might be as below.

# Apply boxcox with lamda Auto to normalize the data
dataset_t4$Age_Population_Box <- BoxCox(dataset_t4$Age_Population, lambda = "auto")
dataset_t4$Age_Population_Box<-scale(dataset_t4$Age_Population_Box,center=TRUE,scale=TRUE)
hist(dataset_t4$Age_Population_Box, main="After transformation, Histogram for Age Population", xlab="Mean of Age population")
abline(v = mean(dataset_t4$Age_Population_Box), col="red", lwd=3, lty=2)

• Transforming Vulnerable Population data

hist(dataset_t4$Vulnerable_Population, main="Histogram for Vulnerable Population", xlab="Mean of Vulnerable population")
abline(v = mean(dataset_t4$Vulnerable_Population), col="red", lwd=3, lty=2)

• Histogram of Vulnerable Population show, it is not normalize data. We can convert it by applying boxcox method with one outlier which we can ignore.

# Apply boxcox with lamda Auto to normalize the data
dataset_t4$Vulnerable_Population_Box_1 <- BoxCox(dataset_t4$Vulnerable_Population, lambda = "auto")
dataset_t4$Vulnerable_Population_Box <- BoxCox(dataset_t4$Vulnerable_Population_Box_1, lambda = "auto")
hist(dataset_t4$Vulnerable_Population_Box, main="After transformation, Histogram for Vulnerable Population", xlab="Mean of Vulnerable population")
abline(v = mean(dataset_t4$Vulnerable_Population_Box), col="red", lwd=3, lty=2)