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
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.
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
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.
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
Wizualizacja pomaga zrozumieć strukturę powiązań między jednostkami chorobowymi.
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).
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ł.
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")
| 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.
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.