Efficient Products Clustering Can Drive Retail Sales
By: Sarit Maitra
Tags: Forecasting, Statistical Analysis, Unsupervised Learning, Clustering, Advance Planning

# number of weeks

DF <- data.frame(df[, 2:53], row.names = df$Product_Code)

print(names(DF)); #Check whether there is missing value.

print(sum(is.na(DF)))

We have 800 products in this data set and it is impractical to analyze data of all 800 products. So, let us classify the products into groups based on the similarity of transactions over 52 weeks.

We will use unsupervised learning for clustering.

Clustering:

It is an optimization problem. In order to optimize either we need to decide based on minimum distance or determine the number of clusters in terms of constraints. Here, we will work with number of clusters. Because the number of clusters (k) must be set before we start the algorithm, let’s try with several different values of k and examine the differences in the results.

The standard algorithm which can define the above is —

where: xi is a data point belonging to the cluster Ck and μk is the mean value of the points assigned to the cluster Ck. Each observation xi is assigned to a given cluster such that the sum of squares distance of the observation to their assigned cluster centers μk is minimized.

Now, there are quite a few clustering algo available and there is no easy way to find the right algo for our data. We have to experiment and find the best fitted algo for any given dataset.

Principal component analysis:

# principal component analysis

res.pca <- PCA(DF, graph = FALSE) # Extract eigenvalues/variances

print(get_eig(res.pca)) # Visualize eigenvalues/variances

fviz_screeplot(res.pca, addlabels = TRUE, ylim = c(0, 50))

fviz_pca_var(res.pca, col.var="contrib",

gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),

repel = TRUE # Avoid text overlapping

)

Variable contribution to principal axes:

fviz_contrib(res.pca, choice = "var", axes = 1, top = 10) fviz_contrib(res.pca, choice = "var", axes = 2, top = 10)

# Extract the results for individuals

ind <- get_pca_ind(res.pca)

ind # Coordinates of individuals

head(ind$coord) fviz_pca_ind(res.pca, col.ind = "cos2",

gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),

repel = TRUE)

Principal component analysis gives us a clear visibility of number of clusters for the products we have. This was important as a first step to our data mining exercise.

Let’s use factoextra package which can handle the results of PCA, CA, MCA, MFA, FAMD and HMFA from several packages, for extracting and visualizing the most important information contained in our data. More so, it gives a human understandable output.

set.seed(123)

k1 <- kmeans(DF, centers = 2, nstart = 25)

k2 <- kmeans(DF, centers = 3, nstart = 25)

k3 <- kmeans(DF, centers = 4, nstart = 25)

k4 <- kmeans(DF, centers = 5, nstart = 25) # plots to compare

p1 <- fviz_cluster(k1, geom = "point", DF) + ggtitle("k = 2")

p2 <- fviz_cluster(k2, geom = "point", DF) + ggtitle("k = 3")

p3 <- fviz_cluster(k3, geom = "point", DF) + ggtitle("k = 4")

p4 <- fviz_cluster(k4, geom = "point", DF) + ggtitle("k = 5") grid.arrange(p1, p2, p3, p4, nrow = 2)

This assessment gives us an idea about k=3 or 4 between clusters, however, we are not sure about the optimal clusters. If we know the number of clusters we want, then, probably k-means is a good choice for our use case.

Besides elbow method, other popular methods for determining the optimal clusters are Silhouette method and Gap statistic

K-means clustering:

# Elbow method

set.seed(101)

fviz_nbclust(DF, kmeans, method = "wss") # WSS means the sum of distances between the points

# and the corresponding centroids for each cluster

Here, we have tried to model for every number of clusters from 1 to 10 and collect the WSS values for each model. Look at the plot below. With the increase in clusters, the value of WSS decreases.The elbow point is 3 indicates 3 clusters.

Silhouette method:

silhouette_score = function(k){

km = kmeans(DF, centers = k, nstart=25)

ss = silhouette(km$cluster, dist(DF))

mean(ss[, 3])}

k = 2:10

avg_sil = sapply(k,silhouette_score )

