data()
data(package = .packages(all.available = TRUE))
# Load the package and dataset
data(penguins)
#Reading the dataset, saved in R
mydata <- force(penguins)
# Check first few rows
head(penguins)
## species island bill_len bill_dep flipper_len body_mass sex year
## 1 Adelie Torgersen 39.1 18.7 181 3750 male 2007
## 2 Adelie Torgersen 39.5 17.4 186 3800 female 2007
## 3 Adelie Torgersen 40.3 18.0 195 3250 female 2007
## 4 Adelie Torgersen NA NA NA NA <NA> 2007
## 5 Adelie Torgersen 36.7 19.3 193 3450 female 2007
## 6 Adelie Torgersen 39.3 20.6 190 3650 male 2007
# Structure of dataset
str(penguins)
## 'data.frame': 344 obs. of 8 variables:
## $ species : Factor w/ 3 levels "Adelie","Chinstrap",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ island : Factor w/ 3 levels "Biscoe","Dream",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ bill_len : num 39.1 39.5 40.3 NA 36.7 39.3 38.9 39.2 34.1 42 ...
## $ bill_dep : num 18.7 17.4 18 NA 19.3 20.6 17.8 19.6 18.1 20.2 ...
## $ flipper_len: int 181 186 195 NA 193 190 181 195 193 190 ...
## $ body_mass : int 3750 3800 3250 NA 3450 3650 3625 4675 3475 4250 ...
## $ sex : Factor w/ 2 levels "female","male": 2 1 1 NA 1 2 1 2 NA NA ...
## $ year : int 2007 2007 2007 2007 2007 2007 2007 2007 2007 2007 ...
# Summary statistics of all variables (includes missing values info)
summary(penguins)
## species island bill_len bill_dep
## Adelie :152 Biscoe :168 Min. :32.10 Min. :13.10
## Chinstrap: 68 Dream :124 1st Qu.:39.23 1st Qu.:15.60
## Gentoo :124 Torgersen: 52 Median :44.45 Median :17.30
## Mean :43.92 Mean :17.15
## 3rd Qu.:48.50 3rd Qu.:18.70
## Max. :59.60 Max. :21.50
## NA's :2 NA's :2
## flipper_len body_mass sex year
## Min. :172.0 Min. :2700 female:165 Min. :2007
## 1st Qu.:190.0 1st Qu.:3550 male :168 1st Qu.:2007
## Median :197.0 Median :4050 NA's : 11 Median :2008
## Mean :200.9 Mean :4202 Mean :2008
## 3rd Qu.:213.0 3rd Qu.:4750 3rd Qu.:2009
## Max. :231.0 Max. :6300 Max. :2009
## NA's :2 NA's :2
Explanation:
The dataset contains 344 observations of 8 variables describing three penguin species (Adelie, Chinstrap, Gentoo) across different islands. Key measurements include bill length and depth, flipper length, body mass, sex, and year of study. Some variables (bill length, bill depth, flipper length, body mass, sex) have a few missing values. On average, penguins have a bill length of ~44 mm, flipper length of ~201 mm, and body mass of ~4200 g, with variation across species.
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, union
# Remove rows with missing values
penguins_clean <- penguins %>% na.omit()
# Filter penguins observed in or after 2008
after2008 <- penguins_clean[penguins_clean$year %in% c(2008, 2009), ]
# Show selected variables
after2008[, c("species", "island", "sex", "body_mass", "year")]
## species island sex body_mass year
## 51 Adelie Biscoe female 3500 2008
## 52 Adelie Biscoe male 4300 2008
## 53 Adelie Biscoe female 3450 2008
## 54 Adelie Biscoe male 4050 2008
## 55 Adelie Biscoe female 2900 2008
## 56 Adelie Biscoe male 3700 2008
## 57 Adelie Biscoe female 3550 2008
## 58 Adelie Biscoe male 3800 2008
## 59 Adelie Biscoe female 2850 2008
## 60 Adelie Biscoe male 3750 2008
## 61 Adelie Biscoe female 3150 2008
## 62 Adelie Biscoe male 4400 2008
## 63 Adelie Biscoe female 3600 2008
## 64 Adelie Biscoe male 4050 2008
## 65 Adelie Biscoe female 2850 2008
## 66 Adelie Biscoe male 3950 2008
## 67 Adelie Biscoe female 3350 2008
## 68 Adelie Biscoe male 4100 2008
## 69 Adelie Torgersen female 3050 2008
## 70 Adelie Torgersen male 4450 2008
## 71 Adelie Torgersen female 3600 2008
## 72 Adelie Torgersen male 3900 2008
## 73 Adelie Torgersen female 3550 2008
## 74 Adelie Torgersen male 4150 2008
## 75 Adelie Torgersen female 3700 2008
## 76 Adelie Torgersen male 4250 2008
## 77 Adelie Torgersen female 3700 2008
## 78 Adelie Torgersen male 3900 2008
## 79 Adelie Torgersen female 3550 2008
## 80 Adelie Torgersen male 4000 2008
## 81 Adelie Torgersen female 3200 2008
## 82 Adelie Torgersen male 4700 2008
## 83 Adelie Torgersen female 3800 2008
## 84 Adelie Torgersen male 4200 2008
## 85 Adelie Dream female 3350 2008
## 86 Adelie Dream male 3550 2008
## 87 Adelie Dream male 3800 2008
## 88 Adelie Dream female 3500 2008
## 89 Adelie Dream male 3950 2008
## 90 Adelie Dream female 3600 2008
## 91 Adelie Dream female 3550 2008
## 92 Adelie Dream male 4300 2008
## 93 Adelie Dream female 3400 2008
## 94 Adelie Dream male 4450 2008
## 95 Adelie Dream female 3300 2008
## 96 Adelie Dream male 4300 2008
## 97 Adelie Dream female 3700 2008
## 98 Adelie Dream male 4350 2008
## 99 Adelie Dream female 2900 2008
## 100 Adelie Dream male 4100 2008
## 101 Adelie Biscoe female 3725 2009
## 102 Adelie Biscoe male 4725 2009
## 103 Adelie Biscoe female 3075 2009
## 104 Adelie Biscoe male 4250 2009
## 105 Adelie Biscoe female 2925 2009
## 106 Adelie Biscoe male 3550 2009
## 107 Adelie Biscoe female 3750 2009
## 108 Adelie Biscoe male 3900 2009
## 109 Adelie Biscoe female 3175 2009
## 110 Adelie Biscoe male 4775 2009
## 111 Adelie Biscoe female 3825 2009
## 112 Adelie Biscoe male 4600 2009
## 113 Adelie Biscoe female 3200 2009
## 114 Adelie Biscoe male 4275 2009
## 115 Adelie Biscoe female 3900 2009
## 116 Adelie Biscoe male 4075 2009
## 117 Adelie Torgersen female 2900 2009
## 118 Adelie Torgersen male 3775 2009
## 119 Adelie Torgersen female 3350 2009
## 120 Adelie Torgersen male 3325 2009
## 121 Adelie Torgersen female 3150 2009
## 122 Adelie Torgersen male 3500 2009
## 123 Adelie Torgersen female 3450 2009
## 124 Adelie Torgersen male 3875 2009
## 125 Adelie Torgersen female 3050 2009
## 126 Adelie Torgersen male 4000 2009
## 127 Adelie Torgersen female 3275 2009
## 128 Adelie Torgersen male 4300 2009
## 129 Adelie Torgersen female 3050 2009
## 130 Adelie Torgersen male 4000 2009
## 131 Adelie Torgersen female 3325 2009
## 132 Adelie Torgersen male 3500 2009
## 133 Adelie Dream female 3500 2009
## 134 Adelie Dream male 4475 2009
## 135 Adelie Dream female 3425 2009
## 136 Adelie Dream male 3900 2009
## 137 Adelie Dream female 3175 2009
## 138 Adelie Dream male 3975 2009
## 139 Adelie Dream female 3400 2009
## 140 Adelie Dream male 4250 2009
## 141 Adelie Dream female 3400 2009
## 142 Adelie Dream male 3475 2009
## 143 Adelie Dream female 3050 2009
## 144 Adelie Dream male 3725 2009
## 145 Adelie Dream female 3000 2009
## 146 Adelie Dream male 3650 2009
## 147 Adelie Dream male 4250 2009
## 148 Adelie Dream female 3475 2009
## 149 Adelie Dream female 3450 2009
## 150 Adelie Dream male 3750 2009
## 151 Adelie Dream female 3700 2009
## 152 Adelie Dream male 4000 2009
## 187 Gentoo Biscoe female 5150 2008
## 188 Gentoo Biscoe male 5400 2008
## 189 Gentoo Biscoe female 4950 2008
## 190 Gentoo Biscoe male 5250 2008
## 191 Gentoo Biscoe female 4350 2008
## 192 Gentoo Biscoe male 5350 2008
## 193 Gentoo Biscoe female 3950 2008
## 194 Gentoo Biscoe male 5700 2008
## 195 Gentoo Biscoe female 4300 2008
## 196 Gentoo Biscoe male 4750 2008
## 197 Gentoo Biscoe male 5550 2008
## 198 Gentoo Biscoe female 4900 2008
## 199 Gentoo Biscoe female 4200 2008
## 200 Gentoo Biscoe male 5400 2008
## 201 Gentoo Biscoe female 5100 2008
## 202 Gentoo Biscoe male 5300 2008
## 203 Gentoo Biscoe female 4850 2008
## 204 Gentoo Biscoe male 5300 2008
## 205 Gentoo Biscoe female 4400 2008
## 206 Gentoo Biscoe male 5000 2008
## 207 Gentoo Biscoe female 4900 2008
## 208 Gentoo Biscoe male 5050 2008
## 209 Gentoo Biscoe female 4300 2008
## 210 Gentoo Biscoe male 5000 2008
## 211 Gentoo Biscoe female 4450 2008
## 212 Gentoo Biscoe male 5550 2008
## 213 Gentoo Biscoe female 4200 2008
## 214 Gentoo Biscoe male 5300 2008
## 215 Gentoo Biscoe female 4400 2008
## 216 Gentoo Biscoe male 5650 2008
## 217 Gentoo Biscoe female 4700 2008
## 218 Gentoo Biscoe male 5700 2008
## 220 Gentoo Biscoe male 5800 2008
## 221 Gentoo Biscoe female 4700 2008
## 222 Gentoo Biscoe male 5550 2008
## 223 Gentoo Biscoe female 4750 2008
## 224 Gentoo Biscoe male 5000 2008
## 225 Gentoo Biscoe male 5100 2008
## 226 Gentoo Biscoe female 5200 2008
## 227 Gentoo Biscoe female 4700 2008
## 228 Gentoo Biscoe male 5800 2008
## 229 Gentoo Biscoe female 4600 2008
## 230 Gentoo Biscoe male 6000 2008
## 231 Gentoo Biscoe female 4750 2008
## 232 Gentoo Biscoe male 5950 2008
## 233 Gentoo Biscoe female 4625 2009
## 234 Gentoo Biscoe male 5450 2009
## 235 Gentoo Biscoe female 4725 2009
## 236 Gentoo Biscoe male 5350 2009
## 237 Gentoo Biscoe female 4750 2009
## 238 Gentoo Biscoe male 5600 2009
## 239 Gentoo Biscoe female 4600 2009
## 240 Gentoo Biscoe male 5300 2009
## 241 Gentoo Biscoe female 4875 2009
## 242 Gentoo Biscoe male 5550 2009
## 243 Gentoo Biscoe female 4950 2009
## 244 Gentoo Biscoe male 5400 2009
## 245 Gentoo Biscoe female 4750 2009
## 246 Gentoo Biscoe male 5650 2009
## 247 Gentoo Biscoe female 4850 2009
## 248 Gentoo Biscoe male 5200 2009
## 249 Gentoo Biscoe male 4925 2009
## 250 Gentoo Biscoe female 4875 2009
## 251 Gentoo Biscoe female 4625 2009
## 252 Gentoo Biscoe male 5250 2009
## 253 Gentoo Biscoe female 4850 2009
## 254 Gentoo Biscoe male 5600 2009
## 255 Gentoo Biscoe female 4975 2009
## 256 Gentoo Biscoe male 5500 2009
## 258 Gentoo Biscoe male 5500 2009
## 259 Gentoo Biscoe female 4700 2009
## 260 Gentoo Biscoe male 5500 2009
## 261 Gentoo Biscoe female 4575 2009
## 262 Gentoo Biscoe male 5500 2009
## 263 Gentoo Biscoe female 5000 2009
## 264 Gentoo Biscoe male 5950 2009
## 265 Gentoo Biscoe female 4650 2009
## 266 Gentoo Biscoe male 5500 2009
## 267 Gentoo Biscoe female 4375 2009
## 268 Gentoo Biscoe male 5850 2009
## 270 Gentoo Biscoe male 6000 2009
## 271 Gentoo Biscoe female 4925 2009
## 273 Gentoo Biscoe female 4850 2009
## 274 Gentoo Biscoe male 5750 2009
## 275 Gentoo Biscoe female 5200 2009
## 276 Gentoo Biscoe male 5400 2009
## 303 Chinstrap Dream female 3400 2008
## 304 Chinstrap Dream male 3800 2008
## 305 Chinstrap Dream female 3700 2008
## 306 Chinstrap Dream male 4550 2008
## 307 Chinstrap Dream female 3200 2008
## 308 Chinstrap Dream male 4300 2008
## 309 Chinstrap Dream female 3350 2008
## 310 Chinstrap Dream male 4100 2008
## 311 Chinstrap Dream male 3600 2008
## 312 Chinstrap Dream female 3900 2008
## 313 Chinstrap Dream female 3850 2008
## 314 Chinstrap Dream male 4800 2008
## 315 Chinstrap Dream female 2700 2008
## 316 Chinstrap Dream male 4500 2008
## 317 Chinstrap Dream male 3950 2008
## 318 Chinstrap Dream female 3650 2008
## 319 Chinstrap Dream male 3550 2008
## 320 Chinstrap Dream female 3500 2008
## 321 Chinstrap Dream female 3675 2009
## 322 Chinstrap Dream male 4450 2009
## 323 Chinstrap Dream female 3400 2009
## 324 Chinstrap Dream male 4300 2009
## 325 Chinstrap Dream male 3250 2009
## 326 Chinstrap Dream female 3675 2009
## 327 Chinstrap Dream female 3325 2009
## 328 Chinstrap Dream male 3950 2009
## 329 Chinstrap Dream female 3600 2009
## 330 Chinstrap Dream male 4050 2009
## 331 Chinstrap Dream female 3350 2009
## 332 Chinstrap Dream male 3450 2009
## 333 Chinstrap Dream female 3250 2009
## 334 Chinstrap Dream male 4050 2009
## 335 Chinstrap Dream male 3800 2009
## 336 Chinstrap Dream female 3525 2009
## 337 Chinstrap Dream male 3950 2009
## 338 Chinstrap Dream female 3650 2009
## 339 Chinstrap Dream female 3650 2009
## 340 Chinstrap Dream male 4000 2009
## 341 Chinstrap Dream female 3400 2009
## 342 Chinstrap Dream male 3775 2009
## 343 Chinstrap Dream male 4100 2009
## 344 Chinstrap Dream female 3775 2009
# Create a new variable: body mass in kilograms
penguins_clean$body_mass_kg <- penguins_clean$body_mass / 1000
# Display first values
head(penguins_clean$body_mass_kg)
## [1] 3.750 3.800 3.250 3.450 3.650 3.625
# Rename a variable in penguins_clean
names(penguins_clean)[names(penguins_clean) == "flipper"] <- "Flipper_Length"
# Check the new column names
names(penguins_clean)
## [1] "species" "island" "bill_len" "bill_dep" "flipper_len"
## [6] "body_mass" "sex" "year" "body_mass_kg"
Explanation: - Removed missing values I used na.omit() to drop rows with incomplete data, ensuring analyses are based only on complete cases. - Filtered data by year I created a subset after2008 that includes only penguins observed in 2008 or 2009, focusing on more recent observations. - Selected key variables From this subset, I displayed only species, island, sex, body mass, and year for a clearer view of important characteristics. - Created a new variable I added body_mass_kg by converting body mass from grams to kilograms (dividing by 1000), making the values easier to interpret. - Renamed a variable I changed the variable name flipper to Flipper_Length for better readability and consistency in the dataset.
# Summary statistics for penguin variables
summary(penguins_clean$bill_dep)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13.10 15.60 17.30 17.16 18.70 21.50
summary(penguins_clean$flipper_len)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 172 190 197 201 213 231
summary(penguins_clean$body_mass)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2700 3550 4050 4207 4775 6300
sapply(penguins_clean[, c("bill_dep", "flipper_len", "body_mass")], summary)
## bill_dep flipper_len body_mass
## Min. 13.10000 172.000 2700.000
## 1st Qu. 15.60000 190.000 3550.000
## Median 17.30000 197.000 4050.000
## Mean 17.16486 200.967 4207.057
## 3rd Qu. 18.70000 213.000 4775.000
## Max. 21.50000 231.000 6300.000
Explanation: Descriptive Statistics for Selected Variables - The descriptive statistics summarize three important penguin traits: - Bill depth: Values range from 13.1 mm to 21.5 mm, with a mean of 17.2 mm. This indicates that most penguins have bills of moderate depth,with only slight variation across the population. - Flipper length: Ranging from 172 mm to 231 mm, the median is 197 mm and the mean is about 201 mm. The relatively narrow spread suggests flipper length is fairly consistent among penguins. - Body mass: With a range of 2,700 g to 6,300 g, and an average of 4,207 g,body mass shows greater variability, reflecting species differences and sexual dimorphism. In summary, while bill depth and flipper length are relatively stable traits, body mass displays more substantial variation across individuals.
# Recode sex variable into factor with labels
penguins_clean$sex <- factor(penguins_clean$sex,
levels = c("male", "female"),
labels = c("M", "F"))
# Descriptive statistics for selected variables grouped by sex
library(psych)
describeBy(penguins_clean[, c("bill_dep", "flipper_len",
"body_mass", "bill_len")],
group = penguins_clean$sex)
##
## Descriptive statistics by group
## group: M
## vars n mean sd median trimmed mad min max range
## bill_dep 1 168 17.89 1.86 18.45 17.92 2.00 14.1 21.5 7.4
## flipper_len 2 168 204.51 14.55 200.50 204.15 15.57 178.0 231.0 53.0
## body_mass 3 168 4545.68 787.63 4300.00 4515.07 815.43 3250.0 6300.0 3050.0
## bill_len 4 168 45.85 5.37 46.80 45.93 6.67 34.6 59.6 25.0
## skew kurtosis se
## bill_dep -0.23 -1.11 0.14
## flipper_len 0.27 -1.21 1.12
## body_mass 0.37 -1.23 60.77
## bill_len -0.11 -1.16 0.41
## ------------------------------------------------------------
## group: F
## vars n mean sd median trimmed mad min max range
## bill_dep 1 165 16.43 1.80 17.0 16.45 2.08 13.1 20.7 7.6
## flipper_len 2 165 197.36 12.50 193.0 197.10 11.86 172.0 222.0 50.0
## body_mass 3 165 3862.27 666.17 3650.0 3834.02 667.17 2700.0 5200.0 2500.0
## bill_len 4 165 42.10 4.90 42.8 42.07 5.93 32.1 58.0 25.9
## skew kurtosis se
## bill_dep -0.22 -1.20 0.14
## flipper_len 0.28 -1.23 0.97
## body_mass 0.44 -1.15 51.86
## bill_len 0.05 -0.82 0.38
Explanation:
library(ggplot2)
##
## Attaching package: 'ggplot2'
## The following objects are masked from 'package:psych':
##
## %+%, alpha
# Histogram of body mass
ggplot(penguins_clean, aes(x = body_mass, fill = sex)) +
geom_histogram(position = "dodge", binwidth = 200, fill = "skyblue", color = "black") +
labs(title = "Distribution of Penguin Body Mass",
x = "Body Mass (g)", y = "Count")
labs(fill = "sex")
## <ggplot2::labels> List of 1
## $ fill: chr "sex"
Explanation:
Using ggplot2, a histogram of the penguins’ body mass was created to visualize its distribution. The binwidth was set to 200 grams, and the bars were colored sky blue with black borders. The histogram shows how many penguins fall into each body mass range, allowing us to see the shape of the distribution, identify peaks, and check for skewness or unusual values (outliers). This type of plot is helpful to understand the spread and central tendency of body mass in the dataset.
# Histogram of flipper length
ggplot(penguins_clean, aes(x = flipper_len)) +
geom_histogram(binwidth = 5, fill = "lightgreen", color = "black") +
labs(title = "Distribution of Penguin Flipper Length",
x = "Flipper Length (mm)", y = "Count")
Explanation:
A histogram of penguins’ flipper length was created using ggplot2. The binwidth was set to 5 mm, with light green bars and black borders. This histogram shows how flipper lengths are distributed across the penguins in the dataset, allowing us to see the central tendency, spread, and any unusual values or patterns in the data. Visualizing the data this way helps to understand the general characteristics of flipper length and compare it with other variables if needed.
# Boxplot of body mass by species
ggplot(penguins_clean, aes(x = species, y = body_mass, fill = species)) +
geom_boxplot() +
labs(title = "Body Mass by Penguin Species",
x = "Species", y = "Body Mass (g)")
Explanation:
A boxplot was created to compare body mass across different penguin species using ggplot2. Each species is represented on the x-axis, and body mass on the y-axis, with different fill colors for each species. The boxplot shows the median, interquartile range (IQR), and potential outliers for each species. This visualization helps to quickly compare the central tendency, spread, and variability of body mass among the penguin species, and to identify any unusual values within each group.
# Scatterplot: flipper length vs body mass
ggplot(penguins_clean, aes(x = flipper_len, y = body_mass, color = species)) +
geom_point(alpha = 0.7) +
labs(title = "Flipper Length vs Body Mass by Species",
x = "Flipper Length (mm)", y = "Body Mass (g)")
Explanation:
A scatterplot was created to examine the relationship between flipper length (x-axis) and body mass (y-axis), with points colored by penguin species. Each point represents an individual penguin, and the color helps distinguish species. This plot allows us to see patterns and trends, such as whether penguins with longer flippers tend to have higher body mass, and to compare these relationships across species. It also helps to identify clusters or any unusual observations in the dataset.
#install.packages("readxl")
#install.packages("effectsize")
library(effectsize)
##
## Attaching package: 'effectsize'
## The following object is masked from 'package:psych':
##
## phi
library(readxl)
mydata <- read_xlsx("C:/Users/majci/OneDrive/Namizje/R data/Maja Project/R Take Home Exam 2025/Task 2/Business School.xlsx")
head(mydata)
## # 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)
# Graph the distribution of undergrad degrees
ggplot(mydata, aes(x = `Undergrad Degree`)) +
geom_bar(fill = "lightblue", color = "black") +
labs(title = "Distribution of Undergrad Degrees",
x = "Undergraduate Degree",
y = "Count") +
theme(axis.text.x = element_text(angle =45,hjust=1))
Explanation: - Business degree is the most common in our case. There are 35 students in the MBA programme.
library(psych)
describe(mydata$`Annual Salary`)
## vars n mean sd median trimmed mad min max range skew
## X1 1 100 109058 41501.49 103500 104600.2 25945.5 20000 340000 320000 2.22
## kurtosis se
## X1 9.41 4150.15
Explanation:
The sample includes 100 MBA students. The average annual salary is $109,058. The median salary is $103,500, meaning that half of the students earn $103,500 or less, while the other half earn more.
library(ggplot2)
# Histogram of Annual Salary
ggplot(mydata, aes(x = `Annual Salary`)) +
geom_histogram(binwidth = 5000, fill = "grey", color = "purple") +
labs(title = "Distribution of Annual Salary",
x = "Annual Salary ($)", y = "Count") +
theme_minimal()
Explanation:
The annual salary distribution among MBA students is right-skewed, with a positive skewness of 2.22. This indicates that most salaries are concentrated at the lower end, while a few higher salaries stretch the distribution to the right. The dataset also contains outliers at both the lower and upper ends of the salary range.
iqr_value <- IQR(mydata$`Annual Salary`)
iqr_value
## [1] 36875
Explanation:
The central 50 % of the values of Annual Salaries are spread across a band that is 36875 wide.
# One-sample t-test
t_test_result <- t.test(mydata$`MBA Grade`, mu = 74)
t_test_result
##
## One Sample t-test
##
## data: mydata$`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
Explanation:
The one-sample t-test shows that the mean MBA Grade (76.04) is significantly higher than the hypothesized value of 74 (t = 2.66, p = 0.009). The 95% confidence interval (74.52–77.56) lies entirely above 74, confirming that the average MBA Grade is greater than 74.
# Install effsize package if not already installed
#install.packages("effsize")
library(effsize)
##
## Attaching package: 'effsize'
## The following object is masked from 'package:psych':
##
## cohen.d
# Effect size (Cohen's d)
effectsize::cohens_d(x = mydata$ `MBA Grade`, mu = 74)
## Cohen's d | 95% CI
## ------------------------
## 0.27 | [0.07, 0.46]
##
## - Deviation from a difference of 74.
Explanation:
Cohen’s d = 0.27 indicates a small effect size, meaning the average MBA Grade is only slightly higher than 74. The 95% CI [0.07, 0.46] confirms the effect is positive but modest.
library(readxl)
mydata <- read_excel("C:/Users/majci/OneDrive/Namizje/R data/Maja Project/R Take Home Exam 2025/Task 3/Apartments.xlsx")
head(mydata)
## # 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:
#Change categorical variables into factors of Parking and Balcony
mydata$Parking <- factor(mydata$Parking,
levels = c(0, 1),
labels = c("No", "Yes"))
mydata$Balcony <- factor(mydata$Balcony,
levels = c(0, 1),
labels = c("No", "Yes"))
str(mydata)
## tibble [85 × 5] (S3: tbl_df/tbl/data.frame)
## $ Age : num [1:85] 7 18 7 28 18 28 14 18 22 25 ...
## $ Distance: num [1:85] 28 1 28 29 18 12 20 6 7 2 ...
## $ Price : num [1:85] 1640 2800 1660 1850 1640 1770 1850 1970 2270 2570 ...
## $ Parking : Factor w/ 2 levels "No","Yes": 1 2 1 1 2 1 1 2 2 2 ...
## $ Balcony : Factor w/ 2 levels "No","Yes": 2 1 1 2 2 2 2 2 1 1 ...
head(mydata)
## # 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
#Run the t-test
t.test(mydata$Price,
mu = 1900,
alternative = "two.sided")
##
## One Sample t-test
##
## data: mydata$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
library(effectsize)
effectsize::cohens_d(mydata$Price, mu=1900)
## Cohen's d | 95% CI
## ------------------------
## 0.31 | [0.10, 0.53]
##
## - Deviation from a difference of 1900.
effectsize::interpret_cohens_d(0.31, rules="sawilowsky2009")
## [1] "small"
## (Rules: sawilowsky2009)
Explanation:
I can conclude that the average price of apartments is significantly different from 1,900 €/m². With a p-value of 0.004, we reject the null hypothesis. The 95% confidence interval excludes 1,900 €/m² and indicates a sample average price of 2,018.9 €/m². The effect size is small (Cohen’s d = 0.31), suggesting a modest difference from the reference value.
#Make and Save results in object fit1
fit1 <- lm(Price ~ Age,
data = mydata)
summary(fit1)
##
## Call:
## lm(formula = Price ~ Age, data = mydata)
##
## 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
cor(mydata$Price, mydata$Age)
## [1] -0.230255
#Make the regression
corr_coeff <- cor(mydata$Age, mydata$Price,
method = "pearson")
print(corr_coeff)
## [1] -0.230255
Explanation:
The regression coefficient of 2,185.5 indicates that newly built apartments (age = 0) are expected to cost 2,185.5 €/m². The correlation coefficient of -0.23 shows a weak negative linear relationship between price and age, meaning that as age increases, price decreases slightly. The coefficient of determination (R² = 0.053) indicates that only 5.3% of the variation in price is explained by age alone. This suggests that age is not a strong predictor of price and that other factors, such as parking, a balcony, and distance from the city center, have a larger effect.
#Show the scateerplot
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':
##
## recode
scatterplotMatrix(mydata[ , c(1, 2, 3)],
smooth = FALSE)
Explanation:
Multicollinearity looks at the relationships between explanatory variables, here Age and Distance. It happens when two or more predictors are highly correlated, making it difficult to separate their individual effect on the dependent variable and leading to biased coefficient estimates. From the scatterplot matrix, the relationship between Age and Distance is almost flat (slope close to 0), which means there is no strong linear correlation. Therefore, I can conclude that there is no multicollinearity problem between these variables.
library(Hmisc)
##
## Attaching package: 'Hmisc'
## The following object is masked from 'package:psych':
##
## describe
## The following objects are masked from 'package:dplyr':
##
## src, summarize
## The following objects are masked from 'package:base':
##
## format.pval, units
rcorr(as.matrix(mydata[ , c(-4, -5)]))
## Age Distance Price
## Age 1.00 0.04 -0.23
## Distance 0.04 1.00 -0.63
## Price -0.23 -0.63 1.00
##
## n= 85
##
##
## P
## Age Distance Price
## Age 0.6966 0.0340
## Distance 0.6966 0.0000
## Price 0.0340 0.0000
#Estimate the multiple regression
fit2 <- lm(Price ~ Age + Distance,
data = mydata)
summary(fit2)
##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata)
##
## 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
vif(fit2)
## Age Distance
## 1.001845 1.001845
mean(vif(fit2))
## [1] 1.001845
Explanation:
Variance Inflation Factor (VIF) and scatterplot check: I looked at both the scatterplot matrix and the VIF statistics to examine multicollinearity between Age and Distance. A VIF below 5 indicates no serious multicollinearity, and the scatterplot shows the linear relationship between the variables. In this case, both Age and Distance have VIF values around 1, and the mean VIF is also 1, while the scatterplot shows no strong linear trend. Therefore, I can conclude that there is no multicollinearity between these two explanatory variables.
#Calculate standard residuals and Cook Distances
mydata$StdRes <- round(rstandard(fit2), 3)
hist(mydata$StdRes,
main = "Histogram of standardized residuals",
col = "orange",
xlab = "Standardized residuals",
ylab = "Frequency",
xlim = c(-3, 3))
mydata$CooksDis <- round(cooks.distance(fit2), 3)
hist(mydata$CooksDis,
main = "Histogram of Cooks distances",
col = "darkgreen",
xlab = "Cooks distances",
ylab = "Frequency")
head(mydata[order(mydata$StdRes),], 6)
## # A tibble: 6 × 7
## Age Distance Price Parking Balcony StdRes CooksDis
## <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
## 4 13 8 1800 No No -1.38 0.012
## 5 14 16 1660 No Yes -1.26 0.008
## 6 24 5 1830 Yes No -1.19 0.012
head(mydata[order(-mydata$CooksDis),], 6)
## # A tibble: 6 × 7
## Age Distance Price Parking Balcony StdRes CooksDis
## <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
mydata$ID <- seq_len(nrow(mydata))
library(dplyr)
mydata <- mydata %>%
filter(!(ID %in% c(38, 55, 33, 53, 22)))
View(mydata)
fit2 <- lm(Price ~ Age + Distance,
data = mydata)
hist(mydata$CooksDis,
xlab = "Cooks distance",
ylab = "Frequency",
main = "New histogram of Cooks distances")
Explanation:
I calculated Cook’s distance for all observations in my model to identify influential cases. Using the rule D>4/n, the cutoff value for my dataset was 0.04. I found that cases 38, 55, 33, 53, and 22 exceeded this threshold and therefore had a large influence on the regression. These observations were removed from the dataset to improve the model fit, and the cleaned data were then viewed for further analysis.
# Get the potential heteroskedasticity with scatterplot between standarized residuals
mydata$StdFitted <- scale(fit2$fitted.values)
library(car)
scatterplot(x = mydata$StdFitted, y = mydata$StdRes,
xlab = "Standardized fitted values",
ylab = "Standardized residuals",
boxplots = FALSE,
regLine = FALSE,
smooth = FALSE)
#install.packages("olsrr")
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
Explanation:
Heteroskedasticity occurs when the spread of residuals changes at different values of the explanatory variables. I checked this by plotting standardized residuals against standardized fitted values. From the scatterplot, the residuals appear to have constant variance across all fitted values, so there is no sign of heteroskedasticity. This means the assumption of homoscedasticity is satisfied.
# Show the graph and explain
hist(mydata$StdRes,
main = "Histogram of standardized residuals",
xlab = "Standardized residuals",
ylab = "Density",
col = "purple",
prob = TRUE,
xlim = c(-3, 3))
shapiro.test(mydata$StdRes)
##
## Shapiro-Wilk normality test
##
## data: mydata$StdRes
## W = 0.93418, p-value = 0.0004761
hist(rstandard(fit2))
Explanation:
The Shapiro–Wilk normality test was conducted on the standardized residuals (mydata$StdRes) to check whether they follow a normal distribution. The test statistic was W = 0.93418 with a p-value of 0.0004761. Since the p-value is less than 0.05, we reject the null hypothesis that the residuals are normally distributed. This indicates that the standardized residuals deviate significantly from normality, suggesting that the normality assumption for the regression model may not be fully satisfied.
#Estimate the fit2 again without potentially excluded units
mydata <- mydata[!(mydata$CooksDis == 0.320), ]
fit2 <- lm(Price ~Age + Distance,
data = mydata)
summary(fit2)
##
## Call:
## lm(formula = Price ~ Age + Distance, data = mydata)
##
## 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
sqrt(summary(fit2)$r.squared)
## [1] 0.732187
Explanation:
Controlling for all other variables, an increase of 1 km in distance from the city center is associated with an average decrease of 24.06 €/m² in price (p < 0.001), and an increase of 1 year in apartment age corresponds to an average decrease of 8.67 €/m² (p < 0.001). The linear effects of age and distance explain 53.61% of the variation in price, and the predicted price for newly built apartments (age = 0) is 2,502.46 €/m². Overall, there is a strong linear relationship, indicating that age and distance are good predictors of price.
#Estimate the linear regression function Price
fit3 <- lm(Price ~ Age + Distance + Parking + Balcony,
data = mydata)
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
Explanation:
We cannot reject the null hypothesis, which means that adding balcony and parking does not significantly improve the model. Therefore, age and price remain the primary variables explaining most of the variation in price.
From the ANOVA table, the p-value = 0.0305 < 0.05, so I reject H₀ at the 5% significance level. This means that the more complex model fit3, which includes Parking and Balcony, provides a significantly better fit to the data than fit2.
summary(fit3)
##
## Call:
## lm(formula = Price ~ Age + Distance + Parking + Balcony, data = mydata)
##
## 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
Explanation:
The model explains about 56% of the variation in Price, which means it fits the data fairly well. Age has a negative effect, with price decreasing by about 8 units per year, and Distance also lowers the price by about 22 units for each extra unit. Parking increases the price by about 129 units and is statistically significant, while Balcony has almost no effect and is not significant. The F-test shows that the model overall is highly significant, meaning at least one of the predictors clearly affects Price.
Fitted_ID2 <- fitted(fit3)[mydata$ID == 2]
Residual_ID2 <- resid(fit3)[mydata$ID == 2]
round(c(Fitted = Fitted_ID2, Residual = Residual_ID2), 3)
## Fitted.2 Residual.2
## 2356.597 443.403
Explanation:
For apartment ID 2, the fitted value from the regression model is 2356.60. This is the price that the model predicts based on Age, Distance, Parking, and Balcony. The residual is 443.40, which means the actual price of this apartment is 443 units higher than what the model predicted. In other words, the model underestimates the price of apartment ID 2 by that amount.