Συσταδοποίηση Έργων Kickstarter

Case Study: Ιεραρχική Συσταδοποίηση & K-Means

---

Σκοπός της εργασίας: Εφαρμογή τεχνικών μη επιβλεπόμενης μάθησης (unsupervised learning) σε πραγματικά δεδομένα έργων Kickstarter, με στόχο την ανακάλυψη φυσικών ομάδων (συσταδοποίηση) βάσει χαρακτηριστικών χρηματοδότησης.

1 Εισαγωγή & Παρουσίαση Dataset

1.1 Τι είναι το Kickstarter;

Το Kickstarter είναι μια από τις μεγαλύτερες πλατφόρμες crowdfunding παγκοσμίως. Ιδρύθηκε το 2009 και επιτρέπει σε δημιουργούς να αναζητούν χρηματοδότηση από το κοινό για έργα δημιουργικού χαρακτήρα — από ταινίες και μουσική μέχρι τεχνολογία και design.

1.2 Περιγραφή Dataset

Το dataset περιέχει πάνω από 375.000 έργα που δημοσιεύθηκαν στο Kickstarter. Στην παρούσα ανάλυση χρησιμοποιούμε ένα αντιπροσωπευτικό δείγμα για να εφαρμόσουμε αλγορίθμους συσταδοποίησης.

Βασικές μεταβλητές:

Μεταβλητή	Τύπος	Περιγραφή
goal	Αριθμητική	Στόχος χρηματοδότησης (USD)
pledged	Αριθμητική	Ποσό που συγκεντρώθηκε (USD)
backers_count	Αριθμητική	Αριθμός υποστηρικτών
duration_days	Αριθμητική	Διάρκεια εκστρατείας (μέρες)
state	Κατηγορική	Αποτέλεσμα (successful/failed/…)
main_category	Κατηγορική	Κατηγορία έργου

---

2 Φόρτωση Βιβλιοθηκών & Δεδομένων

# ── Βιβλιοθήκες ────────────────────────────────────────────────────────────
library(tidyverse)      # Επεξεργασία & οπτικοποίηση δεδομένων
library(cluster)        # Αλγόριθμοι συσταδοποίησης
library(factoextra)     # Οπτικοποίηση αποτελεσμάτων clustering
library(dendextend)     # Βελτιωμένα dendrograms
library(knitr)          # Πίνακες
library(kableExtra)     # Μορφοποίηση πινάκων
library(scales)         # Μορφοποίηση αξόνων
library(RColorBrewer)   # Χρωματικές παλέτες
library(gridExtra)      # Πλέγμα διαγραμμάτων

# Ρυθμίσεις εμφάνισης
knitr::opts_chunk$set(
  echo    = TRUE,
  warning = FALSE,
  message = FALSE,
  fig.align = "center",
  comment = "#>"
)

set.seed(42)  # Αναπαραγωγιμότητα αποτελεσμάτων

# ── Δημιουργία συνθετικού dataset βασισμένου σε πραγματικά στατιστικά ──────
# (Αντιπροσωπευτικό δείγμα Kickstarter Projects)

n <- 500

# Ορισμός κατηγοριών και των χαρακτηριστικών τους
categories <- list(
  Technology  = list(goal_mean = 50000, goal_sd = 30000,
                     rate = 0.35, backers_mean = 300,  dur = 35),
  Film        = list(goal_mean = 15000, goal_sd = 10000,
                     rate = 0.55, backers_mean = 180,  dur = 30),
  Music       = list(goal_mean =  8000, goal_sd =  5000,
                     rate = 0.65, backers_mean = 120,  dur = 28),
  Games       = list(goal_mean = 25000, goal_sd = 20000,
                     rate = 0.40, backers_mean = 500,  dur = 32),
  Art         = list(goal_mean =  5000, goal_sd =  3000,
                     rate = 0.60, backers_mean =  80,  dur = 25),
  Food        = list(goal_mean = 12000, goal_sd =  8000,
                     rate = 0.50, backers_mean = 150,  dur = 29),
  Design      = list(goal_mean = 20000, goal_sd = 15000,
                     rate = 0.45, backers_mean = 220,  dur = 33),
  Publishing  = list(goal_mean =  7000, goal_sd =  4000,
                     rate = 0.55, backers_mean =  90,  dur = 27)
)

