Task 1 — Read the data and look at it

rentals <- read_csv("CampusRentals.csv")

glimpse(rentals)
## Rows: 120
## Columns: 7
## $ apt_id    <chr> "A001", "A002", "A003", "A004", "A005", "A006", "A007", "A00…
## $ sqft      <dbl> 1213, 529, 1250, 575, 988, 528, 700, 1169, 844, 1110, 1199, …
## $ bedrooms  <dbl> 3, 1, 3, 1, 2, 1, 2, 3, 2, 3, 3, 1, 2, 2, 3, 3, 1, 2, 1, 3, …
## $ dist_km   <dbl> 2.3, 1.1, 5.3, 3.1, 3.7, 4.5, 0.8, 1.6, 4.4, 5.1, 2.4, 3.2, …
## $ age_years <dbl> 34, 38, 34, 37, 6, 34, 23, 25, 4, 23, 3, 26, 12, 32, 17, 5, …
## $ parking   <dbl> 0, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, …
## $ rent      <dbl> 1431, 1000, 1286, 722, 1330, 664, 1171, 1697, 1263, 1324, 16…
summary(rentals)
##     apt_id               sqft           bedrooms        dist_km    
##  Length:120         Min.   : 374.0   Min.   :1.000   Min.   :0.30  
##  Class :character   1st Qu.: 600.0   1st Qu.:1.000   1st Qu.:2.05  
##  Mode  :character   Median : 774.0   Median :2.000   Median :3.35  
##                     Mean   : 782.7   Mean   :1.817   Mean   :3.23  
##                     3rd Qu.: 892.0   3rd Qu.:2.000   3rd Qu.:4.50  
##                     Max.   :1327.0   Max.   :3.000   Max.   :6.00  
##    age_years        parking         rent       
##  Min.   : 1.00   Min.   :0.0   Min.   : 614.0  
##  1st Qu.: 9.00   1st Qu.:0.0   1st Qu.: 918.2  
##  Median :20.00   Median :0.5   Median :1041.5  
##  Mean   :19.31   Mean   :0.5   Mean   :1090.2  
##  3rd Qu.:30.00   3rd Qu.:1.0   3rd Qu.:1271.2  
##  Max.   :40.00   Max.   :1.0   Max.   :1717.0

(a) Rent vs sqft, coloured by parking

ggplot(rentals, aes(x = sqft, y = rent, color = factor(parking))) +
  geom_point() +
  labs(
    title = "Monthly Rent vs. Apartment Size",
    x = "Size (square feet)",
    y = "Monthly Rent (USD)",
    color = "Parking\n(1 = yes, 0 = no)"
  )

(b) Rent vs each numeric predictor, faceted

rentals_long <- rentals %>%
  select(rent, sqft, bedrooms, dist_km, age_years) %>%
  pivot_longer(cols = c(sqft, bedrooms, dist_km, age_years),
               names_to = "predictor", values_to = "value")

ggplot(rentals_long, aes(x = value, y = rent)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE) +
  facet_wrap(~ predictor, scales = "free_x") +
  labs(
    title = "Rent vs. Numeric Predictors",
    x = "Predictor value",
    y = "Monthly Rent (USD)"
  )

Correlation matrix

numeric_cols <- rentals %>% select(sqft, bedrooms, dist_km, age_years, parking, rent)
round(cor(numeric_cols), 2)
##            sqft bedrooms dist_km age_years parking  rent
## sqft       1.00     0.91    0.01     -0.21   -0.08  0.86
## bedrooms   0.91     1.00    0.07     -0.23   -0.07  0.79
## dist_km    0.01     0.07    1.00      0.06    0.12 -0.33
## age_years -0.21    -0.23    0.06      1.00    0.00 -0.45
## parking   -0.08    -0.07    0.12      0.00    1.00  0.03
## rent       0.86     0.79   -0.33     -0.45    0.03  1.00

Description (3–4 sentences)

Square footage and number of bedrooms both show a strong positive relationship with rent (r = 0.86 and r = 0.79), which is also clear in the faceted scatterplots as a tight upward trend. Distance from campus and building age are both negatively related to rent (r = -0.33 and r = -0.45) — apartments farther from campus and older buildings tend to rent for less. Parking shows almost no linear relationship with rent on its own (r = 0.03), even though the colour-coded plot in (a) suggests parking spots tend to cluster among higher-rent units, hinting its effect may only show up once size is controlled for. One thing worth flagging is that sqft and bedrooms are themselves highly correlated (r = 0.91), so they are largely capturing the same information about apartment size, which could cause redundancy in a multiple regression.

Task 2 — Split the data

set.seed(6625)

n <- nrow(rentals)
val_idx <- sample(1:n, size = round(0.30 * n))

val   <- rentals[val_idx, ]
train <- rentals[-val_idx, ]

cat("Training rows:", nrow(train), "\n")
## Training rows: 84
cat("Validation rows:", nrow(val), "\n")
## Validation rows: 36

Why is a random split the right choice here?

