Individual Assignment JE
Jonathan Edel
2025-09-22
Graded Assignment
In this assignment, we are given a typical e-commerce dataset from an appearal seller, and tasked with predicting whether an item will be returned. We will attempt to train a predictive model to best predict the likelihood of an order being returned, based on the information available about the order.
Data cleanup
We will start with data cleanup. It is generally accepted that 50=80% of the work-hours of data science projects is data cleanup.
We will go variable by variable in this exercise. This is a visualization, but I have also included the full data cleanup script I am using. Not you will need to change the WD.
After cursory initial investigation, we start with the basic step of merging the user and orders datasets. This is possible, as they both contain the same unique order identifier (order_item_id). We also load all packages used in data cleanup.
#Load the necessary packages
library(lubridate) # date management## Warning: package 'lubridate' was built under R version 4.4.3##
## Attaching package: 'lubridate'## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, unionlibrary(ggplot2) # charts## Warning: package 'ggplot2' was built under R version 4.4.3library(dplyr) # data handling## Warning: package 'dplyr' was built under R version 4.4.3##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(glmnet) # implementation of the methods## Warning: package 'glmnet' was built under R version 4.4.3## Loading required package: Matrix## Loaded glmnet 4.1-10library(caret) # machine-learning workflow## Warning: package 'caret' was built under R version 4.4.3## Loading required package: lattice# set working directory:
setwd("C:/Users/jedel/OneDrive/Desktop/Data for ML class/Individual Assignment")
#Load data
users <- read.csv("users.csv", sep = ",")
orders <- read.csv("orders.csv", sep = ",")
# Merge data into a single source
orders_full <- merge(orders, users, by = "user_id")In addition to looking through the table, we also compute simple summary statistics. All details of preparatory data examination are not included in this markup.
summary(orders_full)## user_id order_item_id order_date delivery_date
## Min. : 9 Min. : 1 Length:75000 Length:75000
## 1st Qu.:14674 1st Qu.:18751 Class :character Class :character
## Median :30479 Median :37501 Mode :character Mode :character
## Mean :25739 Mean :37501
## 3rd Qu.:36477 3rd Qu.:56250
## Max. :43801 Max. :75000
## item_id item_size item_color brand_id
## Min. : 1.0 Length:75000 Length:75000 Min. : 1.00
## 1st Qu.: 175.0 Class :character Class :character 1st Qu.: 5.00
## Median : 479.0 Mode :character Mode :character Median : 24.00
## Mean : 784.7 Mean : 28.83
## 3rd Qu.:1516.0 3rd Qu.: 43.00
## Max. :2224.0 Max. :137.00
## item_price return user_title user_dob
## Min. : 0.00 Min. :0.0000 Length:75000 Length:75000
## 1st Qu.: 29.90 1st Qu.:0.0000 Class :character Class :character
## Median : 49.90 Median :0.0000 Mode :character Mode :character
## Mean : 60.67 Mean :0.4501
## 3rd Qu.: 74.90 3rd Qu.:1.0000
## Max. :999.00 Max. :1.0000
## user_state user_reg_date
## Length:75000 Length:75000
## Class :character Class :character
## Mode :character Mode :character
##
##
## Next, we will convert returns to a factor, and set all dates to ymd format. This is directly from the assignment. We will calculate delivery time once we get to order date and delivery date.
# Convert all dates into proper proper date format
orders_full$order_date <- ymd(orders_full$order_date)
orders_full$delivery_date <- ymd(orders_full$delivery_date)
orders_full$user_dob <- ymd(orders_full$user_dob)
orders_full$user_reg_date <- ymd(orders_full$user_reg_date)
#convert returns to "Yes" or "No"
orders_full$return <- factor(orders_full$return,
levels = c(0, 1),
labels = c("No", "Yes"))Now, we will start looking at individual variables. These are in no particular order. Let’s start with item price. ### Price We first pull summary statistics, and view as a table.
# Item price
summary(orders_full$item_price)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.00 29.90 49.90 60.67 74.90 999.00Prices seem to fall within a reasonable range for appearal, with some extremes at both ends.
There are also two outliers with a price of 999. Appear can be expensive, so we will assume these are correct.
We can also see that 324 observations where the price is 0. All of these observations are unsized. There seem to be a mix of returned and unreturned items. This could indicate missing data, a promotion, or a return. Because these observations account for only .00432% of the dataset, we will exclude them:
orders_full <- orders_full %>%
filter(item_price > 0)Brand ID
Next, let’s look at brand. We have no information on what these brands are beyond a numeric ID. First, we’ll pull some summary information - I’d like to know how many unique brands there are, and if any of them account for a particularly large portion of sales.
# Check brand ID counts and how much of the data they make up
brand_counts <- orders_full %>%
count(brand_id, sort = TRUE)
n_unique_brands <- nrow(brand_counts)
n_unique_brands## [1] 129head(brand_counts, 25) # preview top 10 brands## brand_id n
## 1 3 8399
## 2 1 6546
## 3 5 4388
## 4 37 3168
## 5 11 2812
## 6 20 2205
## 7 17 1886
## 8 6 1875
## 9 38 1678
## 10 14 1631
## 11 40 1473
## 12 46 1466
## 13 43 1448
## 14 28 1403
## 15 49 1370
## 16 42 1360
## 17 29 1229
## 18 25 1082
## 19 33 982
## 20 21 976
## 21 19 962
## 22 30 962
## 23 47 931
## 24 48 900
## 25 53 884Here we can see that only three brands (IDs 3, 1, and 5) account for >5% of observations (computations were done outside of R, but can be easily reproduced). For simplicity and time, we will keep these, and merge all others into an “other” category.
We will also need to how brand data is stored. Currently, brand is stored as an integer. Because some models may multiply this by a coefficient, we will change brands to a string.
# Create buckets and set to string
orders_full <- orders_full %>%
mutate(
brand_id = as.character(brand_id), # ensure string type
brand_id = if_else(brand_id %in% c("1", "3", "5"),
brand_id, "Other")
)We can now see counts per brand over 2/3 of observations are “other”. That’s not perfect, but with our limited information, its what we will go for.
# See a table of the above
table(orders_full$brand_id)##
## 1 3 5 Other
## 6546 8399 4388 55339User State
Next, we will look at which Bundesland a given user is from.
# Show observation counts per state
unique(orders_full$user_state)## [1] "Rhineland-Palatinate" "Lower Saxony"
## [3] "Berlin" "Saxony"
## [5] "Hesse" "Schleswig-Holstein"
## [7] "North Rhine-Westphalia" "Baden-Wuerttemberg"
## [9] "Bavaria" "Mecklenburg-Western Pomerania"
## [11] "Saarland" "Bremen"
## [13] "Hamburg" "Brandenburg"
## [15] "Saxony-Anhalt" "Thuringia"table(orders_full$user_state)##
## Baden-Wuerttemberg Bavaria
## 9162 10443
## Berlin Brandenburg
## 2948 1676
## Bremen Hamburg
## 923 1934
## Hesse Lower Saxony
## 5506 11251
## Mecklenburg-Western Pomerania North Rhine-Westphalia
## 1159 16930
## Rhineland-Palatinate Saarland
## 3621 656
## Saxony Saxony-Anhalt
## 2335 868
## Schleswig-Holstein Thuringia
## 4164 1096This seems reasonable. All 16 federal subjects are represented, and distribution seems believable. Bremen having low orders while Lower Saxony has high orders seem odd, but we don’t know much about this company beyond this dataset. No cleanup action will be taken here.
Delivery Date
Next, we will look at delivery date, order date, and the calculated variable delivery time.
Authors note: This was the first section I prepared, and served as my Feuertaufe for R. Please accept my apologies for inefficiencies and redundancies here.
We will start by calculating delivery time, and creating a new variable.
#Calcualte delivery time
orders_full$delivery_time <- orders_full$delivery_date - orders_full$order_dateNext, we will ID possible issues by counting NA values. Note that we did this for all observations in the initial data checks.
# Count NA values in observations
colSums(is.na(orders_full)) ## user_id order_item_id order_date delivery_date item_id
## 0 0 0 7900 0
## item_size item_color brand_id item_price return
## 0 0 0 0 0
## user_title user_dob user_state user_reg_date delivery_time
## 0 6351 0 0 7900We see ~6000 NA values in user_dob, and ~8000 in both delivery date and time.
On further investigation, we can see that NA values in delivery_date are only present when an order has been returned. This could be due to deletion of delivery data upon return, or a similar operational issue. We would like to avoid discarding these observations if possible.
# Conditional NA values
sum(is.na(orders_full$delivery_date[orders_full$return == "Yes"]))## [1] 0sum(is.na(orders_full$delivery_date[orders_full$return == "No"]))## [1] 7900In addition, we see that there are illogical delivery times in the 1990s. We will remove them, as these account for ~1% of the observations. Imputation could lead to inaccurate predictions as it may distort relationships between delivery date/time and other predictors.
# Summarize delivery date entries
summary(orders_full$delivery_date)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## "1994-12-31" "2016-07-04" "2016-07-26" "2016-04-13" "2016-08-11" "2017-01-23"
## NA's
## "7900"# Remove observations with impossible delivery dates
orders_full <- orders_full %>%
filter(delivery_date >= as.Date("2016-01-01") | is.na(delivery_date))We can create a histogram demonstrating that delivery dates are within a beleviiable time-frame. Remember, all order dates are in June-August 2016.
# Create a year-month variable
orders_full$year_month <- floor_date(orders_full$delivery_date, unit = "month")
# update data for histogram to exclude the removed observations
monthly_counts_delivery_date <- orders_full %>%
group_by(year_month) %>%
summarize(count = n(), .groups = "drop")
#Plot histogram
ggplot(monthly_counts_delivery_date, aes(x = year_month, y = count)) +
geom_col(fill = "steelblue") +
scale_x_date(date_labels = "%Y-%m", date_breaks = "1 month") +
labs(title = "Number of Observations by Year-Month of Delivery",
x = "Year-Month",
y = "Number of Orders") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_col()`).
We now create a similar visualization to better understand delivery time. For readability, we only chart observations where delivery >100 days.
#
ggplot(orders_full, aes(x = delivery_time)) +
geom_histogram(binwidth = 1, fill = "steelblue", color = "black") +
labs(title = "Histogram of Delivery Time",
x = "Delivery Time (days)",
y = "Number of Observations") +
coord_cartesian(xlim = c(0, 50)) + # limit x-axis to 0-100
theme_minimal()## Don't know how to automatically pick scale for object of type <difftime>.
## Defaulting to continuous.## Warning: Removed 7900 rows containing non-finite outside the scale range
## (`stat_bin()`).
We can see that there the majority of orders are fulfilled within a week. Because high but non-outlier delivery times may disproportionately a model, we will bucket these. Because ~10% of our dataset has a value of NA for delivery time, we will also include an “unknown” bucket, as this category may have explanatory power. We choose roughly even buckets based on total delivery time.
# Create buckets
orders_full <- orders_full %>%
mutate(
delivery_days = as.numeric(delivery_time, units = "days"), # convert difftime → numeric days
delivery_time_bucket = case_when(
is.na(delivery_days) ~ "unknown",
delivery_days >= 0 & delivery_days <= 1 ~ "0-1 days",
delivery_days >= 1 & delivery_days <= 2 ~ "0-2 days",
delivery_days >= 2 & delivery_days <= 3 ~ "2-3 days",
delivery_days >= 3 & delivery_days <= 7 ~ "3-7 days",
delivery_days > 7 ~ ">7 days"
)
)
# Display table
table(orders_full$delivery_time_bucket)##
## >7 days 0-1 days 0-2 days 2-3 days 3-7 days unknown
## 12536 11570 13226 12161 16395 7900Order Date
We see that order date can be one of three months:
# Count number of observations per month
orders_monthly_counts <- orders_full %>%
group_by(year_month) %>%
summarize(count = n(), .groups = "drop")
# This plot shows order date can be one of three months.
ggplot(orders_monthly_counts, aes(x = year_month, y = count)) +
geom_col(fill = "steelblue") +
scale_x_date(date_labels = "%Y-%m", date_breaks = "1 month") +
labs(title = "Number of Observations by Year-Month of Delivery",
x = "Year-Month",
y = "Number of Orders") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_col()`).
Seasonality can be significant, but this data is noisy. We will instead use three buckets for each month.
orders_full <- orders_full %>%
mutate(order_date_bucket = case_when(
format(order_date, "%Y-%m") == "2016-06" ~ "June",
format(order_date, "%Y-%m") == "2016-07" ~ "July",
format(order_date, "%Y-%m") == "2016-08" ~ "August",
TRUE ~ "Other"
))
# table
table(orders_full$order_date_bucket)##
## August July June
## 27855 25504 20429Account Age
We will look at an additional calculated variable: account age is the difference between order date and user registration date. First we calcualte this value:
# Add account age
orders_full <- orders_full %>%
mutate(
# account age in days
account_age_days = as.numeric(order_date - user_reg_date)
)Numerous observations have a value of -1. This may be because the account was created for a new user. While ‘-1’ is not an intuitive value for for an account’s age, I beleive this is realistic. Account creation systems may lag order placement and tracking systems for operational reasons.
As with delivery time, we will create buckets. An age of ‘-1’ will be represented as ‘New’:
# Bucket account age
orders_full <- orders_full %>%
mutate(
account_age_bucket = case_when(
account_age_days == -1 ~ "New",
account_age_days >= 0 & account_age_days <= 365 ~ "0-1 years",
account_age_days > 365 ~ "> 1 year",
TRUE ~ NA_character_ # catch-all for unexpected cases
)
)
table(orders_full$account_age_bucket)##
## > 1 year 0-1 years New
## 32158 27696 13934We see here a reasonably even split in buckets, excluding ‘New’, which has fewer observations.
Dates of Birth
To get us started, a histogram is a great way to visualize user birth dates:
#create counts for each unique string entry
counts_dob <- orders_full %>%
count(user_dob) %>%
arrange(desc(n))
#create chart
ggplot(counts_dob, aes(x = user_dob, y = n)) +
geom_col(fill = "steelblue", colour = "black", width = 0.8) +
labs(title = "Frequency of DOB",
x = "DOB",
y = "Count") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_col()`).
Looks like we have some outliers, and some unrealistic dates. This may be because default dates are used on some account. There may be varying default dates on different platforms. There are also a significan’t number of NA values
# Count DOB frequencies
dob_counts <- as.data.frame(table(orders_full$user_dob))
# Sort in decreasing order of frequency
dob_counts <- dob_counts[order(-dob_counts$Freq), ]
# Rename columns for clarity
colnames(dob_counts) <- c("user_dob", "count")
# Show the result
head(dob_counts)## user_dob count
## 1 1900-11-21 712
## 576 1949-11-21 344
## 4259 1965-06-10 182
## 7581 1980-12-11 107
## 869 1951-12-30 97
## 1278 1954-04-07 88It looks like some of the outliers occur pretty frequently. To prevent these from interfering with our predictive models, let’s convert them to NA. Specifically, we will convert all dates before 1930 and after 200 to NA. We also convert all values which occur in over 75 observations to NA - this is to remove default dates which could be realistic birth dates. We convert them to NA as we will bucket these values as ‘unknown’ at a later step.
Note on the histogram - we will convert DoB back to ymd at a later step. This histogram is only intended to visualize distribution.
# Convert DOBs that occur > 100 times to NA
orders_full <- orders_full %>%
add_count(user_dob, name = "dob_freq") %>%
mutate(user_dob = if_else(dob_freq > 75, NA_Date_, user_dob)) %>%
select(-dob_freq)
# Convert DOBs before 1930 or after 2000 to NA.
orders_full$user_dob <- ifelse(
year(orders_full$user_dob) < 1930 | year(orders_full$user_dob) > 2000,
NA,
orders_full$user_dob
)
#Re-plot the histogram to see practical results
#update counts for each unique string entry
counts_dob <- orders_full %>%
count(user_dob) %>%
arrange(desc(n))
#create chart
ggplot(counts_dob, aes(x = user_dob, y = n)) +
geom_col(fill = "steelblue", colour = "black", width = 0.8) +
labs(title = "Frequency of DOB",
x = "DOB",
y = "Count") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1))## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_col()`).
While there are still some outliers here, this looks like a much more realistic distribution. As before, we will create buckets. Because we don’t know much about user behavior outside this dataset, we will create 5 buckets: 4 quartiles representing the highest 25% of ages, the next highest 25%, etc, and unknown:
# 1. Compute quartiles of user_dob (ignoring NAs)
dob_quartiles <- quantile(orders_full$user_dob, probs = c(0.25, 0.5, 0.75), na.rm = TRUE)
# 2. Create DOB bins based on quartiles, plus "Unknown"
orders_full <- orders_full %>%
mutate(dob_bin = case_when(
is.na(user_dob) ~ "Unknown",
user_dob <= dob_quartiles[1] ~ "Q1", # oldest
user_dob <= dob_quartiles[2] ~ "Q2",
user_dob <= dob_quartiles[3] ~ "Q3",
user_dob > dob_quartiles[3] ~ "Q4"
))
# Make it a factor in quartile order
orders_full$dob_bin <- factor(orders_full$dob_bin,
levels = c("Q1", "Q2", "Q3", "Q4", "Unknown"))
# Convert dates back to ymd
orders_full$user_dob <- as.Date(orders_full$user_dob, origin = "1970-01-01")User Title
We take a quick look at the data on user title:
# Summarize possible values and counts for user_title
unique(orders_full$user_title)## [1] "Mrs" "Company" "Mr" "Family" "not reported"table(orders_full$user_title)##
## Company Family Mr Mrs not reported
## 90 297 2755 70549 97The outputs here seem reasonable. We move on without taking action.
Item Color
Let’s move on to item color. It is odd that this online retailer does not have some identifier for item category (pants, shirts, jackets, etc), beyond just color, but we will work with the data we have available.
# Summarize possible values and counts for item_color
unique(orders_full$item_color)## [1] "black" "ancient" "grey" "turquoise"
## [5] "green" "ash" "red" "denim"
## [9] "petrol" "brown" "ocher" "berry"
## [13] "aquamarine" "mahagoni" "blue" "white"
## [17] "khaki" "silver" "purple" "dark oliv"
## [21] "pink" "anthracite" "aubergine" "orange"
## [25] "navy" "mint" "olive" "curry"
## [29] "stained" "mocca" "magenta" "darkblue"
## [33] "basalt" "?" "nature" "pallid"
## [37] "bordeaux" "fuchsia" "dark denim" "blau"
## [41] "azure" "hibiscus" "beige" "striped"
## [45] "yellow" "curled" "ecru" "dark garnet"
## [49] "dark navy" "floral" "gold" "aqua"
## [53] "champagner" "jade" "coral" "cognac"
## [57] "dark grey" "ebony" "baltic blue" "cobalt blue"
## [61] "antique pink" "creme" "habana" "mango"
## [65] "currant purple" "kanel" "almond" "terracotta"
## [69] "ivory" "brwon" "apricot" "caramel"
## [73] "aviator" "avocado" "amethyst" "copper coin"
## [77] "opal"table(orders_full$item_color)##
## ? almond amethyst ancient anthracite
## 25 13 5 121 1723
## antique pink apricot aqua aquamarine ash
## 10 10 35 254 1191
## aubergine aviator avocado azure baltic blue
## 699 8 4 397 19
## basalt beige berry black blau
## 189 609 1465 13297 178
## blue bordeaux brown brwon caramel
## 8228 481 6328 10 9
## champagner cobalt blue cognac copper coin coral
## 42 25 58 6 133
## creme curled currant purple curry dark denim
## 3 11 6 244 561
## dark garnet dark grey dark navy dark oliv darkblue
## 11 32 21 30 59
## denim ebony ecru floral fuchsia
## 1543 11 230 57 92
## gold green grey habana hibiscus
## 37 3814 6623 14 157
## ivory jade kanel khaki magenta
## 37 46 31 338 537
## mahagoni mango mint mocca nature
## 92 62 125 1366 649
## navy ocher olive opal orange
## 236 1859 1616 1 723
## pallid petrol pink purple red
## 229 2495 788 2936 5406
## silver stained striped terracotta turquoise
## 102 1227 83 7 727
## white yellow
## 2693 249This seems noisy. We will manually combine some obvious pairs, based on intuition. This was done manually, by using intuition to check and modify groups suggested by an LLM.
It is worth noting that an approach like factor analysis may be applied to similar problems where there is too much noise/too many variables. Because colors are relatively intuitive, we took a simple approach in this case.
orders_full <- orders_full %>%
mutate(item_color_simple = case_when(
item_color %in% c("black", "ebony", "anthracite", "basalt") ~ "black",
item_color %in% c("grey", "ash", "dark grey") ~ "grey",
item_color %in% c("white", "ecru", "creme", "ivory") ~ "white",
item_color %in% c("red", "dark garnet", "bordeaux", "terracotta") ~ "red",
item_color %in% c("blue", "navy", "darkblue", "blau", "denim", "dark denim", "cobalt blue", "baltic blue", "azure") ~ "blue",
item_color %in% c("green", "mint", "olive", "avocado", "petrol", "turquoise", "aqua", "aquamarine") ~ "green",
item_color %in% c("yellow", "gold", "mango", "apricot", "curry", "champagner", "ocher", "orange") ~ "yellow",
item_color %in% c("pink", "magenta", "hibiscus", "antique pink", "fuchsia", "purple", "aubergine", "currant purple") ~ "magenta",
item_color %in% c("brown", "brwon", "mocca", "cognac", "caramel", "mahagoni", "terracotta") ~ "brown",
TRUE ~ "other"
))Item Size
Item size presents us with a challenge. There is no unified system for sizing, and sizes are represented numerically, semi-numerically (46+, etc), and non-numerically. Within the numerical sizes, there is no obvious sizing schema.
Let’s take a quick look:
# Summarize possible values and counts for item_size
unique(orders_full$item_size)## [1] "40" "37" "41" "l" "m" "42" "xl"
## [8] "unsized" "33" "44" "11" "39" "152" "xxl"
## [15] "38" "41+" "43" "28" "34" "1" "13"
## [22] "30" "32" "2" "35" "3" "29" "31"
## [29] "27" "10" "36+" "36" "39+" "26" "38+"
## [36] "s" "18" "7" "7+" "42+" "24" "21"
## [43] "22" "46" "3332" "8" "9" "5+" "5"
## [50] "4+" "8+" "40+" "4" "48" "6+" "10+"
## [57] "37+" "104" "6" "50" "45" "23" "12"
## [64] "116" "128" "14" "47" "xs" "9+" "164"
## [71] "25" "140" "20" "3634" "xxxl" "4032" "45+"
## [78] "19" "3632" "44+" "80" "46+" "54" "2+"
## [85] "100" "56" "3+" "52" "3832" "3132" "3432"
## [92] "58" "11+" "43+" "176" "90" "49" "4034"table(orders_full$item_size)##
## 1 10 10+ 100 104 11 11+ 116 12 128
## 28 192 136 11 44 137 15 70 56 87
## 13 14 140 152 164 176 18 19 2 2+
## 28 6 92 77 21 6 73 78 6 2
## 20 21 22 23 24 25 26 27 28 29
## 84 111 99 77 86 50 79 82 62 117
## 3 3+ 30 31 3132 32 33 3332 34 3432
## 23 10 101 143 1 121 106 24 132 8
## 35 36 36+ 3632 3634 37 37+ 38 38+ 3832
## 176 1039 18 15 1 1719 55 4217 110 7
## 39 39+ 4 4+ 40 40+ 4032 4034 41 41+
## 4926 151 118 76 5591 122 9 1 3642 93
## 42 42+ 43 43+ 44 44+ 45 45+ 46 46+
## 3666 92 1200 8 1493 8 165 7 934 7
## 47 48 49 5 5+ 50 52 54 56 58
## 31 663 1 190 196 116 18 18 15 2
## 6 6+ 7 7+ 8 8+ 80 9 9+ 90
## 342 326 308 264 382 184 2 297 149 7
## l m s unsized xl xs xxl xxxl
## 9221 7502 2841 3257 8289 28 6723 69# Since the table command is difficult to intuitively read, we create a separate dataset to interpret frequencies of sizes
item_size_freq <- orders_full %>%
group_by(item_size) %>%
summarize(count = n(), .groups = "drop") %>%
arrange(desc(count))
item_size_freq$percent <- item_size_freq$count / sum(item_size_freq$count)
item_size_freq$percent <- paste0(round(item_size_freq$percent * 100, 1), "%")
head(item_size_freq)## # A tibble: 6 × 3
## item_size count percent
## <chr> <int> <chr>
## 1 l 9221 12.5%
## 2 xl 8289 11.2%
## 3 m 7502 10.2%
## 4 xxl 6723 9.1%
## 5 40 5591 7.6%
## 6 39 4926 6.7%From this, we can identify several patterns:
Numerous observations fit into expected “s, m, l, xl…” categories
A meaningful subset of sizes have a “+” symbol next to them - we will make an assumption and consider all of these “plus sizes”
The majority of non-‘+’ numeric sizes appear to have a numeric value <50.
While they may follow different sizing schemas across observations, the numeric values may nonetheless have explanatory power.
We will take several actions here:
We will merge the letter sizes into: S, M, L, and XL, and XXL
We remove all 536 observations in which numeric size is >50
We merge all remaining numeric sizes into quartiles.
Plus non-numeric, and we will merge these into a separate ‘plus’ category
# Merge the letter sizes into: S, M, L, and XL, and XXL:
orders_full <- orders_full %>%
mutate(
item_size = dplyr::recode(item_size,
"XS" = "S",
"XXXL" = "XXL")
)%>%
# remove observations in which numeric size is >50
mutate(size_numeric = suppressWarnings(as.numeric(item_size))) %>%
filter(is.na(size_numeric) | size_numeric <= 50)
# Merge numeric into quartiles
orders_full <- orders_full %>%
# Standardize letter sizes and trim whitespace
mutate(item_size = toupper(trimws(item_size))) %>%
# Compute quartiles for numeric sizes only
mutate(size_quartiles = ifelse(!is.na(size_numeric),
ntile(size_numeric, 4),
NA)) %>%
# Create unified clean size column
mutate(size_category = case_when(
item_size %in% c("S","M","L","XL","XXL") ~ item_size, # keep standard letters
!is.na(size_numeric) & size_quartiles == 1 ~ "numeric Q1", # numeric quartiles
!is.na(size_numeric) & size_quartiles == 2 ~ "numeric Q2",
!is.na(size_numeric) & size_quartiles == 3 ~ "numeric Q3",
!is.na(size_numeric) & size_quartiles == 4 ~ "numeric Q4",
TRUE ~ "plus" # everything else → plus
)) %>%
# convert to factor with sensible order
mutate(size_category = factor(size_category,
levels = c("S","M","L","XL","XXL",
"numeric Q1","numeric Q2","numeric Q3","numeric Q4",
"plus"))) %>%
select(-size_numeric, -size_quartiles) # remove helper columns
# Let's take a look at the new Size category variable
item_size_category_freq <- orders_full %>%
group_by(size_category) %>%
summarize(count = n(), .groups = "drop") %>%
arrange(desc(count))
item_size_category_freq$percent <- item_size_category_freq$count / sum(item_size_category_freq$count)
item_size_category_freq$percent <- paste0(round(item_size_category_freq$percent * 100, 1), "%")
table(orders_full$size_category) # optional to view above##
## S M L XL XXL numeric Q1 numeric Q2
## 2841 7502 9221 8289 6723 8324 8323
## numeric Q3 numeric Q4 plus
## 8323 8323 5383Last steps
Now that we have completed data cleaning, we will save a CSV of our cleaned data locally. In case you encounter errors if following along with this markup, I have attached the unmodified R Script I use to create orders_clean.csv.
write.csv(orders_full, "orders_clean.csv", row.names = FALSE)