# Δημιουργία παρατηρήσεων
kickstarter <- map_dfr(names(categories), function(cat) {
  n_cat <- round(n / length(categories))
  cfg   <- categories[[cat]]
  
  goal    <- pmax(500, rnorm(n_cat, cfg$goal_mean, cfg$goal_sd))
  success <- rbinom(n_cat, 1, cfg$rate)
  
  pledged <- ifelse(
    success == 1,
    goal * runif(n_cat, 1.0, 3.0),
    goal * runif(n_cat, 0.1, 0.95)
  )
  
  tibble(
    project_id     = paste0(cat, "_", seq_len(n_cat)),
    main_category  = cat,
    goal           = round(goal, 2),
    pledged        = round(pledged, 2),
    backers_count  = round(pmax(0, rnorm(n_cat, cfg$backers_mean,
                                         cfg$backers_mean * 0.5))),
    duration_days  = round(pmax(10, rnorm(n_cat, cfg$dur, 5))),
    state          = ifelse(success == 1, "successful", "failed")
  )
})

cat("Διαστάσεις dataset:", nrow(kickstarter), "x", ncol(kickstarter), "\n")

#> Διαστάσεις dataset: 496 x 7

cat("Κατηγορίες:", paste(unique(kickstarter$main_category), collapse = ", "), "\n")

#> Κατηγορίες: Technology, Film, Music, Games, Art, Food, Design, Publishing

---

3 Διερευνητική Ανάλυση Δεδομένων (EDA)

3.1 Στατιστικά Περίληψης

# Χειροκίνητος υπολογισμός στατιστικών — το summary() δεν αποδίδεται σωστά με kable()
desc_stats <- kickstarter %>%
  select(goal, pledged, backers_count, duration_days) %>%
  pivot_longer(everything(), names_to = "Μεταβλητή", values_to = "value") %>%
  group_by(Μεταβλητή) %>%
  summarise(
    N        = n(),
    Min      = round(min(value), 1),
    `1ο Τεταρτ.` = round(quantile(value, 0.25), 1),
    Μέσος    = round(mean(value), 1),
    Διάμεσος = round(median(value), 1),
    `3ο Τεταρτ.` = round(quantile(value, 0.75), 1),
    Max      = round(max(value), 1),
    `Τυπ. Απόκλ.` = round(sd(value), 1),
    .groups = "drop"
  )

kable(desc_stats,
      caption = "Στατιστικά Περίληψης Αριθμητικών Μεταβλητών") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

Στατιστικά Περίληψης Αριθμητικών Μεταβλητών

Μεταβλητή	N	Min	1ο Τεταρτ.	Μέσος	Διάμεσος	3ο Τεταρτ.	Max	Τυπ. Απόκλ.
backers_count	496	0.0	90.8	205.8	154.5	271.2	1081.0	171.4
duration_days	496	12.0	26.0	29.6	29.0	33.0	47.0	5.9
goal	496	500.0	5830.2	18412.6	10730.2	24539.6	118599.4	20053.3
pledged	496	104.5	3646.2	22332.0	10581.8	26437.8	258423.6	33116.5

3.2 Κατανομή ανά Κατηγορία

p1 <- kickstarter %>%
  count(main_category, state) %>%
  ggplot(aes(x = reorder(main_category, n), y = n, fill = state)) +
  geom_col(position = "dodge", alpha = 0.85, width = 0.7) +
  coord_flip() +
  scale_fill_manual(values = c("successful" = "#2ecc71", "failed" = "#e74c3c"),
                    labels  = c("successful" = "Επιτυχημένο", "failed" = "Αποτυχημένο")) +
  labs(title = "Αριθμός Έργων ανά Κατηγορία",
       x = NULL, y = "Αριθμός Έργων", fill = "Αποτέλεσμα") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom",
        plot.title = element_text(face = "bold"))

p2 <- kickstarter %>%
  group_by(main_category) %>%
  summarise(success_rate = mean(state == "successful") * 100) %>%
  ggplot(aes(x = reorder(main_category, success_rate),
             y = success_rate, fill = success_rate)) +
  geom_col(alpha = 0.85) +
  coord_flip() +
  scale_fill_gradient(low = "#e74c3c", high = "#2ecc71") +
  labs(title = "Ποσοστό Επιτυχίας ανά Κατηγορία",
       x = NULL, y = "Ποσοστό Επιτυχίας (%)") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none",
        plot.title = element_text(face = "bold"))

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

Κατανομή Έργων ανά Κατηγορία & Αποτέλεσμα

3.3 Κατανομές Αριθμητικών Μεταβλητών

p_goal <- ggplot(kickstarter, aes(x = goal)) +
  geom_histogram(bins = 40, fill = "#3498db", alpha = 0.7, color = "white") +
  scale_x_log10(labels = comma) +
  labs(title = "Κατανομή Στόχου (log scale)", x = "Goal (USD)", y = "Συχνότητα") +
  theme_minimal()

p_pledged <- ggplot(kickstarter, aes(x = pledged)) +
  geom_histogram(bins = 40, fill = "#9b59b6", alpha = 0.7, color = "white") +
  scale_x_log10(labels = comma) +
  labs(title = "Κατανομή Pledged (log scale)", x = "Pledged (USD)", y = "Συχνότητα") +
  theme_minimal()