This is cross-sectional data — a snapshot of currently available listings — not a time series, so there is no chronological order that a random split would violate. Each apartment listing is basically an independent observation, and the apt_id order in the file has no meaningful structure (it’s not, say, sorted by date). A random split therefore gives training and validation sets that are both representative samples of the same underlying population of apartments, which is exactly what we want when the goal is to see how well the model generalizes to listings it hasn’t seen.

Task 3 — Fit two models

model_simple <- lm(rent ~ sqft, data = train)
summary(model_simple)
## 
## Call:
## lm(formula = rent ~ sqft, data = train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -252.089  -97.427   -7.482   96.997  258.286 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 360.64839   50.02927   7.209 2.52e-10 ***
## sqft          0.94195    0.06116  15.401  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 125.3 on 82 degrees of freedom
## Multiple R-squared:  0.7431, Adjusted R-squared:   0.74 
## F-statistic: 237.2 on 1 and 82 DF,  p-value: < 2.2e-16
model_full <- lm(rent ~ sqft + bedrooms + dist_km + age_years + parking, data = train)
summary(model_full)
## 
## Call:
## lm(formula = rent ~ sqft + bedrooms + dist_km + age_years + parking, 
##     data = train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -144.457  -53.025    5.416   45.305  171.911 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 597.7891    36.0303  16.591  < 2e-16 ***
## sqft          0.8571     0.0825  10.389 2.27e-16 ***
## bedrooms     20.9422    25.1142   0.834    0.407    
## dist_km     -49.1157     4.2863 -11.459  < 2e-16 ***
## age_years    -4.8946     0.6319  -7.746 2.92e-11 ***
## parking      77.9624    14.1637   5.504 4.57e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 64.07 on 78 degrees of freedom
## Multiple R-squared:  0.9361, Adjusted R-squared:  0.932 
## F-statistic: 228.7 on 5 and 78 DF,  p-value: < 2.2e-16

Interpretation

sqft coefficient: In the full model, the coefficient on sqft is about 0.86. Holding bedrooms, distance from campus, age, and parking fixed, each additional square foot of living space is associated with about $0.86 more in monthly rent, on average.

parking coefficient: The coefficient on parking is about 77.96. Holding sqft, bedrooms, distance from campus, and age fixed, an apartment that has parking (parking = 1) rents for about $77.96 more per month, on average, than an otherwise identical apartment without parking (parking = 0).

Predictor with a large p-value: bedrooms has a large p-value (≈ 0.41), so it is not statistically significant in the full model — but it shouldn’t be dropped yet without further checks (see Task 5).

Task 4 — Check the residuals

train <- train %>%
  mutate(
    fitted_full = fitted(model_full),
    resid_full  = residuals(model_full)
  )

# Residuals vs fitted
ggplot(train, aes(x = fitted_full, y = resid_full)) +
  geom_point() +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(
    title = "Residuals vs. Fitted Values (Full Model)",
    x = "Fitted values (USD)",
    y = "Residuals (USD)"
  )

# Histogram of residuals
ggplot(train, aes(x = resid_full)) +
  geom_histogram(bins = 15, color = "black", fill = "grey70") +
  labs(
    title = "Histogram of Residuals (Full Model)",
    x = "Residuals (USD)",
    y = "Count"
  )

shapiro.test(residuals(model_full))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(model_full)
## W = 0.98358, p-value = 0.3629

(a) Curve, funnel, or neither?

The residuals vs. fitted plot shows neither a clear curve nor a funnel — the points scatter fairly evenly above and below the zero line across the whole range of fitted values, with no obvious bend or systematic widening/narrowing of spread. A curved pattern would indicate the relationship between the predictors and rent isn’t actually linear (the model is missing some nonlinear term), while a funnel shape (residual spread growing or shrinking with fitted value) would indicate heteroscedasticity — non-constant error variance that would make the standard errors and prediction intervals unreliable. Since we see neither here, the linearity and constant-variance assumptions look reasonably well satisfied.

(b) Shapiro-Wilk null hypothesis and interpretation

The null hypothesis of the Shapiro-Wilk test is that the residuals are drawn from a normally distributed population. Here the test returns W = 0.984 with a p-value of about 0.36, which is well above any conventional significance level (e.g., 0.05), so we fail to reject H0 — there is no evidence against normality of the residuals. This matters for Task 6 because the predict(..., interval = "prediction") interval relies on the assumption that residuals are approximately normally distributed; since that assumption holds up here, we can trust the prediction interval as a reasonably accurate range rather than one that’s systematically too narrow or too wide.

Task 5 — Select and score

