Course project: Exploring a large data set

Author

Barite Bedasso

Published

May 6, 2001

Part 1.

A) Data Import

library(readr)
 patients <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/patients.csv", na = "NULL")
Rows: 500000 Columns: 15
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (12): first_name, middle_initial, last_name, gender, race, religion, ma...
dbl   (2): patient_id, zip
date  (1): birth_date

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
library(readr)
disease_types <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/disease_types.csv", na = "NULL")
Rows: 9175 Columns: 3
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (2): icd9cm, name
dbl (1): disease_id

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
library(readr)
diseases <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/diseases.csv", na = "NULL")
Rows: 9687836 Columns: 3
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl  (2): encounter_id, disease_id
dttm (1): date

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
medications <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/medications.csv", na = "NULL")
Rows: 2704000 Columns: 9
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr  (2): dose_units, rate_units
dbl  (6): medications_id, encounter_id, medication_id, patient_id, dose, rate
dttm (1): date

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
medication_types <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/medication_types.csv", na = "NULL")
Rows: 2330 Columns: 7
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (6): medication_name, class, strength, strength_units, form, route
dbl (1): medication_id

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
providers <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/providers.csv", na = "NULL")
Rows: 6097 Columns: 6
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (5): first_name, middle_initial, last_name, gender, status
dbl (1): provider_id

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
departments <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/departments.csv", na = "NULL")
Rows: 74 Columns: 2
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (1): department_name
dbl (1): department_id

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
encounters <- read_csv("/Users/baritebedasso/Desktop/HINF 5531 Course Project Data Files/encounters.csv", na = "NULL")
Rows: 8673082 Columns: 13
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl  (11): encounter_id, patient_id, department_id, provider_id, age, bp_sys...
dttm  (2): admit_date, discharge_date

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

B) Data Summary: 

num_patients <- nrow(patients)
print(num_patients)
[1] 500000

  1. Counts

    a. 500,000 patients

    b. 8,673,082 encountter

    c. 2330 medication types

    d. 2,704,000 medications

    e. 9,175 disease types

    f. 9,687,836 diseases

    g. 74 departments

    h. 6,097 providers

    i.

    library(knitr)
library(reshape2)
library(dplyr)
    
Attaching package: 'dplyr'
    The following objects are masked from 'package:stats':

    filter, lag
    The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union
    patient_stratified_table<- select(patients, race, gender, marital_status, patient_id)

#remove additional warning code
options(dplyr.summarise.inform=FALSE)

patient_stratified_table<- patient_stratified_table %>%
                  group_by(race, gender, marital_status) %>% 
                  summarize(total= n())

kable(head(patient_stratified_table))
    race gender marital_status total
    AFRICAN AMERICAN F DIVORCED 392
    AFRICAN AMERICAN F LIFE PARTNER 2
    AFRICAN AMERICAN F MARRIED 1043
    AFRICAN AMERICAN F SEPARATED 175
    AFRICAN AMERICAN F SINGLE 3565
    AFRICAN AMERICAN F UNKNOWN 56

2. Ten most common encounters

a. Medications 

encounter_with_meds <- merge(encounters, medications)
encounter_with_meds <- merge(encounter_with_meds, medication_types)

encounter_with_meds <- encounter_with_meds %>%
  select(medication_id, medication_name) %>%
  count(medication_name) %>%
  slice_max(order_by = n, n=10)

kable(head(encounter_with_meds, n=10))
medication_name n
HEPARIN 165533
SODIUM CHLORIDE 128494
ACETAMINOPHEN 98849
DOCUSATE SODIUM 80953
MORPHINE 69788
CHLORHEXIDINE GLUCONATE 61846
FAT EMULSION 59350
0.9% SODIUM CHLORIDE 56427
0.5 NORMAL SALINE WITH POTASSIUM CHLORIDE 54295
INSULIN REGULAR 52199

b. Diseases

top_n_diseases <- merge(encounters, diseases)
top_n_diseases <- merge(top_n_diseases, disease_types)

top_n_diseases <- top_n_diseases %>%
  select(disease_id, name) %>%
  count(name) %>%
  slice_max(order_by = n, n=10)

kable(head(top_n_diseases, n=10))
name n
UNSPECIFIED ESSENTIAL HYPERTENSION 199128
DIABETES MELLITUS WITHOUT MENTION OF COMPLICATION, TYPE II OR UNSPECIFIED TYPE, NOT STATED AS UNCONTROLLED 105793
SUPERVISION OF OTHER NORMAL PREGNANCY 96188
SCREENING EXAMINATION FOR PULMONARY TUBERCULOSIS 77709
PAIN IN LIMB 74145
LUMBAGO 56882
OTHER AND UNSPECIFIED HYPERLIPIDEMIA 56880
ASTHMA, UNSPECIFIED TYPE, UNSPECIFIED 55351
DEPRESSIVE DISORDER, NOT ELSEWHERE CLASSIFIED 54355
ROUTINE INFANT OR CHILD HEALTH CHECK 52834

