Analýza zákazníkov potravinárskej spoločnosti

Viacrozmerné metódy analýzy dát

1 Úvod

Potravinárska spoločnosť plánuje novú marketingovú kampaň a chce maximalizovať jej účinnosť. Na základe pilotnej kampane, ktorej sa zúčastnilo 1 956 zákazníkov, budeme analyzovať ich charakteristiky a správanie pomocou viacrozmerných štatistických metód.

Ciele analýzy: 1. Popisná štatistika – charakteristiky skupín zákazníkov 2. Redukcia dimenzionality – faktorová analýza a PCA 3. Segmentácia zákazníkov – zhluková analýza 4. Regresná analýza – kvantifikovanie vplyvu premenných na správanie zákazníkov

2 Načítanie dát a príprava

2.1 Načítanie knižníc

# Základné knižnice pre prácu s dátami
library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggcorrplot)

# Štatistické analýzy
library(psych)
library(factoextra)
library(cluster)
library(NbClust)

# Výstup a formátovanie
library(knitr)
library(kableExtra)
library(corrplot)
library(gridExtra)
library(scales)

# Testy a diagnostika
library(lmtest)
library(car)
library(tibble)

2.2 Načítanie a prvý pohľad na dáta

Dôležité: V prostredí musí byť dataset s názvom Food.
Ak ho máš v Exceli, môžeš ho načítať cez read_excel().

# Ak máš dataset už nahraný ako objekt Food:
data_raw <- read_excel("Food.xlsx")

# Alternatíva pri Excel súbore:
# data_raw <- read_excel("Food.xlsx")

cat("Počet zákazníkov:", nrow(data_raw), "\n")

## Počet zákazníkov: 1956

cat("Počet premenných:", ncol(data_raw), "\n")

## Počet premenných: 25

cat("\nNázvy premenných:\n")

## 
## Názvy premenných:

print(names(data_raw))

##  [1] "Age"                 "Education"           "Marital_Status"     
##  [4] "Income"              "Kidhome"             "Teenhome"           
##  [7] "Recency"             "MntWines"            "MntFruits"          
## [10] "MntMeatProducts"     "MntFishProducts"     "MntSweetProducts"   
## [13] "MntGoldProds"        "NumDealsPurchases"   "NumWebPurchases"    
## [16] "NumCatalogPurchases" "NumStorePurchases"   "NumWebVisitsMonth"  
## [19] "AcceptedCmp3"        "AcceptedCmp4"        "AcceptedCmp5"       
## [22] "AcceptedCmp1"        "AcceptedCmp2"        "Complain"           
## [25] "Response"

