HW 3
Hing Yee Yashelyn Wong
1. Import the dataset Apartments.xlsx
library(readxl)
mydata <- read_xlsx("./Apartments.xlsx")
head(mydata)## # A tibble: 6 × 5
## Age Distance Price Parking Balcony
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 7 28 1640 0 1
## 2 18 1 2800 1 0
## 3 7 28 1660 0 0
## 4 28 29 1850 0 1
## 5 18 18 1640 1 1
## 6 28 12 1770 0 1Description:
- Age: Age of an apartment in years
- Distance: The distance from city center in km
- Price: Price per m2
- Parking: 0-No, 1-Yes
- Balcony: 0-No, 1-Yes
2. Change categorical variables into factors. (0.5 p)
mydata$ParkingF <- factor(mydata$Parking, levels = c(0,1), labels = c("No", "Yes"))
mydata$BalconyF <- factor(mydata$Balcony, levels = c(0,1), labels = c("No", "Yes"))
head(mydata)## # A tibble: 6 × 7
## Age Distance Price Parking Balcony ParkingF BalconyF
## <dbl> <dbl> <dbl> <dbl> <dbl> <fct> <fct>
## 1 7 28 1640 0 1 No Yes
## 2 18 1 2800 1 0 Yes No
## 3 7 28 1660 0 0 No No
## 4 28 29 1850 0 1 No Yes
## 5 18 18 1640 1 1 Yes Yes
## 6 28 12 1770 0 1 No Yes3. Test the hypothesis H0: Mu_Price = 1900 eur. What can you conclude? (1 p)
t.test(mydata$Price, mu = 1900, alternative = "two.sided")##
## One Sample t-test
##
## data: mydata$Price
## t = 2.9022, df = 84, p-value = 0.004731
## alternative hypothesis: true mean is not equal to 1900
## 95 percent confidence interval:
## 1937.443 2100.440
## sample estimates:
## mean of x
## 2018.941H0: Mu_Price = 1900 eur
H1: Mu_Price ≠ 1900 eur
We reject H0 at p=0.005. The average price per m2 of an apartment is not equal to 1900 eur.
4. Estimate the simple regression function: Price = f(Age). Save results in object fit1 and explain the estimate of regression coefficient, coefficient of correlation and coefficient of determination. (2 p)
fit1 <- lm(Price ~ Age, data = mydata)
summary(fit1)##
## Call:
## lm(formula = Price ~ Age, data = mydata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -623.9 -278.0 -69.8 243.5 776.1
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2185.455 87.043 25.108 <2e-16 ***
## Age -8.975 4.164 -2.156 0.034 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 369.9 on 83 degrees of freedom
## Multiple R-squared: 0.05302, Adjusted R-squared: 0.04161
## F-statistic: 4.647 on 1 and 83 DF, p-value: 0.03401cor(mydata$Price, mydata$Age)## [1] -0.230255Regression coefficient = -8.975: If the age of an apartment is increased by 1 year, the price per m2 decreases by 8.975 eur on average.
Coefficient of correlation = -0.230255: There is a weak and negative linear relationship between age and the price of the apartments.
Coefficient of determination = 0.05302: Around 5.3% of variability of price can be explained by the age of the apartment.
5. Show the scateerplot matrix between Price, Age and Distance. Based on the matrix determine if there is potential problem with multicolinearity. (0.5 p)
library(car)## Loading required package: carDatascatterplotMatrix(mydata[ , c(1:3)], smooth = FALSE)
Based on the matrix, there is no potential problem with multicolinearity.
6. Estimate the multiple regression function: Price = f(Age, Distance). Save it in object named fit2.
fit2 <- lm(Price ~ Age + Distance, data = mydata)
summary(fit2)##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -603.23 -219.94 -85.68 211.31 689.58
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2460.101 76.632 32.10 < 2e-16 ***
## Age -7.934 3.225 -2.46 0.016 *
## Distance -20.667 2.748 -7.52 6.18e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 286.3 on 82 degrees of freedom
## Multiple R-squared: 0.4396, Adjusted R-squared: 0.4259
## F-statistic: 32.16 on 2 and 82 DF, p-value: 4.896e-117. Chech the multicolinearity with VIF statistics. Explain the findings. (1 p)
vif(fit2)## Age Distance
## 1.001845 1.001845Both values are less than 5, so there is no multicolinearity.
8. Calculate standardized residuals and Cooks Distances for model fit2. Remove any potentially problematic units (outliers or units with high influence). (2 p)
mydata$StdResid <- round(rstandard(fit2), 3)
mydata$CooksD <- round(cooks.distance(fit2), 3)
hist(mydata$StdResid, xlab = "Standardized residuals", ylab = "Frequency", main = "Histogram of standardized residuals")
As all values are within +-3, it is unnecessary to remove any data points.
hist(mydata$CooksD, xlab = "Cooks distance", ylab = "Frequency", main = "Histogram of Cooks distances")
As there is a wide gap, the observation following the gap will be removed.
head(mydata[order(mydata$StdResid), ], 3)## # A tibble: 3 × 9
## Age Distance Price Parking Balcony ParkingF BalconyF StdResid CooksD
## <dbl> <dbl> <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl>
## 1 7 2 1760 0 1 No Yes -2.15 0.066
## 2 12 14 1650 0 1 No Yes -1.50 0.013
## 3 12 14 1650 0 0 No No -1.50 0.013head(mydata[order(-mydata$CooksD), ], 6)## # A tibble: 6 × 9
## Age Distance Price Parking Balcony ParkingF BalconyF StdResid CooksD
## <dbl> <dbl> <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl>
## 1 5 45 2180 1 1 Yes Yes 2.58 0.32
## 2 43 37 1740 0 0 No No 1.44 0.104
## 3 2 11 2790 1 0 Yes No 2.05 0.069
## 4 7 2 1760 0 1 No Yes -2.15 0.066
## 5 37 3 2540 1 1 Yes Yes 1.58 0.061
## 6 40 2 2400 0 1 No Yes 1.09 0.038library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:car':
##
## recode## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionmydata <- mydata %>%
filter(!CooksD == 0.320)fit2 <- lm(Price ~ Age + Distance, data = mydata)9. Check for potential heteroskedasticity with scatterplot between standarized residuals and standardized fitted values. Explain the findings. (1 p)
mydata$StdFitted <- scale(fit2$fitted.values)
library(car)
scatterplot(y = mydata$StdResid, x = mydata$StdFitted, ylab = "Standardized residuals", xlab = "Standardized fitted values", boxplots = FALSE, regLine = FALSE, smooth = FALSE)
There seems to have some heteroskedasticity as the data points seems to be opening out a little. Breusch Pagan Test will be used to further determine if there is heteroskedasticity or not.
install.packages("olsrr", repos = "https://cloud.r-project.org/", dependencies = TRUE)## Installing package into 'C:/Users/user/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)## package 'olsrr' successfully unpacked and MD5 sums checked
##
## The downloaded binary packages are in
## C:\Users\user\AppData\Local\Temp\Rtmp6HBVEz\downloaded_packageslibrary(olsrr)##
## Attaching package: 'olsrr'## The following object is masked from 'package:datasets':
##
## riversols_test_breusch_pagan(fit2)##
## Breusch Pagan Test for Heteroskedasticity
## -----------------------------------------
## Ho: the variance is constant
## Ha: the variance is not constant
##
## Data
## ---------------------------------
## Response : Price
## Variables: fitted values of Price
##
## Test Summary
## -----------------------------
## DF = 1
## Chi2 = 2.927455
## Prob > Chi2 = 0.08708469H0: The variance is constant.
H1: The variance is not constant.
We cannot reject H0. The variance is constant, so there is no heteroskedasticity.
10. Are standardized residuals ditributed normally? Show the graph and formally test it. Explain the findings. (1 p)
hist(mydata$StdResid, xlab = "Standardized residuals", ylab = "Frequency", main = "Histogram of standardized residuals")
shapiro.test(mydata$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata$StdResid
## W = 0.94879, p-value = 0.002187H0: Standardized Residuals are normally distributed.
H1: Standardized Residuals are not normally distributed.
We reject H0 at p=0.003. The standardized residuals are not normally distributed. This may be due to the sample size being too small (less than 100).
11. Estimate the fit2 again without potentially excluded units and show the summary of the model. Explain all coefficients. (2 p)
fit2 <- lm(Price ~ Age + Distance,
data = mydata)
summary(fit2)##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -604.92 -229.63 -56.49 192.97 599.35
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2456.076 73.931 33.221 < 2e-16 ***
## Age -6.464 3.159 -2.046 0.044 *
## Distance -22.955 2.786 -8.240 2.52e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 276.1 on 81 degrees of freedom
## Multiple R-squared: 0.4838, Adjusted R-squared: 0.4711
## F-statistic: 37.96 on 2 and 81 DF, p-value: 2.339e-12Intercept = 2456.076: The price of a new apartment in the city center is 2456.076 eur per m2 on average.
Regression coefficient for Age = -6.464: If the age of an apartment is increased by 1 year, the price per m2 decreases by 6.464 eur on average, assuming all other variables remain constant.
Regression coefficient for Distance = -22.955: If the distance of the apartment from the city center is increased by 1 km, the price per m2 decreases by 22.955 on average, assuming all other variables remain constant.
Coefficient of determination = 0.4838: Around 48.38% of variability of price can be explained by the age and the distance of the apartment.
12. Estimate the linear regression function Price = f(Age, Distance, Parking and Balcony). Be careful to correctly include categorical variables. Save the object named fit3.
fit3 <- lm(Price ~ Age + Distance + ParkingF + BalconyF,
data = mydata)
summary(fit3)##
## Call:
## lm(formula = Price ~ Age + Distance + ParkingF + BalconyF, data = mydata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -473.21 -192.37 -28.89 204.17 558.77
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2329.724 93.066 25.033 < 2e-16 ***
## Age -5.821 3.074 -1.894 0.06190 .
## Distance -20.279 2.886 -7.026 6.66e-10 ***
## ParkingFYes 167.531 62.864 2.665 0.00933 **
## BalconyFYes -15.207 59.201 -0.257 0.79795
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.5 on 79 degrees of freedom
## Multiple R-squared: 0.5275, Adjusted R-squared: 0.5035
## F-statistic: 22.04 on 4 and 79 DF, p-value: 3.018e-1213. With function anova check if model fit3 fits data better than model fit2. (1 p)
anova(fit2, fit3)## Analysis of Variance Table
##
## Model 1: Price ~ Age + Distance
## Model 2: Price ~ Age + Distance + ParkingF + BalconyF
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 81 6176767
## 2 79 5654480 2 522287 3.6485 0.03051 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1H0: Fit 2 is better than Fit 3.
H1: Fit 3 is better than Fit 2.
We reject H0 at p=0.04, so Fit 3 is better than Fit 2.
14. Show the results of fit3 and explain regression coefficient for both categorical variables. Can you write down the hypothesis which is being tested with F-statistics, shown at the bottom of the output? (2 p)
summary(fit3)##
## Call:
## lm(formula = Price ~ Age + Distance + ParkingF + BalconyF, data = mydata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -473.21 -192.37 -28.89 204.17 558.77
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2329.724 93.066 25.033 < 2e-16 ***
## Age -5.821 3.074 -1.894 0.06190 .
## Distance -20.279 2.886 -7.026 6.66e-10 ***
## ParkingFYes 167.531 62.864 2.665 0.00933 **
## BalconyFYes -15.207 59.201 -0.257 0.79795
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.5 on 79 degrees of freedom
## Multiple R-squared: 0.5275, Adjusted R-squared: 0.5035
## F-statistic: 22.04 on 4 and 79 DF, p-value: 3.018e-12Given the values of all other explanatory variables, apartments with parking have on average price per m2 higher by 167.531 eur compared to apartments without parking (p=0.01).
We cannot say that balcony has a statistically significant effect of an apartment’s price per m2.
F-statistics:
H0: 𝜌2 = 0
H1: 𝜌2 > 0
We reject H0 at p<0.001.
15. Save fitted values and calculate the residual for apartment ID2. (1 p)
mydata$Fitted <- fitted.values(fit3)
mydata$Residuals <- residuals(fit3)
mydata[2, 12]## # A tibble: 1 × 1
## Residuals
## <dbl>
## 1 428.The residual for apartment ID2 is 427.8.