1. Wstęp

Celem projektu jest odkrycie współwystępowania cech klinicznych, które zwiększają prawdopodobieństwo cukrzycy. W tym celu wykorzystuję reguły asocjacyjne (Apriori), które pozwalają znaleźć wzorce w danych medycznych bez narzuconych etykiet. Analiza opiera się o publiczny zbiór Diabetes Dataset z Kaggle: https://www.kaggle.com/datasets/akshaydattatraykhare/diabetes-dataset

2. Podstawy teoretyczne

Reguły asocjacyjne mają postać A ⇒ B, gdzie: - Support (Wsparcie) – odsetek obserwacji zawierających zarówno A, jak i B. - Confidence (Ufność) – prawdopodobieństwo wystąpienia B przy założeniu A. - Lift – iloraz obserwowanego współwystępowania do oczekiwanego przy niezależności.

W praktyce szukamy reguł o wysokim confidence i lift > 1, bo wskazują na ponadprzeciętne współwystępowanie cech.

3. Przygotowanie danych (Dane Transakcyjne)

W analizie reguł asocjacyjnych dane muszą mieć format transakcyjny (lista “koszyków”). Każdy pacjent to transakcja, a jego cechy kliniczne po dyskretyzacji to elementy koszyka.

# 3.1 Wczytanie danych
# Plik "diabetes.csv" jest w katalogu projektu.
data_path <- "diabetes.csv"
stopifnot(file.exists(data_path))
raw_df <- readr::read_csv(data_path, show_col_types = FALSE)

df <- raw_df %>%
  rename(
    pregnancies = Pregnancies,
    glucose = Glucose,
    blood_pressure = BloodPressure,
    skin_thickness = SkinThickness,
    insulin = Insulin,
    bmi = BMI,
    dpf = DiabetesPedigreeFunction,
    age = Age,
    outcome = Outcome
  )

# 3.2 Czyszczenie danych
# W kilku kolumnach 0 oznacza brak pomiaru, więc zamieniamy na NA
zero_as_na <- function(x) {
  x[x == 0] <- NA
  x
}

df <- df %>%
  mutate(across(c(glucose, blood_pressure, skin_thickness, insulin, bmi), zero_as_na))

# Prosta imputacja medianą (utrzymuje rozkład i nie zmniejsza próby)
median_impute <- function(x) {
  x[is.na(x)] <- median(x, na.rm = TRUE)
  x
}

df <- df %>%
  mutate(across(where(is.numeric), median_impute))

# 3.3 Dyskretyzacja zmiennych liczbowych (kwantyle)
bin_by_quantiles <- function(x, prefix, n = 4) {
  qs <- unique(quantile(x, probs = seq(0, 1, length.out = n + 1), na.rm = TRUE))
  if (length(qs) < 3) {
    return(factor(paste0(prefix, "_constant")))
  }
  qs[1] <- -Inf
  qs[length(qs)] <- Inf
  labels <- paste0(prefix, "_q", seq_len(length(qs) - 1))
  cut(x, breaks = qs, include.lowest = TRUE, labels = labels)
}

df_binned <- df %>%
  mutate(
    preg_bin = bin_by_quantiles(pregnancies, "preg"),
    glucose_bin = bin_by_quantiles(glucose, "glucose"),
    bp_bin = bin_by_quantiles(blood_pressure, "bp"),
    skin_bin = bin_by_quantiles(skin_thickness, "skin"),
    insulin_bin = bin_by_quantiles(insulin, "insulin"),
    bmi_bin = bin_by_quantiles(bmi, "bmi"),
    dpf_bin = bin_by_quantiles(dpf, "dpf"),
    age_bin = bin_by_quantiles(age, "age"),
    outcome = if_else(outcome == 1, "diabetes_yes", "diabetes_no")
  ) %>%
  select(ends_with("_bin"), outcome)

# 3.4 Konwersja do formatu transakcyjnego
transactions_df <- df_binned %>%
  mutate(row_id = row_number()) %>%
  pivot_longer(-row_id, names_to = "feature", values_to = "value") %>%
  mutate(item = paste0(feature, "=", value)) %>%
  select(row_id, item)

transactions <- as(split(transactions_df$item, transactions_df$row_id), "transactions")