head(data_raw) %>%
  kable(caption = "Ukážka dát (prvých 6 zákazníkov)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                font_size = 11) %>%
  scroll_box(width = "100%")

Ukážka dát (prvých 6 zákazníkov)

Age	Education	Marital_Status	Income	Kidhome	Teenhome	Recency	MntWines	MntFruits	MntMeatProducts	MntFishProducts	MntSweetProducts	MntGoldProds	NumDealsPurchases	NumWebPurchases	NumCatalogPurchases	NumStorePurchases	NumWebVisitsMonth	AcceptedCmp3	AcceptedCmp4	AcceptedCmp5	AcceptedCmp1	AcceptedCmp2	Complain	Response
67	Graduation	Single	58138	0	0	58	635	88	546	172	88	88	3	8	10	4	7	0	0	0	0	0	0	1
70	Graduation	Single	46344	1	1	38	11	1	6	2	1	6	2	1	1	2	5	0	0	0	0	0	0	0
59	Graduation	Together	71613	0	0	26	426	49	127	111	21	42	1	8	2	10	4	0	0	0	0	0	0	0
40	Graduation	Together	26646	1	0	26	11	4	20	10	3	5	2	2	0	4	6	0	0	0	0	0	0	0
43	PhD	Married	58293	1	0	94	173	43	118	46	27	15	5	5	3	6	5	0	0	0	0	0	0	0
57	Master	Together	62513	0	1	16	520	42	98	0	42	14	2	6	4	10	6	0	0	0	0	0	0	0

3 Predspracovanie dát

3.1 Kontrola chýbajúcich hodnôt

missing_summary <- data_raw %>%
  summarise(across(everything(), ~ sum(is.na(.)))) %>%
  pivot_longer(everything(), names_to = "Premenná", values_to = "Chýbajúce_hodnoty") %>%
  filter(Chýbajúce_hodnoty > 0)

if (nrow(missing_summary) > 0) {
  missing_summary %>%
    kable(caption = "Premenné s chýbajúcimi hodnotami") %>%
    kable_styling(bootstrap_options = c("striped", "hover"))
} else {
  cat("✓ Žiadne chýbajúce hodnoty neboli nájdené.\n")
}

Premenné s chýbajúcimi hodnotami

Premenná	Chýbajúce_hodnoty
Age	27
Education	9
Marital_Status	12
Income	26
Kidhome	5
Teenhome	1
Recency	15
MntWines	20
MntFruits	13
MntMeatProducts	18
MntFishProducts	15
MntSweetProducts	18
MntGoldProds	21
NumDealsPurchases	15
NumWebPurchases	14
NumCatalogPurchases	17
NumStorePurchases	23
NumWebVisitsMonth	3

3.2 Čistenie a transformácia dát

data <- data_raw %>%
  drop_na() %>%
  mutate(
    Education = factor(Education,
                       levels = c("Basic", "Graduation", "Master", "PhD"),
                       ordered = TRUE),
    Marital_Status = factor(Marital_Status),

    Marital_Simple = case_when(
      Marital_Status %in% c("Married", "Together") ~ "V páre",
      TRUE ~ "Sám/a"
    ) %>% factor(),

    TotalSpend = MntWines + MntFruits + MntMeatProducts +
      MntFishProducts + MntSweetProducts + MntGoldProds,

    TotalPurchases = NumWebPurchases + NumCatalogPurchases +
      NumStorePurchases,

    TotalCmpResponse = AcceptedCmp1 + AcceptedCmp2 + AcceptedCmp3 +
      AcceptedCmp4 + AcceptedCmp5,

    AnyPreviousCmp = as.integer(TotalCmpResponse > 0),

    AgeGroup = case_when(
      Age < 35 ~ "Mladí (< 35)",
      Age < 50 ~ "Stredný vek (35–49)",
      Age < 65 ~ "Starší (50–64)",
      TRUE ~ "Seniori (65+)"
    ) %>% factor(levels = c("Mladí (< 35)", "Stredný vek (35–49)",
                            "Starší (50–64)", "Seniori (65+)"))
  )

cat("Po čistení zostalo zákazníkov:", nrow(data), "\n")

## Po čistení zostalo zákazníkov: 1795

cat("Premenné po transformácii:", ncol(data), "\n")

## Premenné po transformácii: 31

3.3 Kontrola úrovní meraných hodnôt

tibble(
  Premenná = c("Age", "Education", "Marital_Status", "Income", "Kidhome",
               "Teenhome", "Recency", "MntWines", "MntFruits", "MntMeatProducts",
               "MntFishProducts", "MntSweetProducts", "MntGoldProds",
               "NumDealsPurchases", "NumWebPurchases", "NumCatalogPurchases",
               "NumStorePurchases", "NumWebVisitsMonth", "AcceptedCmp1-5",
               "Complain", "Response"),
  `Typ premennej` = c("Pomerová", "Ordinálna", "Nominálna", "Pomerová",
                      "Pomerová", "Pomerová", "Pomerová", rep("Pomerová", 6),
                      rep("Pomerová", 5), "Binárna", "Binárna", "Binárna"),
  `Meracia škála` = c("Spojitá", "Kategorická", "Kategorická", "Spojitá",
                      rep("Diskrétna", 2), rep("Spojitá", 7),
                      rep("Diskrétna", 5), "Binárna", "Binárna", "Binárna")
) %>%
  kable(caption = "Prehľad úrovní meraných hodnôt") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))

Prehľad úrovní meraných hodnôt

Premenná	Typ premennej	Meracia škála
Age	Pomerová	Spojitá
Education	Ordinálna	Kategorická
Marital_Status	Nominálna	Kategorická
Income	Pomerová	Spojitá
Kidhome	Pomerová	Diskrétna
Teenhome	Pomerová	Diskrétna
Recency	Pomerová	Spojitá
MntWines	Pomerová	Spojitá
MntFruits	Pomerová	Spojitá
MntMeatProducts	Pomerová	Spojitá
MntFishProducts	Pomerová	Spojitá
MntSweetProducts	Pomerová	Spojitá
MntGoldProds	Pomerová	Spojitá
NumDealsPurchases	Pomerová	Diskrétna
NumWebPurchases	Pomerová	Diskrétna
NumCatalogPurchases	Pomerová	Diskrétna
NumStorePurchases	Pomerová	Diskrétna
NumWebVisitsMonth	Pomerová	Diskrétna
AcceptedCmp1-5	Binárna	Binárna
Complain	Binárna	Binárna
Response	Binárna	Binárna

4 Popisná štatistika

4.1 Základné štatistiky numerických premenných

numeric_vars <- data %>%
  select(Age, Income, Recency, MntWines, MntFruits, MntMeatProducts,
         MntFishProducts, MntSweetProducts, MntGoldProds, TotalSpend,
         NumDealsPurchases, NumWebPurchases, NumCatalogPurchases,
         NumStorePurchases)