c. Departments

top_n_department <- merge(encounters, departments)

top_n_department <- top_n_department %>%
  select(department_id, department_name) %>%
  count(department_name)%>%
  slice_max (order_by = n , n=10) 

kable(head(top_n_department, n=10))
department_name n
INTERNAL MEDICINE 6161008
RADIOLOGY - GENERAL 274655
FAMILY PRACTICE 256618
OPHTHALMOLOGY 205301
ORTHOPAEDIC 152366
PEDIATRICS - GENERAL 127959
OBG - GENERAL 125574
CANCER CENTER 99552
PSYCHIATRY 98276
EMERGENCY MEDICINE 97810

d. Providers

top_n_provider <- merge(encounters, providers)

top_n_provider<- top_n_provider%>%
  select(provider_id, first_name, last_name) %>%
  count(first_name, last_name) %>%
  slice_max(order_by = n, n=10)

kable(head(top_n_provider, n=10))
first_name last_name n
Zane Fisk 2072933
John Christmas 284007
James Fullerton 183224
Richard Swain 170247
William McCash 153352
Robert Scheuerman 149833
Michael Shapcott 139752
Thomas Wilder-Neligan 138973
Mark Ross 116536
Charles Graham 109350

C) Data Manipulation

encounters <- mutate(encounters, BMI = (weight/(height* height) * 703))
 
patient_enc <- select(encounters, BMI, height, weight, patient_id, age, admit_date, discharge_date, department_id)
patient_enc <- inner_join(patient_enc, patients, by="patient_id")

gender_bmi <- select(patient_enc, BMI, gender, patient_id)
gender_bmi <- group_by(gender_bmi, gender)
gender_bmi_summary <- summarize(gender_bmi, mean_bmi= mean(BMI, na.rm= TRUE), n= n())
kable(head(gender_bmi_summary))
gender mean_bmi n
F 58.49255 4915933
M 366.50221 3757149 
race_bmi <- select(patient_enc, BMI, gender, patient_id, race)
race_bmi <- group_by(race_bmi, race)
race_bmi_summary <- summarize(race_bmi, mean_bmi=mean(BMI, na.rm= TRUE), n= n())
kable(head(race_bmi_summary, n= 10))
race mean_bmi n
AFRICAN AMERICAN 46.08875 262626
ASIAN 27.45869 126760
CAUCASIAN 242.83709 7024266
DECLINED 26.45896 37656
HISPANIC 81.93855 147485
MULTIRACIAL 25.08431 17709
NATIVE AMERICAN 80.94976 28158
OTHER 30.18215 137152
PACIFIC ISLANDER 25.72638 1190
UNKNOWN 34.09725 890080 
gender_race_bmi <- select(patient_enc, BMI, gender, patient_id, race, gender)
gender_race_bmi <- group_by(gender_race_bmi, gender, race)
gender_race_bmi_summary <- summarize(gender_race_bmi, mean_bmi= mean(BMI, na.rm= TRUE), n= n())
gender_race_bmi_summary
# A tibble: 20 × 4
# Groups:   gender [2]
   gender race             mean_bmi       n
   <chr>  <chr>               <dbl>   <int>
 1 F      AFRICAN AMERICAN     40.0  141709
 2 F      ASIAN                28.6   80674
 3 F      CAUCASIAN            62.6 4034298
 4 F      DECLINED             26.8   19686
 5 F      HISPANIC            108.    82642
 6 F      MULTIRACIAL          21.6    9122
 7 F      NATIVE AMERICAN      88.0   18394
 8 F      OTHER                29.5   71745
 9 F      PACIFIC ISLANDER     26.2     438
10 F      UNKNOWN              32.5  457225
11 M      AFRICAN AMERICAN     52.3  120917
12 M      ASIAN                25.8   46086
13 M      CAUCASIAN           454.  2989968
14 M      DECLINED             26.1   17970
15 M      HISPANIC             54.6   64843
16 M      MULTIRACIAL          28.6    8587
17 M      NATIVE AMERICAN      70.4    9764
18 M      OTHER                30.9   65407
19 M      PACIFIC ISLANDER     25.3     752
20 M      UNKNOWN              35.9  432855

2.