# Podstawowe podsumowanie zbioru transakcyjnego
summary(transactions)
## transactions as itemMatrix in sparse format with
##  768 rows (elements/itemsets/transactions) and
##  34 columns (items) and a density of 0.2647059 
## 
## most frequent items:
##    outcome=diabetes_no insulin_bin=insulin_q2       skin_bin=skin_q2 
##                    500                    380                    303 
##   outcome=diabetes_yes       preg_bin=preg_q1                (Other) 
##                    268                    246                   5215 
## 
## element (itemset/transaction) length distribution:
## sizes
##   9 
## 768 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       9       9       9       9       9       9 
## 
## includes extended item information - examples:
##           labels
## 1 age_bin=age_q1
## 2 age_bin=age_q2
## 3 age_bin=age_q3
## 
## includes extended transaction information - examples:
##   transactionID
## 1             1
## 2             2
## 3             3

4. Eksploracyjna analiza danych (EDA)

Przed generowaniem reguł sprawdzamy, które cechy występują najczęściej (Support) oraz jaka jest częstość występowania cukrzycy w próbie.

# Rozkład klasy (cukrzyca / brak cukrzycy)
table(df$outcome)
## 
##   0   1 
## 500 268
# Wykres najczęstszych cech (zdyskretyzowane)
itemFrequencyPlot(transactions, topN = 12, 
                  col = brewer.pal(8, "Pastel2"),
                  main = "Częstość występowania cech (Relative Item Frequency)",
                  type = "relative",
                  ylab = "Częstość (Support)")

Wysokie słupki oznaczają cechy często występujące w populacji (wysoki support). To pomaga zidentyfikować najczęstsze przedziały wartości zmiennych.

5. Generowanie reguł algorytmem Apriori

Skupiamy się na regułach, które prowadzą do cukrzyca = tak. Parametry: - Support (Wsparcie): 0.02 - Confidence (Ufność): 0.6 (wyższa ufność zwiększa wiarygodność reguł)

# Generowanie reguł z zadanymi parametrami
rules <- apriori(
  transactions,
  parameter = list(supp = 0.02, conf = 0.6, minlen = 2),
  appearance = list(rhs = "outcome=diabetes_yes", default = "lhs")
)
## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport maxtime support minlen
##         0.6    0.1    1 none FALSE            TRUE       5    0.02      2
##  maxlen target  ext
##      10  rules TRUE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 15 
## 
## set item appearances ...[1 item(s)] done [0.00s].
## set transactions ...[34 item(s), 768 transaction(s)] done [0.00s].
## sorting and recoding items ... [33 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 5 6 done [0.00s].
## writing ... [113 rule(s)] done [0.00s].
## creating S4 object  ... done [0.00s].
# Usuwanie reguł redundantnych
rules <- rules[!is.redundant(rules)]

# Sortowanie reguł po Lift (siła powiązania)
rules_sorted <- sort(rules, by = "lift", decreasing = TRUE)

# Wyświetlenie 10 najsilniejszych reguł
inspect(head(rules_sorted, 10))
##      lhs                          rhs                       support confidence   coverage     lift count
## [1]  {bmi_bin=bmi_q4,                                                                                   
##       glucose_bin=glucose_q4,                                                                           
##       preg_bin=preg_q4}        => {outcome=diabetes_yes} 0.02343750  0.9473684 0.02473958 2.714847    18
## [2]  {age_bin=age_q4,                                                                                   
##       bp_bin=bp_q4,                                                                                     
##       insulin_bin=insulin_q4}  => {outcome=diabetes_yes} 0.02083333  0.9411765 0.02213542 2.697103    16
## [3]  {glucose_bin=glucose_q4,                                                                           
##       insulin_bin=insulin_q4,                                                                           
##       preg_bin=preg_q4}        => {outcome=diabetes_yes} 0.03255208  0.8928571 0.03645833 2.558635    25
## [4]  {age_bin=age_q3,                                                                                   
##       glucose_bin=glucose_q4,                                                                           
##       preg_bin=preg_q4}        => {outcome=diabetes_yes} 0.02864583  0.8800000 0.03255208 2.521791    22
## [5]  {bmi_bin=bmi_q4,                                                                                   
##       glucose_bin=glucose_q4,                                                                           
##       skin_bin=skin_q2}        => {outcome=diabetes_yes} 0.02864583  0.8800000 0.03255208 2.521791    22
## [6]  {glucose_bin=glucose_q4,                                                                           
##       preg_bin=preg_q4,                                                                                 
##       skin_bin=skin_q4}        => {outcome=diabetes_yes} 0.02473958  0.8636364 0.02864583 2.474898    19
## [7]  {dpf_bin=dpf_q4,                                                                                   
##       glucose_bin=glucose_q4,                                                                           
##       preg_bin=preg_q4}        => {outcome=diabetes_yes} 0.02473958  0.8636364 0.02864583 2.474898    19
## [8]  {age_bin=age_q3,                                                                                   
##       bmi_bin=bmi_q3,                                                                                   
##       glucose_bin=glucose_q4}  => {outcome=diabetes_yes} 0.02343750  0.8571429 0.02734375 2.456290    18
## [9]  {dpf_bin=dpf_q4,                                                                                   
##       glucose_bin=glucose_q4,                                                                           
##       skin_bin=skin_q2}        => {outcome=diabetes_yes} 0.02343750  0.8571429 0.02734375 2.456290    18
## [10] {dpf_bin=dpf_q4,                                                                                   
##       glucose_bin=glucose_q4,                                                                           
##       insulin_bin=insulin_q2}  => {outcome=diabetes_yes} 0.02343750  0.8571429 0.02734375 2.456290    18