plot(k, type = 'b', avg_sil, xlab = 'number of clusters', ylab ='average silhouette scores', frame = 'False')

Here also, the optimal number looks like 3

Gap statistic:

Gap statistic standardizes the graph of log(Wk), where Wk is the within-cluster dispersion, by comparing it to its expectation under an appropriate null reference distribution of the data.

fviz_nbclust(DF, kmeans, method = "gap_stat")

This shows different output as 4 clusters. Let us apply this with 4 clusters as per findings from Gap-Statistic method and plot the pattern of weeks as per clustering from k-means columns.

cluster_4 <- kmeans(DF,centers = 4,nstart = 10)

cluster_4$cluster <- as.factor(cluster_4$cluster)

cluster_4 # plotting pattern of weeks as per clustering from kmeans columns ggplot(DF, aes(W1,W44,color =cluster_4$cluster)) +geom_point()

What we can interpret here is that, there are 124, 197 and 490 products in each group, respectively. The cluster plot shows that a clearly separated three clusters, and the between_SS / total_SS = 88.6 % suggests this clustering model is a good fit for the data. Specifically, there are 490 products classified into group 1.

group1 = data.frame(t(DF[cluster_3$cluster == 3,]))

summary(sapply(group1, mean)) hist(sapply(group1, mean), main = "Histogram of Product Group 1", xlab = "Number of Transactions")

Here, the average weekly transaction is 1.66. There are quite a few products having < 1 weekly transactions (long bar in the histogram). The transactions of other products looks like following a normal distribution. Let’s separate the initial group 1 into two parts:

group 0 with average weekly transactions < 2, and

a new group 1 containing the rest products.

group0 <- group1[,sapply(group1, mean) <= 2]

group1 <- group1[,sapply(group1, mean) > 2] group2 <- data.frame(t(DF[cluster_3$cluster == 1]))

group3 <- data.frame(t(DF[cluster_3$cluster == 2])) # pie chart

slices <- c(ncol(group0), ncol(group1), ncol(group2), ncol(group3))

lbls <- c("Group 0:", "Group 1:", "Group 2:", "Group 3:")

lbls <- paste(lbls, percent(slices/sum(slices)))

pie(slices,labels = lbls, col=rainbow(length(lbls)), main ="Pie Chart of Product Segmentation")

We can see that,

37.2% products belong to Group 0,

23.2% to Group 1,

15.3% to Group 2, and

24.3% to Group 3.

Box plot of product segmentation:

group1_mean <- sapply(group1, mean)

group2_mean <- sapply(group2, mean)

group3_mean <- sapply(group3, mean)

boxplot(group1_mean, group2_mean, group3_mean, main = "Box-Plot of Product Segmentation", names = c("Group 1", "Group 2", "Group 3")) lapply(list(group1_mean, group2_mean, group3_mean), summary)

The displayed results reveal that, products are clustered into four separately groups.

Group 0 has the lowest number of weekly transactions; and

Group 2 has the largest number of transactions.

Analyze and Forecast:

We will analyze each group separately which is kind of iterative process.

Analysis (Group0):

summary(group0_mean) par(mfrow = c(1, 2))

hist(group0_mean, main = "Histogram of Group 1", xlab = "Number of Transactions")

boxplot(group0_mean, main = "Box-plot of Group 1", names = c("Group0"))

According to the histogram, the distribution of the average weekly transactions of Group 0 is right skewed. More over, the box plot shows that the 3rd quartile is around 0.5, which means that the majority products in this group have less than 1 transactions per week. Though there are some products have weekly transactions larger than 1, those are considered as outliers in the box plot considering a very small proportion of all products. Therefore, it can be concluded that, this group have very low demand.

For further analysis, we would like to select a representative product, whose average weekly transaction is mostly close to a target value (i.e., median or mean). In this case, since the distribution is right skewed, we select the median as our target value. The representative product of this group is the product whose number of transactions is minimally different from the median.

Forecast:

idx0 <- which.min(abs(group0_mean-summary(group0_mean)['Median']))

print(idx0) # First row and all columns

DF[215,] #Convert P215 data to time series