desc_stats <- describe(numeric_vars) %>%
  select(n, mean, sd, median, min, max, skew, kurtosis) %>%
  round(2)

desc_stats %>%
  kable(caption = "Popisná štatistika numerických premenných") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed")) %>%
  scroll_box(width = "100%")

Popisná štatistika numerických premenných

	n	mean	sd	median	min	max	skew	kurtosis
Age	1795	54.75	11.03	54	28	75	-0.02	-0.85
Income	1795	51679.39	21477.72	50664	1730	162397	0.47	1.13
Recency	1795	49.01	29.02	49	0	99	0.00	-1.21
MntWines	1795	304.47	339.38	172	0	1493	1.19	0.62
MntFruits	1795	25.25	39.30	7	0	199	2.15	4.29
MntMeatProducts	1795	165.51	225.92	64	1	1725	2.11	5.67
MntFishProducts	1795	35.38	52.66	11	0	258	1.99	3.49
MntSweetProducts	1795	25.35	39.54	7	0	198	2.18	4.41
MntGoldProds	1795	42.85	50.86	24	0	321	1.84	3.20
TotalSpend	1795	598.82	605.39	373	5	2525	0.89	-0.31
NumDealsPurchases	1795	2.37	1.96	2	0	15	2.38	8.63
NumWebPurchases	1795	4.04	2.69	3	0	25	1.07	2.83
NumCatalogPurchases	1795	2.61	2.94	2	0	28	2.10	9.94
NumStorePurchases	1795	5.71	3.22	5	0	13	0.71	-0.58

Interpretácia: Priemerný zákazník má vek ~54 rokov, ročný príjem ~52 000 jednotiek a celkové výdavky ~600 jednotiek za 2 roky. Výdavky na víno a mäso dominujú portfóliu.

4.2 Rozdelenie kategorických premenných

p1 <- data %>%
  count(Education) %>%
  ggplot(aes(x = Education, y = n, fill = Education)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), vjust = -0.3, size = 3.5) +
  scale_fill_brewer(palette = "Blues") +
  labs(title = "Vzdelanie zákazníkov", x = "", y = "Počet") +
  theme_minimal() +
  theme(legend.position = "none")

p2 <- data %>%
  count(Marital_Status) %>%
  ggplot(aes(x = reorder(Marital_Status, -n), y = n, fill = Marital_Status)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), vjust = -0.3, size = 3.5) +
  scale_fill_brewer(palette = "Greens") +
  labs(title = "Rodinný stav zákazníkov", x = "", y = "Počet") +
  theme_minimal() +
  theme(legend.position = "none")

p3 <- data %>%
  count(AgeGroup) %>%
  ggplot(aes(x = AgeGroup, y = n, fill = AgeGroup)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = n), vjust = -0.3, size = 3.5) +
  scale_fill_brewer(palette = "Oranges") +
  labs(title = "Vekové skupiny zákazníkov", x = "", y = "Počet") +
  theme_minimal() +
  theme(legend.position = "none",
        axis.text.x = element_text(angle = 20, hjust = 1))

p4 <- data %>%
  summarise(across(starts_with("AcceptedCmp"), mean)) %>%
  pivot_longer(everything(), names_to = "Kampaň", values_to = "Podiel") %>%
  mutate(Kampaň = gsub("AcceptedCmp", "Kampaň ", Kampaň)) %>%
  ggplot(aes(x = Kampaň, y = Podiel, fill = Kampaň)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = percent(Podiel, 0.1)), vjust = -0.3, size = 3.5) +
  scale_fill_brewer(palette = "Purples") +
  scale_y_continuous(labels = percent) +
  labs(title = "Miera prijatia predchádzajúcich kampaní", x = "", y = "Podiel zákazníkov") +
  theme_minimal() +
  theme(legend.position = "none")

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

5 Faktorová analýza

5.1 Výber premenných pre faktorovú analýzu

fa_vars <- data %>%
  select(MntWines, MntFruits, MntMeatProducts, MntFishProducts,
         MntSweetProducts, MntGoldProds,
         NumDealsPurchases, NumWebPurchases, NumCatalogPurchases,
         NumStorePurchases, NumWebVisitsMonth,
         Income) %>%
  scale() %>%
  as.data.frame()

cor_matrix <- cor(fa_vars)

cat("Determinant korelačnej matice:", round(det(cor_matrix), 6), "\n")

## Determinant korelačnej matice: 0.0012

cat("Ak je determinant > 0, matica nie je singulárna a FA je možná.\n")

## Ak je determinant > 0, matica nie je singulárna a FA je možná.

corrplot(cor_matrix, method = "color", type = "upper",
         tl.cex = 0.8, tl.col = "black",
         col = colorRampPalette(c("#d73027", "white", "#1a9850"))(200),
         title = "Korelačná matica premenných pre FA",
         mar = c(0, 0, 2, 0))

