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

1.1 Περιγραφή του Dataset

Στην παρούσα εργασία χρησιμοποιείται το Kickstarter Projects dataset, το οποίο περιέχει δεδομένα από καμπάνιες crowdfunding που δημοσιεύτηκαν στην πλατφόρμα Kickstarter έως τον Ιανουάριο του 2018.

Το ερευνητικό ερώτημα είναι: «Μπορούμε να προβλέψουμε αν μια καμπάνια Kickstarter θα πετύχει τον χρηματοδοτικό της στόχο;»

Πηγή: Kaggle – Kickstarter Projects
Αρχείο: ks-projects-201801.csv

Οδηγίες φόρτωσης: Κατεβάστε το αρχείο ks-projects-201801.csv από το Kaggle και τοποθετήστε το στον ίδιο φάκελο με το παρόν .Rmd αρχείο.

1.2 Μεταβλητές Dataset

Μεταβλητή	Τύπος	Περιγραφή
state	Binary (0/1)	Αποτέλεσμα καμπάνιας — εξαρτημένη μεταβλητή
main_category	Κατηγορική	Κύρια κατηγορία project (Film, Music, Games κ.λπ.)
usd_goal_real	Αριθμητική	Στόχος χρηματοδότησης σε USD
country	Κατηγορική	Χώρα προέλευσης του δημιουργού
duration_days	Αριθμητική	Διάρκεια καμπάνιας σε ημέρες (υπολογιζόμενη)
launch_month	Κατηγορική	Μήνας έναρξης καμπάνιας (εποχικότητα)
launch_year	Κατηγορική	Έτος έναρξης καμπάνιας

Σημείωση για την εξαρτημένη μεταβλητή: Το αρχικό πεδίο state περιέχει πολλές κατηγορίες (successful, failed, canceled, live, suspended). Διατηρούμε μόνο τις successful (= 1) και failed (= 0), αφαιρώντας τις υπόλοιπες.

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

pkgs <- c("caTools", "ROCR", "dplyr", "ggplot2", "scales", "knitr", "lubridate")
for (p in pkgs) {
  if (!require(p, character.only = TRUE, quietly = TRUE)) {
    # Προσθέτουμε το repos="[https://cloud.r-project.org](https://cloud.r-project.org)"
    install.packages(p, repos = "[https://cloud.r-project.org](https://cloud.r-project.org)", quiet = TRUE)
    library(p, character.only = TRUE)
  }
}

# Διαβάστε το CSV από τον τρέχοντα φάκελο
# Αν το αρχείο βρίσκεται σε άλλο μονοπάτι, αλλάξτε το path εδώ:
df_raw <- read.csv("/Users/omirosloupis/Desktop/BUSINESS ANALYTICS/ergasies/ks-projects-201801.csv",
                   stringsAsFactors = FALSE,
                   encoding        = "UTF-8")

cat("Αρχικές διαστάσεις dataset:", nrow(df_raw), "x", ncol(df_raw), "\n")

## Αρχικές διαστάσεις dataset: 378661 x 15

cat("Μεταβλητές:", paste(names(df_raw), collapse = ", "), "\n")

## Μεταβλητές: ID, name, category, main_category, currency, deadline, goal, launched, pledged, state, backers, country, usd.pledged, usd_pledged_real, usd_goal_real

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

# Κατανομή όλων των κατηγοριών state πριν τον φιλτραρισμό
state_counts <- as.data.frame(table(df_raw$state))
names(state_counts) <- c("State", "Count")
state_counts$Pct <- round(state_counts$Count / sum(state_counts$Count) * 100, 1)

kable(state_counts,
      caption   = "Κατανομή Κατηγοριών State (αρχικό dataset)",
      row.names = FALSE,
      align     = "lrr")

Κατανομή Κατηγοριών State (αρχικό dataset)
State	Count	Pct
canceled	38779	10.2
failed	197719	52.2
live	2799	0.7
successful	133956	35.4
suspended	1846	0.5
undefined	3562	0.9

# Top κατηγορίες
top_cats <- df_raw %>%
  filter(state %in% c("successful", "failed")) %>%
  count(main_category, state) %>%
  group_by(main_category) %>%
  mutate(total = sum(n)) %>%
  ungroup() %>%
  mutate(main_category = reorder(main_category, total))

ggplot(top_cats, aes(x = main_category, y = n, fill = state)) +
  geom_bar(stat = "identity", position = "stack", alpha = 0.85) +
  scale_fill_manual(values = c("failed" = "#e74c3c", "successful" = "#2ecc71"),
                    labels  = c("Αποτυχία", "Επιτυχία")) +
  coord_flip() +
  labs(title = "Αριθμός Καμπανιών ανά Κατηγορία & Αποτέλεσμα",
       x     = "Κατηγορία",
       y     = "Αριθμός Καμπανιών",
       fill  = "Αποτέλεσμα") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold"))

# Ποσοστό επιτυχίας ανά κατηγορία
success_rate <- df_raw %>%
  filter(state %in% c("successful", "failed")) %>%
  group_by(main_category) %>%
  summarise(
    Total      = n(),
    Successful = sum(state == "successful"),
    Rate_pct   = round(Successful / Total * 100, 1)
  ) %>%
  arrange(desc(Rate_pct))

kable(success_rate,
      caption   = "Ποσοστό Επιτυχίας ανά Κύρια Κατηγορία",
      row.names = FALSE,
      align     = "lrrr")