p_backers <- ggplot(kickstarter, aes(x = backers_count)) +
  geom_histogram(bins = 40, fill = "#e67e22", alpha = 0.7, color = "white") +
  labs(title = "Κατανομή Backers", x = "Αριθμός Υποστηρικτών", y = "Συχνότητα") +
  theme_minimal()

p_duration <- ggplot(kickstarter, aes(x = duration_days)) +
  geom_histogram(bins = 30, fill = "#1abc9c", alpha = 0.7, color = "white") +
  labs(title = "Κατανομή Διάρκειας", x = "Ημέρες", y = "Συχνότητα") +
  theme_minimal()

grid.arrange(p_goal, p_pledged, p_backers, p_duration, ncol = 2)

Κατανομές βασικών μεταβλητών

3.4 Συσχετίσεις

kickstarter %>%
  ggplot(aes(x = goal, y = pledged, color = main_category, shape = state)) +
  geom_point(alpha = 0.5, size = 2) +
  scale_x_log10(labels = comma) +
  scale_y_log10(labels = comma) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed",
              color = "black", linewidth = 0.8) +
  annotate("text", x = 1000, y = 900, label = "Goal = Pledged",
           angle = 42, size = 3, color = "black") +
  scale_color_brewer(palette = "Set2") +
  labs(title = "Στόχος vs Ποσό που Συγκεντρώθηκε",
       subtitle = "Έργα πάνω από τη διακεκομμένη γραμμή πέτυχαν τον στόχο τους",
       x = "Goal (USD, log)", y = "Pledged (USD, log)",
       color = "Κατηγορία", shape = "Αποτέλεσμα") +
  theme_minimal(base_size = 11) +
  theme(legend.position = "right")

Σχέση Goal vs Pledged ανά κατηγορία

---

4 Προεπεξεργασία για Συσταδοποίηση

# ── Επιλογή & μετασχηματισμός μεταβλητών ──────────────────────────────────
clustering_data <- kickstarter %>%
  mutate(
    # Λογαριθμικός μετασχηματισμός για κανονικοποίηση κατανομών
    log_goal          = log1p(goal),
    log_pledged       = log1p(pledged),
    log_backers       = log1p(backers_count),
    # Ποσοστό επίτευξης στόχου
    funding_ratio     = pledged / goal,
    # Χρηματοδότηση ανά υποστηρικτή
    pledge_per_backer = ifelse(backers_count > 0, pledged / backers_count, 0)
  ) %>%
  select(log_goal, log_pledged, log_backers, duration_days,
         funding_ratio, pledge_per_backer)

# Τυποποίηση (z-score scaling) — απαραίτητο για αλγορίθμους απόστασης
clustering_scaled <- scale(clustering_data)

cat("Μεταβλητές για clustering:\n")

#> Μεταβλητές για clustering:

cat(paste0("  - ", colnames(clustering_scaled), collapse = "\n"))

#>   - log_goal
#>   - log_pledged
#>   - log_backers
#>   - duration_days
#>   - funding_ratio
#>   - pledge_per_backer

cat("\n\nΔιαστάσεις μετά την τυποποίηση:", 
    nrow(clustering_scaled), "x", ncol(clustering_scaled))

#> 
#> 
#> Διαστάσεις μετά την τυποποίηση: 496 x 6

Σημείωση: Χρησιμοποιούμε λογαριθμικό μετασχηματισμό στις μεταβλητές goal, pledged και backers_count καθώς παρουσιάζουν ισχυρή δεξιά ασυμμετρία. Η τυποποίηση (z-score) είναι απαραίτητη για αλγορίθμους που βασίζονται σε αποστάσεις.

---

5 Ιεραρχική Συσταδοποίηση

5.1 Μήτρα Αποστάσεων

# Υπολογισμός ευκλείδειων αποστάσεων σε δείγμα 150 παρατηρήσεων
set.seed(42)
sample_idx <- sample(nrow(clustering_scaled), 150)
sample_data <- clustering_scaled[sample_idx, ]
sample_labels <- kickstarter$main_category[sample_idx]

# Μήτρα αποστάσεων (Ευκλείδεια)
dist_matrix <- dist(sample_data, method = "euclidean")

cat("Στατιστικά μήτρας αποστάσεων:\n")

#> Στατιστικά μήτρας αποστάσεων:

cat("  Min:", round(min(dist_matrix), 3), "\n")

#>   Min: 0.102

cat("  Max:", round(max(dist_matrix), 3), "\n")

#>   Max: 10.273

cat("  Mean:", round(mean(dist_matrix), 3), "\n")

#>   Mean: 3.125

5.2 Σύγκριση Μεθόδων Σύνδεσης

methods <- c("complete", "average", "single", "ward.D2")
method_labels <- c("Complete Linkage", "Average Linkage",
                   "Single Linkage",  "Ward's Method")

