TakeHomeExam_Bootcamp
2025-09-21
Sara Špajzar
Task 1
mydata <- read.table("./Salary.csv",
header = TRUE,
sep = ",",
dec = ".")
head(mydata, 10)## Age Gender Education.Level Job.Title Years.of.Experience Salary Country Race Senior
## 1 32 Male 1 Software Engineer 5 90000 UK White 0
## 2 28 Female 2 Data Analyst 3 65000 USA Hispanic 0
## 3 45 Male 3 Manager 15 150000 Canada White 1
## 4 36 Female 1 Sales Associate 7 60000 USA Hispanic 0
## 5 52 Male 2 Director 20 200000 USA Asian 0
## 6 29 Male 1 Marketing Analyst 2 55000 USA Hispanic 0
## 7 42 Female 2 Product Manager 12 120000 USA Asian 0
## 8 31 Male 1 Sales Manager 4 80000 China Korean 0
## 9 26 Female 1 Marketing Coordinator 1 45000 China Chinese 0
## 10 38 Male 3 Scientist 10 110000 Australia Australian 11.) Explanation of variables
This dataset provides a collection of annual salary information from various industries and regions across the globe and includes details on job titles, education level, experience, geographic locations, race and level of positions of such annual salaries. The data set contains 6684 units of observations, and 9 variables.
Description of variables:
- Salary (dependent variable): The respondent’s annual compensation (in USD).
- Age (numeric variable): The respondent’s age (in years).
- Gender (categorical variable): Male or Female.
- Education Level (ordinal variable): 0 = High School, 1 = Bachelor Degree, 2 = Master Degree, 3 = Phd.
- Job Title (categorical variable): The respondent’s current professional title or role.
- Years of Experience (numeric variable): The total number of years the respondent has worked (in years).
- Country (categorical variable): The country where the respondent is currently employed or resides.
- Race (categorical variable): The respondent’s self-identified racial or ethnic group.
- Senior: A binary indicator of whether the respondent holds a senior-level position (0 = not senior, 1 = senior).
2.) Data Manipulation
mydata$Education.LevelFactor <- factor(mydata$Education.Level,
levels = c(0, 1, 2, 3),
labels = c("High School", "Bachelor Degree", "Master Degree", "Phd"))
mydata$SeniorFactor <- factor(mydata$Senior,
levels = c(0, 1),
labels = c("Not senior", "Senior"))After analyzing the data, I noticed some of the potential data entry errors, for example some annual salaries were as low as 350$. The annual salary of $350 is not realistic and thus suggests a data entry error. To ensure accurate analysis, I will create a cleaned data set (mydata2), excluding annual salaries below $5000.
mydata2 <- subset(mydata, Salary >= 5000) # Created a new dataset with condition: only annual salaries above 5,000
mydata2$SalaryK <- mydata2$Salary / 1000. # Created a new variable: Salary in thousands
colnames(mydata2)[6] <- "AnnualSalary" # Renamed a variable
head(mydata2[order(mydata2$AnnualSalary), c(-7, -8, -10, -11, -12) ], 6)## Age Gender Education.Level Job.Title Years.of.Experience AnnualSalary Senior
## 3876 22 Male 0 Sales Associate 1 25000 0
## 3889 29 Female 0 Sales Associate 1 25000 0
## 3904 29 Female 0 Sales Associate 1 25000 0
## 3919 29 Female 0 Sales Associate 1 25000 0
## 3934 29 Female 0 Sales Associate 1 25000 0
## 3949 29 Female 0 Sales Associate 1 25000 03.) Descriptive statistics
mean(mydata2$AnnualSalary)## [1] 115375.9median(mydata2$AnnualSalary)## [1] 115000sd(mydata2$AnnualSalary)## [1] 52747.8Explanation of Sample Statistics:
- The average annual salary in the dataset is about €115,375.9, with a median annual salary of €115,000. The similarity between the mean and the median suggests that annual salaries are fairly symmetrically distributed.
- The standard deviation is quite high at around €52,747.8, which indicates that there is a wide variation in salaries among individuals.
summary(mydata2[c(-2, -3, -4, -7, -8, -9, -12)])## Age Years.of.Experience AnnualSalary Education.LevelFactor SeniorFactor
## Min. :21.00 Min. : 0.000 Min. : 25000 High School : 436 Not senior:5721
## 1st Qu.:28.00 1st Qu.: 3.000 1st Qu.: 70000 Bachelor Degree:3018 Senior : 959
## Median :32.00 Median : 7.000 Median :115000 Master Degree :1858
## Mean :33.61 Mean : 8.081 Mean :115376 Phd :1368
## 3rd Qu.:38.00 3rd Qu.:12.000 3rd Qu.:160000
## Max. :62.00 Max. :34.000 Max. :250000Explanation of Additional Sample Statistics:
- The median annual salary is 115,000$. Indicating that 50% of respondents earn less or equal to 115,000 dollars, and the other 50% earn more than 115,000 dollars.
- For Age, the third quartile of 38 indicates that 75% of employees are aged 38 or younger, while the remaining 25% are older than 38.
- For Work Experience, the first quartile of 3 and the third quartile of 12, suggest that the middle 50% of employees have between 3 and 12 years of experience.
- The education level that is the most represented in the sample is Bachelor Degree, with 3018 units with this education. The least represented level of education is High School, with only 436 units.
- In the sample we also have 5721 respondents who do not have a senior-level position, and 959 respondents who have a senior-level position.
Additionally, after summarizing the data I noticed some of the respondents had 0 years of experience (less than 0.5 years), we can assume they just started their job.
4.) Distribution of the variables
library(ggplot2)
ggplot(mydata2, aes(x = SalaryK)) +
geom_histogram(fill = "darkseagreen1",
color = "darkseagreen4",
bins = 10) +
labs(title = "Salary Distribution",
x = "Annual Salary (in thousands)",
y = "Frequency") +
theme_minimal(base_size = 14)
Results of the histogram:
- The graph shows the frequency distribution of annual salaries across all respondents.
- Interpretation: Most salaries cluster from 50,000 to 150,000.
- Fewer respondents earn very low or very high salaries.
- The distribution looks right-skewed (a longer tail toward higher salaries). This means the majority of employees earn mid-range salaries, with relatively few high earners.
boxplot(AnnualSalary ~ Gender,
data = mydata2,
main = "Salary by Gender",
ylab = "Annual Salary",
col = c("lightpink", "darkslategray3"),
border = c("lightpink3", "darkslategray4"))
Results of the boxplot:
- The graph shows the spread of salaries separately for male and female respondents.
- Interpretation: Both genders have a similar range of salaries.
- The median salary for males appears slightly higher than for females.
- Male salaries also seem to have a wider spread (larger interquartile range and higher max values). This suggests a possible gender pay gap where men earn a bit more on average and have more very high salaries.
ggplot(mydata2, aes(x=Years.of.Experience, y=SalaryK)) +
geom_point(color = "plum2") +
geom_smooth(method= "lm", se= FALSE, color="plum4") +
labs(title = "Experience vs Salary",
x="Years of Experience", y="Annual Salary (in thousands)") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Results of the scatterplot:
- The graph shows the relationship between years of experience and annual salary.
- Interpretation: Salaries generally increase with experience up to about 15–20 years.
- Beyond 20 years, the relationship flattens — additional experience doesn’t lead to much higher pay.
- There’s quite a lot of variation at each level of experience is not the only factor affecting salary.
Task 2
library(readxl)
mydata3 <- read_xlsx("./Task 2/Business School.xlsx")
mydata3 <- as.data.frame(mydata3)
head(mydata3)## Student ID Undergrad Degree Undergrad Grade MBA Grade Work Experience Employability (Before) Employability (After)
## 1 1 Business 68.4 90.2 No 252 276
## 2 2 Computer Science 70.2 68.7 Yes 101 119
## 3 3 Finance 76.4 83.3 No 401 462
## 4 4 Business 82.6 88.7 No 287 342
## 5 5 Finance 76.9 75.4 No 275 347
## 6 6 Computer Science 83.3 82.1 No 254 313
## Status Annual Salary
## 1 Placed 111000
## 2 Placed 107000
## 3 Placed 109000
## 4 Placed 148000
## 5 Placed 255500
## 6 Placed 1035001.) Distribution of undergrad degrees
ggplot(mydata3, aes(x = `Undergrad Degree`)) +
geom_bar(color= "paleturquoise4", fill= "paleturquoise2") +
labs(title = "Distribution of Undergrad Degrees",
x = "Undergrad Degree",
y = "Frequency") +
theme_minimal() +
geom_text(stat = "count",
aes(label = ..count..),
vjust = -0.3) 
The most common undergraduate degree is Business, with 35 out of 100 students in the data set.
This means more than one-third of the MBA students come from a Business background, while Art and Engineering are the least represented.
2.) Descriptive statistics
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphadescribe(mydata3$"Annual Salary")## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 100 109058 41501.49 103500 104600.2 25945.5 20000 340000 320000 2.22 9.41 4150.15ggplot(mydata3, aes(x = `Annual Salary`)) +
geom_histogram(bins = 10, fill = "thistle2", color = "thistle4") +
scale_x_continuous(labels = scales::comma) +
labs(title = "Annual Salary Distribution",
x = "Annual Salary (USD per year)",
y = "Frequency") +
theme_minimal(base_size = 13)
The distribution of annual salaries is skewed to the right, with salaries concentrated around the median and a few high outliers up to 340,000. The average annual salary is about 109,058 USD, with most students earning between 80,000 and 130,000 USD.
3.) Hypothesis testing
t.test(mydata3$`MBA Grade`,
mu = 74,
alternative = "two.sided")##
## One Sample t-test
##
## data: mydata3$`MBA Grade`
## t = 2.6587, df = 99, p-value = 0.00915
## alternative hypothesis: true mean is not equal to 74
## 95 percent confidence interval:
## 74.51764 77.56346
## sample estimates:
## mean of x
## 76.04055library(effectsize)##
## Attaching package: 'effectsize'## The following object is masked from 'package:psych':
##
## phieffectsize::cohens_d(mydata3$`MBA Grade`, mu= 74)## Cohen's d | 95% CI
## ------------------------
## 0.27 | [0.07, 0.46]
##
## - Deviation from a difference of 74.- H0: 𝜇MBA Grade = 74
- H1: 𝜇MBA Grade ≠ 74
Since p<0.05, we reject H0. The current MBA student’s average grade is significantly higher than 74. The effect size is small (d=0.27), meaning the difference is statistically significant (with n=100 students, the test has enough power to detect even small deviations).
effectsize::interpret_cohens_d(0.27, rules="sawilowsky2009")## [1] "small"
## (Rules: sawilowsky2009)As previously stated the effect size (Cohen’s d = 0.27) is small, meaning the grade difference is statistically significant but of limited practical importance.
Task 3
Import the dataset Apartments.xlsx
library(readxl)
mydata4 <- read_xlsx("./Task 3/Apartments.xlsx")
mydata4 <- as.data.frame(mydata4)
head(mydata4)## 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
Change categorical variables into factors.
mydata4$ParkingFactor <- factor(mydata4$Parking,
levels = c(0, 1),
labels = c("No", "Yes"))
mydata4$BalconyFactor <- factor(mydata4$Balcony,
levels = c(0, 1),
labels = c("No", "Yes"))
head(mydata4)## 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 YesTest the hypothesis H0: Mu_Price = 1900 eur. What can you conclude?
t.test(mydata4$Price,
mu = 1900,
alternative = "two.sided")##
## One Sample t-test
##
## data: mydata4$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.941- H0: mu_Price = 1900 EUR.
- H1: mu_Price ≠ 1900 EUR.
We can reject H0 at 5% significance level (since p < 0.05). The true average price is significantly different from 1900 EUR (it is grater than 1900, the mean Price is 2018.94 EUR). We can say that with 95% certainty the true average price of the apartments lies between 1937.44 and 2100.44 EUR.
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.
fit1 <- lm(Price ~ Age,
data = mydata4)
summary(fit1)##
## Call:
## lm(formula = Price ~ Age, data = mydata4)
##
## 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(mydata4$Price, mydata4$Age)## [1] -0.230255The regression coefficient for Age is -8.975. This means that, if the apartment gets 1 year older, its average price decreases by about 8.975 EUR per m², assuming all other variables remain the same. Since p = 0.034 (< 0.05), this negative effect is statistically significant.
Coefficient of correlation between Price and Age is -0.23. This indicates a weak negative relationship: as apartments get older, price tends to decline slightly.
Coefficient of determination (R²) equals to 0.053. This means that only about 5.3% of the variation in Price can be explained by the linear effect of Age. The rest 94.7% of the variation in Price can be explained by other factors not included in this regression.
Show the scateerplot matrix between Price, Age and Distance. Based on the matrix determine if there is potential problem with multicolinearity.
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:psych':
##
## logitscatterplotMatrix(mydata4[ , c(-4, -5, -6, -7)],
smooth = FALSE) 
The scatterplot matrix shows negative relationships between Price and both Age and Distance, while Age and Distance are not strongly related. Therefore, there is no potential problem with multicollinearity in this data set.
Estimate the multiple regression function: Price = f(Age, Distance). Save it in object named fit2.
fit2 <- lm(Price ~ Age + Distance,
data = mydata4)
summary(fit2)##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata4)
##
## 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 shows that both Age and Distance significantly reduce Price.
- Each extra year lowers Price by about 7.93 (p=0.016).
- Each extra unit of Distance lowers Price by about 20.67 (p<0.001).
The model explains 44% of Price variation (R²=0.44) and is statistically significant overall (p<0.001).
Chech the multicolinearity with VIF statistics. Explain the findings.
library(car)
vif(fit2)## Age Distance
## 1.001845 1.001845The VIF values for Age and Distance are about 1, well below 5, meaning there is no multicollinearity issue in the model.
Calculate standardized residuals and Cooks Distances for model fit2. Remove any potentially problematic units (outliers or units with high influence).
mydata4$StdResid <- round(rstandard(fit2), 3)
head(mydata4[order(mydata4$StdResid),], 5)## Age Distance Price Parking Balcony ParkingFactor BalconyFactor StdResid
## 53 7 2 1760 0 1 No Yes -2.152
## 13 12 14 1650 0 1 No Yes -1.499
## 72 12 14 1650 0 0 No No -1.499
## 20 13 8 1800 0 0 No No -1.381
## 35 14 16 1660 0 1 No Yes -1.261hist(mydata4$StdResid,
xlab = "Standardized residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals",
col = "rosybrown1",
border = "brown4")
The histogram of standardized residuals is roughly centered around zero, with most values between -2 and 2. This suggests no extreme outliers or major deviations.
mydata4$CooksD <- round(cooks.distance(fit2), 3)
head(mydata4[order(-mydata4$CooksD),], 5)## 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.061hist(mydata4$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances",
col = "thistle1",
border = "orchid4")
After observing both, the histogram of standardized residuals and the histogram of Cooks distances, we can observe a unit with a notecably larger Cooks distance than other units. This unit has thus has a stronger influence on the regression model. It is the 38th unit in the data set, its standardized residual is 2.577 (close to 3), which suggests we should remove it.
Check for potential heteroskedasticity with scatterplot between standarized residuals and standrdized fitted values. Explain the findings.
mydata4$StdFitted <- scale(fit2$fitted.values)
library(car)
scatterplot(x = mydata4$StdFitted, y = mydata4$StdRes,
xlab = "Standardized fitted values",
ylab = "Standardized Residuals",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
The scatterplot shows that the points are spread randomly without a clear shape or pattern. This suggests no heteroskedasticity problem, as the variance of residuals looks roughly constant.
library(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 = 0.968106
## Prob > Chi2 = 0.325153To formally test for Heteroskedasticity, I used the Breusch Pagan Test:
- H0: The variance is constant.
- H1: The variance is not constant.
As the p-value equals to 0.087 (p>0.05) we fail to reject H0. This means that there is no significant evidence of heteroskedasticity.
Both the scatterplot and statistical test indicate that the homoscedasticity assumption holds.
Are standardized residuals ditributed normally? Show the graph and formally test it. Explain the findings.
hist(mydata4$StdResid,
xlab = "Standardized residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals",
col = "rosybrown1",
border = "brown4")
shapiro.test(mydata4$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata4$StdResid
## W = 0.95303, p-value = 0.003645- H0: Standardized residuals are normally distributed.
- H1: Standardized residuals are not normally ditributed.
The histogram shows that residuals are not normally distributed. The Shapiro-Wilk test confirms this: at the 5% level, we reject H0 (p< 0.05), so the distribution is not normal.
Estimate the fit2 again without potentially excluded units and show the summary of the model. Explain all coefficients.
mydata4 <- mydata4 [!(mydata4$CooksD == 0.320), ]
fit2 <- lm(Price ~ Age + Distance,
data = mydata4)
summary(fit2)##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata4)
##
## 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-12sqrt(summary(fit2)$r.squared)## [1] 0.6955609- Intercept equals to 2456.076, this is a baseline price when Age and Distance both equal to 0.
- Age (-6.46, p=0.044): Each additional year decreases price by 6.464 EUR, statistically significant.
- Distance (-22.96, p<0.001): Each additional unit of distance reduces price by 22.96E EUR, highly significant. Model fit: R² = 0.4838. This means that about 48.4% of price variation can be explained by the linear effect of Age and Distance.
- sqrt(R²) = 0.663. This number suggests that the correlation between predicted and actual prices is 0.663, which means the model has a moderate predictive power.
- Overall model can be categorised as strongly significant (F-test p < 0.001).
Both Age and Distance negatively affect price. Distance has the stronger effect, and the model explains nearly half of the price variation.
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 = mydata4)
summary(fit3)##
## Call:
## lm(formula = Price ~ Age + Distance + ParkingFactor + BalconyFactor,
## data = mydata4)
##
## 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 ***
## ParkingFactorYes 167.531 62.864 2.665 0.00933 **
## BalconyFactorYes -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-12- Intercept (2329.72): Predicted price when Age = 0, Distance = 0, apartment has no parking & no balcony.
- Age (-5.821, p=0.0619). This suggests that older properties are worth 5.82 EUR less per year, but effect is only marginally significant.
- Distance (-20.279, p<0.001). This number indicates that Price decreases by 20.279 EUR for each additional distance unit (highly significant).
- ParkingFactorYes (167.531, p<0.01). This means having parking increases price by 167.53 EUR, significant.
- BalconyFactorYes (-15.207, p=0.79795). This indicates that apartment having a Balcony has no significant effect on price.
- Model fit: R² = 0.53. About 53% of price variation can be explained by variables Age, Distance, Parking and Balcony.
To shortly summarize, Distance lowers price, Parking raises it, Age has a weak effect, and having Balconies does not really have a significant effect on Price.
With function anova check if model fit3 fits data better than model fit2.
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 81 6176767
## 2 79 5654480 2 522287 3.6485 0.03051 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1ANOVA tests whether model improvements are significant.
- H0: Fit2 (Age + Distance) fits as well as Fit3.
- H1: Fit3 (Age + Distance + ParkingFactor + BalconyFactor) fits better than Fit2.
Since p = 0.0305 (p < 0.05), we reject H0 and conclude that fit3, with more variables, provides a better fit.
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?
summary(fit3)##
## Call:
## lm(formula = Price ~ Age + Distance + ParkingFactor + BalconyFactor,
## data = mydata4)
##
## 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 ***
## ParkingFactorYes 167.531 62.864 2.665 0.00933 **
## BalconyFactorYes -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-12- H0: All regression coefficients (excluding the intercept) = 0
- H1: At least one of the regression coefficients ≠ 0
Age (-5.821, p=0.0619). This means that older properties tend to be cheaper, but effect is only marginally significant.
Distance (-20.279, p<0.001). Each additional unit farther reduces price by about 20, which is strongly significant.
ParkingFactorYes (167.531, p<0.01). This suggests that when the apartment has a Parking, this increases price by 167.531 EUR; statistically significant.
BalconyFactorYes (-15.207, p=0.79795). This suggests that apartment having Balcony has almost no effect; not significant.
Model fit:
- R² = 0.5275, Adj R² = 0.5035. This means that 50.35% of price variability is explained by the linear effect of Age, Distance, Parking and Balcony.
- F-statistic (22.04, p<0.001). We can reject H0. The model is statistically significant overall.
To summarize, Distance and Parking strongly affect price, Age has a weak effect, and Balcony is not significant. The overall model is a good fit.
Save fitted values and claculate the residual for apartment ID2.
mydata4$FittedValues <- fitted.values(fit3)
mydata4$Residuals <- residuals(fit3)
head(mydata4[ , colnames(mydata4) %in% c("Price", "Balcony", "FittedValues", "Residuals")])## Price Balcony FittedValues Residuals
## 1 1640 1 1705.952 -65.95206
## 2 2800 0 2372.197 427.80292
## 3 1660 0 1721.159 -61.15894
## 4 1850 1 1563.431 286.56890
## 5 1640 1 2012.244 -372.24396
## 6 1770 1 1908.177 -138.17733For apartment ID2:
- Actual Price = 2800
- Predicted (Fitted) Price = 2372.197
- Residual = 427.803.
The actual price of the apartment is greater by 427.803 EUR than the predicted (fitted) price from the regression. This means that the model underestimated the price of apartment ID2 by 427.803 EUR.