Ποσοστό Επιτυχίας ανά Κύρια Κατηγορία
main_category	Total	Successful	Rate_pct
Dance	3573	2338	65.4
Theater	10242	6534	63.8
Comics	9878	5842	59.1
Music	45949	24197	52.7
Art	25641	11510	44.9
Games	28521	12518	43.9
Film & Video	56527	23623	41.8
Design	25364	10550	41.6
Publishing	35445	12300	34.7
Photography	9689	3305	34.1
Fashion	19775	5593	28.3
Food	22054	6085	27.6
Crafts	7818	2115	27.1
Journalism	4149	1012	24.4
Technology	27050	6434	23.8

4 Προεπεξεργασία Δεδομένων

df_model <- df_raw %>%
  # 1. Κρατάμε μόνο successful & failed
  filter(state %in% c("successful", "failed")) %>%
  # 2. Μετατροπή ημερομηνιών
  mutate(
    launched = ymd_hms(launched),
    deadline = ymd(deadline)
  ) %>%
  # 3. Υπολογισμός διάρκειας καμπάνιας (ημέρες)
  mutate(
    duration_days = as.integer(difftime(deadline, launched, units = "days")),
    launch_month  = as.factor(month(launched)),
    launch_year   = as.factor(year(launched))
  ) %>%
  # 4. Δυαδική εξαρτημένη μεταβλητή — integer για συμβατότητα με ROCR
  mutate(
    state_binary = as.integer(state == "successful")
  ) %>%
  # 5. Επιλογή τελικών μεταβλητών
  select(state_binary, main_category, usd_goal_real,
         country, duration_days, launch_month, launch_year) %>%
  # 6. Κατηγορικές μεταβλητές ως factor
  mutate(
    main_category = as.factor(main_category),
    country       = as.factor(country)
  ) %>%
  # 7. Αφαίρεση εξωφρενικών τιμών στόχου (< $1 ή > $10M)
  filter(usd_goal_real >= 1, usd_goal_real <= 10000000) %>%
  # 8. Αφαίρεση αδύνατης διάρκειας
  filter(duration_days > 0, duration_days <= 92)

cat("Διαστάσεις μετά επεξεργασία:", nrow(df_model), "x", ncol(df_model), "\n")

## Διαστάσεις μετά επεξεργασία: 331446 x 7

cat("Κατανομή εξαρτημένης (0=Failed, 1=Successful):\n")

## Κατανομή εξαρτημένης (0=Failed, 1=Successful):

print(table(df_model$state_binary))

## 
##      0      1 
## 197548 133898

cat("Ποσοστό επιτυχίας:", round(mean(df_model$state_binary) * 100, 1), "%\n")

## Ποσοστό επιτυχίας: 40.4 %

cat("Σύνολο NA         :", sum(is.na(df_model)), "\n")

## Σύνολο NA         : 0

# Κατανομή στόχου χρηματοδότησης (log scale)
ggplot(df_model, aes(x = usd_goal_real, fill = factor(state_binary))) +
  geom_histogram(bins = 60, alpha = 0.7, position = "identity") +
  scale_x_log10(labels = scales::dollar_format()) +
  scale_fill_manual(values = c("0" = "#e74c3c", "1" = "#2ecc71"),
                    labels  = c("Αποτυχία", "Επιτυχία")) +
  labs(title = "Κατανομή Στόχου Χρηματοδότησης (log scale)",
       x     = "Στόχος USD (log)",
       y     = "Πλήθος Καμπανιών",
       fill  = "Αποτέλεσμα") +
  theme_minimal(base_size = 12) +
  theme(plot.title = element_text(face = "bold"))

# Διάρκεια καμπάνιας ανά αποτέλεσμα
ggplot(df_model, aes(x = factor(state_binary), y = duration_days,
                     fill = factor(state_binary))) +
  geom_boxplot(alpha = 0.8, outlier.alpha = 0.2) +
  scale_fill_manual(values = c("0" = "#e74c3c", "1" = "#2ecc71")) +
  scale_x_discrete(labels = c("0" = "Αποτυχία", "1" = "Επιτυχία")) +
  labs(title = "Διάρκεια Καμπάνιας ανά Αποτέλεσμα",
       x     = "Αποτέλεσμα",
       y     = "Διάρκεια (ημέρες)") +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none",
        plot.title = element_text(face = "bold"))

5 Διαχωρισμός σε Training & Testing Sets

Seed: Ορίζεται ως 942 — τα 2 τελευταία ψηφία (42) αντιστοιχούν στα 2 τελευταία ψηφία του ιδρυματικού email. Το training set αποτελεί το 65% της βάσης.

set.seed(942)

split_idx <- sample.split(df_model$state_binary, SplitRatio = 0.65)

train <- subset(df_model, split_idx == TRUE)
test  <- subset(df_model, split_idx == FALSE)

cat("╔═══════════════════════════════════════════╗\n")

## ╔═══════════════════════════════════════════╗

cat("║        ΑΡΙΘΜΟΣ ΚΑΤΑΧΩΡΗΣΕΩΝ              ║\n")

## ║        ΑΡΙΘΜΟΣ ΚΑΤΑΧΩΡΗΣΕΩΝ              ║

cat("╠═══════════════════════════════════════════╣\n")

## ╠═══════════════════════════════════════════╣

cat(sprintf("║  Training set (train) : %6d καταχωρήσεις ║\n", nrow(train)))