kmo_result <- KMO(cor_matrix)
bartlett_result <- cortest.bartlett(cor_matrix, n = nrow(fa_vars))

cat("=== KMO Test ===\n")

## === KMO Test ===

cat("Celková KMO hodnota:", round(kmo_result$MSA, 3), "\n\n")

## Celková KMO hodnota: 0.892

cat("=== Bartlettov test sféricity ===\n")

## === Bartlettov test sféricity ===

cat("Chi-kvadrát:", round(bartlett_result$chisq, 2), "\n")

## Chi-kvadrát: 12032.76

cat("df:", bartlett_result$df, "\n")

## df: 66

cat("p-hodnota:", bartlett_result$p.value, "\n")

## p-hodnota: 0

5.2 Výber počtu faktorov

eigenvalues <- eigen(cor_matrix)$values
scree_data <- data.frame(
  Faktor = 1:length(eigenvalues),
  Eigenvalue = eigenvalues
)

ggplot(scree_data, aes(x = Faktor, y = Eigenvalue)) +
  geom_line(color = "steelblue", linewidth = 1) +
  geom_point(color = "steelblue", size = 3) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "red", linewidth = 1) +
  geom_text(aes(label = round(Eigenvalue, 2)), vjust = -0.8, size = 3) +
  labs(title = "Scree plot – Výber počtu faktorov",
       subtitle = "Červená čiara: Kaiserovo kritérium (eigenvalue > 1)",
       x = "Faktor", y = "Vlastné číslo (Eigenvalue)") +
  theme_minimal()

fa.parallel(fa_vars, fa = "fa", n.iter = 100,
            main = "Paralelná analýza – Faktorová analýza")

## Parallel analysis suggests that the number of factors =  4  and the number of components =  NA

5.3 Výsledky faktorovej analýzy

fa_model <- fa(fa_vars, nfactors = 3, rotate = "varimax", fm = "pa")
print(fa_model$loadings, cutoff = 0.35, sort = TRUE)

## 
## Loadings:
##                     PA1    PA3    PA2   
## MntWines             0.699              
## MntMeatProducts      0.617  0.511       
## NumCatalogPurchases  0.671  0.434       
## NumStorePurchases    0.593  0.398       
## NumWebVisitsMonth   -0.602         0.453
## Income               0.840  0.350       
## MntFruits                   0.682       
## MntFishProducts             0.754       
## MntSweetProducts            0.651       
## NumDealsPurchases                  0.505
## NumWebPurchases      0.379         0.633
## MntGoldProds                0.472       
## 
##                  PA1   PA3   PA2
## SS loadings    3.278 2.722 1.097
## Proportion Var 0.273 0.227 0.091
## Cumulative Var 0.273 0.500 0.591

fa_loadings <- fa_model$loadings

loadings_df <- as.data.frame(unclass(fa_loadings)) %>%
  tibble::rownames_to_column("Premenná") %>%
  pivot_longer(-Premenná, names_to = "Faktor", values_to = "Záťaž")

ggplot(loadings_df, aes(x = Premenná, y = Záťaž, fill = Záťaž > 0)) +
  geom_bar(stat = "identity") +
  facet_wrap(~ Faktor, ncol = 1) +
  coord_flip() +
  scale_fill_manual(values = c("firebrick", "steelblue"),
                    labels = c("Záporná", "Kladná")) +
  geom_hline(yintercept = c(-0.35, 0.35), linetype = "dashed", alpha = 0.5) +
  labs(title = "Faktorové záťaže po rotácii varimax",
       x = "", y = "Záťaž", fill = "Smer záťaže") +
  theme_minimal()

cat("=== Vysvetlená variabilita faktorov ===\n")

## === Vysvetlená variabilita faktorov ===

print(fa_model$Vaccounted)

##                             PA1       PA3        PA2
## SS loadings           3.2777840 2.7223608 1.09737923
## Proportion Var        0.2731487 0.2268634 0.09144827
## Cumulative Var        0.2731487 0.5000121 0.59146033
## Proportion Explained  0.4618208 0.3835649 0.15461437
## Cumulative Proportion 0.4618208 0.8453856 1.00000000

cat("\nCelková vysvetlená variabilita:",
    round(sum(fa_model$Vaccounted["Proportion Var", ]) * 100, 1), "%\n")

## 
## Celková vysvetlená variabilita: 59.1 %

6 PCA

6.1 Príprava dát pre PCA

pca_vars <- data %>%
  select(Age, Income, Kidhome, Teenhome, Recency,
         MntWines, MntFruits, MntMeatProducts, MntFishProducts,
         MntSweetProducts, MntGoldProds,
         NumDealsPurchases, NumWebPurchases, NumCatalogPurchases,
         NumStorePurchases, NumWebVisitsMonth,
         TotalSpend, TotalPurchases) %>%
  scale()