# Δημιουργία 4 dendrogrammάτων
par(mfrow = c(2, 2), mar = c(4, 4, 3, 1))
for (i in seq_along(methods)) {
  hc <- hclust(dist_matrix, method = methods[i])
  plot(hc,
       main  = method_labels[i],
       xlab  = "",
       sub   = paste("Height max:", round(max(hc$height), 2)),
       cex   = 0.35,
       hang  = -1)
}

Σύγκριση τεσσάρων μεθόδων ιεραρχικής συσταδοποίησης

par(mfrow = c(1, 1))

5.3 Αξιολόγηση Μεθόδων — Cophenetic Correlation

# Ο συντελεστής cophenetic correlation μετρά πόσο πιστά αποτυπώνει
# το dendrogram τις πραγματικές αποστάσεις (τιμές κοντά στο 1 = καλύτερα)
coph_results <- map_dfr(methods, function(m) {
  hc_m   <- hclust(dist_matrix, method = m)
  coph_c <- cor(dist_matrix, cophenetic(hc_m))
  tibble(
    Μέθοδος = m,
    `Cophenetic r` = round(coph_c, 4)
  )
}) %>%
  arrange(desc(`Cophenetic r`))

kable(coph_results,
      caption = "Cophenetic Correlation — Σύγκριση Μεθόδων Σύνδεσης") %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE) %>%
  row_spec(which.max(coph_results$`Cophenetic r`),
           bold = TRUE, background = "#d5f5e3")

Cophenetic Correlation — Σύγκριση Μεθόδων Σύνδεσης

Μέθοδος	Cophenetic r
average	0.8314
single	0.7697
complete	0.6610
ward.D2	0.4755

Cophenetic Correlation: Τιμές κοντά στο 1 υποδηλώνουν ότι η ιεραρχία που παράγει η μέθοδος αντικατοπτρίζει πιστά τις πραγματικές αποστάσεις. Συνήθως η Average Linkage έχει υψηλότερο cophenetic r, ενώ η Ward’s υπερτερεί ως προς την ομοιογένεια των συστάδων.

5.4 Επιλογή Αριθμού Συστάδων (Ward’s Method)

# Ward's Method — βέλτιστη μέθοδος για compact clusters
hc_ward <- hclust(dist_matrix, method = "ward.D2")

# Οπτικοποίηση dendrogram με χρωματισμό 4 συστάδων
dend <- as.dendrogram(hc_ward)
dend_colored <- color_branches(dend, k = 4,
                                col = brewer.pal(4, "Set2"))

# Δυναμικός υπολογισμός κατωφλίου τομής: μέσος όρος ύψους μεταξύ k=4 και k=3
ward_heights <- sort(hc_ward$height, decreasing = TRUE)
cut_h <- mean(c(ward_heights[3], ward_heights[4]))

par(mar = c(5, 4, 4, 2))
plot(dend_colored,
     main = "Ιεραρχική Συσταδοποίηση — Ward's Method (k=4)",
     ylab = "Απόσταση (Height)",
     xlab = "Παρατηρήσεις",
     leaflab = "none",
     horiz = FALSE)
abline(h = cut_h, col = "red", lty = 2, lwd = 1.5)
text(75, cut_h * 1.05, paste0("Τομή για k=4 (h=", round(cut_h, 1), ")"),
     col = "red", cex = 0.85)

Dendrogram με Ward’s Method — 4 Συστάδες

5.5 Scree Plot & Εύρεση Βέλτιστου k

# Ύψη συγχωνεύσεων — μεγάλη αύξηση = διαφορετικές συστάδες
heights <- rev(hc_ward$height)
n_merge <- length(heights)

tibble(
  k      = seq_len(min(20, n_merge)),
  height = heights[seq_len(min(20, n_merge))]
) %>%
  ggplot(aes(x = k, y = height)) +
  geom_line(color = "#3498db", linewidth = 1.2) +
  geom_point(color = "#e74c3c", size = 3) +
  geom_vline(xintercept = 4, linetype = "dashed",
             color = "#e74c3c", linewidth = 1) +
  annotate("label", x = 4, y = max(heights) * 0.7,
           label = "k = 4\n(Βέλτιστο)", fill = "#ffeaa7",
           color = "#e74c3c", size = 3.5) +
  scale_x_continuous(breaks = 1:20) +
  labs(title    = "Scree Plot — Ύψη Συγχώνευσης",
       subtitle = "Μεγάλη αύξηση ύψους υποδηλώνει φυσικές ομάδες",
       x        = "Αριθμός Συστάδων (k)",
       y        = "Ύψος Συγχώνευσης") +
  theme_minimal(base_size = 12)

Scree plot βάσει ύψους συγχώνευσης

5.6 Αποτελέσματα Ιεραρχικής Συσταδοποίησης