model_step <- step(model_full, direction = "backward")
## Start:  AIC=704.66
## rent ~ sqft + bedrooms + dist_km + age_years + parking
## 
##             Df Sum of Sq    RSS    AIC
## - bedrooms   1      2855 323091 703.41
## <none>                   320236 704.66
## - parking    1    124392 444627 730.23
## - age_years  1    246345 566581 750.59
## - sqft       1    443137 763373 775.63
## - dist_km    1    539068 859303 785.58
## 
## Step:  AIC=703.41
## rent ~ sqft + dist_km + age_years + parking
## 
##             Df Sum of Sq     RSS    AIC
## <none>                    323091 703.41
## - parking    1    128321  451411 729.50
## - age_years  1    262290  585380 751.33
## - dist_km    1    541277  864367 784.07
## - sqft       1   3364566 3687656 905.93
summary(model_step)
## 
## Call:
## lm(formula = rent ~ sqft + dist_km + age_years + parking, data = train)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -153.22  -44.63    5.66   44.95  177.28 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 585.88211   33.01629  17.745  < 2e-16 ***
## sqft          0.92043    0.03209  28.682  < 2e-16 ***
## dist_km     -48.51414    4.21704 -11.504  < 2e-16 ***
## age_years    -4.98140    0.62203  -8.008 8.40e-12 ***
## parking      78.92225   14.08963   5.601 2.99e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 63.95 on 79 degrees of freedom
## Multiple R-squared:  0.9356, Adjusted R-squared:  0.9323 
## F-statistic: 286.8 on 4 and 79 DF,  p-value: < 2.2e-16

Which predictor did step() remove, and why isn’t that surprising?

step() removed bedrooms. This isn’t surprising given the Task 1 correlation table: bedrooms and sqft are correlated at r = 0.91, meaning they carry largely the same information about how big an apartment is. Once sqft is already in the model, bedrooms adds little extra explanatory power — which is exactly why it had the large, non-significant p-value (≈ 0.41) we flagged in Task 3 — so backward selection drops it in favor of the more informative sqft.

rmse <- function(actual, predicted) {
  sqrt(mean((actual - predicted)^2))
}

pred_simple <- predict(model_simple, newdata = val)
pred_full   <- predict(model_full,   newdata = val)
pred_step   <- predict(model_step,   newdata = val)

results <- tibble(
  model = c("Simple", "Full", "Step"),
  validation_RMSE = c(
    rmse(val$rent, pred_simple),
    rmse(val$rent, pred_full),
    rmse(val$rent, pred_step)
  ),
  adj_R2 = c(
    summary(model_simple)$adj.r.squared,
    summary(model_full)$adj.r.squared,
    summary(model_step)$adj.r.squared
  )
) %>%
  arrange(validation_RMSE)

results
## # A tibble: 3 × 3
##   model  validation_RMSE adj_R2
##   <chr>            <dbl>  <dbl>
## 1 Full              66.9  0.932
## 2 Step              67.6  0.932
## 3 Simple           124.   0.740

Which model wins, and why?

The Full and Step models are essentially tied (validation RMSE ≈ $66.9 vs. ≈ $67.6, adjusted R² ≈ 0.932 for both), while the Simple model is clearly worse (validation RMSE ≈ $124, adjusted R² ≈ 0.74). Between Full and Step, the Step model is preferable: it achieves virtually the same predictive accuracy with one fewer predictor (having dropped the redundant, non-significant bedrooms), so it’s the more parsimonious choice — I’ll use model_step going forward. Validation RMSE is a fairer scorecard than training R² because R² (and adjusted R²) are computed on the same data used to fit the model, so they can’t reveal overfitting — a model can fit the training data closely just by chasing noise. Validation RMSE, computed on data the model never saw during fitting, measures how well the model actually generalizes to new listings, which is what we care about in practice. The simple model does so much worse because it only uses sqft, ignoring dist_km, age_years, and parking — predictors that the full model shows have real, significant effects on rent — so it’s missing a large share of the systematic variation in price and pushes more of that variation into the error term.

Task 6 — The recommendation (15 points)

A new listing has just come in: 900 sq ft, 2 bedrooms, 2.0 km from campus, a 10-year-old building, with parking. Use predict() with interval = “prediction” on your chosen model to get a suggested rent and a range.

new_listing <- tibble(
  sqft = 900,
  bedrooms = 2,
  dist_km = 2.0,
  age_years = 10,
  parking = 1
)

predict(model_step, newdata = new_listing, interval = "prediction")
##        fit     lwr      upr
## 1 1346.351 1216.53 1476.173

Based on the model, I’d suggest listing this apartment at around $1,346/month, with a reasonable range of $1,217 to $1,476, that range reflects normal listing-to-listing variation, not uncertainty about the model itself, so it’s a genuine price window rather than a margin of error to shrink. I’d trust this model to help price similar listings: on the validation set it was off by about $67 per apartment on average (validation RMSE), and the residual checks in Task 4 didn’t turn up any curve, funnel, or departure from normality that would undermine that prediction interval. That said, I’d treat it as a starting point for negotiation rather than a final number, and I’d want to add neighborhood or building amenities data (e.g., in-unit laundry, updated appliances, utilities included) to the dataset — right now the model only sees size, bedrooms, distance, age, and parking, and features like these likely explain some of the remaining $60-70 in typical prediction error.

#> Attribution note: I used Claude (Anthropic) as an assistant for this assignment. Claude helped draft the R code and also took some helped in understanding the interpretation except RECOMMENDATION, based on running the analysis on CampusRentals.csv. I reviewed the output and take responsibility for the final submitted content.