## ║  Training set (train) : 215440 καταχωρήσεις ║

cat(sprintf("║  Testing  set (test)  : %6d καταχωρήσεις ║\n", nrow(test)))

## ║  Testing  set (test)  : 116006 καταχωρήσεις ║

cat(sprintf("║  Συνολο               : %6d καταχωρήσεις ║\n", nrow(train) + nrow(test)))

## ║  Συνολο               : 331446 καταχωρήσεις ║

cat(sprintf("║  Ποσοστο train        :  %.1f%%              ║\n",
            nrow(train) / (nrow(train) + nrow(test)) * 100))

## ║  Ποσοστο train        :  65.0%              ║

cat("╚═══════════════════════════════════════════╝\n")

## ╚═══════════════════════════════════════════╝

6 Μοντέλο Λογιστικής Παλινδρόμησης

6.1 Εκπαίδευση Μοντέλου (Όλες οι Ανεξάρτητες Μεταβλητές)

model <- glm(state_binary ~ .,
             data   = train,
             family = binomial(link = "logit"))

summary(model)

## 
## Call:
## glm(formula = state_binary ~ ., family = binomial(link = "logit"), 
##     data = train)
## 
## Coefficients:
##                             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                4.949e-01  1.642e-01   3.014 0.002577 ** 
## main_categoryComics        5.935e-01  3.039e-02  19.528  < 2e-16 ***
## main_categoryCrafts       -7.491e-01  3.588e-02 -20.874  < 2e-16 ***
## main_categoryDance         8.648e-01  4.728e-02  18.290  < 2e-16 ***
## main_categoryDesign        1.143e-01  2.309e-02   4.953 7.31e-07 ***
## main_categoryFashion      -6.391e-01  2.560e-02 -24.960  < 2e-16 ***
## main_categoryFilm & Video -2.177e-02  1.948e-02  -1.117 0.263813    
## main_categoryFood         -5.257e-01  2.510e-02 -20.949  < 2e-16 ***
## main_categoryGames         1.227e-01  2.226e-02   5.511 3.56e-08 ***
## main_categoryJournalism   -7.540e-01  4.826e-02 -15.625  < 2e-16 ***
## main_categoryMusic         3.144e-01  1.993e-02  15.773  < 2e-16 ***
## main_categoryPhotography  -4.326e-01  3.157e-02 -13.701  < 2e-16 ***
## main_categoryPublishing   -3.976e-01  2.128e-02 -18.682  < 2e-16 ***
## main_categoryTechnology   -5.079e-01  2.477e-02 -20.509  < 2e-16 ***
## main_categoryTheater       7.615e-01  3.071e-02  24.797  < 2e-16 ***
## usd_goal_real             -1.384e-05  2.570e-07 -53.857  < 2e-16 ***
## countryAU                  4.661e-01  1.459e-01   3.195 0.001398 ** 
## countryBE                  2.874e-01  1.923e-01   1.495 0.134971    
## countryCA                  4.899e-01  1.439e-01   3.404 0.000665 ***
## countryCH                  4.528e-01  1.810e-01   2.502 0.012351 *  
## countryDE                  2.865e-01  1.503e-01   1.907 0.056534 .  
## countryDK                  7.123e-01  1.679e-01   4.243 2.21e-05 ***
## countryES                  1.588e-01  1.574e-01   1.009 0.312964    
## countryFR                  7.241e-01  1.516e-01   4.776 1.79e-06 ***
## countryGB                  7.359e-01  1.426e-01   5.159 2.48e-07 ***
## countryHK                  1.059e+00  1.827e-01   5.799 6.68e-09 ***
## countryIE                  3.438e-01  1.787e-01   1.924 0.054346 .  
## countryIT                 -1.738e-01  1.572e-01  -1.106 0.268938    
## countryJP                  8.357e-01  5.484e-01   1.524 0.127540    
## countryLU                  7.136e-01  3.719e-01   1.919 0.055025 .  
## countryMX                 -8.167e-02  1.611e-01  -0.507 0.612213    
## countryN,0"                6.984e-01  2.262e-01   3.087 0.002020 ** 
## countryNL                  3.472e-01  1.538e-01   2.257 0.023994 *  
## countryNO                  3.031e-01  1.834e-01   1.652 0.098438 .  
## countryNZ                  5.767e-01  1.603e-01   3.597 0.000322 ***
## countrySE                  5.821e-01  1.582e-01   3.679 0.000234 ***
## countrySG                  6.643e-01  1.916e-01   3.467 0.000526 ***
## countryUS                  7.329e-01  1.420e-01   5.162 2.44e-07 ***
## duration_days             -2.032e-02  3.990e-04 -50.914  < 2e-16 ***
## launch_month2              1.505e-01  2.360e-02   6.376 1.82e-10 ***
## launch_month3              1.679e-01  2.287e-02   7.341 2.12e-13 ***
## launch_month4              1.256e-01  2.322e-02   5.412 6.24e-08 ***
## launch_month5              7.771e-02  2.309e-02   3.366 0.000762 ***
## launch_month6              4.962e-02  2.314e-02   2.144 0.032029 *  
## launch_month7             -9.879e-02  2.292e-02  -4.310 1.63e-05 ***
## launch_month8             -3.634e-02  2.341e-02  -1.552 0.120643    
## launch_month9              8.926e-02  2.355e-02   3.791 0.000150 ***
## launch_month10             1.616e-01  2.305e-02   7.010 2.38e-12 ***
## launch_month11             1.138e-01  2.328e-02   4.889 1.01e-06 ***
## launch_month12            -6.998e-02  2.642e-02  -2.649 0.008081 ** 
## launch_year2010           -4.048e-01  7.986e-02  -5.069 4.00e-07 ***
## launch_year2011           -4.035e-01  7.745e-02  -5.209 1.90e-07 ***
## launch_year2012           -6.174e-01  7.718e-02  -7.999 1.25e-15 ***
## launch_year2013           -5.218e-01  7.723e-02  -6.756 1.41e-11 ***
## launch_year2014           -8.981e-01  7.702e-02 -11.660  < 2e-16 ***
## launch_year2015           -9.981e-01  7.706e-02 -12.951  < 2e-16 ***
## launch_year2016           -7.360e-01  7.729e-02  -9.523  < 2e-16 ***
## launch_year2017           -5.931e-01  7.751e-02  -7.652 1.99e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 290669  on 215439  degrees of freedom
## Residual deviance: 268013  on 215382  degrees of freedom
## AIC: 268129
## 
## Number of Fisher Scoring iterations: 7