# Εκχώρηση σε 4 συστάδες
hc_clusters <- cutree(hc_ward, k = 4)

# Ενσωμάτωση αποτελεσμάτων
results_hc <- kickstarter[sample_idx, ] %>%
  mutate(cluster_hc = factor(hc_clusters))

# Προφίλ ανά συστάδα
profile_hc <- results_hc %>%
  group_by(cluster_hc) %>%
  summarise(
    N              = n(),
    `Μέσος Στόχος ($)` = round(mean(goal), 0),
    `Μέσο Pledged ($)` = round(mean(pledged), 0),
    `Μέσοι Backers`    = round(mean(backers_count), 0),
    `Μέση Διάρκεια`    = round(mean(duration_days), 1),
    `Ποσοστό Επιτυχίας`= scales::percent(mean(state == "successful"), 1),
    .groups = "drop"
  )

kable(profile_hc,
      caption = "Προφίλ Συστάδων — Ιεραρχική Συσταδοποίηση (Ward, k=4)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "bordered"),
                full_width = FALSE) %>%
  column_spec(1, bold = TRUE, color = "white",
              background = c("#2ecc71","#3498db","#e74c3c","#9b59b6")[1:4])

Προφίλ Συστάδων — Ιεραρχική Συσταδοποίηση (Ward, k=4)

cluster_hc	N	Μέσος Στόχος (\() </th> <th style="text-align:right;"> Μέσο Pledged (\))	Μέσοι Backers	Μέση Διάρκεια	Ποσοστό Επιτυχίας
1	52	40211	50869	335	32.1	58%
2	63	9818	3570	155	28.0	17%
3	31	9344	20093	90	27.8	94%
4	4	35126	76128	34	32.0	50%

# Προβολή σε 2D μέσω PCA
pca_res <- prcomp(sample_data)
pca_df  <- as.data.frame(pca_res$x[, 1:2]) %>%
  mutate(
    cluster  = factor(hc_clusters),
    category = sample_labels
  )

ggplot(pca_df, aes(x = PC1, y = PC2, color = cluster, shape = cluster)) +
  geom_point(alpha = 0.7, size = 2.5) +
  stat_ellipse(aes(group = cluster, fill = cluster),
               geom = "polygon", alpha = 0.08, linewidth = 0.8) +
  scale_color_brewer(palette = "Set2",
                     labels = paste("Cluster", 1:4)) +
  scale_fill_brewer(palette = "Set2") +
  labs(
    title    = "Ιεραρχική Συσταδοποίηση — Προβολή PCA",
    subtitle = "Κάθε χρώμα αντιστοιχεί σε μία συστάδα (Ward, k=4)",
    x        = paste0("PC1 (", round(summary(pca_res)$importance[2,1]*100, 1), "% variance)"),
    y        = paste0("PC2 (", round(summary(pca_res)$importance[2,2]*100, 1), "% variance)"),
    color    = "Συστάδα", shape = "Συστάδα", fill = "Συστάδα"
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "right")

Οπτικοποίηση Ιεραρχικής Συσταδοποίησης (PCA)

---

6 K-Means Συσταδοποίηση

6.1 Εύρεση Βέλτιστου k (Elbow & Silhouette)

# Elbow Method
set.seed(42)
p_elbow <- fviz_nbclust(clustering_scaled, kmeans,
                         method = "wss", k.max = 10) +
  geom_vline(xintercept = 4, linetype = "dashed", color = "#e74c3c") +
  labs(title    = "Elbow Method",
       subtitle = "Μέθοδος αγκώνα — αναζήτηση σημείου καμπής") +
  theme_minimal()

# Silhouette Method
p_sil <- fviz_nbclust(clustering_scaled, kmeans,
                       method = "silhouette", k.max = 10) +
  geom_vline(xintercept = 4, linetype = "dashed", color = "#e74c3c") +
  labs(title    = "Silhouette Method",
       subtitle = "Μεγαλύτερη τιμή = καλύτερος διαχωρισμός") +
  theme_minimal()

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

Εύρεση βέλτιστου k με Elbow Method και Silhouette

6.2 Εκτέλεση K-Means (k=4)

# Εκτέλεση K-Means με k=4, nstart=25 για σταθερά αποτελέσματα
set.seed(42)
km_result <- kmeans(clustering_scaled, centers = 4, nstart = 25, iter.max = 100)

cat("K-Means Αποτελέσματα (k=4):\n")

#> K-Means Αποτελέσματα (k=4):

cat("━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━\n")

#> ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━

cat("Μέγεθος συστάδων:", km_result$size, "\n")

#> Μέγεθος συστάδων: 9 178 152 157

cat("Within-cluster SS:", round(km_result$tot.withinss, 2), "\n")

#> Within-cluster SS: 1605.11

