R/final.R at main · OBOptics/R · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
##Load dataset
df <- bua6315_final_project_dataset3
##Load Library
library(tidyverse)
#Identify Missing Values
total_na <- sum(is.na(df))
print(total_na)

sum(is.na(df$variable))
df %>% summarise(across(everything(), ~sum(is.na(.))))
#Use Median Imputation on Missing Values
install.packages("missMethods")
library(missMethods)
df_imp <- impute_median(df, type = "columnwise")
print(df_imp)
##Check for missing values in new dataset
sum(is.na(df_imp$variable))
df_imp %>% summarise(across(everything(), ~sum(is.na(.))))

##Visualize Outliers using Boxplot
library(ggplot2)

ggplot(df_imp, aes(y = Income)) +
  geom_boxplot() +
  ggtitle("Income Outliers (IQR method)")

ggplot(df_imp, aes(y = Weight)) +
  geom_boxplot() +
  ggtitle("Weight Outliers (IQR method)")

##Compute Q1, Q3, and IQR
detect_iqr_outlier <- function(x) {
  Q1 <- quantile(x, 0.25, na.rm=TRUE)
  Q3 <- quantile(x, 0.75, na.rm=TRUE)
  IQR <- Q3 - Q1
  x < (Q1 - 1.5 * IQR) | x > (Q3 + 1.5 * IQR)
}

df_imp %>%
  mutate(out_weight = detect_iqr_outlier(Weight),
         out_income = detect_iqr_outlier(Income)) %>%
  filter(out_weight | out_income)
#Confirm Results
df_imp %>% arrange(desc(Income)) %>% head(10)

##Subset data based on Urban
df_urban <- df_imp %>% filter(Urban == 1)
view(df_urban)

library(dplyr)

# Summarize key stats for Urban Subset
df_urban %>%
  summarise(
    n = n(),
    mean_family = mean(FamilySize, na.rm = TRUE),
    sd_family   = sd(FamilySize, na.rm = TRUE),
    median_family = median(FamilySize, na.rm = TRUE),
    mean_weight = mean(Weight, na.rm = TRUE),
    sd_weight   = sd(Weight, na.rm = TRUE),
    median_weight = median(Weight, na.rm = TRUE),
    mean_income = mean(Income, na.rm = TRUE),
    sd_income   = sd(Income, na.rm = TRUE),
    median_income = median(Income, na.rm = TRUE)
  )
##Compare to Original Data
df_imp %>%
  summarise(
    n = n(),
    mean_family = mean(FamilySize, na.rm = TRUE),
    sd_family   = sd(FamilySize, na.rm = TRUE),
    median_family = median(FamilySize, na.rm = TRUE),
    mean_weight = mean(Weight, na.rm = TRUE),
    sd_weight   = sd(Weight, na.rm = TRUE),
    median_weight = median(Weight, na.rm = TRUE),
    mean_income = mean(Income, na.rm = TRUE),
    sd_income   = sd(Income, na.rm = TRUE),
    median_income = median(Income, na.rm = TRUE)
  )

library(ggplot2)

### Load packages
install.packages(c("tidyr", "ggplot2"))
library(tidyr)
library(ggplot2)


# Reshape to long format
df_long <- df_urban %>%
  pivot_longer(
    cols = Black:White,
    names_to = "race",
    values_to = "income"
  )
##Plot the Scatter Plot
ggplot(df_long, aes(x = Education, y = Income, color = race)) +
  geom_point(size = 3, alpha = 0.7) +
  geom_smooth(method = "lm", se = FALSE) +
  scale_color_manual(values = c(
    "Black"    = "black",
    "White"    = "blue",
    "Hispanic" = "orange"
  )) +
  labs(
    title = "Income vs Education by Race",
    x = "Years of Education",
    y = "Income",
    color = "Race"
  ) +
  theme_minimal()


white_pct <- df_long %>%
  summarise(Percent_White = mean(race == "White") * 100)

print(white_pct)

black_pct <- df_long %>%
  summarise(Percent_Black = mean(race == "Black") * 100)

print(black_pct)