pca_model <- prcomp(pca_vars, center = FALSE, scale. = FALSE)
summary_pca <- summary(pca_model)

cat("Vysvetlená variabilita prvých 8 komponentov:\n")

## Vysvetlená variabilita prvých 8 komponentov:

print(round(summary_pca$importance[, 1:8], 3))

##                          PC1   PC2   PC3   PC4   PC5   PC6   PC7   PC8
## Standard deviation     2.826 1.458 1.127 0.999 0.917 0.881 0.794 0.767
## Proportion of Variance 0.444 0.118 0.071 0.055 0.047 0.043 0.035 0.033
## Cumulative Proportion  0.444 0.562 0.632 0.688 0.735 0.778 0.813 0.846

6.2 Scree plot PCA

fviz_eig(pca_model,
         addlabels = TRUE,
         barfill = "steelblue",
         barcolor = "steelblue",
         linecolor = "red",
         ncp = 10) +
  labs(title = "Scree plot – PCA",
       subtitle = "Podiel vysvetlenej variability jednotlivých komponentov",
       x = "Hlavná komponenta", y = "Podiel variability (%)") +
  theme_minimal()

6.3 PCA záťaže

loadings_pca <- pca_model$rotation[, 1:4]

round(loadings_pca, 3) %>%
  kable(caption = "Záťaže premenných na prvé 4 komponenty PCA") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))

Záťaže premenných na prvé 4 komponenty PCA

	PC1	PC2	PC3	PC4
Age	-0.043	0.360	-0.545	-0.066
Income	-0.299	0.012	-0.185	-0.029
Kidhome	0.233	-0.046	0.285	0.101
Teenhome	0.027	0.526	-0.310	-0.022
Recency	-0.013	0.005	-0.143	0.981
MntWines	-0.282	0.140	0.045	0.000
MntFruits	-0.242	-0.174	0.092	-0.017
MntMeatProducts	-0.285	-0.169	0.028	0.049
MntFishProducts	-0.253	-0.180	0.056	0.002
MntSweetProducts	-0.245	-0.162	0.054	0.063
MntGoldProds	-0.205	0.078	0.212	0.012
NumDealsPurchases	0.024	0.465	0.381	0.096
NumWebPurchases	-0.211	0.345	0.275	0.002
NumCatalogPurchases	-0.290	-0.019	-0.008	0.029
NumStorePurchases	-0.274	0.154	0.030	-0.031
NumWebVisitsMonth	0.217	0.230	0.412	0.050
TotalSpend	-0.336	-0.016	0.068	0.022
TotalPurchases	-0.322	0.191	0.114	-0.002

6.4 PCA biploty

p_biplot1 <- fviz_pca_biplot(pca_model,
                             axes = c(1, 2),
                             geom.ind = "point",
                             col.ind = "gray70",
                             alpha.ind = 0.4,
                             col.var = "contrib",
                             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
                             repel = TRUE,
                             label = "var") +
  labs(title = "PCA Biplot – PC1 vs PC2") +
  theme_minimal()

p_biplot2 <- fviz_pca_biplot(pca_model,
                             axes = c(1, 3),
                             geom.ind = "point",
                             col.ind = "gray70",
                             alpha.ind = 0.4,
                             col.var = "contrib",
                             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
                             repel = TRUE,
                             label = "var") +
  labs(title = "PCA Biplot – PC1 vs PC3") +
  theme_minimal()

grid.arrange(p_biplot1, p_biplot2, ncol = 1)

pca_scores <- as.data.frame(pca_model$x[, 1:4])
pca_scores$Response <- factor(data$Response, labels = c("Odmietol", "Prijal"))
pca_scores$AgeGroup <- data$AgeGroup

ggplot(pca_scores, aes(x = PC1, y = PC2, color = Response)) +
  geom_point(alpha = 0.5, size = 1.5) +
  stat_ellipse(level = 0.90, linewidth = 1.2) +
  scale_color_manual(values = c("steelblue", "firebrick")) +
  labs(title = "PCA skóre zákazníkov podľa reakcie na poslednú kampaň",
       subtitle = "Elipsy pokrývajú 90% zákazníkov v každej skupine",
       x = "PC1", y = "PC2",
       color = "Reakcia") +
  theme_minimal()

7 Segmentácia zákazníkov

7.1 Príprava premenných pre zhlukovanie

cluster_vars <- data %>%
  select(Income, TotalSpend, Age, Kidhome, Teenhome,
         NumWebPurchases, NumCatalogPurchases, NumStorePurchases,
         NumWebVisitsMonth, Recency,
         AcceptedCmp1, AcceptedCmp2, AcceptedCmp3, AcceptedCmp4, AcceptedCmp5)