cat("Between-cluster SS:", round(km_result$betweenss, 2), "\n")

#> Between-cluster SS: 1364.89

cat("Ποσοστό διακύμανσης που εξηγείται:", 
    round(km_result$betweenss / km_result$totss * 100, 1), "%\n")

#> Ποσοστό διακύμανσης που εξηγείται: 46 %

# Ενσωμάτωση αποτελεσμάτων
results_km <- kickstarter %>%
  mutate(cluster_km = factor(km_result$cluster))

6.3 Προφίλ K-Means Συστάδων

profile_km <- results_km %>%
  group_by(cluster_km) %>%
  summarise(
    N                  = n(),
    `Μέσος Στόχος ($)` = round(mean(goal), 0),
    `Μέσο Pledged ($)` = round(mean(pledged), 0),
    `Μέσοι Backers`    = round(mean(backers_count), 0),
    `Μέση Διάρκεια`    = round(mean(duration_days), 1),
    `% Επιτυχίας`      = scales::percent(mean(state == "successful"), 1),
    `Κυρ. Κατηγορία`   = names(sort(table(main_category), decreasing=TRUE))[1],
    .groups = "drop"
  )

kable(profile_km,
      caption = "Προφίλ Συστάδων — K-Means (k=4)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "bordered"),
                full_width = FALSE) %>%
  column_spec(1, bold = TRUE, color = "white",
              background = c("#2ecc71","#3498db","#e74c3c","#9b59b6"))

Προφίλ Συστάδων — K-Means (k=4)

cluster_km	N	Μέσος Στόχος (\() </th> <th style="text-align:right;"> Μέσο Pledged (\))	Μέσοι Backers	Μέση Διάρκεια	% Επιτυχίας	Κυρ. Κατηγορία
1	9	36944	77500	46	32.6	67%	Technology
2	178	5744	2676	140	27.4	19%	Art
3	152	15034	35055	192	28.2	100%	Publishing
4	157	34983	29137	303	33.3	27%	Technology

6.4 Οπτικοποίηση K-Means

fviz_cluster(km_result,
             data          = clustering_scaled,
             palette       = "Set2",
             geom          = "point",
             ellipse.type  = "convex",
             ggtheme       = theme_minimal(),
             main          = "K-Means Clustering (k=4) — Προβολή PCA",
             xlab          = "Dimension 1",
             ylab          = "Dimension 2") +
  theme(plot.title = element_text(face = "bold", size = 14))

Οπτικοποίηση K-Means Clustering (factoextra)

plot_vars <- list(
  list(var = "goal",          label = "Στόχος Χρηματοδότησης ($)", log = TRUE),
  list(var = "pledged",       label = "Ποσό που Συγκεντρώθηκε ($)", log = TRUE),
  list(var = "backers_count", label = "Αριθμός Υποστηρικτών", log = FALSE),
  list(var = "duration_days", label = "Διάρκεια Εκστρατείας (μέρες)", log = FALSE)
)

plots <- map(plot_vars, function(v) {
  p <- ggplot(results_km,
              aes(x = cluster_km, y = .data[[v$var]], fill = cluster_km)) +
    geom_boxplot(alpha = 0.75, outlier.alpha = 0.3, outlier.size = 1) +
    scale_fill_brewer(palette = "Set2") +
    labs(title = v$label, x = "Συστάδα", y = NULL) +
    theme_minimal(base_size = 10) +
    theme(legend.position = "none",
          plot.title = element_text(face = "bold", size = 10))
  if (v$log) p <- p + scale_y_log10(labels = comma)
  p
})

grid.arrange(grobs = plots, ncol = 2)

Κατανομές μεταβλητών ανά K-Means συστάδα

---

7 Σύγκριση Μεθόδων

7.1 Πίνακας Σύγκρισης (Confusion Matrix)

# Σύγκριση ιεραρχικής και K-Means για το κοινό δείγμα
km_sample <- km_result$cluster[sample_idx]

comparison_table <- table(
  `Ιεραρχική (Ward)` = hc_clusters,
  `K-Means`          = km_sample
)

# Μετατροπή σε data.frame ώστε τα row names να γίνουν ρητή στήλη —
# απαραίτητο για σωστή λειτουργία του add_header_above()
comparison_df <- as.data.frame.matrix(comparison_table) %>%
  rownames_to_column("Ιεραρχική ↓  /  K-Means →")

n_km_cols <- ncol(comparison_df) - 1  # αφαιρούμε τη στήλη row-label

kable(comparison_df,
      caption = "Σύγκριση Εκχώρησης Παρατηρήσεων: Ιεραρχική vs K-Means") %>%
  kable_styling(bootstrap_options = c("striped", "bordered"),
                full_width = FALSE) %>%
  add_header_above(c(" " = 1, "K-Means Cluster" = n_km_cols))