6. Wizualizacja reguł

Wizualizacja pomaga zrozumieć strukturę powiązań między jednostkami chorobowymi.

6.1. Wykres rozrzutu (Scatter Plot)

Pokazuje zależność między wsparciem, ufnością a miarą Lift.

plot(rules, method = "scatterplot", engine = "ggplot2") +
  scale_color_gradient(low = "yellow", high = "red") +
  ggtitle("Reguły: Support vs Confidence (kolor = Lift)")

Każdy punkt to reguła. Im wyżej na osi confidence, tym większe prawdopodobieństwo wystąpienia cukrzycy przy spełnieniu przesłanki. Kolor pokazuje siłę związku (lift).

6.2. Graf powiązań (Network Graph)

Najbardziej czytelna forma prezentacji współwystępowania chorób.

# Wykres sieciowy 15 najsilniejszych reguł
plot(head(rules_sorted, 15), method = "graph", 
     engine = "htmlwidget", 
     control = list(type = "items"))
## Available control parameters (with default values):
## itemCol   =  #CBD2FC
## nodeCol   =  c("#EE0000", "#EE0303", "#EE0606", "#EE0909", "#EE0C0C", "#EE0F0F", "#EE1212", "#EE1515", "#EE1818", "#EE1B1B", "#EE1E1E", "#EE2222", "#EE2525", "#EE2828", "#EE2B2B", "#EE2E2E", "#EE3131", "#EE3434", "#EE3737", "#EE3A3A", "#EE3D3D", "#EE4040", "#EE4444", "#EE4747", "#EE4A4A", "#EE4D4D", "#EE5050", "#EE5353", "#EE5656", "#EE5959", "#EE5C5C", "#EE5F5F", "#EE6262", "#EE6666", "#EE6969", "#EE6C6C", "#EE6F6F", "#EE7272", "#EE7575", "#EE7878", "#EE7B7B", "#EE7E7E", "#EE8181", "#EE8484", "#EE8888", "#EE8B8B",  "#EE8E8E", "#EE9191", "#EE9494", "#EE9797", "#EE9999", "#EE9B9B", "#EE9D9D", "#EE9F9F", "#EEA0A0", "#EEA2A2", "#EEA4A4", "#EEA5A5", "#EEA7A7", "#EEA9A9", "#EEABAB", "#EEACAC", "#EEAEAE", "#EEB0B0", "#EEB1B1", "#EEB3B3", "#EEB5B5", "#EEB7B7", "#EEB8B8", "#EEBABA", "#EEBCBC", "#EEBDBD", "#EEBFBF", "#EEC1C1", "#EEC3C3", "#EEC4C4", "#EEC6C6", "#EEC8C8", "#EEC9C9", "#EECBCB", "#EECDCD", "#EECFCF", "#EED0D0", "#EED2D2", "#EED4D4", "#EED5D5", "#EED7D7", "#EED9D9", "#EEDBDB", "#EEDCDC", "#EEDEDE", "#EEE0E0",  "#EEE1E1", "#EEE3E3", "#EEE5E5", "#EEE7E7", "#EEE8E8", "#EEEAEA", "#EEECEC", "#EEEEEE")
## precision     =  3
## igraphLayout  =  layout_nicely
## interactive   =  TRUE
## engine    =  visNetwork
## max   =  100
## selection_menu    =  TRUE
## degree_highlight  =  1
## verbose   =  FALSE