6.2 Ανάλυση Συντελεστών & Στατιστική Σημαντικότητα

coef_table <- summary(model)$coefficients

coef_df <- data.frame(
  Metavliti     = rownames(coef_table),
  Ektimisi      = round(coef_table[, "Estimate"],   4),
  Std_Error     = round(coef_table[, "Std. Error"], 4),
  z_value       = round(coef_table[, "z value"],    4),
  p_value       = round(coef_table[, "Pr(>|z|)"],   6),
  Simantikotita = ifelse(coef_table[, "Pr(>|z|)"] < 0.001, "*** p < 0.001",
                  ifelse(coef_table[, "Pr(>|z|)"] < 0.01,  "**  p < 0.01",
                  ifelse(coef_table[, "Pr(>|z|)"] < 0.05,  "*   p < 0.05",
                  ifelse(coef_table[, "Pr(>|z|)"] < 0.1,   ".   p < 0.1",
                         "—  Μη σημαντικό"))))
)

kable(coef_df,
      caption   = "Συντελεστές Λογιστικής Παλινδρόμησης",
      row.names = FALSE,
      align     = "lrrrrl")

Συντελεστές Λογιστικής Παλινδρόμησης
Metavliti	Ektimisi	Std_Error	z_value	p_value	Simantikotita
(Intercept)	0.4949	0.1642	3.0142	0.002577	** p < 0.01
main_categoryComics	0.5935	0.0304	19.5282	0.000000	*** p < 0.001
main_categoryCrafts	-0.7491	0.0359	-20.8744	0.000000	*** p < 0.001
main_categoryDance	0.8648	0.0473	18.2902	0.000000	*** p < 0.001
main_categoryDesign	0.1143	0.0231	4.9529	0.000001	*** p < 0.001
main_categoryFashion	-0.6391	0.0256	-24.9601	0.000000	*** p < 0.001
main_categoryFilm & Video	-0.0218	0.0195	-1.1174	0.263813	— Μη σημαντικό
main_categoryFood	-0.5257	0.0251	-20.9486	0.000000	*** p < 0.001
main_categoryGames	0.1227	0.0223	5.5113	0.000000	*** p < 0.001
main_categoryJournalism	-0.7540	0.0483	-15.6253	0.000000	*** p < 0.001
main_categoryMusic	0.3144	0.0199	15.7733	0.000000	*** p < 0.001
main_categoryPhotography	-0.4326	0.0316	-13.7007	0.000000	*** p < 0.001
main_categoryPublishing	-0.3976	0.0213	-18.6822	0.000000	*** p < 0.001
main_categoryTechnology	-0.5079	0.0248	-20.5089	0.000000	*** p < 0.001
main_categoryTheater	0.7615	0.0307	24.7967	0.000000	*** p < 0.001
usd_goal_real	0.0000	0.0000	-53.8567	0.000000	*** p < 0.001
countryAU	0.4661	0.1459	3.1952	0.001398	** p < 0.01
countryBE	0.2874	0.1923	1.4948	0.134971	— Μη σημαντικό
countryCA	0.4899	0.1439	3.4036	0.000665	*** p < 0.001
countryCH	0.4528	0.1810	2.5019	0.012351	* p < 0.05
countryDE	0.2865	0.1503	1.9069	0.056534	. p < 0.1
countryDK	0.7123	0.1679	4.2427	0.000022	*** p < 0.001
countryES	0.1588	0.1574	1.0090	0.312964	— Μη σημαντικό
countryFR	0.7241	0.1516	4.7757	0.000002	*** p < 0.001
countryGB	0.7359	0.1426	5.1591	0.000000	*** p < 0.001
countryHK	1.0592	0.1827	5.7987	0.000000	*** p < 0.001
countryIE	0.3438	0.1787	1.9241	0.054346	. p < 0.1
countryIT	-0.1738	0.1572	-1.1055	0.268938	— Μη σημαντικό
countryJP	0.8357	0.5484	1.5239	0.127540	— Μη σημαντικό
countryLU	0.7136	0.3719	1.9187	0.055025	. p < 0.1
countryMX	-0.0817	0.1611	-0.5069	0.612213	— Μη σημαντικό
countryN,0”	0.6984	0.2262	3.0873	0.002020	** p < 0.01
countryNL	0.3472	0.1538	2.2572	0.023994	* p < 0.05
countryNO	0.3031	0.1834	1.6525	0.098438	. p < 0.1
countryNZ	0.5767	0.1603	3.5970	0.000322	*** p < 0.001
countrySE	0.5821	0.1582	3.6795	0.000234	*** p < 0.001
countrySG	0.6643	0.1916	3.4670	0.000526	*** p < 0.001
countryUS	0.7329	0.1420	5.1624	0.000000	*** p < 0.001
duration_days	-0.0203	0.0004	-50.9136	0.000000	*** p < 0.001
launch_month2	0.1505	0.0236	6.3761	0.000000	*** p < 0.001
launch_month3	0.1679	0.0229	7.3411	0.000000	*** p < 0.001
launch_month4	0.1256	0.0232	5.4118	0.000000	*** p < 0.001
launch_month5	0.0777	0.0231	3.3661	0.000762	*** p < 0.001
launch_month6	0.0496	0.0231	2.1440	0.032029	* p < 0.05
launch_month7	-0.0988	0.0229	-4.3104	0.000016	*** p < 0.001
launch_month8	-0.0363	0.0234	-1.5521	0.120643	— Μη σημαντικό
launch_month9	0.0893	0.0235	3.7910	0.000150	*** p < 0.001
launch_month10	0.1616	0.0231	7.0103	0.000000	*** p < 0.001
launch_month11	0.1138	0.0233	4.8894	0.000001	*** p < 0.001
launch_month12	-0.0700	0.0264	-2.6487	0.008081	** p < 0.01
launch_year2010	-0.4048	0.0799	-5.0692	0.000000	*** p < 0.001
launch_year2011	-0.4035	0.0775	-5.2093	0.000000	*** p < 0.001
launch_year2012	-0.6174	0.0772	-7.9990	0.000000	*** p < 0.001
launch_year2013	-0.5218	0.0772	-6.7565	0.000000	*** p < 0.001
launch_year2014	-0.8981	0.0770	-11.6599	0.000000	*** p < 0.001
launch_year2015	-0.9981	0.0771	-12.9510	0.000000	*** p < 0.001
launch_year2016	-0.7360	0.0773	-9.5232	0.000000	*** p < 0.001
launch_year2017	-0.5931	0.0775	-7.6516	0.000000	*** p < 0.001

