Dataset used: diamonds
library(ggplot2)
data("diamonds")
head(diamonds)
## # A tibble: 6 × 10
## carat cut color clarity depth table price x y z
## <dbl> <ord> <ord> <ord> <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1 0.23 Ideal E SI2 61.5 55 326 3.95 3.98 2.43
## 2 0.21 Premium E SI1 59.8 61 326 3.89 3.84 2.31
## 3 0.23 Good E VS1 56.9 65 327 4.05 4.07 2.31
## 4 0.29 Premium I VS2 62.4 58 334 4.2 4.23 2.63
## 5 0.31 Good J SI2 63.3 58 335 4.34 4.35 2.75
## 6 0.24 Very Good J VVS2 62.8 57 336 3.94 3.96 2.48
The given data set deals with price, color and other characteristics of diamonds. Specifically, the dataset contains around 54000 units (diamonds) and 10 variables, among them:
carat (weight of the diamond),
cut (quality of cut),
price (in USD),
x (length in mm)
and other.
mydata <- diamonds #making new data set for further cleaning
mydata <- mydata[ , c(-3, -4, -5, -6, -9, -10)] #clearing up data, removing excess variables, leaving 4 variables for main analysis
names(mydata)[names (mydata) == "x"] <- "length" #renaming a variable, from "x" to "length"
mydata$Price_per_Carat <- mydata$price/mydata$carat #adding new variable to the data set
mydata$Price_per_Carat <- round(mydata$Price_per_Carat, 0) #removing decimals from the new variable, rounding up to whole dollars
head(mydata)
## # A tibble: 6 × 5
## carat cut price length Price_per_Carat
## <dbl> <ord> <int> <dbl> <dbl>
## 1 0.23 Ideal 326 3.95 1417
## 2 0.21 Premium 326 3.89 1552
## 3 0.23 Good 327 4.05 1422
## 4 0.29 Premium 334 4.2 1152
## 5 0.31 Good 335 4.34 1081
## 6 0.24 Very Good 336 3.94 1400
summary(mydata)
## carat cut price length
## Min. :0.2000 Fair : 1610 Min. : 326 Min. : 0.000
## 1st Qu.:0.4000 Good : 4906 1st Qu.: 950 1st Qu.: 4.710
## Median :0.7000 Very Good:12082 Median : 2401 Median : 5.700
## Mean :0.7979 Premium :13791 Mean : 3933 Mean : 5.731
## 3rd Qu.:1.0400 Ideal :21551 3rd Qu.: 5324 3rd Qu.: 6.540
## Max. :5.0100 Max. :18823 Max. :10.740
## Price_per_Carat
## Min. : 1051
## 1st Qu.: 2478
## Median : 3496
## Mean : 4008
## 3rd Qu.: 4950
## Max. :17829
From the results, we know that the price for diamonds ranges from 326 USD up to 18823 USD, with an average (mean) price for a diamond being 3933 USD.
Carat weight of diamonds ranges from 0.2 to 5.01 carats, with an average weight of about 0.80 carats. The median weight is 0.70 carats, meaning that 50% of the diamonds in the data set are lighter or weight 0.70 carats and 50% are heavier.
The average (mean) price per carat is 4008 USD. At the same time, the median is 3496 USD, probably indicating that there are a few very expensive diamonds making the mean higher.
Most diamonds have a high quality cut, 13791 having a Premium and 21551 having an Ideal cut.
ggplot(mydata, aes(price)) +
geom_histogram(binwidth = 1000, color = "royalblue", fill = "cadetblue2") + theme_minimal() +
labs (title = "Diamond Price Distribution",
x = "Price in USD", y = "Number of Diamonds") + scale_x_continuous(breaks = seq(0, 19000, by = 2000)) +
scale_y_continuous(breaks = seq(0, 15000, by = 1000))
The price distribution is skewed to the right. The majority of diamonds costs below 6000 USD, most around 2000 USD. However, some diamonds cost over 18000, and extend the distribution to almost 19000. The skewness explains the high value of mean compared to the median as discussed above.
ggplot(mydata, aes(carat)) +
geom_histogram(binwidth = 0.5, color = "orchid3", fill = "hotpink1") +
theme_dark() +
labs(title = "Diamond Carat Distribution",
x = "Carats (weight)", y = "Number of Diamonds") +
scale_x_continuous(breaks = seq(0, 5, by = 1))
Carat distribution is, similarly to Price, skewed to the right. Most diamonds weight below one carat, with a few heavy diamonds as an exception. The few very heavy diamonds as well as the skewness to the right correspond with the distribution of price, explaining that the few heavy diamonds are more expensive, and the lighter diamonds are cheaper.
library(ggplot2)
ggplot(mydata, aes(x = cut, y = price)) +
geom_boxplot(color = "black",
fill = "hotpink1",
outlier.color = "purple4") +
theme_light() + scale_y_log10() + #for big outliers
labs(title = "Diamond Price by Cut",
x = "Quality of Cut",
y = "Price")
The boxplot shows how diamond prices vary across different cut qualities. According to the boxplot results, Premium cut diamonds have the highest median price, while Ideal cuts are less expensive even with the quality of their cut. A factor in this could be the size of diamonds. Prices vary a lot across all cut qualities, again, potentially due to other factors like the size or length.
ggplot(mydata, aes(x = carat, y = length)) +
geom_point(color = "cadetblue", alpha = 0.5) +
theme_minimal() + geom_smooth(color = "black") +
labs(title = "Diamond Length vs Carat",
x = "Carat (weight)",
y = "Length (mm)")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
The scatterplot shows a strong positive relationship between the diamond’s carat (weight) and its length. As carat increases, length increases too, with the curve increasing at a decreasing rate for bigger diamonds. For smaller diamonds, length grows quickly with added weight, while for larger diamonds the growth slows down. This may reflect that carat measures overall volume, not just length.
library(readxl)
Business_School <- read_excel("~/IMB/Bootcamp/R Take Home Exam 2025/R Take Home Exam 2025/Business School.xlsx")
head(Business_School)
## # 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(Business_School, aes(x = `Undergrad Degree`)) +
geom_bar(fill = "powderblue", color = "black") +
theme_minimal() +
labs(title = "Distribution of Undergraduate Degrees",
x = "Undergraduate Degree", y = "Frequency")
The most common undergraduate degree among MBA students is Business.
library(pastecs)
round(stat.desc(Business_School$`Annual Salary`),1)
## nbr.val nbr.null nbr.na min max range
## 100.0 0.0 0.0 20000.0 340000.0 320000.0
## sum median mean SE.mean CI.mean.0.95 var
## 10905800.0 103500.0 109058.0 4150.1 8234.8 1722373474.7
## std.dev coef.var
## 41501.5 0.4
ggplot(Business_School, aes(x = `Annual Salary`)) +
geom_histogram(binwidth = 20000, fill = "gold1", color = "black") +
theme_minimal() +
labs(title = "Distribution of Annual Salary",
x = "Annual Salary",
y = "Frequency") +
scale_x_continuous(labels = scales::comma, #to eliminate scientific number style
breaks = seq (0, 350000, by = 50000))
The descriptive statistics show that the annual salaries have a wide range from 20000 USD up to 340000 USD, with an average (mean) salary around 109058 USD. The median lies at 103500 USD, indicating that 50% people earn 103500 USD or less and 50% earn more than 103500. The standard deviation of about 41,502 and a coefficient of variation of 0.4 both indicate a relatively high variability of salaries compared to the mean.
The histogram aligns with the statistics, with most salaries around 100000 USD, but also with a few very high outlier salaries above 200,000 USD. The distribution is skewed to the right because of it. Most students earn around 100000 and a small number of high earners pull the average (mean) salary upwards.
The hypothesis test aims to determine whether the average (mean) MBA grade differs from last year’s average (74). Since we are looking at whether the grade stayed same or changed (improved or worsened), it is a two tailed t-test.
t.test(Business_School$`MBA Grade`,
mu = 74,
alternative = "two.sided")
##
## One Sample t-test
##
## data: Business_School$`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.04055
The t-test shows that the current MBA mean grade M = 76.04 is higher than last year’s average grade of 74. The 95% confidence interval does not include 74, thus we reject the null hypothesis and conclude that this year’s students achieved a different (higher) average grade than the previous year.
#install.packages("effectsize")
library(effectsize)
cohens_d(Business_School$`MBA Grade`, mu = 74)
## Cohen's d | 95% CI
## ------------------------
## 0.27 | [0.07, 0.46]
##
## - Deviation from a difference of 74.
The effect size was Cohen’s d = 0.27, which indicates a small effect. This year, the students scored higher, but the improvement is modest.
library(readxl)
apartments <- read_excel("./Apartments.xlsx")
head(apartments)
## # A tibble: 6 × 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 0
## 4 28 29 1850 0 1
## 5 18 18 1640 1 1
## 6 28 12 1770 0 1
Description:
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)
## # A tibble: 6 × 5
## Age Distance Price Parking Balcony
## <dbl> <dbl> <dbl> <fct> <fct>
## 1 7 28 1640 No Yes
## 2 18 1 2800 Yes No
## 3 7 28 1660 No No
## 4 28 29 1850 No Yes
## 5 18 18 1640 Yes Yes
## 6 28 12 1770 No Yes
t.test(apartments$Price,
mu = 1900,
alternative = "two.sided")
##
## One Sample t-test
##
## data: apartments$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
At the 5% significance level, the p-value of 0.0047 is smaller than 0.05, thus we reject the null hypothesis that the mean apartment price equals 1900 EUR. The 95% confidence interval for the mean does not include 1900, confirming the result.
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
coef(fit1) #regression coefficient
## (Intercept) Age
## 2185.454892 -8.975058
cor(apartments$Price, apartments$Age) #coefficient of correlation
## [1] -0.230255
summary(fit1)$r.squared #coefficient of determination
## [1] 0.05301737
The estimates of regression coefficients are 2185.45 and -8.98. When the age of an apartment is 0, the predicted apartment price is about 2185 EUR, and for each additional year of aging, the apartment price decreases by about 9 EUR on average.
The coefficient of correlation is -0.230. It indicates a weak negative relationship, so when age increases, the price tends to decrease just slightly.
The coefficient of determination is 0.053. Only around 5% of the variation in apartment prices is explained by Age. The remaining 95% is explained by other factors.
library(car)
## Loading required package: carData
scatterplotMatrix(apartments[c("Price", "Age", "Distance")],
smooth = FALSE)
The scatterplot matrix shows that the price decreases with both age and distance. Age and Distance do not seem to be strongly correlated with each other, thus from the visual graph there is no evidence of a multicollinearity problem.
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
library(car)
vif(fit2)
## Age Distance
## 1.001845 1.001845
mean(vif(fit2))
## [1] 1.001845
Both values are close to 1, indicating no multicolinearity problem, which would arise with values close and higher than 5. Age and Distance are reliable and independent.
apartments$StdResid <- round(rstandard(fit2), 3) #Standardized residuals
apartments$CooksD <- round(cooks.distance(fit2), 3) #Cooks distances
hist(apartments$StdResid,
xlab = "Standardized residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals")
shapiro.test(apartments$StdResid)
##
## Shapiro-Wilk normality test
##
## data: apartments$StdResid
## W = 0.95303, p-value = 0.003645
hist(apartments$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances")
head(apartments[order(apartments$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.013
head(apartments[order(-apartments$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.038
library(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, union
apartments <- apartments %>%
filter(!CooksD %in% c(0.320, 0.104, 0.069, 0.066, 0.061))
Removed 5 outliers based on Cooks Distances. Standardized Residuals are within -3/+3 with no problematic units.
fit2 <- update(fit2, data = apartments)
apartments$StdResid <- rstandard(fit2)
apartments$StdFitted <- as.numeric(scale(fitted(fit2)))
library(car)
scatterplot(y = apartments$StdResid, x = apartments$StdFitted,
ylab = "Standardized residuals",
xlab = "Standardized fitted values",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
The values are randomly distributed, but slightly fanning at the right side, which indicates possible heteroskedasticity.
library(olsrr)
##
## Attaching package: 'olsrr'
## The following object is masked from 'package:datasets':
##
## rivers
ols_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 = 1.738591
## Prob > Chi2 = 0.1873174
Checking heteroskedasticity with the Breusch Pagan Test. The Breusch Pagan Test shows p = 0.187, indicating we cannot reject the null hypothesis. Thus, there is no heteroskedasticity present.
summary(fit2)
##
## 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
hist(apartments$StdResid,
xlab = "Standardized residuals",
main = "Histogram of standardized residuals")
shapiro.test(apartments$StdResid)
##
## Shapiro-Wilk normality test
##
## data: apartments$StdResid
## W = 0.94156, p-value = 0.001168
After the removal of the 5 outliers, the graph has regained its structure without any gaps and visually is indicating normal distribution. However, the Shapiro -Wilk normality test has resulted in values w = 0.94156 and p-value = 0.001168. The p-value of 0.001168 indicates that the null hypothesis (normality) has to be rejected. The conclusion thus is that the standardized residuals are not normally distributed.
fit2 <- lm(Price ~ Age + Distance, data = apartments)
summary(fit2)
##
## 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
Distance (–24.063): For every additional unit of distance, the apartment’s price decreases on average by 24.06 EUR, holding age constant/ ceteris paribus. This indicates that apartments farther away are cheaper.
Age (-8.674): For every additional year of age, the apartment’s price decreases on average by 8.7 EUR, holding distance constant/ ceteris paribus. Older apartments are cheaper.
Intercept (2502.467): The price of an apartment to expect when when both Age and Distance = 0.
#categorical variables previously changed into factors
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
anova(fit2, 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.1135
Null hypothesis H0 states first model (fit2) is sufficient and the second (fit3) is not a better fit fot the data.
H1 hypothesis states second model (fit3) is better than first (fit2).
P-value = 0.1135, indicates that we cannot reject H0. Adding Parking and Balcony does not significantly improve the model significantly compared to only using Age and Distance. Model fit2 is thus sufficient for explaining apartment prices.
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
ParkingYes (128.7): Apartments with parking cost, on average, 128.7 EUR more than apartments without, ceteris paribus. This effect is statistically significant at the 5% level (p = 0.0376).
BalconyYes (6.032): Apartments with a balcony cost, on average, 6 EUR more than apartments without, ceteris paribus. However, this effect is not statistically significant (p = 0.9165). The data does not provide enough evidence to state that the effect on prices is real for balconies.
Hypothesis being tested by F-statistics:
The null hypothesis states that all regression coefficients except for the intercept are = 0 ( –> none of the variables explain apartment price).
The alternative H1 is that at least one is different from zero.
The p-value is < 0.001, so the H0 is rejected and it is concluded that the model explains apartment prices sufficiently.
apartments$fittedV <- fitted(fit3)
apartments$residFit3 <- residuals(fit3)
head(apartments[2, c("Price", "fittedV", "residFit3")])
## # A tibble: 1 × 3
## Price fittedV residFit3
## <dbl> <dbl> <dbl>
## 1 2800 2357. 443.
The fitted value for apartment ID2 is 2356.597 EUR.
The (actual, observed) Price is 2800 EUR.
Price (2800) - fitted value (2356.597) = 443.4026
The residual = 443.4, indicating the apartment is in reality 443.4 EUR more expensive than it is predicted by the model.