cluster_scaled <- scale(cluster_vars)

cat("Premenné zahrnuté do zhlukovania:\n")

## Premenné zahrnuté do zhlukovania:

print(colnames(cluster_vars))

##  [1] "Income"              "TotalSpend"          "Age"                
##  [4] "Kidhome"             "Teenhome"            "NumWebPurchases"    
##  [7] "NumCatalogPurchases" "NumStorePurchases"   "NumWebVisitsMonth"  
## [10] "Recency"             "AcceptedCmp1"        "AcceptedCmp2"       
## [13] "AcceptedCmp3"        "AcceptedCmp4"        "AcceptedCmp5"

7.2 Výber optimálneho počtu zhlukov

set.seed(123)

p_elbow <- fviz_nbclust(cluster_scaled, kmeans, method = "wss", k.max = 10) +
  labs(title = "Metóda lakťa – optimálny počet zhlukov",
       x = "Počet zhlukov (k)", y = "Celková vnútro-zhluková SSW") +
  theme_minimal()

p_silhouette <- fviz_nbclust(cluster_scaled, kmeans, method = "silhouette", k.max = 10) +
  labs(title = "Siluetová metóda – optimálny počet zhlukov",
       x = "Počet zhlukov (k)", y = "Priemerná šírka siluety") +
  theme_minimal()

grid.arrange(p_elbow, p_silhouette, ncol = 2)

7.3 K-means zhlukovanie

set.seed(123)
kmeans_model <- kmeans(cluster_scaled, centers = 3, nstart = 50, iter.max = 100)

data$Cluster <- factor(kmeans_model$cluster,
                       labels = c("Zhluk 1", "Zhluk 2", "Zhluk 3"))

cat("Veľkosti zhlukov:\n")

## Veľkosti zhlukov:

print(table(data$Cluster))

## 
## Zhluk 1 Zhluk 2 Zhluk 3 
##     892     725     178

cat("\nPodiel zákazníkov v každom zhluku:\n")

## 
## Podiel zákazníkov v každom zhluku:

print(round(prop.table(table(data$Cluster)) * 100, 1))

## 
## Zhluk 1 Zhluk 2 Zhluk 3 
##    49.7    40.4     9.9

7.4 Vizualizácia zhlukov

pca_scores$Cluster <- data$Cluster

p_cluster1 <- ggplot(pca_scores, aes(x = PC1, y = PC2, color = Cluster)) +
  geom_point(alpha = 0.5, size = 1.5) +
  stat_ellipse(level = 0.90, linewidth = 1.2) +
  scale_color_manual(values = c("steelblue", "firebrick", "forestgreen")) +
  labs(title = "Zhluky zákazníkov v priestore PC1 vs PC2",
       x = "PC1", y = "PC2", color = "Zhluk") +
  theme_minimal()

p_cluster2 <- ggplot(pca_scores, aes(x = PC1, y = PC3, color = Cluster)) +
  geom_point(alpha = 0.5, size = 1.5) +
  stat_ellipse(level = 0.90, linewidth = 1.2) +
  scale_color_manual(values = c("steelblue", "firebrick", "forestgreen")) +
  labs(title = "Zhluky zákazníkov v priestore PC1 vs PC3",
       x = "PC1", y = "PC3", color = "Zhluk") +
  theme_minimal()

grid.arrange(p_cluster1, p_cluster2, ncol = 1)

7.5 Profil zhlukov

cluster_profile <- data %>%
  group_by(Cluster) %>%
  summarise(
    Počet = n(),
    `Priem. vek` = round(mean(Age), 1),
    `Priem. príjem` = round(mean(Income), 0),
    `Priem. výdavky` = round(mean(TotalSpend), 0),
    `Priem. deti` = round(mean(Kidhome + Teenhome), 2),
    `Web nákupy` = round(mean(NumWebPurchases), 2),
    `Katalóg` = round(mean(NumCatalogPurchases), 2),
    `Obchod` = round(mean(NumStorePurchases), 2),
    `Recencia (dni)` = round(mean(Recency), 1),
    `% prijalo kampaň 1-5` = round(mean(AnyPreviousCmp) * 100, 1),
    `% prijalo posl. kampaň` = round(mean(Response) * 100, 1),
    .groups = "drop"
  )

cluster_profile %>%
  kable(caption = "Profil zhlukov zákazníkov") %>%
  kable_styling(bootstrap_options = c("striped", "hover")) %>%
  column_spec(1, bold = TRUE)

Profil zhlukov zákazníkov