ts0 <- ts(group0[,idx0], frequency = 365.25/7)

plot(ts0)

We have converted the data to timeseries. In the Julian calendar, the average (mean) length of a year is 365.25 days. However, this can be tried with 365 as well. The representative product of Group 0 is P214.

We can see that, most of time P214 has zero transactions, some 1 transaction, and one 4 transactions per week.

Analysis (Group1):

summary(group1_mean) par(mfrow = c(1, 2))

hist(group1_mean, main = "Histogram of Group 1", xlab = "Number of Transactions")

boxplot(group1_mean, main = "Box-plot of Group 1", names = c("Group1"))

Here, the distribution is almost centered around 4. The distribution is a little bit right skewed in the Box plot, with one outlier. The Q3 percentile > 4 (4.23), most of the products in Group1 is < 4. Therefore, it can be safely assumed that, the products in this group have low demands too.

idx1 <- which.min(abs(group1_mean-summary(group1_mean)['Mean']))

print(idx1) # First row and all columns

DF[318,] #Convert P215 data to time series

ts1 <- ts(group1[,idx1], frequency = 365.25/7)

plot(ts1)

The representative product of Group1 is P318.

summary(group1[,idx1])

boxplot(group1[,idx1], main = "Box-Plot of P318")

The distribution is a little bit right skewed. The average number of weekly transaction is 3.67.

Decomposition (Group1):

# set up plot region

par(mfrow = c(1, 2))

# plot normal variates with mean

acf(ts1, main = "") whitenoise.test(ts1)

According to the time plot, the majority of the number of transactions is between 2 and 5 per week. It is clear that there is no trend or seasonality in this time series. Moreover, the auto correlation plot displays white noise in the data. In this way, there is no need to perform decomposition for this time series prior building a forecasting model.

We will apply (1) ETS(Exponential Smoothing) and (2) ARIMA (Autoregressive Integrated Moving Average ). Moreover, other forecasting methods e.g. average, drift, and naïve will be applied based on the characteristic of the data. With only 52 weeks of transaction data, it is difficult to make long-term forecasting.

ETS(Exponential Smoothing):

Prediction produced using exponential smoothing methods are weighted averages of past observations, with the weights decaying exponentially as the observations get older.

fit_ets <- ets(ts1)

summary(fit_ets)

checkresiduals(fit_ets)

Ljung-Box statistic p‐value > the significance level (\alpha) leads us to not‐to‐reject the null hypothesis or, in other words, the time series is white test. Below plot shows point forecasts and prediction intervals generated from the model.

autoplot(fit_ets)

plot(forecast(fit_ets, h = 4))

The residual plot displays that the residuals have constant variance and zero mean, and there is no significant autocorrelation with each other. Though this indicates the model is a good fit; moreover, the p-value of Ljung-Box test also indicates independence of residuals. However, the forecasting results displaying the prediction interval is excessively wide, with negative values. So, ETS model is not a good choice for this time series.

The ETS(A,N,N) is the simple exponential smoothing with additive errors. This is expected, because the original time series is a white noise, without trend and seasonality.

ARIMA (Group1):

summary(ur.kpss(ts1))

adf.test(ts1)

ur.df(ts1, type='trend', lags = 10, selectlags = "BIC")

p1 = ggAcf(ts1)

p2 = ggPacf(ts1)

grid.arrange(p1, p2, ncol = 2)

This time series of P318 is a white noise, which is a stationary data. Here, both ACF and PACF plots have same observation of stationarity.

ARIMA (Group1):

fit_arima = auto.arima(ts1, seasonal = FALSE)

summary(fit_arima)

checkresiduals(fit_arima)

In terms of model performance, ARIMA may be better, however, forecasting output are quite similar to ETS Compared to ETS model, with an unacceptably wide prediction interval.

autoplot(forecast(fit_arima, h = 4)) + xlab("Week") +

ylab("Number of Transactions") + ggtitle("Group 1: Forecast using ARIMA Method")

Average, Naïve & Drift Methods:

p1 = autoplot(ts1) + autolayer(meanf(ts1, h = 4)) + xlab(“Week”) +

