HW 3
NAME SURNAME
Boris Davidovic
1. Import the dataset Apartments.xlsx
library(readxl)
data <- read_excel('./Apartments.xlsx')Description:
- 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)
data$ParkingF <- factor(data$Parking,
levels = c(0,1),
labels = c("No", "Yes"))
data$BalconyF <- factor(data$Balcony,
levels = c(0,1),
labels = c("No", "Yes"))3. Test the hypothesis H0: Mu_Price = 1900 eur. What can you conclude? (1 p)
summary(data$Price)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1400 1710 1950 2019 2290 2820t_test <- t.test(data$Price, mu = 1900)
print(t_test)##
## One Sample t-test
##
## data: data$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.941It can be concluded that we can reject the null hypothesis of the average price being equal to 1900 EUR as the p-value of the t-test is less than alpha (0.05)
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 = data)
summary(fit1)##
## Call:
## lm(formula = Price ~ Age, data = data)
##
## 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_coef <- sqrt(summary(fit1)$r.squared)
cor_coef## [1] 0.230255The regression coefficient is -8.975 – this means that for every year increase in the age of the apartment, the price per m2 of the apartment decrease by 8.975.
The coefficient of correlation is 0.230255 which indicates that there is some strength in the linear relationship between age and price.
The coefficient of determination is 0.05302 which indicates age has a very small effect on the variability of the apartment price.
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((data[,c(1,2,3)]), smooth = FALSE)
The scatter plot matrix indicates that age and distance could have
multicolinearity as their linear relationship forms a horizontal line
which is an indicator of multicolinearity.
6. Estimate the multiple regression function: Price = f(Age, Distance). Save it in object named fit2.
fit2 <- lm(Price ~ Age + Distance, data = data)
summary(fit2)##
## Call:
## lm(formula = Price ~ Age + Distance, data = data)
##
## 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-11The regression function is: Price = 2460.101 - 7.934(Age) - 20.667(Distance)
7. Chech the multicolinearity with VIF statistics. Explain the findings. (1 p)
vif(fit2)## Age Distance
## 1.001845 1.001845mean(vif(fit2))## [1] 1.001845As the VIF statistics are highly close to 1, this means 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)
data$StdResid <- round(rstandard(fit2), 3)
data$CooksD <- round(cooks.distance(fit2), 3)
hist(data$StdResid,
xlab = "Standard Residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
hist(data$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distance")
head(data[order(data$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(data[order(-data$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, uniondata <- data %>% filter(!StdResid <= -1.499)
data <- data %>% filter(!CooksD >= 0.038)
print(data)## # A tibble: 77 × 9
## Age Distance Price Parking Balcony ParkingF BalconyF StdResid CooksD
## <dbl> <dbl> <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl>
## 1 7 28 1640 0 1 No Yes -0.665 0.007
## 2 18 1 2800 1 0 Yes No 1.78 0.03
## 3 7 28 1660 0 0 No No -0.594 0.006
## 4 28 29 1850 0 1 No Yes 0.754 0.008
## 5 18 18 1640 1 1 Yes Yes -1.07 0.005
## 6 28 12 1770 0 1 No Yes -0.778 0.005
## 7 14 20 1850 0 1 No Yes -0.302 0.001
## 8 18 6 1970 1 1 Yes Yes -0.787 0.004
## 9 22 7 2270 1 0 Yes No 0.455 0.001
## 10 25 2 2570 1 0 Yes No 1.24 0.017
## # ℹ 67 more rowsfit2 <- lm(Price ~ Age + Distance, data = data)
data$StdResid <- round(rstandard(fit2), 3)
data$CooksD <- round(cooks.distance(fit2), 3)
hist(data$StdResid,
xlab = "Standard Residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
hist(data$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distance")
9. Check for potential heteroskedasticity with scatterplot between standarized residuals and standrdized fitted values. Explain the findings. (1 p)
data$StdFitted <- scale(fit2$fitted.values)
library(car)
scatterplot(y = data$StdResid, x = data$StdFitted,
ylab = "Standard residuals",
xlab = "Standardized fitted values",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
From the scatterplot, there is slight evidence of heteroskedasticity as
there is a small narrowing of the scatter as the fitted values
increase.
10. Are standardized residuals ditributed normally? Show the graph and formally test it. Explain the findings. (1 p)
hist(data$StdResid,
xlab = "Standard Residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
shapiro.test(data$StdResid)##
## Shapiro-Wilk normality test
##
## data: data$StdResid
## W = 0.92828, p-value = 0.0003172The standardized residuals are not distributed normally as the p-value from the Shapiro test is signficantly less than 0.05, meaning values are not normally distributed
11. Estimate the fit2 again without potentially excluded units and show the summary of the model. Explain all coefficients. (2 p)
summary(fit2)##
## Call:
## lm(formula = Price ~ Age + Distance, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -412.09 -211.38 -54.55 191.65 476.60
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2539.816 74.371 34.15 < 2e-16 ***
## Age -10.715 3.286 -3.26 0.00168 **
## Distance -23.554 2.647 -8.90 2.57e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 250 on 74 degrees of freedom
## Multiple R-squared: 0.561, Adjusted R-squared: 0.5492
## F-statistic: 47.29 on 2 and 74 DF, p-value: 5.885e-14The intercept coefficient is 2539.816 which is an increase from the previous fit2 summary.
The regression coefficient of Age is -10.715 which means for every year increase in age of the apartment, the price per m2 of the apartment decrease by 10.715. The p-value of Age is 0.00168 which is below 0.05 which indicates Age has a noticeable impact on price.
The regression coefficient of Distance is -23.554 which means for every km increase in distance from the city centre for the apartment, the price per m2 decreases by 23.554. The p-value is 2.57e-13 which is significantly below 0.05, indicating that it has a very strong impact on apartment prices and a much higher impact than age.
The R-square value is 0.561 which is an increase from the previous fit2 regression. This means the removal of excluded units increased how good the fit of the regression is.
The F-squared value in conjunction with the corresponding p-value (5.885e-14 ) indicates the model is statisitically significant.
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 = data)
fit3##
## Call:
## lm(formula = Price ~ Age + Distance + ParkingF + BalconyF, data = data)
##
## Coefficients:
## (Intercept) Age Distance ParkingFYes BalconyFYes
## 2442.301 -10.228 -21.490 119.406 -5.895The function for apartment price in this model is: Price = 2442.301 - 10.228(Age) - 21.490(Distance) + 119.406(ifParkingYes) - 5.895(ifBalconyYes)
13. 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 74 4623967
## 2 72 4389016 2 234951 1.9271 0.153Because the p-value is greater than alpha (0.05), we can’t conclude that fit 3 fits the data better than fit2. To further prove this, from the summary below, we can also see the R-squared is 0.5833 which is slightly higher than fit2, but not enough to justify it fits the data better
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 = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -378.78 -175.74 -29.07 187.96 491.47
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2442.301 94.196 25.928 < 2e-16 ***
## Age -10.228 3.269 -3.129 0.00253 **
## Distance -21.490 2.817 -7.628 7.58e-11 ***
## ParkingFYes 119.406 61.032 1.956 0.05429 .
## BalconyFYes -5.895 57.343 -0.103 0.91840
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 246.9 on 72 degrees of freedom
## Multiple R-squared: 0.5833, Adjusted R-squared: 0.5602
## F-statistic: 25.2 on 4 and 72 DF, p-value: 4.513e-13The regression coefficient regarding categorical variables is 119.406 for if there is parking and -5.895 if there is a balcony included with the apartment. This means that the price per m2 of the apartment increases by 119.406 if there is parking and decreases by 5.895 if there is a balcony.
The null hypothesis of the F-statistic is that none of the independent variables have an effect on the dependent variable (i.e. the regression coefficients are 0). Because the p-value of the F-statistic is 4.513e-13 which is less than alpha (0.05), we can reject the null hypothesis and conclude that the dependent variables DO have an effect on the independent variable which is Price.
15. Save fitted values and calculate the residual for apartment ID2. (1 p)
data$Fitted <- fitted.values(fit3)
data$Residuals <- residuals(fit3)
head(data)## # A tibble: 6 × 12
## Age Distance Price Parking Balcony ParkingF BalconyF StdResid CooksD StdFitted[,1] Fitted Residuals
## <dbl> <dbl> <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 7 28 1640 0 1 No Yes -0.682 0.01 -0.740 1763. -123.
## 2 18 1 2800 1 0 Yes No 1.94 0.041 1.12 2356. 444.
## 3 7 28 1660 0 0 No No -0.6 0.008 -0.740 1769. -109.
## 4 28 29 1850 0 1 No Yes 1.20 0.026 -1.63 1527. 323.
## 5 18 18 1640 1 1 Yes Yes -1.14 0.007 -0.318 1985. -345.
## 6 28 12 1770 0 1 No Yes -0.76 0.006 -0.196 1892. -122.The fitted values for apartment ID2 are 2356.110 and the residuals are 443.8897