los_enc <- mutate(encounters, los=discharge_date-admit_date)
los_enc <- mutate(los_enc, LOS=floor((as.numeric(los)/86400)+1))
los_enc <- filter(los_enc, LOS > 1)
los_enc <- inner_join(los_enc, patients,by="patient_id")
los_enc<-inner_join(los_enc, departments, by="department_id")
kable(head(los_enc))
encounter_id patient_id admit_date discharge_date department_id provider_id age bp_systolic bp_diastolic temperature pulse height weight BMI los LOS first_name middle_initial last_name gender race religion birth_date marital_status language occupation street city state zip department_name
214 2338 1985-12-10 18:25:47 1986-01-09 18:25:47 22 1 82 NA NA NA NA NA NA NA 2592000 secs 31 Lara B Ridley F UNKNOWN OTHER 1903-03-06 SINGLE ENGLISH Office clerk 55 Kerma Crescent High Point NC 27260 INTERNAL MEDICINE
224 2338 1986-01-10 18:25:47 1986-02-06 18:25:47 22 1 82 NA NA NA NA NA NA NA 2332800 secs 28 Lara B Ridley F UNKNOWN OTHER 1903-03-06 SINGLE ENGLISH Office clerk 55 Kerma Crescent High Point NC 27260 INTERNAL MEDICINE
238 2338 1986-02-07 18:38:47 1986-03-09 18:38:47 22 1 82 NA NA NA NA NA NA NA 2592000 secs 31 Lara B Ridley F UNKNOWN OTHER 1903-03-06 SINGLE ENGLISH Office clerk 55 Kerma Crescent High Point NC 27260 INTERNAL MEDICINE
262 2338 1986-03-10 18:40:47 1986-04-08 18:40:47 22 1 82 NA NA NA NA NA NA NA 2505600 secs 30 Lara B Ridley F UNKNOWN OTHER 1903-03-06 SINGLE ENGLISH Office clerk 55 Kerma Crescent High Point NC 27260 INTERNAL MEDICINE
292 2338 1986-04-09 18:41:47 1986-05-09 18:41:47 22 1 82 NA NA NA NA NA NA NA 2592000 secs 31 Lara B Ridley F UNKNOWN OTHER 1903-03-06 SINGLE ENGLISH Office clerk 55 Kerma Crescent High Point NC 27260 INTERNAL MEDICINE
317 2338 1986-05-10 18:42:47 1986-06-08 18:42:47 22 1 82 NA NA NA NA NA NA NA 2505600 secs 30 Lara B Ridley F UNKNOWN OTHER 1903-03-06 SINGLE ENGLISH Office clerk 55 Kerma Crescent High Point NC 27260 INTERNAL MEDICINE 
mean(los_enc$LOS)
[1] 9.044512

Mean LOS is 9.04 days.

Gender LOS:

gender_los <- select(los_enc, LOS, gender, patient_id, age)
gender_los <- group_by(gender_los, gender)
gender_los_summary <- summarize(gender_los, mean_los= mean(LOS, na.rm= TRUE, n= n()))
kable(head(gender_los_summary))
gender mean_los
F 8.165362
M 9.848515

Department LOS:

dept_los <- select(los_enc, LOS, department_id, patient_id, department_name)
dept_los <- group_by(dept_los, department_name)
dept_los_summary <- summarize(dept_los, mean_los = mean(LOS, na.rm = TRUE, n = n()))
dept_los_summary
# A tibble: 71 × 2
   department_name        mean_los
   <chr>                     <dbl>
 1 ALLERGY AND IMMUNOLOGY     4.75
 2 ANESTHESIOLOGY             7.32
 3 AUDIOLOGY                 91.8 
 4 BEHAVIORAL HEALTH         10.1 
 5 BURN UNIT                 14.3 
 6 CANCER CENTER              5.62
 7 CARDIAC REHABILITATION     3.22
 8 CARDIOLOGY                 6.32
 9 CLINICAL RESEARCH          4.5 
10 DENTISTRY                  5.29
# ℹ 61 more rows

Gender and Department LOS simultaneously:

gender_dept_los<- select(los_enc, LOS, department_id, patient_id, department_name, gender)
gender_dept_los<- group_by(gender_dept_los, gender,department_name)
gender_dept_los_summary <- summarize(gender_dept_los, mean_los=mean(LOS, na.rm=TRUE))
summary(gender_dept_los_summary)
    gender          department_name       mean_los      
 Length:131         Length:131         Min.   :  2.000  
 Class :character   Class :character   1st Qu.:  4.863  
 Mode  :character   Mode  :character   Median :  6.952  
                                       Mean   : 14.145  
                                       3rd Qu.:  9.483  
                                       Max.   :367.000  