ylab(“Number of Transactions”) + ggtitle(“Group 1: Average Method”) p2 = autoplot(ts1) + autolayer(naive(ts1, h = 4)) + xlab(“Week”) +

ylab(“Number of Transactions”) + ggtitle(“Group 1: Naive Method”) p3 = autoplot(ts1) + autolayer(rwf(ts1, h = 4)) + xlab(“Week”) +

ylab(“Number of Transactions”) + ggtitle(“Group 1: Drift Method”) grid.arrange(p1, p2, p3, ncol = 3)

In general, none of these methods fit the data better than either ARIMA or ETS method. Specifically, the forecast using Average Method has very similar results. However, the prediction intervals of Naive method and drift method are even wider. Therefore, these methods are not good options.

Since the original data of P318 is a white noise, it is very difficult to make a good prediction for this time series. We notice that the forecasting results of both ARIMA and ETS models are equal to the mean of P318 (3.673/3.68).

However, because of the wide prediction interval, it will put business into risk if we only use the forecasting results directly. Thus, instead of using the mean value, it will be advisable to use the 3rd quartile value, 5 transactions per week and that way, we may cover 75% of business needs.

Analysis (Group3):

idx3 <- which.min(abs(group3_mean-summary(group3_mean)['Median']))

print(idx3) summary(group3_mean) par(mfrow = c(1, 2))

hist(group3_mean, main = "Histogram of Group 3", xlab = "Number of Transactions")

boxplot(group3_mean, main = "Box-plot of Group 3", names = c("Group3"))

According to the histogram, the distribution of weekly transactions is right skewed. In the box plot, the distribution is right skewed, with some outliers. In addition, the 25th percentile is 32.17, which means most of the products in Group3 have weekly transactions larger than 32. Therefore, we can conclude that the products in Group3 have high demands. Here too, the distribution is centered, so, we select the mean as target value.

summary(group3[,idx3])

boxplot(group3[,idx3], main = "Box-Plot of P209")

The data distribution is almost centered. The average number of weekly transaction is 9.9, and the third quartile is 12.

Decomposition (Group3):

ts3 = ts(group3[,idx3], frequency = 365.25/7)

p1 = autoplot(ts3) + xlab("Week") + ylab("Number of Transaction") + ggtitle("Time Plot (Group 2)")

p2 = ggAcf(ts3)

grid.arrange(p1, p2, ncol = 2)

According to the time plot, the majority of the number of transactions is between 6 and 13 per week.

The original time series consists of a trend component and an irregular component, but no seasonal component. Therefore, it is appropriate to use the simple moving average method for smoothing.

autoplot(ts3, series = "Data") + autolayer(ma(ts3, 5), series = "5-MA" ) + autolayer(ma(ma(ts3, 5), 3), series = "3x5-MA") + scale_colour_manual(values=c("Data"="grey50","5-MA"="blue", "3x5-MA" = "red"), breaks=c("Data","5-MA", "3x5-MA"))

With an order of 5, the estimated trend is not smoothing as expected. Thus, moving average of the moving average is performed. The “3x5-MA” trend is a better fit. We will repeat the similar process of applying ETS(Exponential Smoothing) and ARIMA(Autoregressive Integrated Moving Average ) and also will investigate other forecasting methods, such as average, drift, and naïve, etc.

Similar exercise like group0 and group1 can be performed here to find the best fitted model.

Key takeaways:

Clustering is important in the retail business decision-making process. It is a part of effective data mining technique and when dealing with big data, there effective data mining is critical. Data mining covers a wide spectrum of data analysis and knowledge discovery tasks, from data characterization and discrimination to association and correlation analysis, classification, regression, clustering, outlier analysis, sequence analysis, and trend and evolution analysis.

However, we have to remember that, real-life data are messy and likely to contain noise, errors, exceptions, or uncertainty. Errors and noise may confuse the data mining process, leading to the derivation of erroneous patterns. Data cleaning, data preprocessing, outlier detection and removal, and uncertainty reasoning are examples of techniques that need to be integrated with the data mining process to make any efficient segmentation & prediction.

I can be contacted here.