Παρατήρηση: Αναμένεται ο στόχος χρηματοδότησης (usd_goal_real) να έχει αρνητικό συντελεστή με υψηλή σημαντικότητα (p < 0.001): όσο υψηλότερος ο στόχος, τόσο χαμηλότερη η πιθανότητα επιτυχίας. Επίσης, η κατηγορία (main_category) αναμένεται να επηρεάζει σημαντικά το αποτέλεσμα (π.χ. Dance και Comics έχουν ιστορικά υψηλότερα ποσοστά επιτυχίας).

7 Προβλέψεις στο Test Set

# type = "response" → επιστρέφει εκτιμώμενες πιθανότητες [0, 1]
predictTest <- predict(model, newdata = test, type = "response")

cat("Πρώτες 10 προβλεπόμενες πιθανότητες:\n")

## Πρώτες 10 προβλεπόμενες πιθανότητες:

print(round(head(predictTest, 10), 4))

##      4     11     21     22     23     25     26     28     30     35 
## 0.6069 0.0523 0.2115 0.6674 0.5841 0.3493 0.5412 0.3130 0.3474 0.5115

cat("\nΠερίληψη προβλεπόμενων πιθανοτήτων:\n")

## 
## Περίληψη προβλεπόμενων πιθανοτήτων:

print(summary(predictTest))

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.2992  0.4079  0.4038  0.5149  0.8557

Τι μας δείχνει η predict()?
Με type = "response", η predict() επιστρέφει για κάθε καμπάνια του test set την εκτιμώμενη πιθανότητα επιτυχίας P(state = successful | X). Για παράδειγμα, τιμή 0.71 σημαίνει ότι το μοντέλο εκτιμά 71% πιθανότητα η καμπάνια να επιτύχει τον στόχο της. Οι τιμές αυτές κατηγοριοποιούνται στη συνέχεια σε 0 ή 1 βάσει κατωφλίου (threshold = 0.5).

8 Confusion Matrix & Αξιολόγηση Μοντέλου

8.1 Confusion Matrix (Κατώφλι = 0.5)

pred_class <- ifelse(predictTest >= 0.5, 1, 0)

cm <- table(Provlepomeno = pred_class,
            Pragmatiko    = test$state_binary)
print(cm)

##             Pragmatiko
## Provlepomeno     0     1
##            0 55717 27475
##            1 13425 19389

TN <- cm["0", "0"]
FP <- cm["1", "0"]
FN <- cm["0", "1"]
TP <- cm["1", "1"]

accuracy    <- (TP + TN) / sum(cm)
sensitivity <- TP / (TP + FN)
specificity <- TN / (TN + FP)

cat("╔══════════════════════════════════════════════╗\n")

## ╔══════════════════════════════════════════════╗

cat("║           ΑΞΙΟΛΟΓΗΣΗ ΜΟΝΤΕΛΟΥ               ║\n")

## ║           ΑΞΙΟΛΟΓΗΣΗ ΜΟΝΤΕΛΟΥ               ║

cat("╠══════════════════════════════════════════════╣\n")