kable(head(gender_dept_los_summary), n=10)
gender department_name mean_los
F ALLERGY AND IMMUNOLOGY 5.333333
F ANESTHESIOLOGY 7.428571
F AUDIOLOGY 8.000000
F BEHAVIORAL HEALTH 9.428730
F BURN UNIT 16.237654
F CANCER CENTER 5.315790

D) Data Visualization

library(ggplot2)

hist(encounters$age, main="Histogram of Patient Age(y) at Time of Encounter", xlab="Age", ylab= "Frequency", breaks = 20)

2.

library(ggplot2)
encounter_counts <- select(encounters, patient_id,encounter_id)
encounter_counts <- encounter_counts %>% count(encounter_id, name = "Encounter_Count")

ggplot(data = encounter_counts, aes(x = encounter_id)) +
  geom_histogram(binwidth = 50) +
  labs(title = "Histogram of Number of Encounters", x = "Number of Encounters", y = "Count")

library(ggplot2)

hist_plot <- ggplot(data = patient_enc, aes(x = age, y = log(BMI), color = gender)) +
  geom_point() +
  labs(title = "Scatterplot of BMI by Age", x = "Age", y = "log(BMI)") +
  scale_color_manual(values = c("skyblue", "pink"), labels = c("Male", "Female"))


print(hist_plot)
Warning: Removed 8134993 rows containing missing values or values outside the scale
range (`geom_point()`).

panel <- hist_plot +
  geom_point(aes(color = gender), alpha = 0.05) +
  facet_grid(gender ~ race) +
  scale_color_manual(values = c("steelblue", "red"))
Scale for colour is already present.
Adding another scale for colour, which will replace the existing scale.
panel
Warning: Removed 8134993 rows containing missing values or values outside the scale
range (`geom_point()`).
Removed 8134993 rows containing missing values or values outside the scale
range (`geom_point()`).

E) Missing Values

Missing data in key variables like height, weight, systolic and diastolic blood pressure can significantly impact analyses and lead to biased results. Missing height and weight data can prevents accurate calculation of body mass index (BMI), a crucial measure of body composition and health risk assessment. It will create bias analysis related to obesity, overweight prevalence, and associations between BMI and other health outcomes. Missing blood pressure data impairs assessment of hypertension prevalence and cardiovascular disease risk. It limits analyses examining relationships between blood pressure and other factors like age, BMI, etc. It can also affect the identification of individuals requiring hypertension treatment and management.

F) Data validation

The encounters dataset may contain unreasonable values in certain variables like age, blood pressure (both systolic and diastolic), BMI, and temperature. Such extreme values could signal data errors, inconsistencies, or anomalies. Employing data validation techniques is crucial for identifying and addressing outliers or incorrect entries. Depending on the severity and nature of these values, they might be treated as missing data or marked for further scrutiny. Additionally, it’s essential to scrutinize duplicated data, where multiple entries share identical patient identifiers and relevant variables. These duplicates could stem from data entry errors, system glitches, or other issues and must be carefully examined and resolved to ensure data integrity and prevent biases in analysis.

Part 2

  1. Validating ages:

This script calculates the percentage accuracy of age information in the patient_enc dataset. It first creates a new variable expected_age, which computes the age of each patient based on the difference between their admission date (admit_date) and birth date (birth_date). Then, it creates another variable accurate_age that evaluates whether the calculated age matches the provided age in the dataset. Finally, it calculates the percentage of accurate age information by dividing the count of accurate ages by the total number of rows in the dataset (nrow(patient_enc)) and multiplying by 100. The calculated percentage of accurate encounter-specific ages in the dataset is approximately 0.0784%., indicating a very low accuracy rate.

patient_enc <- mutate(patient_enc, expected_age = as.integer(difftime(admit_date, birth_date, units = "auto") / 365.25))

patient_enc <- mutate(patient_enc, accurate_age = ifelse(expected_age == age, TRUE, FALSE))

percentage_accuracy <- sum(patient_enc$accurate_age) / nrow(patient_enc) * 100

percentage_accuracy
[1] 0.000784035
  1. Anonymity and de-identification. To de-identify data, personally identifiable information (PII) like names, addresses, and social security numbers should be entirely removed. Birth dates can be generalized by categorizing them into broader age ranges or retaining only the birth year. Geographic data, like precise addresses or zip codes, can either be generalized to larger regions or removed altogether. Variables indirectly identifying individuals, such as unique identifiers or specific medical conditions, should be carefully evaluated and potentially anonymized or generalized. Techniques like data masking, which involves replacing specific values with consistent pseudonyms or assigning random identifiers, can safeguard sensitive information. The extent of de-identification should be determined considering the context, relevant regulations, and the necessity to balance data utility with privacy protection.