HW 3
NAME SURNAME
Fanshi Zhang
1. Import the dataset Apartments.xlsx
library(readxl)
mydata <- read_xlsx("./Apartments.xlsx")
mydata <- as.data.frame(mydata)
head(mydata)## Age Distance Price Parking Balcony
## 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$ParkingFactor <- factor(mydata$Parking,
levels = c(0, 1),
labels = c("No", "Yes"))
mydata$BalconyFactor <- factor(mydata$Balcony,
levels = c(0, 1),
labels = c("No", "Yes"))
head(mydata)## Age Distance Price Parking Balcony ParkingFactor BalconyFactor
## 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)
mean(mydata$Price)## [1] 2018.941sd(mydata$Price)## [1] 377.8417library(ggplot2)
ggplot(mydata, aes(x = Price)) +
geom_histogram(binwidth = 100, colour = "black") +
ylab("Frequency") +
xlab("Price")
shapiro.test(mydata$Price)##
## Shapiro-Wilk normality test
##
## data: mydata$Price
## W = 0.94017, p-value = 0.0006513H0: the price is normally distributed
H1: the price is not normally distributed
Since the p-value is less than 0.05, we reject the H0, so the price is not normally distributed. So we can’t use t-test, then we choose to use wilcox test.
median(mydata$Price)## [1] 1950wilcox.test(mydata$Price,
mu = 1900,
alternative = "two.sided",
correct = FALSE)##
## Wilcoxon signed rank test
##
## data: mydata$Price
## V = 2328, p-value = 0.02828
## alternative hypothesis: true location is not equal to 1900H0: the location of price is equal to 1900 euro.
H1: the location of price is not equal to 1900 euro.
Since the p-value is less than 0.05, so we reject the H0, the location is not equal to 1900.
library(effectsize)
effectsize(wilcox.test(mydata$Price,
mu = 1900,
correct = FALSE))## r (rank biserial) | 95% CI
## --------------------------------
## 0.27 | [0.04, 0.48]
##
## - Deviation from a difference of 1900.interpret_rank_biserial(0.27, rules = "funder2019")## [1] "medium"
## (Rules: funder2019)#Conclusion: Based on the sample data, we reject the null hypothesis, so the median price is not 1900 euro (P<0.05, r=0.27-medium effect), is higher than 1900 euro.
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_coef <- sqrt(summary(fit1)$r.squared)
cor_coef## [1] 0.230255Estimate of regression coefficient: -8.975. If the age of the apartment increases by 1 year, the price decreases by on average 8.975 euro per m². (p<0.05)
coefficient of correlation: 0.230255. The liner relationship between price and age is weak.
coefficient of determination: 0.05302. 5.302% of the data can be explained by the liner effect of age.
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)## 载入需要的程辑包：carDatascatterplotMatrix(mydata[ , c(1:3)],
smooth = FALSE) 
Since there is no strong linear relationship between age and distance, there is no potencial 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.001845mean(vif(fit2))## [1] 1.001845All VIF statistics are less than 5, and the average VIF is nearly 1, 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")
hist(mydata$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances")
head(mydata[order(mydata$StdResid),], 3)## Age Distance Price Parking Balcony ParkingFactor BalconyFactor StdResid CooksD
## 53 7 2 1760 0 1 No Yes -2.152 0.066
## 13 12 14 1650 0 1 No Yes -1.499 0.013
## 72 12 14 1650 0 0 No No -1.499 0.013head(mydata[order(-mydata$StdResid),], 3)## Age Distance Price Parking Balcony ParkingFactor BalconyFactor StdResid CooksD
## 38 5 45 2180 1 1 Yes Yes 2.577 0.320
## 33 2 11 2790 1 0 Yes No 2.051 0.069
## 2 18 1 2800 1 0 Yes No 1.783 0.030head(mydata[order(-mydata$CooksD),], 6)## Age Distance Price Parking Balcony ParkingFactor BalconyFactor StdResid CooksD
## 38 5 45 2180 1 1 Yes Yes 2.577 0.320
## 55 43 37 1740 0 0 No No 1.445 0.104
## 33 2 11 2790 1 0 Yes No 2.051 0.069
## 53 7 2 1760 0 1 No Yes -2.152 0.066
## 22 37 3 2540 1 1 Yes Yes 1.576 0.061
## 39 40 2 2400 0 1 No Yes 1.091 0.038library(dplyr)##
## 载入程辑包：'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, unionmydata1 <- mydata %>%
filter(! mydata$CooksD == 0.320)9. Check for potential heteroskedasticity with scatterplot between standarized residuals and standrdized fitted values. Explain the findings. (1 p)
fit2 <- lm(Price ~ Age + Distance,
data = mydata1)
mydata1$StdFitted <- scale(fit2$fitted.values)
library(car)
scatterplot(y = mydata1$StdResid, x = mydata1$StdFitted,
ylab = "Standardized residuals",
xlab = "Standardized fitted values",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
Residuals are evenly spread and there is no distinct pattern or model, so there is no potential heteroskedasticity.
10. Are standardized residuals ditributed normally? Show the graph and formally test it. Explain the findings. (1 p)
hist(mydata1$StdResid,
xlab = "Standardized residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
shapiro.test(mydata1$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata1$StdResid
## W = 0.94879, p-value = 0.002187Since the p-value is less than 0.05, the standardized residuals are not normally distributed. And according to the histgraph, there is bimodal distribution.
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
## -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-11-7.934: Assuming the distance is given, if the age increases by 1 year, the price of the apartment per square meter on average decreases by 7.934 euro.(p<0.05)
-20.667: Assuming the age is given, if the distance from the center increases by 1km, the price of the apartment per square meter on average decreases by 20.667 euro.(p<0.001)
0.4396: 43.96% of the data can be explained by the model.
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 + ParkingFactor + BalconyFactor,
data = mydata)
summary(fit3)##
## Call:
## lm(formula = Price ~ Age + Distance + ParkingFactor + BalconyFactor,
## data = mydata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -459.92 -200.66 -57.48 260.08 594.37
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2301.667 94.271 24.415 < 2e-16 ***
## Age -6.799 3.110 -2.186 0.03172 *
## Distance -18.045 2.758 -6.543 5.28e-09 ***
## ParkingFactorYes 196.168 62.868 3.120 0.00251 **
## BalconyFactorYes 1.935 60.014 0.032 0.97436
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 273.7 on 80 degrees of freedom
## Multiple R-squared: 0.5004, Adjusted R-squared: 0.4754
## F-statistic: 20.03 on 4 and 80 DF, p-value: 1.849e-1113. 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 + ParkingFactor + BalconyFactor
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 82 6720983
## 2 80 5991088 2 729894 4.8732 0.01007 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1H0: delta ρ² = 0
H1: delta ρ² > 0
P<0.05, we reject H0, so fit3 is 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 + ParkingFactor + BalconyFactor,
## data = mydata)
##
## Residuals:
## Min 1Q Median 3Q Max
## -459.92 -200.66 -57.48 260.08 594.37
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2301.667 94.271 24.415 < 2e-16 ***
## Age -6.799 3.110 -2.186 0.03172 *
## Distance -18.045 2.758 -6.543 5.28e-09 ***
## ParkingFactorYes 196.168 62.868 3.120 0.00251 **
## BalconyFactorYes 1.935 60.014 0.032 0.97436
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 273.7 on 80 degrees of freedom
## Multiple R-squared: 0.5004, Adjusted R-squared: 0.4754
## F-statistic: 20.03 on 4 and 80 DF, p-value: 1.849e-11196.168: Assuming all values of other variables are unchanged, the price of apartment with parking is on average 196.168 euro higher than the apartment without parking.(p<0.01)
1.935: Assuming all values of other variables are unchanged, the price of apartment with balcony is on average 1.935 euro higher than the apartment without balcony, but the result is not signifiant.
H0: There is no significant linear relationship between the age, distance, parking, balcony and the price in the population.
H1: There is significant linear relationship between the age, distance, parking, balcony and the price in the population.
15. Save fitted values and calculate the residual for apartment ID2. (1 p)
residuals <- residuals(fit3)
head(residuals)## 1 2 3 4 5 6
## -110.74150 442.58893 -88.80674 260.07897 -412.57579 -126.69107So the residual for apartment ID2 is 442.58893.