## ╠══════════════════════════════════════════════╣

cat(sprintf("║  True Positive  (TP) : %6d                ║\n", TP))

## ║  True Positive  (TP) :  19389                ║

cat(sprintf("║  True Negative  (TN) : %6d                ║\n", TN))

## ║  True Negative  (TN) :  55717                ║

cat(sprintf("║  False Positive (FP) : %6d                ║\n", FP))

## ║  False Positive (FP) :  13425                ║

cat(sprintf("║  False Negative (FN) : %6d                ║\n", FN))

## ║  False Negative (FN) :  27475                ║

cat("╠══════════════════════════════════════════════╣\n")

## ╠══════════════════════════════════════════════╣

cat(sprintf("║  Ακριβεια    (Accuracy)   : %.4f           ║\n", accuracy))

## ║  Ακριβεια    (Accuracy)   : 0.6474           ║

cat(sprintf("║  Sensitivity (Recall/TPR) : %.4f           ║\n", sensitivity))

## ║  Sensitivity (Recall/TPR) : 0.4137           ║

cat(sprintf("║  Specificity (TNR)        : %.4f           ║\n", specificity))

## ║  Specificity (TNR)        : 0.8058           ║

cat("╚══════════════════════════════════════════════╝\n")

## ╚══════════════════════════════════════════════╝

8.2 Baseline Model

majority_class    <- names(which.max(table(test$state_binary)))
baseline_accuracy <- max(table(test$state_binary)) / nrow(test)

cat("Πλειοψηφικη κατηγορια στο test set  :", majority_class, "\n")

## Πλειοψηφικη κατηγορια στο test set  : 0

cat("Ακριβεια Baseline Model              :", round(baseline_accuracy, 4), "\n")

## Ακριβεια Baseline Model              : 0.596

cat("Ακριβεια Logistic Regression Model   :", round(accuracy, 4), "\n")

## Ακριβεια Logistic Regression Model   : 0.6474

cat("Βελτιωση εναντι Baseline             :",
    round((accuracy - baseline_accuracy) * 100, 2), "ποσοστιαιες μοναδες\n")

## Βελτιωση εναντι Baseline             : 5.14 ποσοστιαιες μοναδες

Παρατήρηση:
Το baseline model που πάντα προβλέπει την πλειοψηφική κλάση (0 = failed, ~64% των καμπανιών αποτυγχάνουν) επιτυγχάνει ακρίβεια ~64%. Το μοντέλο Λογιστικής Παλινδρόμησης υπερτερεί σημαντικά, αποδεικνύοντας ότι μεταβλητές όπως ο στόχος χρηματοδότησης και η κατηγορία έχουν πραγματική προβλεπτική αξία.

9 ROC Καμπύλη & AUC

9.1 Δημιουργία ROCRpred

# state_binary είναι ήδη integer (0/1) — prediction() λειτουργεί απευθείας
ROCRpred <- prediction(predictTest, test$state_binary)

cat("Αντικειμενο ROCRpred δημιουργηθηκε επιτυχως.\n")

## Αντικειμενο ROCRpred δημιουργηθηκε επιτυχως.

cat("Κλαση       :", class(ROCRpred), "\n")

## Κλαση       : prediction

cat("Παρατηρησεις:", length(predictTest), "\n")

## Παρατηρησεις: 116006

9.2 ROC Καμπύλη με Color-Coding

ROCRperf <- performance(ROCRpred, "tpr", "fpr")

plot(ROCRperf,
     colorize         = TRUE,
     print.cutoffs.at = seq(0, 1, by = 0.1),
     text.adj         = c(-0.2, 1.7),
     main             = "ROC Καμπύλη – Πρόβλεψη Επιτυχίας Kickstarter",
     xlab             = "False Positive Rate (1 – Specificity)",
     ylab             = "True Positive Rate (Sensitivity)",
     lwd              = 2.5)
abline(a = 0, b = 1, lty = 2, col = "gray50", lwd = 1.5)
legend("bottomright",
       legend = c("ROC Καμπύλη (χρώμα = κατώφλι)", "Τυχαίος Ταξινομητής (AUC = 0.5)"),
       col    = c("blue", "gray50"),
       lty    = c(1, 2),
       lwd    = 2,
       bty    = "n")

9.3 Υπολογισμός AUC

auc_val <- performance(ROCRpred, "auc")
auc     <- as.numeric(auc_val@y.values)

cat("╔══════════════════════════════════════════╗\n")

## ╔══════════════════════════════════════════╗

cat(sprintf("║  AUC = %.4f                            ║\n", auc))

## ║  AUC = 0.6828                            ║

cat("╠══════════════════════════════════════════╣\n")

## ╠══════════════════════════════════════════╣

cat("║  Ερμηνεια:                               ║\n")

## ║  Ερμηνεια:                               ║

if (auc >= 0.9) {
  cat("║  Aristh diakritiki ikanotita           ║\n")
} else if (auc >= 0.8) {
  cat("║  Poly kali diakritiki ikanotita        ║\n")
} else if (auc >= 0.7) {
  cat("║  Kali diakritiki ikanotita             ║\n")
} else {
  cat("║  Metria diakritiki ikanotita           ║\n")
}

## ║  Metria diakritiki ikanotita           ║

cat("╚══════════════════════════════════════════╝\n")

## ╚══════════════════════════════════════════╝

