Take_home_exam_KLJ
2025-09-16
Klemen Liam Jelovčan
Take Home Exam 2025
Task 1
data(package = .packages(all.available = TRUE))data("mtcars")
mydata1 <- force(mtcars)
head(mydata1)## mpg cyl disp hp drat wt qsec vs am gear carb
## Mazda RX4 21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
## Mazda RX4 Wag 21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
## Datsun 710 22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
## Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
## Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
## Valiant 18.1 6 225 105 2.76 3.460 20.22 1 0 3 1The data set I have chosen for the first task of the take home exam is Car Road Tests performed by Motor Trend Magazine in the year 1974. The data set consists of 32 units and 11 variables.
Explanation of variables:
- mpg: Fuel consumption [Miles/US gallon]
- cyl: Number of cylinders in the car’s engine
- disp: Displacement or “volume” of the engine [cubic inches]
- hp: Gross Horsepower
- drat: Rear axle ratio
- wt: Weight [1000 lbs]
- qsec: 1/4 mile time [s]
- vs: Engine type (0 = V-shaped, 1 = straight)
- am: Transmission type (0 = automatic, 1 = manual)
- gear: Number of forward gears
- carb: Number of carburetors
mydata1 <- mydata1[, -c(5, 11)]
head(mydata1)## mpg cyl disp hp wt qsec vs am gear
## Mazda RX4 21.0 6 160 110 2.620 16.46 0 1 4
## Mazda RX4 Wag 21.0 6 160 110 2.875 17.02 0 1 4
## Datsun 710 22.8 4 108 93 2.320 18.61 1 1 4
## Hornet 4 Drive 21.4 6 258 110 3.215 19.44 1 0 3
## Hornet Sportabout 18.7 8 360 175 3.440 17.02 0 0 3
## Valiant 18.1 6 225 105 3.460 20.22 1 0 3Here I removed two columns from the data set (Rear axle ratio and Number of carburetors), as they did not carry relevant data for my analysis. I am left with 9 variables for 32 different cars. I used the head function, to check if I have removed the correct columns
mydata1$am <- factor(mydata1$am,
levels = c(0,1),
labels = c("Automatic", "Manual"))
mydata1$vs <- factor(mydata1$vs,
levels = c(0,1),
labels = c("V-shaped", "straight"))
head(mydata1)## mpg cyl disp hp wt qsec vs am
## Mazda RX4 21.0 6 160 110 2.620 16.46 V-shaped Manual
## Mazda RX4 Wag 21.0 6 160 110 2.875 17.02 V-shaped Manual
## Datsun 710 22.8 4 108 93 2.320 18.61 straight Manual
## Hornet 4 Drive 21.4 6 258 110 3.215 19.44 straight Automatic
## Hornet Sportabout 18.7 8 360 175 3.440 17.02 V-shaped Automatic
## Valiant 18.1 6 225 105 3.460 20.22 straight Automatic
## gear
## Mazda RX4 4
## Mazda RX4 Wag 4
## Datsun 710 4
## Hornet 4 Drive 3
## Hornet Sportabout 3
## Valiant 3In this step I replaced the numeric values for two variables with their categorical alternatives. For the transmission type variable: 0 = Automatic, 1 = Manual. For the engine type variable: 0 = V - shaped, 1 = straight.
The next step is creating a new variable, the horsepower per 1000 pounds (P2W). This new variable will show a realistic comparison between different cars based on the power-to-weight criteria.
mydata1$P2W <- mydata1$hp / (mydata1$wt)summary(mydata1)## mpg cyl disp hp
## Min. :10.40 Min. :4.000 Min. : 71.1 Min. : 52.0
## 1st Qu.:15.43 1st Qu.:4.000 1st Qu.:120.8 1st Qu.: 96.5
## Median :19.20 Median :6.000 Median :196.3 Median :123.0
## Mean :20.09 Mean :6.188 Mean :230.7 Mean :146.7
## 3rd Qu.:22.80 3rd Qu.:8.000 3rd Qu.:326.0 3rd Qu.:180.0
## Max. :33.90 Max. :8.000 Max. :472.0 Max. :335.0
## wt qsec vs am
## Min. :1.513 Min. :14.50 V-shaped:18 Automatic:19
## 1st Qu.:2.581 1st Qu.:16.89 straight:14 Manual :13
## Median :3.325 Median :17.71
## Mean :3.217 Mean :17.85
## 3rd Qu.:3.610 3rd Qu.:18.90
## Max. :5.424 Max. :22.90
## gear P2W
## Min. :3.000 Min. :19.44
## 1st Qu.:3.000 1st Qu.:35.67
## Median :4.000 Median :41.04
## Mean :3.688 Mean :45.33
## 3rd Qu.:4.000 3rd Qu.:47.78
## Max. :5.000 Max. :93.84Here it is possible to observe what the descriptive statistics look like for each variable; variables “vs” and “am” are categorical, therefore only the frequency of each category is shown. In the next step I portrayed the descriptive variables for the amount of horsepower a car has, depending on the type of engine it has.
library(psych)
describeBy(mydata1$hp, mydata1$vs)##
## Descriptive statistics by group
## group: V-shaped
## vars n mean sd median trimmed mad min max range skew
## X1 1 18 189.72 60.28 180 186.81 48.18 91 335 244 0.45
## kurtosis se
## X1 -0.15 14.21
## ----------------------------------------------------
## group: straight
## vars n mean sd median trimmed mad min max range skew
## X1 1 14 91.36 24.42 96 92 32.62 52 123 71 -0.24
## kurtosis se
## X1 -1.61 6.53The results show, that cars with V-shaped engines are more likely to have more horsepower than cars with straight engines. This finding is logical and expected as cars with V-shaped engines generally have a higher number of cylinders, therefore a higher engine displacement and consequently more horsepower.
Explanation of sample statistics for V-shaped engines:
- mean = 189.72 hp. This is the arithmetic average number of horsepower a car with a V-shaped engine in our sample group had
- median = 180 hp. This means, that less or equal than 50% of the cars in our sample group, which have a V-shaped engine have 180 hp, while the rest have more than 180 hp.
- range = 244 hp. This is the difference between the highest and lowest value in our sample group.
- sd = 60.28. This shows us how spread out our hp values are, compared to the median. If this number is high, it means our data is very dispersed, if this number is lower (like with the straight engines), the values are more condensed.
library(ggplot2)##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alphaggplot(mydata1, aes(x = disp, y = mpg))+
geom_point(color = "cornflowerblue", size = 3) +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = "Graph showing the consumption of a car relative to the displacement of its engine",
x = "displacement [cubic inches]",
y = "consumption [mpg]")## `geom_smooth()` using formula = 'y ~ x'
ggplot(mydata1, aes(x = wt, y = mpg))+
geom_point(color = "darkgreen", size = 3) +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(title = "Graph showing the consumption of a car relative to its weight",
x = "weight [1000 lbs]",
y = "consumption [mpg]")## `geom_smooth()` using formula = 'y ~ x'
For the final step I created two scatterplots using the ggplot function. The first one shows the consumption of a car relative to the size of its engine. The noticeable trend is negative, portrayed by the trend-line. This is logical, as cars with bigger engines and a higher number of cylinders need more fuel to operate, worsening the consumption (lowering the number in the “mpg” units). The other variable, which has a negative effect on the consumption of a car is its weight. The second graph shows the decline of the consumption as the weight of a car increases.
Task 2
library(readxl)
mydata2 <- read_excel("./Business School.xlsx")
head(mydata2)## # A tibble: 6 × 9
## `Student ID` `Undergrad Degree` `Undergrad Grade` `MBA Grade`
## <dbl> <chr> <dbl> <dbl>
## 1 1 Business 68.4 90.2
## 2 2 Computer Science 70.2 68.7
## 3 3 Finance 76.4 83.3
## 4 4 Business 82.6 88.7
## 5 5 Finance 76.9 75.4
## 6 6 Computer Science 83.3 82.1
## # ℹ 5 more variables: `Work Experience` <chr>,
## # `Employability (Before)` <dbl>, `Employability (After)` <dbl>,
## # Status <chr>, `Annual Salary` <dbl>library(ggplot2)
ggplot(mydata2, aes(x = `Undergrad Degree`)) +
geom_bar(fill = "cornflowerblue", color = "darkgreen") +
labs(title = "Distribution of Undergrad Degrees", x = "Undergrad Degree", y = "Frequency") +
geom_text(stat = "count",
aes(label = ..count..),
vjust = -0.3)## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning
## was generated.
From the barplot depicted above we can see that the most common undergraduate degree is Business.
library(pastecs)
round(stat.desc(mydata2[c(9)], 1))## Annual Salary
## nbr.val 100
## nbr.null 0
## nbr.na 0
## min 20000
## max 340000
## range 320000
## sum 10905800
## median 103500
## mean 109058
## SE.mean 4150
## CI.mean.0.95 8235
## var 1722373475
## std.dev 41501
## coef.var 0ggplot(mydata2, aes(x = `Annual Salary`)) +
geom_histogram(binwidth = 10000, color = "darkgreen", fill = "cornflowerblue") +
labs(title = "Annual Salary Distribution",
x = "Annual Salary [€]",
y = "Frequency") 
The distribution of the annual salary on the histogram depicted above is skewed to the right and unimodal.
t.test (mydata2$`MBA Grade`, mu = 74, alternative = "two.sided")##
## One Sample t-test
##
## data: mydata2$`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.04055The p value here is lower than our significance level alpha = 0.05, which means we can reject the null hypothesis and confirm that the mu of MBA Grades is not equal to 74. From the t-test we can see that it is in fact greater, at 76.04.
cohens_d <- (mean(mydata2$`MBA Grade`, na.rm = TRUE) - 74) / sd(mydata2$`MBA Grade`, na.rm = TRUE)
cohens_d## [1] 0.2658658The students’ MBA Grades were higher than 74, however the effect was small, which indicates moderate partial significance.
Task 3
Import the dataset Apartments.xlsx
library(readxl)
mydata3 <- read_excel("./Apartments.xlsx")
head(mydata3, 3)## # A tibble: 3 × 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 0Description:
- 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.
mydata3$Parking <- factor(mydata3$Parking,
levels =c(0, 1),
labels = c("No", "Yes"))
mydata3$Balcony <- factor(mydata3$Balcony,
levels = c(0, 1),
labels = c("No", "Yes"))Test the hypothesis H0: Mu_Price = 1900 eur. What can you conclude?
t.test(mydata3$Price, mu = 1900, alternative = "two.sided")##
## One Sample t-test
##
## data: mydata3$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.941The p value here is lower than our significance level alpha = 0.05, which means we can reject the null hypothesis at p = 0.005 and conclude, that the monthly price mean of apartments is not equal to 1900 eur. We can see that it is greater.
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 = mydata3)
summary(fit1)##
## Call:
## lm(formula = Price ~ Age, data = mydata3)
##
## 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(mydata3$Age, mydata3$Price, use = "complete.obs")## [1] -0.230255From the estimate of regression coefficient we can observe, that for each year a building, in which there is an apartmen,t is older, the monthly price for said apartment decreases by 8.98 € on average. The coefficient of determination is low, at 0.053; this means that only about 5.3 % of price variation can be explained by age alone. From the coefficient of correlation we can observe the correlation between the age and price of an apartment is small and weak at -0.23.
Show the scatterplot 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(mydata3[ , c(-4, -5)],
smooth = FALSE) 
No obvious multicolinearity can be seen in the matrix.
Estimate the multiple regression function: Price = f(Age, Distance). Save it in object named fit2.
fit2 <- lm(Price ~ Age + Distance, data = mydata3)
summary(fit2)##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata3)
##
## 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-11Coefficient of Age tells us by how much the price of an apartment changes with every year the apartment gets older, providing all else stays the same. Coefficient of Distance tells us by how much the price of an apartment changes if the apartment is 1km further away from the city center, fixing all other variables.
Chech the multicolinearity with VIF statistics. Explain the findings.
library(car)
vif(fit2)## Age Distance
## 1.001845 1.001845If the VIF value is above 5 we have to be careful about multicolinearity. Our values are approx. 1, therefore we do not need to be concerned about multicolinearity.
Calculate standardized residuals and Cooks Distances for model fit2. Remove any potentially problematic units (outliers or units with high influence).
mydata3$StdResid <- round(rstandard(fit2), 3)
mydata3$CooksD <- round(cooks.distance(fit2), 3)
hist(mydata3$StdResid,
xlab = "Standardized residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
shapiro.test(mydata3$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata3$StdResid
## W = 0.95303, p-value = 0.003645hist(mydata3$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances")
head(mydata3[order(mydata3$StdResid),], 3)## # A tibble: 3 × 7
## Age Distance Price Parking Balcony StdResid CooksD
## <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl>
## 1 7 2 1760 No Yes -2.15 0.066
## 2 12 14 1650 No Yes -1.50 0.013
## 3 12 14 1650 No No -1.50 0.013head(mydata3[order(-mydata3$CooksD),], 6)## # A tibble: 6 × 7
## Age Distance Price Parking Balcony StdResid CooksD
## <dbl> <dbl> <dbl> <fct> <fct> <dbl> <dbl>
## 1 5 45 2180 Yes Yes 2.58 0.32
## 2 43 37 1740 No No 1.44 0.104
## 3 2 11 2790 Yes No 2.05 0.069
## 4 7 2 1760 No Yes -2.15 0.066
## 5 37 3 2540 Yes Yes 1.58 0.061
## 6 40 2 2400 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:pastecs':
##
## first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionmydata3c <- mydata3 %>% slice(-c(22, 33, 38, 53, 55))hist(mydata3c$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances")
Check for potential heteroskedasticity with scatterplot between standarized residuals and standrdized fitted values. Explain the findings.
fit2c <- lm(Price ~ Age + Distance, data = mydata3c)mydata3c$StdFitted <- scale(fit2c$fitted.values)
library(car)
scatterplot(y = mydata3c$StdResid, x = mydata3c$StdFitted,
ylab = "Standardized residuals",
xlab = "Standardized fitted values",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
There is no evidence of heteroskedasticity based on the graph depicted above. There is no obvious curve in the dots on the scatterplot.
Are standardized residuals ditributed normally? Show the graph and formally test it. Explain the findings.
par(mfrow = c(1,2))
qqnorm(mydata3c$StdResid, main = "QQ-Plot of Std. Residuals"); qqline(mydata3c$StdResid)
hist(mydata3c$StdResid, breaks = 12, main = "Histogram of Std. Residuals",
xlab = "Standardized Residuals")
shapiro.test(mydata3c$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata3c$StdResid
## W = 0.93418, p-value = 0.0004761par(mfrow = c(1,1))Based on the test we can reject the null hypothesis that the standard residuals are normally distributed at p < 0.001. We can also see the same from the histogram.
Estimate the fit2 again without potentially excluded units and show the summary of the model. Explain all coefficients.
summary(fit2c)##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata3c)
##
## 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-13To explain the significant findings: for each year an apartment ages, the price of it per m2 falls by 8.674 €, providing all else stays the same and for each km the apartment is further away from the city center, its price per m2 falls by 24.063 €, providing all else stays the same.
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 + Parking + Balcony, data = mydata3c)With function anova check if model fit3 fits data better than model fit2.
anova(fit2c, 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.1135Based on what we just showed, the model fit3 does not significantly improve the fit to our data compared to the simpler fit2c model.
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 + Parking + Balcony, data = mydata3c)
##
## 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-13Apartments with parking are predicted to cost about €129 more than otherwise identical apartments without parking, holding Age, Distance, and Balcony fixed. Statistically significant at 5%. Having a balcony is associated with an estimated €6 higher price vs no balcony, controlling for the other variables—but this effect is not statistically significant (no reliable difference).
Hypotheses tested by this F-statistic: H₀: β_Age = β_Distance = β_ParkingYes = β_BalconyYes = 0 H₁: At least one of these coefficients ≠ 0.
Save fitted values and claculate the residual for apartment ID2.
mydata3c$fit3_hat <- fitted(fit3)
mydata3c$resid_fit3 <- resid(fit3)
idx_id2 <- if ("ID" %in% names(mydata3)) {
which(mydata3$ID == 2)[1]
} else {
2L
}
id2_obs <- mydata3c[idx_id2, c("Age","Distance","Parking","Balcony","Price","fit3_hat","resid_fit3")]
id2_obs## # A tibble: 1 × 7
## Age Distance Parking Balcony Price fit3_hat resid_fit3
## <dbl> <dbl> <fct> <fct> <dbl> <dbl> <dbl>
## 1 18 1 Yes No 2800 2357. 443.The calculated residual is equal to 443.4026.