Cluster	Počet	Priem. vek	Priem. príjem	Priem. výdavky	Priem. deti	Web nákupy	Katalóg	Obchod	Recencia (dni)	% prijalo kampaň 1-5	% prijalo posl. kampaň
Zhluk 1	892	52.2	35067	119	1.32	2.39	0.62	3.33	48.2	9.2	10.9
Zhluk 2	725	58.2	65038	951	0.77	5.73	4.21	8.06	49.9	14.8	12.7
Zhluk 3	178	53.6	80520	1568	0.27	5.44	6.07	8.13	49.2	98.9	50.6

8 Regresná analýza

8.1 Formulácia hypotézy

Hypotéza: Výšku celkových výdavkov zákazníka (TotalSpend) ovplyvňuje príjem domácnosti, vek, počet detí, počet nákupov cez katalóg a predchádzajúca odpoveď na kampane.

8.2 Odhad modelu

reg_model <- lm(TotalSpend ~ Income + Age + Kidhome + Teenhome +
                  NumCatalogPurchases + AnyPreviousCmp,
                data = data)

summary(reg_model)

## 
## Call:
## lm(formula = TotalSpend ~ Income + Age + Kidhome + Teenhome + 
##     NumCatalogPurchases + AnyPreviousCmp, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2217.74  -154.69   -19.18   128.02  1152.54 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         -1.105e+02  4.418e+01  -2.501   0.0125 *  
## Income               1.238e-02  4.740e-04  26.124  < 2e-16 ***
## Age                 -5.110e-01  7.239e-01  -0.706   0.4803    
## Kidhome             -1.551e+02  1.566e+01  -9.903  < 2e-16 ***
## Teenhome            -1.172e+02  1.458e+01  -8.038 1.65e-15 ***
## NumCatalogPurchases  7.412e+01  3.457e+00  21.441  < 2e-16 ***
## AnyPreviousCmp       1.833e+02  1.825e+01  10.042  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 294.8 on 1788 degrees of freedom
## Multiple R-squared:  0.7636, Adjusted R-squared:  0.7628 
## F-statistic: 962.8 on 6 and 1788 DF,  p-value: < 2.2e-16

reg_results <- summary(reg_model)
coef_table <- as.data.frame(reg_results$coefficients)

coef_table$Signif <- ifelse(coef_table[,4] < 0.001, "***",
                     ifelse(coef_table[,4] < 0.01, "**",
                     ifelse(coef_table[,4] < 0.05, "*",
                     ifelse(coef_table[,4] < 0.1, ".", ""))))

colnames(coef_table)[1:4] <- c("Odhad", "Std. chyba", "t-hodnota", "p-hodnota")

coef_table %>%
  mutate(across(1:4, ~ round(., 4))) %>%
  kable(caption = "Regresné koeficienty") %>%
  kable_styling(bootstrap_options = c("striped", "hover")) %>%
  footnote(general = "Kódy signif.: *** p<0.001, ** p<0.01, * p<0.05, . p<0.1")

Regresné koeficienty

	Odhad	Std. chyba	t-hodnota	p-hodnota	Signif
(Intercept)	-110.4734	44.1780	-2.5006	0.0125
Income	0.0124	0.0005	26.1237	0.0000	***
Age	-0.5110	0.7239	-0.7060	0.4803
Kidhome	-155.0946	15.6611	-9.9032	0.0000	***
Teenhome	-117.1641	14.5768	-8.0377	0.0000	***
NumCatalogPurchases	74.1214	3.4570	21.4409	0.0000	***
AnyPreviousCmp	183.3061	18.2545	10.0417	0.0000	***
Note:
Kódy signif.: *** p<0.001, ** p<0.01, * p<0.05, . p<0.1

Interpretácia regresných koeficientov: - Income: Za každú 1 jednotku nárastu príjmu sa celkové výdavky zvýšia o cca 0.0124 jednotiek. - Age: Každý rok veku zvyšuje výdavky o cca -0.51 jednotiek. - Kidhome: Každé malé dieťa v domácnosti znižuje výdavky o cca 155.1 jednotiek. - Teenhome: Podobný efekt ako Kidhome, ale s menšou silou. - NumCatalogPurchases: Zákazníci, ktorí nakupujú cez katalóg, míňajú výrazne viac. - AnyPreviousCmp: Zákazníci, ktorí prijali predchádzajúcu kampaň, majú vyššie výdavky.

R² = 0.764 – model vysvetľuje 76.4% variability výdavkov.

F-štatistika: 962.8 (p < 0.001) – celkový model je štatisticky významný.

9 Diagnostika regresie

9.1 Normalita reziduálov

residuals_reg <- residuals(reg_model)

par(mfrow = c(1, 2))
qqnorm(residuals_reg, main = "Q-Q plot reziduálov")
qqline(residuals_reg, col = "red", lwd = 2)

hist(residuals_reg, breaks = 40, main = "Histogram reziduálov",
     xlab = "Reziduály", col = "steelblue", border = "white")