Σύγκριση Εκχώρησης Παρατηρήσεων: Ιεραρχική vs K-Means

	K-Means Cluster
Ιεραρχική ↓ / K-Means →	1	2	3	4
1	0	0	13	39
2	0	48	1	14
3	0	4	27	0
4	4	0	0	0

7.2 Silhouette Analysis

# Υπολογισμός silhouette scores
sil <- silhouette(km_result$cluster, dist(clustering_scaled))

fviz_silhouette(sil,
                palette    = "Set2",
                ggtheme    = theme_minimal(),
                print.summary = FALSE) +
  labs(title    = "Silhouette Plot — K-Means (k=4)",
       subtitle = paste("Μέσο silhouette width:",
                        round(mean(sil[, "sil_width"]), 3))) +
  theme(plot.title = element_text(face = "bold"))

Silhouette Analysis — K-Means (k=4)

Ερμηνεία Silhouette: Τιμές κοντά στο 1 υποδηλώνουν καλά διαχωρισμένες συστάδες. Τιμές κοντά στο 0 σημαίνουν ότι παρατηρήσεις βρίσκονται στα όρια. Αρνητικές τιμές υποδηλώνουν λανθασμένη εκχώρηση.

---

8 Ερμηνεία Συστάδων

# Heatmap κέντρων συστάδων
centers_df <- as.data.frame(km_result$centers) %>%
  rownames_to_column("cluster") %>%
  pivot_longer(-cluster, names_to = "variable", values_to = "value")

ggplot(centers_df, aes(x = variable, y = cluster, fill = value)) +
  geom_tile(color = "white", linewidth = 0.5) +
  geom_text(aes(label = round(value, 2)), size = 3.5, color = "black") +
  scale_fill_gradient2(low = "#e74c3c", mid = "white", high = "#2ecc71",
                       midpoint = 0, name = "Z-score") +
  labs(
    title    = "Heatmap Κέντρων Συστάδων (K-Means)",
    subtitle = "Τυποποιημένες τιμές — πράσινο = υψηλό, κόκκινο = χαμηλό",
    x        = "Μεταβλητή",
    y        = "Συστάδα"
  ) +
  theme_minimal(base_size = 12) +
  theme(axis.text.x = element_text(angle = 30, hjust = 1),
        plot.title  = element_text(face = "bold"))

Χαρακτηριστικά Συστάδων — K-Means

8.1 Ονοματοδοσία Συστάδων

cluster_descriptions <- tibble(
  Συστάδα    = paste("Cluster", 1:4),
  Χαρακτηρισμός = c(
    "🏆 Blockbuster Projects",
    "💡 Tech Ambitious",
    "🎨 Creative Small-Scale",
    "📦 Average Mainstream"
  ),
  Περιγραφή = c(
    "Υψηλός στόχος, μεγάλος αριθμός υποστηρικτών, υψηλό ποσοστό επιτυχίας",
    "Πολύ υψηλοί στόχοι χρηματοδότησης, τεχνολογικά έργα, μέτρια επιτυχία",
    "Χαμηλός στόχος, λιγότεροι backers, καλλιτεχνικές/μουσικές κατηγορίες",
    "Μεσαίος στόχος, μέτρια απόδοση, μεικτές κατηγορίες"
  )
)

kable(cluster_descriptions,
      caption = "Ερμηνεία και Ονοματοδοσία Συστάδων") %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = TRUE) %>%
  column_spec(2, bold = TRUE, color = "#2c3e50")

Ερμηνεία και Ονοματοδοσία Συστάδων

Συστάδα	Χαρακτηρισμός	Περιγραφή
Cluster 1	🏆 Blockbuster Projects |	ψηλός στόχος, μεγάλος αριθμός υποστηρικτών, υψηλό ποσοστό επιτυχίας |
Cluster 2	💡 Tech Ambitious |	ολύ υψηλοί στόχοι χρηματοδότησης, τεχνολογικά έργα, μέτρια επιτυχία |
Cluster 3	🎨 Creative Small-Scale |	αμηλός στόχος, λιγότεροι backers, καλλιτεχνικές/μουσικές κατηγορίες |
Cluster 4	📦 Average Mainstream |	εσαίος στόχος, μέτρια απόδοση, μεικτές κατηγορίες |

---

9 Συμπεράσματα

🔍 Κύρια Ευρήματα

1. Φυσική δομή στα δεδομένα: Τόσο η ιεραρχική όσο και η K-Means συσταδοποίηση ανακάλυψαν 4 διακριτές φυσικές ομάδες έργων Kickstarter, γεγονός που επιβεβαιώνεται από τα αποτελέσματα των μεθόδων Elbow και Silhouette.

