R take-home exam
2025-09-23
Mark Mataruga
Task 1
E-commerce Customer Behavior
The dataset used in this analysis was obtained from the Kaggle platform, the dataset is titled E-commerce Customer Behavior Dataset and contains detailed information about customer demographics, purchasing behavior, membership types, spending patterns, and satisfaction levels. It was selected because it offers a rich variety of both numerical and categorical variables, making it suitable for statistical analysis and visualization in R. The dataset is publicly available at the following link: https://www.kaggle.com/datasets/uom190346a/e-commerce-customer-behavior-dataset
mydata <- read.table("./E-commerce Customer Behavior.csv",
header=TRUE,
sep=",",
dec=".",
check.names = FALSE,
na.strings = c("", "NA", "N/A", " "))
head(mydata, 10)## Customer ID Gender Age City Membership Type Total Spend
## 1 101 Female 29 New York Gold 1120.20
## 2 102 Male 34 Los Angeles Silver 780.50
## 3 103 Female 43 Chicago Bronze 510.75
## 4 104 Male 30 San Francisco Gold 1480.30
## 5 105 Male 27 Miami Silver 720.40
## 6 106 Female 37 Houston Bronze 440.80
## 7 107 Female 31 New York Gold 1150.60
## 8 108 Male 35 Los Angeles Silver 800.90
## 9 109 Female 41 Chicago Bronze 495.25
## 10 110 Male 28 San Francisco Gold 1520.10
## Items Purchased Average Rating Discount Applied
## 1 14 4.6 TRUE
## 2 11 4.1 FALSE
## 3 9 3.4 TRUE
## 4 19 4.7 FALSE
## 5 13 4.0 TRUE
## 6 8 3.1 FALSE
## 7 15 4.5 TRUE
## 8 12 4.2 FALSE
## 9 10 3.6 TRUE
## 10 21 4.8 FALSE
## Days Since Last Purchase Satisfaction Level
## 1 25 Satisfied
## 2 18 Neutral
## 3 42 Unsatisfied
## 4 12 Satisfied
## 5 55 Unsatisfied
## 6 22 Neutral
## 7 28 Satisfied
## 8 14 Neutral
## 9 40 Unsatisfied
## 10 9 SatisfiedDescription:
- Customer ID: A unique numerical identifier assigned to each customer in the dataset
- Gender: The gender of the customer, recorded as either Male or Female.
- Age: The age of the customer in years.
- City: The city where the customer resides.
- Membership Type: The customer’s membership status in the loyalty program, categorized as Gold, Silver, or Bronze.
- Total Spend: The total monetary amount spent by a customer (in USD).
- Items Purchased: The total number of items bought by the customer
- Average Rating: The average satisfaction score given by the customer, measured on a scale from 1 (lowest satisfaction) to 5 (highest satisfaction).
- Discount Applied: A binary variable indicating whether a discount was applied to the purchase (TRUE = Yes, FALSE = No).
- Days Since Last Purchase: The number of days that have passed since the customer’s last purchase.
- Satisfaction Level: A categorical variable describing the customer’s overall level of satisfaction, classified as Satisfied, Neutral, or Unsatisfied.
Data Manipulation
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionmydata2 <- mydata %>%
select(-City) %>%
filter(!is.na(`Satisfaction Level`)) I used the dplyr package to clean and prepare the dataset. Specifically, I removed the variable City because it was not relevant for the analysis, and I filtered out all cases where the variable Satisfaction Level had missing values. This ensured that the dataset used in further analysis contained only complete and relevant observations.
mydata2$`Average Item Value` <- round(mydata2$`Total Spend` / mydata2$`Items Purchased`, 2)I created a new variable called Average Item Value. This was calculated by dividing the total spending (Total Spend) by the number of items purchased (Items Purchased) for each customer. The result was rounded to two decimal places to improve readability and interpretability. This new variable allows us to compare how much, on average, customers spend per item.
mydata2$`Discount Applied` <- factor(mydata2$`Discount Applied`,
levels = c(TRUE, FALSE),
labels = c("Yes", "No"))I recoded the variable Discount Applied into a categorical factor with two levels: Yes and No. This transformation makes the variable easier to interpret in subsequent analyses and ensures it is properly recognized as a categorical predictor in statistical models.
Descriptive statistics for the selected variables
summary(mydata2$Age)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 26.00 30.00 32.00 33.58 37.00 43.00The results indicate that the youngest customer is 26 years old and the oldest is 43 years old. The mean age is 33.58 years, while the median age is 32, which is slightly lower than the mean. This suggests that the distribution of ages is not perfectly symmetric but slightly skewed to the right, as a few older customers raise the average above the median. The first quartile (Q1) is 30, meaning that 25% of customers are aged 30 or younger, while the third quartile (Q3) is 37, indicating that 75% of customers are 37 or younger. Therefore, the middle 50% of the sample lies between 30 and 37 years.
hist(mydata2$Age, col = "darkkhaki",
main = "Distribution by Age",
xlab = "Age",
ylab = "Frequency",
breaks = seq(from = 20, to = 50, by = 1),)
The histogram indicates that most customers fall within the age range of 30 to 37 years, with the highest concentration around 32–33 years. This supports the descriptive statistics, where both the mean (33.6) and median (32) were located in this interval. The distribution is relatively balanced, but with a slight right skew, as there are fewer but noticeable observations in the higher age ranges (above 40).
summary(mydata2[ , -c(1,2,4,8,10)])## Age Total Spend Items Purchased Average Rating
## Min. :26.00 Min. : 410.8 Min. : 7.00 Min. :3.000
## 1st Qu.:30.00 1st Qu.: 505.8 1st Qu.: 9.00 1st Qu.:3.500
## Median :32.00 Median : 780.2 Median :12.00 Median :4.100
## Mean :33.58 Mean : 847.8 Mean :12.63 Mean :4.024
## 3rd Qu.:37.00 3rd Qu.:1160.6 3rd Qu.:15.00 3rd Qu.:4.500
## Max. :43.00 Max. :1520.1 Max. :21.00 Max. :4.900
## Days Since Last Purchase Average Item Value
## Min. : 9.00 Min. :49.52
## 1st Qu.:15.00 1st Qu.:57.17
## Median :23.00 Median :67.03
## Mean :26.61 Mean :65.25
## 3rd Qu.:38.00 3rd Qu.:73.03
## Max. :63.00 Max. :83.59Age (Min = 26): The youngest customer in the dataset is 26 years old.
Total Spend (Median = 780.2): Half of the customers spend less than 780.2 monetary units in total on average, while the other half spend more. This shows the central tendency of spending behavior in the group.
Items Purchased (1st Quartile = 9): Twenty-five percent of customers purchased 9 or fewer items on average, highlighting that a significant proportion of customers are relatively low-volume buyers.
Average Rating (Mean = 4.024): On average, customers rate their satisfaction slightly above 4 on a scale from 1 to 5, suggesting generally positive evaluations of the service or product.
Days Since Last Purchase (Max = 63): The longest recorded gap since the last purchase is 63 days, showing that some customers have not interacted with the company for over two months, which may indicate lower engagement.
Average Item Value (3rd Quartile = 73.03): Seventy-five percent of customers spend less than 73.03 per item on average, while the top 25% spend more than this amount, reflecting a group of higher-value buyers.
library(pastecs)##
## Attaching package: 'pastecs'## The following objects are masked from 'package:dplyr':
##
## first, lastround(stat.desc(mydata2$`Total Spend`), 2)## nbr.val nbr.null nbr.na min max
## 348.00 0.00 0.00 410.80 1520.10
## range sum median mean SE.mean
## 1109.30 295032.00 780.20 847.79 19.39
## CI.mean.0.95 var std.dev coef.var
## 38.13 130821.37 361.69 0.43The dataset contains 348 valid observations, with no missing or null values. The minimum total spend recorded is 410.80, while the maximum reaches 1520.10, resulting in a range of 1109.30. This wide spread indicates substantial differences in customer spending. The mean total spend is 847.79, which is slightly higher than the median of 780.20. This suggests a mild right skew in the distribution, where some higher-spending customers increase the mean above the median. The standard deviation of 361.69 reflects a high degree of variability in the data, and the variance (130,821.37) confirms this dispersion. The coefficient of variation (0.43) indicates that relative variability is considerable, as the standard deviation represents about 43% of the mean value. The standard error of the mean is 19.39, and the 95% confidence interval for the population mean is ±38.13. This implies that we can be 95% confident that the true mean total spend lies between approximately 809.66 and 885.92.
In summary, while most customers spend around 800–850 units in total, there is significant variation, with some customers spending substantially more, which influences the overall distribution.
hist(mydata2$`Total Spend`,
main = "Distribution of Total Spend",
xlab = "Total Spend (in $)",
ylab = "Frequency",
col = "antiquewhite3",
breaks = 30)
round(mean(mydata2$`Total Spend`[mydata2$Gender == "Female"]), 2)## [1] 707.04To examine differences in spending behavior by gender, I calculated the mean value of Total Spend for female customers only. The R command:filters the dataset to include only cases where Gender = Female and then computes the mean of their total spending. The result shows that the average total spend among female customers is 707.04.This value is notably lower than the overall mean of 847.79 (as calculated earlier), suggesting that female customers, on average, spend less compared to the general customer base.
library(psych)
describeBy(mydata2$`Total Spend`, mydata2$Gender)##
## Descriptive statistics by group
## group: Female
## vars n mean sd median trimmed mad min max range
## X1 1 173 707.04 327.47 505.75 681.81 96.15 410.8 1200.8 790
## skew kurtosis se
## X1 0.67 -1.52 24.9
## ----------------------------------------------------
## group: Male
## vars n mean sd median trimmed mad min max range
## X1 1 175 986.93 340.17 800.9 964.23 163.53 660.3 1520.1 859.8
## skew kurtosis se
## X1 0.64 -1.48 25.71To investigate whether spending behavior differs by gender, the describeBy function from the psych package was used. This command provides descriptive statistics for the variable Total Spend separately for female and male customers.
For female customers (n = 173), the mean total spend is 707.04, with a median of 505.75. The minimum and maximum spending values range from 410.8 to 1200.8, and the standard deviation is 327.47, indicating considerable variability among female customers.
For male customers (n = 175), the mean total spend is higher, at 986.93, and the median is 800.9. The spending range is wider, from 660.3 to 1520.1, with a standard deviation of 340.17, which again suggests large differences in individual spending levels.
Comparing the two groups, it is clear that male customers spend significantly more on average than female customers. Not only are the mean and median higher for males, but the minimum spending among males is also greater than the minimum among females. This indicates a consistent difference across the distribution rather than just being influenced by outliers.
Graphing the distribution of the variables
library(car)## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:psych':
##
## logit## The following object is masked from 'package:dplyr':
##
## recodescatterplot(`Total Spend` ~ Age | Gender,
ylab = "Total Spend (in $)",
xlab = "Age",
smooth = FALSE,
col = c("deeppink", "blue"),
pch = c(1, 2),
data = mydata2)
The scatterplot shows individual spending values across different ages, with females represented by pink circles and males by blue triangles. A separate regression line was fitted for each gender to visualize the general trend.
For both genders, the regression lines suggest a negative relationship between age and spending: as age increases, total spending tends to decrease. This trend is slightly stronger among female customers, whose regression line has a steeper downward slope compared to males.
Additionally, the plot confirms the results from descriptive statistics — male customers generally spend more than female customers across almost all age groups. While both groups show a wide range of spending values, male customers are more concentrated in higher spending levels (closer to 1000–1200), whereas female customers are more concentrated in lower spending ranges.
Overall, the scatterplot provides visual evidence that spending declines with age and that males consistently outspend females, reinforcing the descriptive results presented earlier.
library(ggplot2)##
## Attaching package: 'ggplot2'## The following objects are masked from 'package:psych':
##
## %+%, alphaggplot(mydata2, aes(x=`Discount Applied`, y=`Average Rating`)) +
geom_boxplot(fill = c("lightgreen","firebrick1"))
In this visualization, the x-axis represents whether a discount was applied (Yes or No), while the y-axis shows the average rating given by customers.
The results suggest that customers who did not receive a discount reported slightly higher satisfaction ratings, with a higher median compared to those who received a discount. The median rating in the No Discount group is above 4, whereas in the Discount Applied group, it is just below 4.
Both groups exhibit a relatively wide spread of ratings, ranging from about 3.0 to 4.8. However, the interquartile range (IQR) is somewhat larger in the No Discount group, indicating greater variability in ratings among customers who did not receive discounts.
Overall, the boxplot suggests that discounts do not necessarily increase customer satisfaction, as the higher ratings are observed in the group without discounts.
library(ggplot2)
ggplot(mydata2, aes(x = `Membership Type`, y = `Total Spend`)) +
geom_boxplot(fill = "skyblue", color = "black") +
labs(title = "Total Spend by Membership Type",
x = "Membership Type",
y = "Total Spend (in $)") +
theme_minimal()
The boxplot illustrates the differences in Total Spend across the three membership types (Bronze, Silver, Gold). The distribution of spending shows a clear upward trend with higher membership levels.
Customers with Bronze membership spend the least on average, with their median total spend centered around the lower range (approximately 500 USD). The interquartile range (IQR) is narrow, indicating relatively low variation in spending among Bronze members.
Silver members spend more than Bronze, with a median close to 800–900 USD. Their IQR is wider than Bronze, which suggests greater variability in spending patterns among this group.
Gold members demonstrate the highest spending levels, with a median exceeding 1200 USD. The IQR is also the largest, showing that while Gold members consistently spend more, there is also more variability within this group compared to others.
Overall, the plot provides strong evidence that membership type is positively associated with total spending, with higher-tier memberships (Gold) linked to greater customer expenditures. This supports the idea that loyalty programs successfully segment customers by purchasing power and spending behavior.
mydata2 <- mydata2[ , c(5, 7, 9)]
library(car)
scatterplotMatrix(mydata2,
smooth = FALSE)
The scatterplot matrix allows us to observe both the distribution of each variable (on the diagonal) and the bivariate relationships (off-diagonal).
Total Spend and Average Rating: The plot shows a clear positive relationship, as customers spend more, their ratings also tend to increase. This suggests that higher spending customers may be more satisfied, or that satisfaction encourages greater spending.
Total Spend and Days Since Last Purchase: There is a negative relationship, the more time has passed since the last purchase, the lower the total spend tends to be. This finding is intuitive, as less engaged customers (longer gaps between purchases) spend less overall.
Average Rating and Days Since Last Purchase: Here we also observe a negative relationship customers who gave higher ratings tend to have made purchases more recently, while lower ratings are associated with longer gaps since the last transaction.
The density plots on the diagonal further illustrate the distribution of each variable. Total Spend and Days Since Last Purchase appear somewhat skewed, while Average Rating shows a bimodal tendency, with two peaks around lower and higher satisfaction levels.
Task 2
library(readxl)
mydata3 <- read_excel("./Business School.xlsx")
head(mydata3)## # 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>ggplot(mydata3, aes(x = `Undergrad Degree`)) +
geom_bar(colour = "tomato4", fill = "tomato3") +
labs(title = "Distribution of Undergraduate Degrees",
x = "Undergraduate Degree",
y = "Count")
most_common_undergrad <- mydata3 %>%
count(`Undergrad Degree`, sort = TRUE) %>%
slice(1)
most_common_undergrad## # A tibble: 1 × 2
## `Undergrad Degree` n
## <chr> <int>
## 1 Business 35Based on the obtained graph showing the distribution of undergraduate degrees created with the ggplot function, we can conclude that the most common degree is in Business, with 35 of them.
round(stat.desc(mydata3$`Annual Salary`))## nbr.val nbr.null nbr.na min max
## 100 0 0 20000 340000
## range sum median mean SE.mean
## 320000 10905800 103500 109058 4150
## CI.mean.0.95 var std.dev coef.var
## 8235 1722373475 41501 0The results show that the dataset contains 100 valid observations with no missing values. The salaries range from a minimum of 20,000 EUR to a maximum of 340,000 EUR, resulting in a wide spread of 320,000 EUR. The mean annual salary is approximately 109,058 EUR, while the median is slightly lower at 103,500 EUR, indicating a moderately right-skewed distribution where some high salaries pull the mean upward. The standard deviation of about 41,501 EUR and the variance (≈ 1.72 × 10⁸) confirm a substantial variability within the sample. The standard error of the mean is 4,150 EUR, and the 95% confidence interval for the mean is ±8,235 EUR, suggesting that the true population mean is likely to fall within this range.
ggplot(mydata3, aes(x = `Annual Salary`)) +
geom_histogram(binwidth = diff(range(mydata3$`Annual Salary`, na.rm = TRUE))/30, colour = "royalblue4", fill = "royalblue1", boundary = 0, closed = "left") +
labs(title = "Annual Salary – Histogram",
x = "Annual Salary",
y = "Frequency")
mu0 <- 74
# One-sample t-test
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.04055This function compares the sample mean with the hypothesized population mean (μ₀ = 74) under the null hypothesis:
H₀: μ = 74 (the average MBA grade is equal to 74)
H₁: μ ≠ 74 (the average MBA grade is not equal to 74)
The results of the test show a sample mean of 76.04, which is higher than the hypothesized mean. The test statistic is t = 2.6587 with 99 degrees of freedom, and the associated p-value is 0.00915. Since this p-value is below the 5% significance threshold (α = 0.05), the null hypothesis is rejected.
The 95% confidence interval for the true mean ranges from 74.52 to 77.56, which does not include the value of 74. This further supports the conclusion that the true mean grade of the current students is significantly higher than in the previous year.
library(effectsize)##
## Attaching package: 'effectsize'## The following object is masked from 'package:psych':
##
## phicohens_d(mydata3$`MBA Grade`, mu = 74)## Cohen's d | 95% CI
## ------------------------
## 0.27 | [0.07, 0.46]
##
## - Deviation from a difference of 74.The result shows Cohen’s d = 0.27, with a 95% confidence interval ranging from 0.07 to 0.46. Since the entire interval lies above 0, we can be confident that the effect is positive and not due to random variation. Interpreting the magnitude, a Cohen’s d of around 0.27 corresponds to a small effect size according to standard benchmarks. This means that although the MBA cohort’s mean grade is statistically higher than the benchmark of 74 (as shown in the t-test), the practical improvement is relatively modest.
Task 3
Import the dataset Apartments.xlsx
library(readxl)
mydata4 <- read_excel("./Apartments.xlsx")
head(mydata4)## # 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 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$Parking <- factor(mydata4$Parking,
levels = c(0, 1),
labels = c("No", "Yes"))
mydata4$Balcony <- factor(mydata4$Balcony,
levels = c(0, 1),
labels = c("No", "Yes"))
head(mydata4)## # 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 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.941Hypothesis:
H0: μ = 1900
H1: μ ≠ 1900
Based on the results, I can state that the average apartment price differs from 1900 EUR at the 5% significance level (α = 0.05; p < α). Since the confidence interval does not contain the value of 1900 EUR, the null hypothesis H0 can be rejected. This allows me to conclude, with 95% confidence, that the actual mean price of apartments is between 1937.44 EUR 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.230255Regression model: E(Y/X) = β0 + β1 × X1 → Price = 2185.455 – 8.975 × Age
Interpretation of coefficients: The intercept (β0) shows that if Age (X1) equals 0 and all other factors remain constant, the expected average Price amounts to 2185.455 EUR. The slope coefficient (β1) for Age indicates that, for every additional year, the Price decreases by 8.975 EUR on average, provided nothing else changes.
With 95% confidence, I can conclude that the coefficients are statistically different from zero, which leads to rejecting the null hypothesis H0 (p < 0.05).
Coefficient of determination: The R² statistic suggests that 5.302% of the variation in Price can be explained solely by the variable Age (X1).
Correlation coefficient: This value describes both the strength and direction of the linear link between two variables. In this case, Age and Price are negatively related, but the association is weak since the correlation is -0.23.
Show the scateerplot matrix between Price, Age and Distance. Based on the matrix determine if there is potential problem with multicolinearity.
library(car)
scatterplotMatrix(mydata4[ , c(3, 1, 2)],
smooth = FALSE)
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-11Check the multicolinearity with VIF statistics. Explain the findings.
vif(fit2)## Age Distance
## 1.001845 1.001845mean(vif(fit2))## [1] 1.001845The Variance Inflation Factor (VIF) is a measure used to evaluate and detect multicollinearity among explanatory variables. When VIF values are below 5, the variables can be safely included in the model. However, if VIF is 5 or higher, it suggests a high degree of overlap, meaning the variable may need to be reconsidered or excluded due to multicollinearity. Ideally, the average of all VIF values should be close to 1. In this case, since both Age and Distance have VIF values under 5 and their average is near 1, I can conclude that multicollinearity is not an issue.
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) #Standardized residuals
mydata4$CooksD <- round(cooks.distance(fit2), 3) #Cooks distances
hist(mydata4$StdResid,
xlab = "Standardized residuals",
ylab = "Frequency",
main = "Histogram of standardized residuals",
xlim = c(-3, 3),
col = "lightskyblue")
hist(mydata4$CooksD,
xlab = "Cooks distance",
ylab = "Frequency",
main = "Histogram of Cooks distances",
col = "darkgoldenrod1")
head(mydata4[order(mydata4$StdResid),], 3) #Three units with lowest value of stand. residuals## # 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(mydata4[order(-mydata4$CooksD),], 3) #Three units with highest value of Cooks distance## # A tibble: 3 × 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.069From the standardized residuals histogram, it is clear that there are no extreme outliers, since all values fall within the range of -3 to 3. On the other hand, the Cook’s distance histogram indicates that one observation has a notably higher Cook’s distance compared to the rest, meaning it has a stronger influence on the regression model. I identified the problematic unit, the one with CooksD = 0.320, and I am going to remove it later.
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(y = mydata4$StdResid, x = mydata4$StdFitted,
ylab = "Standardized residuals",
xlab = "Standardized fitted values",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
Heteroscedasticity describes the situation where residuals have unequal variability, meaning their spread changes across different levels of explanatory variables. In the scatterplot, the variance of standardized residuals appears constant, indicating that heteroscedasticity is not present. This suggests the model satisfies the assumption of homoscedasticity.
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.325153The test results show a Chi-squared statistic of 0.9681 with a corresponding p-value of 0.3252. Since the p-value is considerably higher than the conventional significance level of 0.05, we fail to reject the null hypothesis. This means there is no statistical evidence of heteroskedasticity in the model.
Are standardized residuals ditributed normally? Show the graph and formally test it. Explain the findings.
hist(mydata4$StdResid,
xlab = "Standardized residuals",
ylab = "Density",
main = "Histogram of standardized residuals",
xlim = c(-3, 3),
col = "darkseagreen",
freq = FALSE)
curve(dnorm(x, mean = mean(mydata4$StdResid), sd = sd(mydata4$StdResid)),
col = "red",
lwd = 2,
add = TRUE)
shapiro.test(mydata4$StdResid)##
## Shapiro-Wilk normality test
##
## data: mydata4$StdResid
## W = 0.95303, p-value = 0.003645By examining the histogram, it is evident that the data does not follow a normal distribution. To make this clearer, I added a normal distribution curve for comparison, showing how the residuals should appear if they were normally distributed. Additionally, I verified this assumption using the Shapiro-Wilk test for normality.
H0: the distribution is normal
H1: the distribution is not normal
At the 5% significance level, H0 can be rejected, meaning the distribution is not normal.
Estimate the fit2 again without potentially excluded units and show the summary of the model. Explain all coefficients.
library(dplyr)
mydata4 <- mydata4 %>%
filter(!CooksD == 0.320) #Removing highest CooksD
fit2 <- lm(Price ~ Age + Distance,
data = mydata4)
summary(fit2) #Results of regression model##
## 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.6955609To begin with, I removed the observation that had a Cook’s distance of 0.320 and recalculated the regression (fit2) without it.
The new regression equation is: Price = 2456.076 – 6.464 × Age – 22.955 × Distance
Interpretation of coefficients: The intercept shows that if Age (X1) is 0 and all other factors remain unchanged, the average Price will be 2456.076 EUR. The coefficient for Age indicates that, on average, Price decreases by 6.464 EUR for every additional year, assuming everything else is constant. The coefficient for Distance means that with each unit increase in Distance, the Price drops by 22.955 EUR on average, while other variables stay fixed.
H0: coefficients = 0
H1: coefficients ≠ 0
At the 5% significance level, the null hypothesis can be rejected for all three coefficients (p < 0.05), meaning they are statistically significant.
Correlation coefficient: By taking the square root of R², the correlation is 0.6955609, which suggests a strong positive relationship between Age, Distance, and Price.
Coefficient of determination: The R² value shows that 48.38% of the variation in Price is explained by Age and Distance (X1 and X2).
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 = mydata4)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 + Parking + Balcony
## 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 ' ' 1Analysis of Variance (ANOVA) is applied when we want to test if there are statistically significant differences between the means of three or more groups.
H0: model 1 (fit2) performs better
H1: model 2 (fit3) performs better
At the 5% significance level, H0 is rejected since p < 0.05. This means ANOVA indicates that model 2 (fit3), which includes more variables and is therefore more complex, 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 + Parking + Balcony, 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 ***
## ParkingYes 167.531 62.864 2.665 0.00933 **
## BalconyYes -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-12The regression coefficient for Parking indicates that, if an apartment includes parking while all other factors remain constant, its average Price is 167.53 EUR higher. In contrast, the coefficient for Balcony shows that having a balcony reduces the Price by about 15.207 EUR on average, assuming no other changes.
Save fitted values and claculate the residual for apartment ID2.
mydata4$Fitted <- fitted.values(fit3)
mydata4$Residuals <- residuals(fit3)
round(mydata4[2, 10], 3)## # A tibble: 1 × 1
## Residuals
## <dbl>
## 1 428.The residual for apartment ID2 shows that the actual selling price of this apartment is 427.8 EUR higher than the value predicted by the regression model.