par(mfrow = c(1, 1))

set.seed(42)
sw_sample <- sample(residuals_reg, min(5000, length(residuals_reg)))
sw_test <- shapiro.test(sw_sample)

cat("Shapiro-Wilk test normality reziduálov:\n")

## Shapiro-Wilk test normality reziduálov:

cat("W =", round(sw_test$statistic, 4), ", p-hodnota =", sw_test$p.value, "\n")

## W = 0.9163 , p-hodnota = 2.120483e-30

9.2 Homoskedasticita

bp_test <- bptest(reg_model)

cat("Breusch-Pagan test:\n")

## Breusch-Pagan test:

cat("BP =", round(bp_test$statistic, 3), ", p-hodnota =",
    round(bp_test$p.value, 4), "\n")

## BP = 402.139 , p-hodnota = 0

plot(fitted(reg_model), residuals_reg,
     xlab = "Fitted hodnoty", ylab = "Reziduály",
     main = "Reziduály vs Fitted hodnoty",
     pch = 20, col = rgb(0.2, 0.4, 0.6, 0.3))
abline(h = 0, col = "red", lwd = 2)

9.3 Multikolinearita

vif_values <- vif(reg_model)

cat("Hodnoty VIF:\n")

## Hodnoty VIF:

print(round(vif_values, 3))

##              Income                 Age             Kidhome            Teenhome 
##               2.139               1.316               1.485               1.304 
## NumCatalogPurchases      AnyPreviousCmp 
##               2.125               1.115

cat("\nInterpretácia:\n")

## 
## Interpretácia:

cat("VIF > 10 = závažná multikolinearita\n")

## VIF > 10 = závažná multikolinearita

cat("VIF > 5 = stredná multikolinearita\n")

## VIF > 5 = stredná multikolinearita

cat("VIF < 5 = prijateľné\n")

## VIF < 5 = prijateľné

9.4 Autokorelácia reziduálov

dw_test <- dwtest(reg_model)

cat("Durbin-Watson test:\n")

## Durbin-Watson test:

cat("DW =", round(dw_test$statistic, 3), ", p-hodnota =",
    round(dw_test$p.value, 4), "\n")

## DW = 1.983 , p-hodnota = 0.3568

cat("DW ≈ 2: žiadna autokorelcia | DW < 1.5: pozitívna autokorelcia | DW > 2.5: záporná autokorelcia\n")

## DW ≈ 2: žiadna autokorelcia | DW < 1.5: pozitívna autokorelcia | DW > 2.5: záporná autokorelcia

10 Záver a odporúčania

10.1 Súhrn výsledkov analýzy

tibble(
  Analýza = c("Popisná štatistika", "Faktorová analýza", "PCA",
              "Zhluková analýza", "Regresná analýza"),
  `Kľúčové zistenie` = c(
    "Zákazníci, ktorí prijali poslednú kampaň, majú vyšší príjem, vyššie výdavky a menej detí",
    "Identifikované 3 faktory: Prémiový zákazník, Zľavový online nakupujúci, Aktívny nakupujúci",
    "Prvé komponenty zachytávajú dominantnú časť variability",
    "3 zhluky: Prémiový, Stredný online a Cenovo citlivý segment",
    "Príjem, vek, katalógové nákupy a absencia detí sú významné prediktory výdavkov"
  )
) %>%
  kable(caption = "Súhrn výsledkov analýzy") %>%
  kable_styling(bootstrap_options = c("striped", "hover")) %>%
  column_spec(1, bold = TRUE, width = "20%") %>%
  column_spec(2, width = "80%")

Súhrn výsledkov analýzy

Analýza	Kľúčové zistenie
Popisná štatistika	Zákazníci, ktorí prijali poslednú kampaň, majú vyšší príjem, vyššie výdavky a menej detí
Faktorová analýza	Identifikované 3 faktory: Prémiový zákazník, Zľavový online nakupujúci, Aktívny nakupujúci
PCA	Prvé komponenty zachytávajú dominantnú časť variability
Zhluková analýza	3 zhluky: Prémiový, Stredný online a Cenovo citlivý segment
Regresná analýza	Príjem, vek, katalógové nákupy a absencia detí sú významné prediktory výdavkov

10.2 Marketingové odporúčania

1. Primárna cieľová skupina: Zákazníci zo Zhluku 2 – vysoký príjem, vyššie výdavky, bez malých detí.
2. Sekundárna cieľová skupina: Zákazníci zo Zhluku 3 – aktívni online, citliví na digitálne kampane.
3. Vylúčiť zo silného cielenia: Zhluk 1 – cenovo citlivý segment s nízkymi výdavkami.
4. Kľúčové premenné pre personalizáciu: príjem, vek, počet detí a história katalógových nákupov.