5943_AppliedDataAnalysisInBusinessWithR_HW3
Markus Weiss
2024-05-03
1. Import the dataset Apartments.xlsx
# Load dataset
apartments <- read_xlsx("Apartments.xlsx")
head(apartments)NADescription:
- 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)
# Convert character columns to factors
apartments$Parking <- factor(apartments$Parking,
levels = c(0, 1),
labels = c("no", "yes"))
apartments$Balcony <- factor(apartments$Balcony,
levels = c(0, 1),
labels = c("no", "yes"))
head(apartments)NA3. Test the hypothesis H0: Mu_Price = 1900 eur. What can you conclude? (1 p)
# Explore the dataset
summary(apartments) Age Distance Price Parking Balcony
Min. : 1.00 Min. : 1.00 Min. :1400 no :42 no :48
1st Qu.:12.00 1st Qu.: 4.00 1st Qu.:1710 yes:43 yes:37
Median :18.00 Median :12.00 Median :1950
Mean :18.55 Mean :14.22 Mean :2019
3rd Qu.:24.00 3rd Qu.:20.00 3rd Qu.:2290
Max. :45.00 Max. :45.00 Max. :2820 describe(apartments)apartments
5 Variables 85 Observations
---------------------------------------------------------------------------------------------------------------------------------
Age
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
85 0 29 0.99 18.55 10.86 6.2 7.0 12.0 18.0 24.0 32.0 37.8
lowest : 1 2 5 6 7, highest: 37 38 40 43 45
---------------------------------------------------------------------------------------------------------------------------------
Distance
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
85 0 30 0.997 14.22 12.62 1.0 2.0 4.0 12.0 20.0 29.0 38.6
lowest : 1 2 3 4 5, highest: 33 37 39 40 45
---------------------------------------------------------------------------------------------------------------------------------
Price
n missing distinct Info Mean Gmd .05 .10 .25 .50 .75 .90 .95
85 0 50 0.999 2019 427.5 1570 1620 1710 1950 2290 2570 2782
lowest : 1400 1510 1560 1610 1620, highest: 2750 2790 2800 2810 2820
---------------------------------------------------------------------------------------------------------------------------------
Parking
n missing distinct
85 0 2
Value no yes
Frequency 42 43
Proportion 0.494 0.506
---------------------------------------------------------------------------------------------------------------------------------
Balcony
n missing distinct
85 0 2
Value no yes
Frequency 48 37
Proportion 0.565 0.435
---------------------------------------------------------------------------------------------------------------------------------# Plot distribution of price
hist(apartments$Price,
main = "Distribution of the variable Price",
ylab = "Frequency",
xlab = "Price",
breaks = seq(1000, 3000, 200),
right = FALSE)
# Test for normality
shapiro.test(apartments$Price)
Shapiro-Wilk normality test
data: apartments$Price
W = 0.94017, p-value = 0.0006513wilcox.test(apartments$Price,
mu = 1900,
correct = FALSE)
Wilcoxon signed rank test
data: apartments$Price
V = 2328, p-value = 0.02828
alternative hypothesis: true location is not equal to 1900effectsize(wilcox.test(apartments$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)The descriptive and graphical analysis would lead me to the conclusion that Mu_Price is NOT equal to 1900 eur and Price is NOT normally distributed, but let’s see what the statistical tests show.
First I used the Shapiro-Wilk test to check if Price is normally distributed, which it is not because I can reject H_0 of the Shapiro-Wilk test at p < 0.001 and accept H_1 that Price is NOT normally distributed.
Thus, I won’t use the t-test but its alternative, the Wilcoxon Signed Rank Test with H_0 being Median_Price = 1900 and H_1 being Median_Price =/= 1900 and cannot reject H_0 at p = 0.028 and conclude that Median_Price = 1900, which according to funder2019 is a medium effect size.
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)
# Scatterplot
scatterplot(Price ~ Age,
ylab = "Price per m2",
xlab = "Age of aparment in years",
smooth = FALSE,
data = apartments)
# Regression with Age as a predictor for price
fit1 <- lm(Price ~ Age,
data = apartments)
summary(fit1)
Call:
lm(formula = Price ~ Age, data = apartments)
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.03401# Correlation coefficient
cor_coef1 <- sqrt(summary(fit1)$r.squared)
cor_coef1[1] 0.230255Regression Coefficient:
- Age: Reject H_0 at p = 0.034 and accept H_1 that beta is NOT equal to 0 and that we have a significant negative correlation between Age and Price and each additional year that an apartment ages leads to an average decrease of its price per m² of 8.975 eur.
Correlation Coefficient:
A correlation coefficient of only 0.230 indicates a weak negative linear relationship between the age of an apartment and its price per m².
Determination Coefficient:
Judging by the R-squared, approximately 5.302% of the variation in the price per m² can be explained by knowing the age of the apartment. This very low R-squared value suggests that other factors besides age play significant roles in determining the price per m² of apartments.
5. Show the scatterplot matrix between Price, Age and Distance. Based on the matrix determine if there is a potential problem with multicolinearity. (0.5 p)
# Scatterplot
scatterplotMatrix(~ Price + Age + Distance, data = apartments)
Looking at the scatterplot matrix for Price, Age and Distance, we can see that:
Price vs. Age: This scatterplot suggests a slight negative trend where Price decreases as Age increases. While there is some variation, the pattern does suggest a possible relationship.
Price vs. Distance: This plot shows a clear negative trend where Price decreases as Distance increases, suggesting that apartments closer to the city center should be priced higher. This relationship appears to be moderately strong and could be significant.
Age vs. Distance: This scatterplot does not show a clear trend and I would argue that there should not be a correlation between Age and Distance and no problems with multicollinearity when predicting Price.
6. Estimate the multiple regression function: Price = f(Age, Distance). Save it in object named fit2.
# Regression with Age and Distance as a predictors for Price
fit2 <- lm(Price ~ Age + Distance,
data = apartments)
summary(fit2)
Call:
lm(formula = Price ~ Age + Distance, data = apartments)
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# Correlation coefficient
cor_coef2 <- sqrt(summary(fit2)$r.squared)
cor_coef2[1] 0.6629887Regression Coefficients:
Age: Like with the previous regression, reject H_0 but this time at a more significant p = 0.016 and accept H_1 that beta is NOT equal to 0 and that we have a significant negative correlation between Age and Price and each additional year that an apartment ages leads to an average decrease of its price per m² of 7.934 eur.
Distance: Reject H_0 at p < 0.001 and accept H_1 that beta is NOT equal to 0 and that we have a significant negative correlation between Distance and Price and each additional km that an apartment is further away from the city center leads to an average decrease of its price per m² of 20.667 eur.
Correlation Coefficient:
A correlation coefficient of only 0.662 indicates a semi-strong negative linear relationship between the age of an apartment, its distance from the city center and its price per m².
Determination Coefficient:
Judging by the R-squared, approximately 43.96% of the variation in the price per m² can be explained by knowing the age and distance from the city center of the apartment. This good R-squared value suggests that age and distance explain the price to a decent degree but still less than half, so other factors besides them play a bigger role in determining the price per m² of apartments.
7. Check the multicolinearity with VIF statistics. Explain the findings. (1 p)
# VIF statisctic
vif(fit2) Age Distance
1.001845 1.001845 mean(vif(fit2))[1] 1.001845Both VIF’s are way below 5 and the average VIF is close to 1, so there is no issue with multicoliniearity.
8. Calculate standardized residuals and Cooks Distances for model fit2. Remove any potentially problematic units (outliers or units with high influence). (2 p)
# Standardiued residuals and cooks distance
apartments$StdResid <- round(rstandard(fit2), 3)
apartments$StdFitted <- scale(fit2$fitted.values)
apartments$CooksD <- round(cooks.distance(fit2), 3)
hist(apartments$StdResid,
xlab = "Standardized Residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
# Check if standardized residuals are normally distributed
shapiro.test(apartments$StdResid)
Shapiro-Wilk normality test
data: apartments$StdResid
W = 0.95303, p-value = 0.003645hist(apartments$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances")
Judging by the histogram of the standardized residuals, all residuals are between +-3 where they should be so we technically do not have any outliers but there seem to be entries with values both at the lower and upper end that do not belong to the majority. However, they do NOT seem to be normally distributed which is confirmed by the Shapiro-Wilk Test on them where I have to reject H_0 at p = 0.004 that they are normally distributed and accept H_1 that the are NOT normally distributed.
Furthermore, by taking a look at the histogram of the Cooks distances, it becomes obvious that there is a large gap between 0.15 and 0.30 and I need to remove the high impact outliers above that gap.
# Check for highg impact outliers with the highest Cooks distances
head(apartments[order(-apartments$CooksD),], 10)
# Remove identified high impact outliers
apartments <- apartments %>%
filter(!CooksD == 0.320)
hist(apartments$StdResid,
xlab = "Standardized Residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
# Check if standardized residuals are normally distributed
shapiro.test(apartments$StdResid)
Shapiro-Wilk normality test
data: apartments$StdResid
W = 0.94879, p-value = 0.002187hist(apartments$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances")
Still some gaps remain in the Cooks distance plot that were not obvious before and we need to exclude even more entries where the Cooks disances are above 0.04.
# Check for highg impact outliers with the highest Cooks distances
head(apartments[order(-apartments$CooksD),], 10)
# Remove identified high impact outliers
apartments <- apartments %>%
filter(!CooksD > 0.04)
hist(apartments$StdResid,
xlab = "Standardized Residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
# Check if standardized residuals are normally distributed
shapiro.test(apartments$StdResid)
Shapiro-Wilk normality test
data: apartments$StdResid
W = 0.93418, p-value = 0.0004761hist(apartments$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances")
After removing all high impact outliers, all standardized residuals now fall in a narrower band, albeit still NOT normally distributed according to the Shapiro-Wilk Test where I need to reject H_0 at p < 0.001 and accept H_1, and more importantly there are no more gaps in the Cooks distances histogram.
9. Check for potential heteroskedasticity with scatterplot between standarized residuals and standardized fitted values. Explain the findings. (1 p)
# Check for potential heteroskedasticity
scatterplot(y = apartments$StdResid, x = apartments$StdFitted,
ylab = "Standardized Residuals",
xlab = "Standardized fitted values",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
Judging by the scatterplot of the standarized residuals and standardized fitted values, there is no linearity issue and likely no heteroskedasticity issue a well.
10. Are standardized residuals ditributed normally? Show the graph and formally test it. Explain the findings. (1 p)
hist(apartments$StdResid,
xlab = "Standardized Residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
# Check if standardized residuals are normally distributed
shapiro.test(apartments$StdResid)
Shapiro-Wilk normality test
data: apartments$StdResid
W = 0.93418, p-value = 0.0004761As stated before in 8., there is NO normal distribution of the standardized residuals since “after removing all high impact outliers, all standardized residuals now fall in a narrower band, albeit still NOT normally distributed according to the Shapiro-Wilk Test where I need to reject H_0 at p < 0.001 and accept H_1,…”
11. Estimate the fit2 again without potentially excluded units and show the summary of the model. Explain all coefficients. (2 p)
# Regression with Age and Distance as a predictors for Price
fit2b <- lm(Price ~ Age + Distance,
data = apartments)
summary(fit2b)
Call:
lm(formula = Price ~ Age + Distance, data = apartments)
Residuals:
Min 1Q Median 3Q Max
-411.50 -203.69 -45.24 191.11 492.56
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2502.467 75.024 33.356 < 2e-16 ***
Age -8.674 3.221 -2.693 0.00869 **
Distance -24.063 2.692 -8.939 1.57e-13 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 256.8 on 77 degrees of freedom
Multiple R-squared: 0.5361, Adjusted R-squared: 0.524
F-statistic: 44.49 on 2 and 77 DF, p-value: 1.437e-13# Correlation coefficient
cor_coef2b <- sqrt(summary(fit2b)$r.squared)
cor_coef2b[1] 0.732187# VIF statisctic
vif(fit2b) Age Distance
1.001257 1.001257 mean(vif(fit2b))[1] 1.001257Regression Coefficients:
-Age: Like with the previous regression, reject H_0 but this time at a even more significant p = 0.009 and accept H_1 that beta is NOT equal to 0 and that we have a significant negative correlation between Age and Price and each additional year that an apartment ages leads to an average decrease of its price per m² of 8.674 eur.
-Distance: Reject H_0 at p < 0.001 and accept H_1 that beta is NOT equal to 0 and that we have a significant negative correlation between Distance and Price and each additional km that an apartment is further away from the city center leads to an average decrease of its price per m² of 24.063 eur.
Correlation Coefficient:
A correlation coefficient of 0.732 indicates a strong negative linear relationship between the age of an apartment, its distance from the city center and its price per m².
Determination Coefficient:
Judging by the R-squared, approximately 53.61% of the variation in the price per m² can be explained by knowing the age and distance from the city center of the apartment. This good R-squared value suggests that age and distance explain the price well with more than half, so other factors besides them play a role too in determining the price per m² of apartments but a smaller one.
Compared to the previous regression with outliers: Removing the outliers made both predictors more significant, especially Age, led to an increase in the correlation coefficient and nudged the determination coefficient over 50%.
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.
# Regression with Age and Distance as a predictors for Price
fit3 <- lm(Price ~ Age + Distance + Parking + Balcony,
data = apartments)
summary(fit3)
Call:
lm(formula = Price ~ Age + Distance + Parking + Balcony, data = apartments)
Residuals:
Min 1Q Median 3Q Max
-390.93 -198.19 -53.64 186.73 518.34
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2393.316 93.930 25.480 < 2e-16 ***
Age -7.970 3.191 -2.498 0.0147 *
Distance -21.961 2.830 -7.762 3.39e-11 ***
Parkingyes 128.700 60.801 2.117 0.0376 *
Balconyyes 6.032 57.307 0.105 0.9165
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 252.7 on 75 degrees of freedom
Multiple R-squared: 0.5623, Adjusted R-squared: 0.5389
F-statistic: 24.08 on 4 and 75 DF, p-value: 7.764e-13# Correlation coefficient
cor_coef3 <- sqrt(summary(fit3)$r.squared)
cor_coef3[1] 0.7498334# VIF statisctic
vif(fit3) Age Distance Parking Balcony
1.014239 1.141993 1.157384 1.005037 mean(vif(fit3))[1] 1.079664Regression Coefficients:
Age: Like with the previous regression using only two predictors, reject H_0 but this time at a less significant p = 0.015 and accept H_1 that beta is NOT equal to 0 and that we have a significant negative correlation between Age and Price and each additional year that an apartment ages leads to an average decrease of its price per m² of 7.970 eur assuming all other variables remain unchanged.
Distance: Reject H_0 at p < 0.001 and accept H_1 that beta is NOT equal to 0 and that we have a significant negative correlation between Distance and Price and each additional km that an apartment is further away from the city center leads to an average decrease of its price per m² of 21.961 eur assuming all other variables remain unchanged.
Parking: Reject H_0 at p = 0.038 and accept H_1 that beta is NOT equal to 0 and that we have a significant positive correlation between Parking and Price and having parking space leads to an average increase of its price per m² of 128.700 eur assuming all other variables remain unchanged.
Correlation Coefficient: A correlation coefficient of 0.75 indicates a strong linear relationship between the age of an apartment, its distance from the city center, the availability of parking space and its price per m².
Determination Coefficient:
Judging by the R-squared, approximately 53.89% of the variation in the price per m² can be explained by knowing the age, distance from the city center of the apartment and the availability of parking spaces. This good R-squared value suggests that age, distance and parking explain the price well with more than half, so other factors besides them play a role too in determining the price per m² of apartments but a smaller one.
13. With function anova check if model fit3 fits data better than model fit2. (1 p)
# Compare regression models
anova(fit2b, fit3)Analysis of Variance Table
Model 1: Price ~ Age + Distance
Model 2: Price ~ Age + Distance + Parking + Balcony
Res.Df RSS Df Sum of Sq F Pr(>F)
1 77 5077362
2 75 4791128 2 286234 2.2403 0.1135Residual Degrees of Freedom: Model 1, this is 77, and for Model 2, it is 75. The difference in degrees of freedom corresponds to the number of additional predictors Parking and Balcony included in Model 2 compared to Model 1.
Residual Sum of Squares: Model 1, the RSS is 5,077,362, and for Model 2, it is 4,791,128. A lower RSS indicates a better model fit as it suggests smaller deviations of the observed values from the model’s predicted values.
-Degrees of Freedom: This is the difference in the number of parameters between the two models. Here, 2 additional parameters are estimated in Model 2 with the inclusion of Parking and Balcony.
Sum of Squares: This shows the difference in RSS between the two models, which is 286,234. This value represents the improvement in model fit that can be attributed to the addition of the new parameters.
F-statistic: With a value is 2.2403. It tests whether the extra parameters added in Model 2 significantly improve the model’s fit.
Since the p-value is 0.114, we can NOT reject H_0 that the addition of Parking and Balcony does provide a significant improvement in predicting Price over just using Age and Distance and Model 1 (Price ~ Age + Distance) is sufficient for modeling the relationship and I would only include Parking and/or Balcony if required by similar past research for example.
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 + Parking + Balcony, data = apartments)
Residuals:
Min 1Q Median 3Q Max
-390.93 -198.19 -53.64 186.73 518.34
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2393.316 93.930 25.480 < 2e-16 ***
Age -7.970 3.191 -2.498 0.0147 *
Distance -21.961 2.830 -7.762 3.39e-11 ***
Parkingyes 128.700 60.801 2.117 0.0376 *
Balconyyes 6.032 57.307 0.105 0.9165
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 252.7 on 75 degrees of freedom
Multiple R-squared: 0.5623, Adjusted R-squared: 0.5389
F-statistic: 24.08 on 4 and 75 DF, p-value: 7.764e-13Categorical Regression Coefficients:
As stated in 12. for Parking: “Reject H_0 at p = 0.038 and accept H_1 that beta is NOT equal to 0 and that we have a significant positive correlation between Parking and Price and having parking space leads to an average increase of its price per m² of 128.700 eur assuming all other variables remain unchanged.”
Balcony: I can NOT reject H_0 with a high p = 0.917 and assume that beta is equal to 0 and that we have NO significant correlation between Balcony and Price and having a balcony does NOT lead to an average increase of its price per m² assuming all other variables remain unchanged.
F-statistic:
The F-statistic is used to test the overall significance of the regression model. With H_O that the independent variables Age., Distance, Parking and Balcony have NO significant effect on Price and H_1 that the independent variables do have a significant effect on Price. I reject H_0 at p < 0.001 and accept H_1 that there is a significant effect of the dependent variables on Price.
15. Save fitted values and calculate the residual for apartment ID2. (1 p)
# Standardiued residuals
apartments$StdResid3 <- round(rstandard(fit3), 3)
apartments$StdResid3[2] 2
1.794 Since the Appartments.xlsx file does not contain an ID column, I will assume that the apartment in row 2 has the ID = 2 and thus a standardized residual of 1.794.