STAT380- Homework 1
Ethan Agaon
2026-09-09
Question 1
Situation: A bank wants to decide whether to approve a loan applicant. Outcome Variable: loan default status – categorical Potential Predictor Variables: credit score, annual income, debt-to-income ratio, employment length, loan amount requested, existing number of credit accounts. Primary Goal: Prediction
Situation: A real estate company wants to understand what drives home prices in a city. Outcome Variable:sale price of a house. Potential Predictor Variables: square footage, number of bedrooms/bathrooms, lot size, age of the house, distance to downtown, school district rating. Primary Goal: Infrence.
Question 2
True because even without the estimate of f, the model y=f(x) + ε includes irreducible error term ε. Since ε has a nonzero variance, some prediction error will always remain no matter how well you know f.
False because lower training error doesn’t guarantee a better model. a very flexible model can fit the training data extremely well but overfit, capturing noise rather than the true underlying pattern can lead to poor performance on new, unseen data even though training error looks great.
False because MSE typically follows a U-shape as flexibility increases: it first decreases as the model captures more of the true signal, then increases again once the model starts over fitting and picking up noise, it doesn’t increase monotonically the whole way.
Question 3
health_survey <- read.csv("mock_health_survey_data.csv", stringsAsFactors = T)
head(health_survey)## ID nationality gender age activity smoke family_hist area height weight
## 1 1 South Korea M 69 Low No 3 <NA> 176.68 80.81
## 2 2 Korea f NA High <NA> 1 <NA> 163.87 53.38
## 3 3 South Korea F 81 Low <NA> 5 Toronto 164.44 59.35
## 4 4 India f 31 Low <NA> 5 <NA> 163.23 64.49
## 5 5 Egypt Female 36 Low No 2 <NA> 166.34 55.93
## 6 6 South Korea Female 69 High No 6 <NA> 160.69 59.70
## bp_mmhg
## 1 120
## 2 112
## 3 102
## 4 112
## 5 130
## 6 129str(health_survey)## 'data.frame': 101 obs. of 11 variables:
## $ ID : Factor w/ 101 levels "1","10","100",..: 1 13 24 35 46 57 68 79 90 2 ...
## $ nationality: Factor w/ 12 levels "","Brazil","China",..: 9 6 9 5 4 9 12 9 4 2 ...
## $ gender : Factor w/ 8 levels "","f","F","female",..: 6 2 3 2 5 5 6 6 3 3 ...
## $ age : int 69 NA 81 31 36 69 81 NA 50 36 ...
## $ activity : Factor w/ 7 levels "","H","High",..: 5 3 5 5 5 3 4 7 3 5 ...
## $ smoke : Factor w/ 5 levels "","N","No","Y",..: 3 NA NA NA 3 3 3 3 5 4 ...
## $ family_hist: int 3 1 5 5 2 6 1 3 1 4 ...
## $ area : Factor w/ 6 levels "","Dubai","London",..: NA NA 6 NA NA NA NA NA NA NA ...
## $ height : num 177 164 164 163 166 ...
## $ weight : num 80.8 53.4 59.4 64.5 55.9 ...
## $ bp_mmhg : int 120 112 102 112 130 129 117 108 120 182 ...summary(health_survey)## ID nationality gender age activity
## 1 : 1 China :18 M :38 Min. : 20.00 : 1
## 10 : 1 India :17 F :32 1st Qu.: 33.00 H : 3
## 100 : 1 Egypt :15 Female :10 Median : 50.00 High :20
## 11 : 1 Brazil :14 Male : 9 Mean : 51.63 low : 4
## 12 : 1 Mexico :10 f : 5 3rd Qu.: 69.00 Low :38
## 13 : 1 South Korea:10 female : 3 Max. :106.00 Med : 4
## (Other):95 (Other) :17 (Other): 4 NA's :22 Medium:31
## smoke family_hist area height weight
## : 1 Min. : 0.000 : 1 Min. : 61.76 Min. : 48.65
## N :15 1st Qu.: 2.000 Dubai : 4 1st Qu.:159.00 1st Qu.: 59.38
## No :54 Median : 3.000 London : 5 Median :164.93 Median : 69.87
## Y : 3 Mean : 3.151 New York : 4 Mean :155.26 Mean : 80.01
## Yes :11 3rd Qu.: 4.000 Singapore: 3 3rd Qu.:174.16 3rd Qu.: 79.67
## NA's:17 Max. :10.000 Toronto : 7 Max. :187.57 Max. :183.93
## NA's :15 NA's :77 NA's :4 NA's :2
## bp_mmhg
## Min. : 92.0
## 1st Qu.:105.8
## Median :114.0
## Mean :115.3
## 3rd Qu.:122.2
## Max. :182.0
## NA's :1library(ggplot2)
ggplot(health_survey, aes(x = age)) +
geom_histogram(binwidth = 5, na.rm = TRUE) +
labs(title = "Distribution of Age")
ggplot(health_survey, aes(x = gender)) +
geom_bar() +
labs(title = "Count by Gender")
ggplot(health_survey, aes(x = height, y = weight)) +
geom_point(na.rm = TRUE) +
labs(title = "Height vs. Weight")
ggplot(health_survey, aes(x = nationality)) +
geom_bar() +
coord_flip() +
labs(title = "Count by Nationality")
After my EDA, I found that categorical labels like nationality has “South Korea,” “Korea,” “USA,” “United States” all referring to overlapping categories; gender has “M,” “F,” “Male,” “Female,” “male,” “female” as separate factor levels instead of being consolidated. I also found that NA appears across multiple columns such as age, activity, and area and str()/summary() will show you counts per column. There are also possible data entry errors, inconsistent capitilization, and the area column seems mostly missing.
For nationality, my plan is to consolidate duplicate country names into single consistent categories. For gender, my plan is to collapse into two consistent levels like “M”/“F”. For age, my plan is to justify whether to impute or drop rows, weighing that around 22% is a lot to lose; flag 106 as an outlier to watch rather than necessarily removing it. For activity, my plan is to standardize capitalization into 3 levels and convert the blank entry into NA. For smoke, my plan is to consolidate to Yes/No, convert blank to NA, then decide on imputation or removal for the ~18 missing/blank total. For area, my plan is toconsider dropping the column entirely rather than imputing, since there’s too little information to meaningfully fill in. For height, my plan is to lag values below a realistic threshold (e.g., <120) as anomalies, investigate/correct or convert to NA, then handle remaining missing values. For weight, my plan is to flag extreme high values for review. Lastly, for bp_mmhg my plan is to decide whether to cap/flag extreme values or leave them, and impute or drop the single missing value.
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, unionlibrary(forcats)
levels(health_survey$nationality)## [1] "" "Brazil" "China"
## [4] "Egypt" "India" "Korea"
## [7] "Mexico" "Republic of Korea" "South Korea"
## [10] "United States" "US" "USA"levels(health_survey$gender)## [1] "" "f" "F" "female" "Female" "M" "male" "Male"levels(health_survey$activity)## [1] "" "H" "High" "low" "Low" "Med" "Medium"levels(health_survey$smoke)## [1] "" "N" "No" "Y" "Yes"health_survey <- health_survey %>%
mutate(
nationality = fct_recode(nationality,
"South Korea" = "Korea",
"United States" = "USA",
"South Korea" = "Republic of Korea",
"United States" = "US"
),
gender = fct_recode(gender,
"M" = "Male",
"F" = "Female",
"F" = "f",
"F" = "female",
"M" = "male"
),
activity = fct_recode(activity,
"High" = "H",
"High" = "high",
"Low" = "low",
"Medium" = "Med",
"Medium" = "medium"
),
smoke = fct_recode(smoke,
"No" = "N",
"Yes" = "Y"
)
)## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `activity = fct_recode(...)`.
## Caused by warning:
## ! Unknown levels in `f`: high, mediumhealth_survey <- health_survey %>%
mutate(
activity = na_if(activity, ""),
smoke = na_if(smoke, ""),
area = na_if(area, "")
) %>%
mutate(
activity = droplevels(activity),
smoke = droplevels(smoke),
nationality = droplevels(nationality),
gender = droplevels(gender)
)
health_survey <- health_survey %>%
mutate(
height = ifelse(height < 100, NA, height)
)
health_survey <- health_survey %>%
mutate(
weight = ifelse(weight > 180, NA, weight),
bp_mmhg = ifelse(bp_mmhg > 180, NA, bp_mmhg)
)
summary(health_survey)## ID nationality gender age activity smoke
## 1 : 1 China :18 : 1 Min. : 20.00 High :23 No :69
## 10 : 1 India :17 F:50 1st Qu.: 33.00 Low :42 Yes :14
## 100 : 1 Egypt :15 M:50 Median : 50.00 Medium:35 NA's:18
## 11 : 1 Brazil :14 Mean : 51.63 NA's : 1
## 12 : 1 South Korea :13 3rd Qu.: 69.00
## 13 : 1 United States:13 Max. :106.00
## (Other):95 (Other) :11 NA's :22
## family_hist area height weight
## Min. : 0.000 : 0 Min. :152.3 Min. : 48.65
## 1st Qu.: 2.000 Dubai : 4 1st Qu.:160.8 1st Qu.: 59.38
## Median : 3.000 London : 5 Median :168.7 Median : 69.54
## Mean : 3.151 New York : 4 Mean :167.8 Mean : 78.95
## 3rd Qu.: 4.000 Singapore: 3 3rd Qu.:174.4 3rd Qu.: 79.16
## Max. :10.000 Toronto : 7 Max. :187.6 Max. :179.02
## NA's :15 NA's :78 NA's :16 NA's :3
## bp_mmhg
## Min. : 92.0
## 1st Qu.:105.5
## Median :114.0
## Mean :114.6
## 3rd Qu.:121.5
## Max. :165.0
## NA's :2summary(health_survey)## ID nationality gender age activity smoke
## 1 : 1 China :18 : 1 Min. : 20.00 High :23 No :69
## 10 : 1 India :17 F:50 1st Qu.: 33.00 Low :42 Yes :14
## 100 : 1 Egypt :15 M:50 Median : 50.00 Medium:35 NA's:18
## 11 : 1 Brazil :14 Mean : 51.63 NA's : 1
## 12 : 1 South Korea :13 3rd Qu.: 69.00
## 13 : 1 United States:13 Max. :106.00
## (Other):95 (Other) :11 NA's :22
## family_hist area height weight
## Min. : 0.000 : 0 Min. :152.3 Min. : 48.65
## 1st Qu.: 2.000 Dubai : 4 1st Qu.:160.8 1st Qu.: 59.38
## Median : 3.000 London : 5 Median :168.7 Median : 69.54
## Mean : 3.151 New York : 4 Mean :167.8 Mean : 78.95
## 3rd Qu.: 4.000 Singapore: 3 3rd Qu.:174.4 3rd Qu.: 79.16
## Max. :10.000 Toronto : 7 Max. :187.6 Max. :179.02
## NA's :15 NA's :78 NA's :16 NA's :3
## bp_mmhg
## Min. : 92.0
## 1st Qu.:105.5
## Median :114.0
## Mean :114.6
## 3rd Qu.:121.5
## Max. :165.0
## NA's :2health_survey <- health_survey %>%
mutate(
age = ifelse(is.na(age), median(age, na.rm = TRUE), age),
family_hist = ifelse(is.na(family_hist), median(family_hist, na.rm = TRUE), family_hist),
height = ifelse(is.na(height), median(height, na.rm = TRUE), height),
weight = ifelse(is.na(weight), median(weight, na.rm = TRUE), weight),
bp_mmhg = ifelse(is.na(bp_mmhg), median(bp_mmhg, na.rm = TRUE), bp_mmhg)
)
get_mode <- function(x) {
ux <- na.omit(unique(x))
ux[which.max(tabulate(match(x, ux)))]
}
health_survey <- health_survey %>%
mutate(
activity = ifelse(is.na(activity), get_mode(activity), as.character(activity)),
activity = as.factor(activity),
smoke = ifelse(is.na(smoke), get_mode(smoke), as.character(smoke)),
smoke = as.factor(smoke)
)
health_survey <- health_survey %>%
select(-area)
summary(health_survey)## ID nationality gender age activity smoke
## 1 : 1 China :18 : 1 Min. : 20.00 2 : 1 1 :18
## 10 : 1 India :17 F:50 1st Qu.: 36.00 High :23 No :69
## 100 : 1 Egypt :15 M:50 Median : 50.00 Low :42 Yes:14
## 11 : 1 Brazil :14 Mean : 51.28 Medium:35
## 12 : 1 South Korea :13 3rd Qu.: 64.00
## 13 : 1 United States:13 Max. :106.00
## (Other):95 (Other) :11
## family_hist height weight bp_mmhg
## Min. : 0.000 Min. :152.3 Min. : 48.65 Min. : 92.0
## 1st Qu.: 2.000 1st Qu.:162.3 1st Qu.: 59.40 1st Qu.:106.0
## Median : 3.000 Median :168.7 Median : 69.54 Median :114.0
## Mean : 3.129 Mean :168.0 Mean : 78.67 Mean :114.6
## 3rd Qu.: 4.000 3rd Qu.:173.8 3rd Qu.: 78.09 3rd Qu.:121.0
## Max. :10.000 Max. :187.6 Max. :179.02 Max. :165.0
## library(fastDummies)
health_survey <- health_survey %>%
dummy_cols(
select_columns = c("nationality", "gender", "activity", "smoke"),
remove_selected_columns = TRUE
)
summary(health_survey)## ID age family_hist height
## 1 : 1 Min. : 20.00 Min. : 0.000 Min. :152.3
## 10 : 1 1st Qu.: 36.00 1st Qu.: 2.000 1st Qu.:162.3
## 100 : 1 Median : 50.00 Median : 3.000 Median :168.7
## 11 : 1 Mean : 51.28 Mean : 3.129 Mean :168.0
## 12 : 1 3rd Qu.: 64.00 3rd Qu.: 4.000 3rd Qu.:173.8
## 13 : 1 Max. :106.00 Max. :10.000 Max. :187.6
## (Other):95
## weight bp_mmhg nationality_ nationality_Brazil
## Min. : 48.65 Min. : 92.0 Min. :0.000000 Min. :0.0000
## 1st Qu.: 59.40 1st Qu.:106.0 1st Qu.:0.000000 1st Qu.:0.0000
## Median : 69.54 Median :114.0 Median :0.000000 Median :0.0000
## Mean : 78.67 Mean :114.6 Mean :0.009901 Mean :0.1386
## 3rd Qu.: 78.09 3rd Qu.:121.0 3rd Qu.:0.000000 3rd Qu.:0.0000
## Max. :179.02 Max. :165.0 Max. :1.000000 Max. :1.0000
##
## nationality_China nationality_Egypt nationality_India nationality_South Korea
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.0000 Median :0.0000 Median :0.0000 Median :0.0000
## Mean :0.1782 Mean :0.1485 Mean :0.1683 Mean :0.1287
## 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:0.0000 3rd Qu.:0.0000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
##
## nationality_Mexico nationality_United States gender_
## Min. :0.00000 Min. :0.0000 Min. :0.000000
## 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.000000
## Median :0.00000 Median :0.0000 Median :0.000000
## Mean :0.09901 Mean :0.1287 Mean :0.009901
## 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.000000
## Max. :1.00000 Max. :1.0000 Max. :1.000000
##
## gender_F gender_M activity_2 activity_High
## Min. :0.000 Min. :0.000 Min. :0.000000 Min. :0.0000
## 1st Qu.:0.000 1st Qu.:0.000 1st Qu.:0.000000 1st Qu.:0.0000
## Median :0.000 Median :0.000 Median :0.000000 Median :0.0000
## Mean :0.495 Mean :0.495 Mean :0.009901 Mean :0.2277
## 3rd Qu.:1.000 3rd Qu.:1.000 3rd Qu.:0.000000 3rd Qu.:0.0000
## Max. :1.000 Max. :1.000 Max. :1.000000 Max. :1.0000
##
## activity_Low activity_Medium smoke_1 smoke_No
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.0000 Median :0.0000 Median :0.0000 Median :1.0000
## Mean :0.4158 Mean :0.3465 Mean :0.1782 Mean :0.6832
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.0000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
##
## smoke_Yes
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.1386
## 3rd Qu.:0.0000
## Max. :1.0000
## Question 4
library(Lahman)
library(dplyr)
data(Batting)
data(Pitching)
data(People)
head(Batting)## playerID yearID stint teamID lgID G AB R H X2B X3B HR RBI SB CS BB SO IBB
## 1 aardsda01 2004 1 SFN NL 11 0 0 0 0 0 0 0 0 0 0 0 0
## 2 aardsda01 2006 1 CHN NL 45 2 0 0 0 0 0 0 0 0 0 0 0
## 3 aardsda01 2007 1 CHA AL 25 0 0 0 0 0 0 0 0 0 0 0 0
## 4 aardsda01 2008 1 BOS AL 47 1 0 0 0 0 0 0 0 0 0 1 0
## 5 aardsda01 2009 1 SEA AL 73 0 0 0 0 0 0 0 0 0 0 0 0
## 6 aardsda01 2010 1 SEA AL 53 0 0 0 0 0 0 0 0 0 0 0 0
## HBP SH SF GIDP
## 1 0 0 0 0
## 2 0 1 0 0
## 3 0 0 0 0
## 4 0 0 0 0
## 5 0 0 0 0
## 6 0 0 0 0head(Pitching)## playerID yearID stint teamID lgID W L G GS CG SHO SV IPouts H ER HR BB SO
## 1 aardsda01 2004 1 SFN NL 1 0 11 0 0 0 0 32 20 8 1 10 5
## 2 aardsda01 2006 1 CHN NL 3 0 45 0 0 0 0 159 41 24 9 28 49
## 3 aardsda01 2007 1 CHA AL 2 1 25 0 0 0 0 97 39 23 4 17 36
## 4 aardsda01 2008 1 BOS AL 4 2 47 0 0 0 0 146 49 30 4 35 49
## 5 aardsda01 2009 1 SEA AL 3 6 73 0 0 0 38 214 49 20 4 34 80
## 6 aardsda01 2010 1 SEA AL 0 6 53 0 0 0 31 149 33 19 5 25 49
## BAOpp ERA IBB WP HBP BK BFP GF R SH SF GIDP
## 1 0.417 6.75 0 0 2 0 61 5 8 0 1 1
## 2 0.214 4.08 0 1 1 0 225 9 25 1 3 2
## 3 0.300 6.40 3 2 1 0 151 7 24 2 1 1
## 4 0.268 5.55 2 3 5 0 228 7 32 3 2 4
## 5 0.190 2.52 3 2 0 0 296 53 23 2 1 2
## 6 0.198 3.44 5 2 2 0 202 43 19 7 1 5head(People)## playerID birthYear birthMonth birthDay birthCity birthCountry birthState
## 1 aardsda01 1981 12 27 Denver USA CO
## 2 aaronha01 1934 2 5 Mobile USA AL
## 3 aaronto01 1939 8 5 Mobile USA AL
## 4 aasedo01 1954 9 8 Orange USA CA
## 5 abadan01 1972 8 25 Palm Beach USA FL
## 6 abadfe01 1985 12 17 La Romana D.R. La Romana
## deathYear deathMonth deathDay deathCountry deathState deathCity nameFirst
## 1 NA NA NA <NA> <NA> <NA> David
## 2 2021 1 22 USA GA Atlanta Hank
## 3 1984 8 16 USA GA Atlanta Tommie
## 4 NA NA NA <NA> <NA> <NA> Don
## 5 NA NA NA <NA> <NA> <NA> Andy
## 6 NA NA NA <NA> <NA> <NA> Fernando
## nameLast nameGiven weight height bats throws debut bbrefID
## 1 Aardsma David Allan 215 75 R R 2004-04-06 aardsda01
## 2 Aaron Henry Louis 180 72 R R 1954-04-13 aaronha01
## 3 Aaron Tommie Lee 190 75 R R 1962-04-10 aaronto01
## 4 Aase Donald William 190 75 R R 1977-07-26 aasedo01
## 5 Abad Fausto Andres 184 73 L L 2001-09-10 abadan01
## 6 Abad Fernando Antonio 235 74 L L 2010-07-28 abadfe01
## finalGame retroID deathDate birthDate
## 1 2015-08-23 aardd001 <NA> 1981-12-27
## 2 1976-10-03 aaroh101 2021-01-22 1934-02-05
## 3 1971-09-26 aarot101 1984-08-16 1939-08-05
## 4 1990-10-03 aased001 <NA> 1954-09-08
## 5 2006-04-13 abada001 <NA> 1972-08-25
## 6 2023-07-18 abadf001 <NA> 1985-12-17career_batting <- Batting %>%
group_by(playerID) %>%
summarise(
total_HR = sum(HR, na.rm = TRUE),
total_SB = sum(SB, na.rm = TRUE)
) %>%
filter(total_HR >= 300, total_SB >= 300)
result_a <- career_batting %>%
left_join(People, by = "playerID") %>%
select(nameFirst, nameLast, total_HR, total_SB)
result_a## # A tibble: 8 × 4
## nameFirst nameLast total_HR total_SB
## <chr> <chr> <int> <int>
## 1 Carlos Beltran 435 312
## 2 Barry Bonds 762 514
## 3 Bobby Bonds 332 461
## 4 Andre Dawson 438 314
## 5 Steve Finley 304 320
## 6 Willie Mays 660 339
## 7 Alex Rodriguez 696 329
## 8 Reggie Sanders 305 304career_pitching <- Pitching %>%
group_by(playerID) %>%
summarise(
total_W = sum(W, na.rm = TRUE),
total_SO = sum(SO, na.rm = TRUE)
) %>%
filter(total_W >= 300, total_SO >= 3000)
result_b <- career_pitching %>%
left_join(People, by = "playerID") %>%
select(nameFirst, nameLast, total_W, total_SO)
result_b## # A tibble: 10 × 4
## nameFirst nameLast total_W total_SO
## <chr> <chr> <int> <int>
## 1 Steve Carlton 329 4136
## 2 Roger Clemens 354 4672
## 3 Randy Johnson 303 4875
## 4 Walter Johnson 417 3509
## 5 Greg Maddux 355 3371
## 6 Phil Niekro 318 3342
## 7 Gaylord Perry 314 3534
## 8 Nolan Ryan 324 5714
## 9 Tom Seaver 311 3640
## 10 Don Sutton 324 3574career_hits <- Batting %>%
group_by(playerID) %>%
summarise(total_H = sum(H, na.rm = TRUE)) %>%
arrange(desc(total_H)) %>%
slice_head(n = 3)
result_c <- career_hits %>%
left_join(People, by = "playerID") %>%
select(nameFirst, nameLast, total_H)
result_c## # A tibble: 3 × 3
## nameFirst nameLast total_H
## <chr> <chr> <int>
## 1 Pete Rose 4256
## 2 Ty Cobb 4189
## 3 Hank Aaron 3771Question 5
rainfall <- read.csv("Rainfall.csv", stringsAsFactors = T)
names(rainfall) <- trimws(names(rainfall))
head(rainfall)## day pressure maxtemp temparature mintemp dewpoint humidity cloud rainfall
## 1 1 1025.9 19.9 18.3 16.8 13.1 72 49 yes
## 2 2 1022.0 21.7 18.9 17.2 15.6 81 83 yes
## 3 3 1019.7 20.3 19.3 18.0 18.4 95 91 yes
## 4 4 1018.9 22.3 20.6 19.1 18.8 90 88 yes
## 5 5 1015.9 21.3 20.7 20.2 19.9 95 81 yes
## 6 6 1018.8 24.3 20.9 19.2 18.0 84 51 yes
## sunshine winddirection windspeed
## 1 9.3 80 26.3
## 2 0.6 50 15.3
## 3 0.0 40 14.2
## 4 1.0 50 16.9
## 5 0.0 40 13.7
## 6 7.7 20 14.5str(rainfall)## 'data.frame': 366 obs. of 12 variables:
## $ day : int 1 2 3 4 5 6 7 8 9 10 ...
## $ pressure : num 1026 1022 1020 1019 1016 ...
## $ maxtemp : num 19.9 21.7 20.3 22.3 21.3 24.3 21.4 21 18.9 18.5 ...
## $ temparature : num 18.3 18.9 19.3 20.6 20.7 20.9 18.8 18.4 18.1 18 ...
## $ mintemp : num 16.8 17.2 18 19.1 20.2 19.2 17 16.5 17.1 17.2 ...
## $ dewpoint : num 13.1 15.6 18.4 18.8 19.9 18 15 14.4 14.3 15.5 ...
## $ humidity : int 72 81 95 90 95 84 79 78 78 85 ...
## $ cloud : int 49 83 91 88 81 51 56 28 79 91 ...
## $ rainfall : Factor w/ 2 levels "no","yes": 2 2 2 2 2 2 1 1 1 2 ...
## $ sunshine : num 9.3 0.6 0 1 0 7.7 3.4 7.7 3.3 0 ...
## $ winddirection: int 80 50 40 50 40 20 30 60 70 70 ...
## $ windspeed : num 26.3 15.3 14.2 16.9 13.7 14.5 21.5 14.3 39.3 37.7 ...summary(rainfall)## day pressure maxtemp temparature
## Min. : 1.00 Min. : 998.5 Min. : 7.10 Min. : 4.90
## 1st Qu.: 8.00 1st Qu.:1008.5 1st Qu.:21.20 1st Qu.:18.82
## Median :16.00 Median :1013.0 Median :27.75 Median :25.45
## Mean :15.76 Mean :1013.7 Mean :26.19 Mean :23.75
## 3rd Qu.:23.00 3rd Qu.:1018.1 3rd Qu.:31.20 3rd Qu.:28.60
## Max. :31.00 Max. :1034.6 Max. :36.30 Max. :32.40
##
## mintemp dewpoint humidity cloud rainfall
## Min. : 3.10 Min. :-0.40 Min. :36.00 Min. : 0.00 no :117
## 1st Qu.:17.12 1st Qu.:16.12 1st Qu.:75.00 1st Qu.: 58.00 yes:249
## Median :23.70 Median :21.95 Median :80.50 Median : 80.00
## Mean :21.89 Mean :19.99 Mean :80.18 Mean : 71.13
## 3rd Qu.:26.57 3rd Qu.:25.00 3rd Qu.:87.00 3rd Qu.: 88.00
## Max. :30.00 Max. :26.70 Max. :98.00 Max. :100.00
##
## sunshine winddirection windspeed
## Min. : 0.000 Min. : 10.0 Min. : 4.40
## 1st Qu.: 0.500 1st Qu.: 40.0 1st Qu.:13.70
## Median : 3.500 Median : 70.0 Median :20.50
## Mean : 4.419 Mean :101.5 Mean :21.54
## 3rd Qu.: 8.200 3rd Qu.:190.0 3rd Qu.:27.90
## Max. :12.100 Max. :350.0 Max. :59.50
## NA's :1 NA's :1table(rainfall$rainfall)##
## no yes
## 117 249library(ggplot2)
ggplot(rainfall, aes(x = rainfall)) + geom_bar() +
labs(title = "Rain vs. No Rain Days")
ggplot(rainfall, aes(x = humidity)) + geom_histogram(bins = 20) +
labs(title = "Distribution of Humidity")
ggplot(rainfall, aes(x = pressure)) + geom_histogram(bins = 20) +
labs(title = "Distribution of Pressure")
ggplot(rainfall, aes(x = temparature, y = humidity, color = rainfall)) +
geom_point(alpha = 0.6) +
labs(title = "Temperature vs. Humidity by Rainfall")
After my EDA, I found that in the columns pressure, humidity, cloud, and winddirection had leading/ trailing whitespace. I also found that there is a missing value in winddirection and windspeed. I also found that the outcome variable rainfall is a “yes”/“no” factor and that there is a class imbalance.
# To simplify, let’s drop the row with missing values, and assume we have a clean dataset.
rainfall_clean <- na.omit(rainfall) #removes any row that has at least one missing value (NA) in any column storing the result as a new, complete-case dataset.
#----- Train/Test Split -----
# We will use creatDataPartition() function in caret package
# install.packages("caret") # install package first if you don’t have it installed
library(caret) # Loads the caret package, which provides tools for machine learning workflows. used for createDataPartition().## Loading required package: lattice# We use a specific seed to make it reproducible
set.seed(380) # Fixes the random generator to a specific starting point (380) so that any random process that follows the train/test split produces the same result every time the code is run. This makes the split reproducible instead of different on every run.
train_index <- createDataPartition(rainfall_clean$rainfall, p = 0.8, list = FALSE) #Generates a set of row indices for an 80% split, using stratified sampling on the outcome variable rainfall. This means it preserves the same "yes"/"no" proportion (~68%/32%) in the training set as in the full dataset, rather than just randomly picking rows and risking an imbalanced split. list = FALSE returns the indices as a matrix/vector rather than a list, which is easier to subset with.
train_data <- rainfall_clean[train_index, ]
test_data <- rainfall_clean[-train_index, ]
#Uses those indices to split the cleaned dataset into two pieces: train_data (the 80% used to build the model) and test_data (the remaining 20%, held out to evaluate how well the model generalizes to unseen data). The -train_index means "every row not in train_index."
xvar <- c("day", "pressure", "maxtemp", "temparature", "mintemp", "dewpoint",
"humidity", "cloud", "sunshine", "winddirection", "windspeed")
#Defines a vector of column names that will serve as the predictor variables (features) for the KNN model — every numeric weather measurement except the outcome (rainfall) itself.
train_x_raw <- train_data[xvar]
test_x_raw <- test_data[xvar]
#Subsets just those predictor columns from train_data and test_data, creating separate predictor-only data frames. This is a common step before KNN, since KNN needs a clean numeric feature matrix, not the outcome column mixed in.
train_y <- train_data$rainfall
test_y <- test_data$rainfall
#Pulls out the outcome variable (rainfall) separately for the training and test sets. KNN functions in R (like class::knn()) expect predictors (x) and the class labels (y) as separate arguments, which is why they're split apart here rather than kept in the same data frame.train_x_scaled <- scale(train_x_raw)
test_x_scaled <- scale(test_x_raw,
center = attr(train_x_scaled, "scaled:center"),
scale = attr(train_x_scaled, "scaled:scale"))library(class)
set.seed(380)
knn_pred_k1 <- knn(train = train_x_scaled,
test = test_x_scaled,
cl = train_y,
k = 1)
conf_matrix_k1 <- table(Predicted = knn_pred_k1, Actual = test_y)
conf_matrix_k1## Actual
## Predicted no yes
## no 10 10
## yes 13 39test_error_k1 <- mean(knn_pred_k1 != test_y)
test_error_k1## [1] 0.3194444k_values <- c(3, 5, 7, 9, 11)
test_errors <- numeric(length(k_values))
for (i in seq_along(k_values)) {
set.seed(380)
pred <- knn(train = train_x_scaled,
test = test_x_scaled,
cl = train_y,
k = k_values[i])
test_errors[i] <- mean(pred != test_y)
}
# Combine with K=1 result from the previous part for a full picture
results <- data.frame(K = c(1, k_values),
test_error = c(test_error_k1, test_errors))
results## K test_error
## 1 1 0.3194444
## 2 3 0.3055556
## 3 5 0.2916667
## 4 7 0.2361111
## 5 9 0.2638889
## 6 11 0.2777778Test error follows this pattern because of the bias-variance tradeoff: small K makes the model too flexible, so it overfits to noise in individual nearby points (high variance); large K makes the model too simple, so it averages over neighbors that aren’t truly similar and misses real patterns (high bias). Test error is lowest at a middle K that balances the two — too small or too large in either direction hurts generalization to new data.