Ερμηνεία AUC:
Το AUC (Area Under the ROC Curve) εκφράζει τη συνολική διακριτική ικανότητα του μοντέλου ανεξαρτήτως κατωφλίου. Κυμαίνεται από 0.5 (τυχαία) έως 1.0 (τέλεια). Τιμή AUC > 0.70 θεωρείται καλή απόδοση για αυτό το πρόβλημα, δεδομένης της πολυπλοκότητας της επιτυχίας μιας καμπάνιας crowdfunding.

10 Επανάληψη με `na.omit` — Sets train2 & test2

Επαναλαμβάνουμε την ανάλυση χρησιμοποιώντας μόνο τις πλήρεις παρατηρήσεις με na.omit().

df_clean <- na.omit(df_model)

cat("Καταχωρησεις ΠΡΙΝ na.omit :", nrow(df_model), "\n")

## Καταχωρησεις ΠΡΙΝ na.omit : 331446

cat("Καταχωρησεις ΜΕΤΑ  na.omit:", nrow(df_clean), "\n")

## Καταχωρησεις ΜΕΤΑ  na.omit: 331446

cat("Αφαιρεθηκαν               :", nrow(df_model) - nrow(df_clean), "καταχωρησεις\n\n")

## Αφαιρεθηκαν               : 0 καταχωρησεις

set.seed(942)
split2 <- sample.split(df_clean$state_binary, SplitRatio = 0.65)

train2 <- subset(df_clean, split2 == TRUE)
test2  <- subset(df_clean, split2 == FALSE)

cat("╔═══════════════════════════════════════════╗\n")

## ╔═══════════════════════════════════════════╗

cat("║       ΝΕΑ SETS (na.omit)                 ║\n")

## ║       ΝΕΑ SETS (na.omit)                 ║

cat("╠═══════════════════════════════════════════╣\n")

## ╠═══════════════════════════════════════════╣

cat(sprintf("║  train2 : %6d καταχωρησεις           ║\n", nrow(train2)))

## ║  train2 : 215440 καταχωρησεις           ║

cat(sprintf("║  test2  : %6d καταχωρησεις           ║\n", nrow(test2)))

## ║  test2  : 116006 καταχωρησεις           ║

cat("╚═══════════════════════════════════════════╝\n")

## ╚═══════════════════════════════════════════╝

model2 <- glm(state_binary ~ .,
              data   = train2,
              family = binomial(link = "logit"))

predictTest2 <- predict(model2, newdata = test2, type = "response")

pred_class2 <- ifelse(predictTest2 >= 0.5, 1, 0)
cm2 <- table(Provlepomeno = pred_class2,
             Pragmatiko    = test2$state_binary)

TN2 <- cm2["0", "0"]; FP2 <- cm2["1", "0"]
FN2 <- cm2["0", "1"]; TP2 <- cm2["1", "1"]

accuracy2    <- (TP2 + TN2) / sum(cm2)
sensitivity2 <- TP2 / (TP2 + FN2)
specificity2 <- TN2 / (TN2 + FP2)

ROCRpred2 <- prediction(predictTest2, test2$state_binary)
auc2      <- as.numeric(performance(ROCRpred2, "auc")@y.values)

cat("=== Αποτελεσματα Μοντελου 2 (na.omit) ===\n")

## === Αποτελεσματα Μοντελου 2 (na.omit) ===

cat(sprintf("Ακριβεια    : %.4f\n", accuracy2))

## Ακριβεια    : 0.6474

cat(sprintf("Sensitivity : %.4f\n", sensitivity2))

## Sensitivity : 0.4137

cat(sprintf("Specificity : %.4f\n", specificity2))

## Specificity : 0.8058

cat(sprintf("AUC         : %.4f\n", auc2))

## AUC         : 0.6828

ROCRperf2 <- performance(ROCRpred2, "tpr", "fpr")

plot(ROCRperf2,
     colorize         = TRUE,
     print.cutoffs.at = seq(0, 1, by = 0.1),
     text.adj         = c(-0.2, 1.7),
     main             = paste0("ROC Καμπύλη – Μοντέλο 2 (na.omit)  |  AUC = ",
                               round(auc2, 4)),
     xlab             = "False Positive Rate (1 – Specificity)",
     ylab             = "True Positive Rate (Sensitivity)",
     lwd              = 2.5)
abline(a = 0, b = 1, lty = 2, col = "gray50", lwd = 1.5)
legend("bottomright",
       legend = c("ROC Καμπύλη (χρώμα = κατώφλι)", "Τυχαίος Ταξινομητής (AUC = 0.5)"),
       col    = c("blue", "gray50"),
       lty    = c(1, 2),
       lwd    = 2,
       bty    = "n")

11 Σύγκριση Μοντέλων

comparison <- data.frame(
  Montelo     = c("Μοντέλο 1 (με NA)", "Μοντέλο 2 (na.omit)", "Baseline"),
  Train       = c(nrow(train),  nrow(train2), nrow(train)),
  Test        = c(nrow(test),   nrow(test2),  nrow(test)),
  Akriveia    = c(round(accuracy,   4), round(accuracy2,   4),
                  round(baseline_accuracy, 4)),
  Sensitivity = c(round(sensitivity,  4), round(sensitivity2, 4), NA),
  Specificity = c(round(specificity,  4), round(specificity2, 4), NA),
  AUC         = c(round(auc, 4), round(auc2, 4), 0.5000)
)