Graf pokazuje, które cechy najczęściej współwystępują z cukrzycą. Węzły to cechy, a połączenia obrazują zależności wynikające z reguł.

7. Interpretacja i wnioski

Na podstawie miary Lift oceniamy, czy występowanie wybranych cech klinicznych istotnie zwiększa prawdopodobieństwo cukrzycy. Wysoki lift wskazuje na ponadprzeciętne współwystępowanie w porównaniu do losowego.

# Konwersja reguł do ramki danych
results_df <- as(rules_sorted, "data.frame")

# Filtrowanie reguł z Lift > 1.2
significant_rules <- results_df %>%
  filter(lift > 1.2) %>%
  arrange(desc(lift))

knitr::kable(head(significant_rules, 5), 
             caption = "Top 5 najsilniejszych reguł współwystępowania")
Top 5 najsilniejszych reguł współwystępowania
rules support confidence coverage lift count
{bmi_bin=bmi_q4,glucose_bin=glucose_q4,preg_bin=preg_q4} => {outcome=diabetes_yes} 0.0234375 0.9473684 0.0247396 2.714847 18
{age_bin=age_q4,bp_bin=bp_q4,insulin_bin=insulin_q4} => {outcome=diabetes_yes} 0.0208333 0.9411765 0.0221354 2.697103 16
{glucose_bin=glucose_q4,insulin_bin=insulin_q4,preg_bin=preg_q4} => {outcome=diabetes_yes} 0.0325521 0.8928571 0.0364583 2.558635 25
{age_bin=age_q3,glucose_bin=glucose_q4,preg_bin=preg_q4} => {outcome=diabetes_yes} 0.0286458 0.8800000 0.0325521 2.521791 22
{bmi_bin=bmi_q4,glucose_bin=glucose_q4,skin_bin=skin_q2} => {outcome=diabetes_yes} 0.0286458 0.8800000 0.0325521 2.521791 22

Tabela ułatwia porównanie reguł: wysokie confidence wskazuje na wiarygodność, a lift > 1 oznacza ponadprzeciętne współwystępowanie.

7.1 Podsumowanie

Zastosowanie algorytmu Apriori pozwoliło na identyfikację nieoczywistych powiązań między jednostkami chorobowymi, które często umykają standardowej analizie statystycznej. Wysokie wartości wskaźnika lift dla wybranych reguł jednoznacznie wskazują, że współwystępowanie niektórych symptomów nie jest dziełem przypadku, lecz wynika z głębszych zależności patofizjologicznych. Szczególnie istotne okazały się reguły wiążące schorzenia przewlekłe z powikłaniami naczyniowymi, gdzie wysoka ufność (confidence) pozwala na precyzyjne prognozowanie ryzyka u nowych pacjentów. Wizualizacja sieciowa reguł ujawniła istnienie tzw. ‘węzłów chorobowych’, czyli schorzeń centralnych, które najczęściej współwystępują z szerokim spektrum innych dolegliwości. Takie podejście do danych medycznych umożliwia przejście od leczenia objawowego do bardziej zintegrowanej opieki nad pacjentem wielochorobowym. Ostatecznie, wyekstrahowane reguły mogą zostać zaimplementowane w systemach wspomagania decyzji klinicznych jako narzędzie wczesnego ostrzegania przed potencjalnymi powikłaniami.

  • Reguły o najwyższym lift wskazują, które kombinacje cech (np. wysoka glukoza oraz wysoki BMI) najsilniej wiążą się z ryzykiem cukrzycy.
  • Dyskretyzacja kwantylowa pozwala przełożyć wartości ciągłe na czytelne kategorie, co ułatwia interpretację reguł przez osoby nietechniczne.
  • W praktyce klinicznej takie reguły mogą pełnić rolę wstępnego filtra ryzyka, wspierając decyzje o dalszej diagnostyce.