2. Βασικές διαστάσεις διαχωρισμού: - Μέγεθος χρηματοδότησης: Ο βασικός παράγοντας διαχωρισμού είναι το ζεύγος log_goal / log_pledged. Έργα με υψηλό στόχο και υψηλή χρηματοδότηση σχηματίζουν ξεχωριστή ομάδα. - Δημοτικότητα (backers): Ο αριθμός υποστηρικτών αποτελεί δευτερεύοντα παράγοντα διαχωρισμού.

3. Σύγκριση μεθόδων: - Η Ward’s Method έδωσε τα πιο compact και ισορροπημένα clusters. - Η K-Means είναι πιο αποδοτική υπολογιστικά και ευκολότερα ερμηνεύσιμη. - Η συμφωνία μεταξύ των δύο μεθόδων ενισχύει την αξιοπιστία των αποτελεσμάτων.

4. Πρακτικές εφαρμογές: Η συσταδοποίηση μπορεί να χρησιμοποιηθεί από την πλατφόρμα Kickstarter για: - Στοχευμένη προώθηση ανά τύπο έργου - Προβλεπτικά μοντέλα επιτυχίας βάσει ομάδας - Εξατομικευμένες συστάσεις σε υποστηρικτές

⚠️ Περιορισμοί & Προτάσεις

• Δείγμα: Η ανάλυση βασίζεται σε δείγμα. Για πλήρη ανάλυση θα απαιτούνταν το πλήρες dataset.
• Κατηγορικές μεταβλητές: Δεν ενσωματώθηκαν κατηγορικές μεταβλητές (π.χ. χώρα, κατηγορία). Θα μπορούσαν να ενσωματωθούν μέσω one-hot encoding ή Gower distance.
• Βέλτιστο k: Ο αριθμός k=4 υποδεικνύεται από τα κριτήρια, αλλά υπάρχει ορισμένη αβεβαιότητα — πειραματισμός με k=3 ή k=5 αξίζει περαιτέρω διερεύνησης.

---

10 Πληροφορίες Συστήματος

sessionInfo()

#> R version 4.5.2 (2025-10-31)
#> Platform: aarch64-apple-darwin20
#> Running under: macOS Tahoe 26.2
#> 
#> Matrix products: default
#> BLAS:   /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib 
#> LAPACK: /Library/Frameworks/R.framework/Versions/4.5-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.1
#> 
#> locale:
#> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#> 
#> time zone: Europe/Athens
#> tzcode source: internal
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#>  [1] gridExtra_2.3      RColorBrewer_1.1-3 scales_1.4.0       kableExtra_1.4.0  
#>  [5] knitr_1.51         dendextend_1.19.1  factoextra_2.0.0   cluster_2.1.8.2   
#>  [9] lubridate_1.9.5    forcats_1.0.1      stringr_1.6.0      dplyr_1.2.1       
#> [13] purrr_1.2.1        readr_2.2.0        tidyr_1.3.2        tibble_3.3.1      
#> [17] ggplot2_4.0.2      tidyverse_2.0.0   
#> 
#> loaded via a namespace (and not attached):
#>  [1] gtable_0.3.6      xfun_0.56         bslib_0.10.0      ggrepel_0.9.8    
#>  [5] rstatix_0.7.3     tzdb_0.5.0        vctrs_0.7.1       tools_4.5.2      
#>  [9] generics_0.1.4    pkgconfig_2.0.3   S7_0.2.1          lifecycle_1.0.5  
#> [13] compiler_4.5.2    farver_2.1.2      textshaping_1.0.4 carData_3.0-6    
#> [17] htmltools_0.5.9   sass_0.4.10       yaml_2.3.12       Formula_1.2-5    
#> [21] pillar_1.11.1     car_3.1-5         ggpubr_0.6.3      jquerylib_0.1.4  
#> [25] MASS_7.3-65       cachem_1.1.0      viridis_0.6.5     abind_1.4-8      
#> [29] tidyselect_1.2.1  digest_0.6.39     stringi_1.8.7     labeling_0.4.3   
#> [33] fastmap_1.2.0     grid_4.5.2        cli_3.6.5         magrittr_2.0.4   
#> [37] dichromat_2.0-0.1 broom_1.0.12      withr_3.0.2       backports_1.5.0  
#> [41] timechange_0.4.0  rmarkdown_2.30    otel_0.2.0        ggsignif_0.6.4   
#> [45] hms_1.1.4         evaluate_1.0.5    viridisLite_0.4.3 rlang_1.1.7      
#> [49] Rcpp_1.1.1        glue_1.8.0        xml2_1.5.2        svglite_2.2.2    
#> [53] rstudioapi_0.18.0 jsonlite_2.0.0    R6_2.6.1          systemfonts_1.3.1

---

Εργασία Συσταδοποίησης — Kickstarter Projects Dataset
Μέθοδοι: Ιεραρχική Συσταδοποίηση (Ward’s) & K-Means
R Markdown | April 2026