kable(comparison,
      caption   = "Συγκριτικός Πίνακας Μοντέλων Λογιστικής Παλινδρόμησης",
      row.names = FALSE,
      align     = "lrrrrrr",
      na        = "—")

Συγκριτικός Πίνακας Μοντέλων Λογιστικής Παλινδρόμησης
Montelo	Train	Test	Akriveia	Sensitivity	Specificity	AUC
Μοντέλο 1 (με NA)	215440	116006	0.6474	0.4137	0.8058	0.6828
Μοντέλο 2 (na.omit)	215440	116006	0.6474	0.4137	0.8058	0.6828
Baseline	215440	116006	0.5960	NA	NA	0.5000

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

Από την ανάλυση Λογιστικής Παλινδρόμησης στο Kickstarter dataset προκύπτουν τα εξής βασικά συμπεράσματα:

Σημαντικές Μεταβλητές: Ο στόχος χρηματοδότησης (usd_goal_real) εμφανίζει αρνητικό συντελεστή με υψηλή σημαντικότητα (p < 0.001): υψηλότερος στόχος μειώνει σημαντικά την πιθανότητα επιτυχίας. Η κατηγορία (main_category) επίσης διαφοροποιείται σημαντικά — κατηγορίες όπως Dance και Comics έχουν ιστορικά υψηλότερα ποσοστά επιτυχίας.
Απόδοση Μοντέλου: Η ακρίβεια του μοντέλου υπερτερεί του baseline (~64%), επιβεβαιώνοντας ότι οι επιλεγμένες μεταβλητές εξηγούν μέρος της επιτυχίας μιας καμπάνιας.
AUC: Η τιμή AUC αντικατοπτρίζει τη διακριτική ικανότητα του μοντέλου. Το crowdfunding εξαρτάται και από παράγοντες που δεν υπάρχουν στο dataset (ποιότητα περιεχομένου, marketing, δίκτυο δημιουργού), οπότε ένα AUC στο 0.70–0.75 θεωρείται ικανοποιητικό.
Επίδραση na.omit: Δεδομένου ότι το Kickstarter dataset έχει σχετικά λίγες ελλείπουσες τιμές (κυρίως στο usd_goal_real), τα δύο μοντέλα αναμένεται να δίνουν παρόμοια αποτελέσματα.
Sensitivity vs Specificity: Σε επιχειρηματικό πλαίσιο, υψηλό sensitivity (αναγνώριση επιτυχημένων καμπανιών) είναι χρήσιμο για επενδυτές/δημιουργούς που θέλουν να εντοπίσουν υποσχόμενα projects.

Εργασία στο πλαίσιο του μαθήματος Επιχειρηματική Αναλυτική – Τμήμα Εφαρμοσμένης Πληροφορικής, ΠΑΜΑΚ

## R Version  : R version 4.5.2 (2025-10-31)

## Ημερομηνια : 20/04/2026 14:08

Λογιστική Παλινδρόμηση – Case Study

Kickstarter Projects: Πρόβλεψη Επιτυχίας Καμπάνιας Χρηματοδότησης

Φοιτητής Εφαρμοσμένης Πληροφορικής

2026-04-20

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

1.1 Περιγραφή του Dataset

1.2 Μεταβλητές Dataset

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

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

4 Προεπεξεργασία Δεδομένων

5 Διαχωρισμός σε Training & Testing Sets

6 Μοντέλο Λογιστικής Παλινδρόμησης

6.1 Εκπαίδευση Μοντέλου (Όλες οι Ανεξάρτητες Μεταβλητές)

6.2 Ανάλυση Συντελεστών & Στατιστική Σημαντικότητα

7 Προβλέψεις στο Test Set

8 Confusion Matrix & Αξιολόγηση Μοντέλου

8.1 Confusion Matrix (Κατώφλι = 0.5)

8.2 Baseline Model

9 ROC Καμπύλη & AUC

9.1 Δημιουργία ROCRpred

9.2 ROC Καμπύλη με Color-Coding

9.3 Υπολογισμός AUC

10 Επανάληψη με `na.omit` — Sets train2 & test2

11 Σύγκριση Μοντέλων

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

Λογιστική Παλινδρόμηση – Case Study

Kickstarter Projects: Πρόβλεψη Επιτυχίας Καμπάνιας Χρηματοδότησης

Φοιτητής Εφαρμοσμένης Πληροφορικής

2026-04-20

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

1.1 Περιγραφή του Dataset

1.2 Μεταβλητές Dataset

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

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

4 Προεπεξεργασία Δεδομένων

5 Διαχωρισμός σε Training & Testing Sets

6 Μοντέλο Λογιστικής Παλινδρόμησης

6.1 Εκπαίδευση Μοντέλου (Όλες οι Ανεξάρτητες Μεταβλητές)

6.2 Ανάλυση Συντελεστών & Στατιστική Σημαντικότητα

7 Προβλέψεις στο Test Set

8 Confusion Matrix & Αξιολόγηση Μοντέλου

8.1 Confusion Matrix (Κατώφλι = 0.5)

8.2 Baseline Model

9 ROC Καμπύλη & AUC

9.1 Δημιουργία ROCRpred

9.2 ROC Καμπύλη με Color-Coding

9.3 Υπολογισμός AUC

10 Επανάληψη με na.omit — Sets train2 & test2

11 Σύγκριση Μοντέλων

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

10 Επανάληψη με `na.omit` — Sets train2 & test2