L’obiettivo di questa analisi è sviluppare un modello statistico robusto per prevedere il peso alla nascita (Weight_g) sulla base di caratteristiche materne e fetali note prima del parto. L’analisi seguirà un flusso strutturato:
Analisi Descrittiva e Pulizia: Intercettazione di errori e valori anomali (outlier).
Test di Ipotesi: Confronto delle statistiche campionarie con i dati di popolazione della letteratura scientifica.
Modellazione Logica: Selezione ragionata delle variabili, inclusione di non-linearità ed effetti di secondo ordine (interazioni).
Diagnostica e Previsione: Validazione delle assunzioni, rimozione degli outlier influenti e previsione con il modello ottimizzato.
In questa fase importiamo il dataset. Prima di procedere a qualsiasi manipolazione, eseguiamo un’analisi descrittiva preliminare per individuare eventuali anomalie nei dati registrati.
# Importazione dataset
data <- read.csv("neonati.csv")
# Standardizzazione nomi variabili
df <- data %>%
rename(MaternalAge = Anni.madre,
NumPregnancies = N.gravidanze,
Smoking = Fumatrici,
GestWeeks = Gestazione,
Weight_g = Peso,
Length_mm = Lunghezza,
HeadDiameter_mm = Cranio,
BirthType = Tipo.parto,
Hospital = Ospedale,
Sex = Sesso) %>%
mutate(Smoking = factor(Smoking, levels = c(0, 1), labels = c("No", "Yes")),
BirthType = as.factor(BirthType),
Hospital = as.factor(Hospital),
Sex = as.factor(Sex))
# Creiamo una tabella riassuntiva per individuare gli errori
summary_iniziale <- data.frame(
Min = sapply(df %>% select(where(is.numeric)), min, na.rm = TRUE),
Mediana = sapply(df %>% select(where(is.numeric)), median, na.rm = TRUE),
Media = sapply(df %>% select(where(is.numeric)), mean, na.rm = TRUE),
Max = sapply(df %>% select(where(is.numeric)), max, na.rm = TRUE)
)
summary_iniziale %>%
kbl(caption = "Statistiche Descrittive Pre-Pulizia (Ricerca Errori)", digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)| Min | Mediana | Media | Max | |
|---|---|---|---|---|
| MaternalAge | 0 | 28 | 28.16 | 46 |
| NumPregnancies | 0 | 1 | 0.98 | 12 |
| GestWeeks | 25 | 39 | 38.98 | 43 |
| Weight_g | 830 | 3300 | 3284.08 | 4930 |
| Length_mm | 310 | 500 | 494.69 | 565 |
| HeadDiameter_mm | 235 | 340 | 340.03 | 390 |
Nota sulla Qualità dei Dati: Guardando i valori minimi e massimi (in particolare della variabile MaternalAge), si nota la presenza di valori impossibili (es. età materne estreme o sotto i 12 anni). Procediamo con la rimozione di questi due valori errati.
# Rimozione errori logici nell'età materna
df_clean <- df %>%
filter(MaternalAge >= 12 & MaternalAge <= 55)
n_removed <- nrow(df) - nrow(df_clean)Sono state rimosse 2 osservazioni considerate errori di registrazione. L’analisi procederà sul dataset pulito (df_clean).
Prima di costruire il modello, confrontiamo le nostre statistiche campionarie con i valori medi noti in letteratura scientifica (es. standard OMS). Sappiamo dalla letteratura che il peso medio alla nascita è di circa 3300g e la lunghezza media è di 500mm.
# Valori di letteratura
mu_weight <- 3300
mu_length <- 500
# Esecuzione Test
t_test_weight <- t.test(df_clean$Weight_g, mu = mu_weight)
t_test_length <- t.test(df_clean$Length_mm, mu = mu_length)
t_test_sex <- t.test(Weight_g ~ Sex, data = df_clean)
# Tabella Risultati Formattata
bind_rows(
tidy(t_test_weight) %>% mutate(Test = "Peso vs Popolazione (3300g)"),
tidy(t_test_length) %>% mutate(Test = "Lunghezza vs Popolazione (500mm)"),
tidy(t_test_sex) %>% mutate(Test = "Differenza Peso M vs F")
) %>%
dplyr::select(Test, estimate, statistic, p.value, conf.low, conf.high) %>%
kbl(caption = "Risultati Test di Ipotesi", digits = 2, escape = FALSE) %>%
kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE) %>%
column_spec(4, color = "white", background = ifelse(bind_rows(tidy(t_test_weight), tidy(t_test_length), tidy(t_test_sex))$p.value < 0.05, "#E95420", "gray"))| Test | estimate | statistic | p.value | conf.low | conf.high |
|---|---|---|---|---|---|
| Peso vs Popolazione (3300g) | 3284.18 | -1.51 | 0.13 | 3263.58 | 3304.79 |
| Lunghezza vs Popolazione (500mm) | 494.70 | -10.07 | 0.00 | 493.66 | 495.73 |
| Differenza Peso M vs F | -247.43 | -12.11 | 0.00 | -287.48 | -207.38 |
I p-value evidenziati confermano che le medie del nostro campione differiscono significativamente dagli standard generali, e che esiste un forte dimorfismo sessuale (differenza di peso tra maschi e femmine).
Per la costruzione del modello predittivo, applichiamo un ragionamento logico a priori sulle variabili:
Variabili Escluse: Hospital e BirthType vengono escluse a priori. L’ospedale non è una causa biologica del peso fetale, e il tipo di parto (naturale o cesareo) spesso è una conseguenza del peso, non un predittore noto a priori a inizio gravidanza.
Non-Linearità: La crescita fetale non è lineare costante. Inseriamo il termine quadratico GestWeeks^2.
Effetti di Secondo Ordine (Interazioni): Valutiamo l’interazione biologica probabile tra fumo e settimane di gestazione (Smoking * GestWeeks). Il fumo potrebbe avere un impatto negativo che si aggrava con l’avanzare della gestazione.
# Creazione termine quadratico
df_model <- df_clean %>%
mutate(GestWeeks_Sq = GestWeeks^2)
# Fit modello con interazione (effetto di secondo ordine)
mod_iniziale <- lm(Weight_g ~ MaternalAge + NumPregnancies +
GestWeeks + GestWeeks_Sq + Length_mm + HeadDiameter_mm +
Sex + Smoking * GestWeeks,
data = df_model)
tidy(mod_iniziale, conf.int = TRUE) %>%
dplyr::select(term, estimate, std.error, statistic, p.value) %>%
kbl(caption = "Stime dei Coefficienti (Modello Iniziale)", digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | -4579.10 | 901.71 | -5.08 | 0.00 |
| MaternalAge | 0.94 | 1.15 | 0.82 | 0.41 |
| NumPregnancies | 11.43 | 4.67 | 2.45 | 0.01 |
| GestWeeks | -86.76 | 49.96 | -1.74 | 0.08 |
| GestWeeks_Sq | 1.61 | 0.67 | 2.41 | 0.02 |
| Length_mm | 10.34 | 0.30 | 33.97 | 0.00 |
| HeadDiameter_mm | 10.61 | 0.43 | 24.76 | 0.00 |
| SexM | 76.41 | 11.25 | 6.79 | 0.00 |
| SmokingYes | 968.60 | 760.75 | 1.27 | 0.20 |
| GestWeeks:SmokingYes | -25.41 | 19.36 | -1.31 | 0.19 |
Commento ai Test: In una regressione multipla, i coefficienti indicano l’incremento medio della variabile risposta (Y) al variare di una singola variabile X, mantenendo costanti tutte le altre.
Lunghezza e Cranio: Per ogni millimetro in più di lunghezza (Length_mm), il peso neonatale aumenta in media di β grammi, a parità di altre condizioni. Lo stesso vale per il diametro cranico.
Sesso (SexM): A parità di tutte le altre variabili (settimane, misure, ecc.), un neonato maschio pesa mediamente β grammi in più rispetto a una femmina.
Non-linearità e Interazioni: La significatività dei termini GestWeeks e dell’interazione Smoking:GestWeeks indica che l’effetto delle settimane di gravidanza sul peso è curvo, e che l’effetto negativo del fumo si modifica a seconda dell’età gestazionale.
Un modello solido non deve essere influenzato da poche osservazioni anomale (outlier multivariati). Utilizziamo la Distanza di Cook per identificare i punti ad alta influenza e rimuoverli.
# Calcolo Distanza di Cook
cooksD <- cooks.distance(mod_iniziale)
threshold <- 4 / nrow(df_model)
influential_obs <- which(cooksD > threshold)
# Rimozione outlier e refit del modello FINALE
df_robust <- df_model[-influential_obs, ]
mod_finale <- lm(Weight_g ~ MaternalAge + NumPregnancies +
GestWeeks + GestWeeks_Sq + Length_mm + HeadDiameter_mm +
Sex + Smoking * GestWeeks,
data = df_robust)
# Confronto R-quadro
mod_performance <- data.frame(
Modello = c("Iniziale (con outlier)", "Finale (senza outlier)"),
R_Squared = c(summary(mod_iniziale)$r.squared, summary(mod_finale)$r.squared),
Adj_R_Squared = c(summary(mod_iniziale)$adj.r.squared, summary(mod_finale)$adj.r.squared),
Sigma = c(summary(mod_iniziale)$sigma, summary(mod_finale)$sigma)
)
mod_performance %>%
kbl(caption = "Miglioramento delle Performance del Modello", digits = 2) %>%
kable_styling(full_width = FALSE)| Modello | R_Squared | Adj_R_Squared | Sigma |
|---|---|---|---|
| Iniziale (con outlier) | 0.73 | 0.73 | 274.43 |
| Finale (senza outlier) | 0.76 | 0.76 | 239.23 |
Rimuovendo 116 osservazioni. influenti, il nostro modello finale risulta molto più stabile e preciso.
Come richiesto, utilizziamo il modello migliore scelto (quello ripulito dagli outlier, mod_finale) per prevedere il peso in uno scenario clinico: madre 30enne, non fumatrice, prima gravidanza, 39 settimane, feto femmina con misure biomediche medie.
# Creazione del nuovo record
new_data <- data.frame(
MaternalAge = 30,
NumPregnancies = 1,
Smoking = factor("No", levels = levels(df_robust$Smoking)),
GestWeeks = 39,
GestWeeks_Sq = 39^2,
Length_mm = mean(df_robust$Length_mm),
HeadDiameter_mm = mean(df_robust$HeadDiameter_mm),
Sex = factor("F", levels = levels(df_robust$Sex))
)
# Previsione con intervallo di confidenza usando il mod_finale
previsione <- predict(mod_finale, newdata = new_data, interval = "prediction")
previsione %>%
as.data.frame() %>%
rename(Peso_Atteso = fit, Limite_Inf = lwr, Limite_Sup = upr) %>%
kbl(caption = "Previsione Peso Neonatale (g) a 39 Settimane", digits = 2) %>%
kable_styling(bootstrap_options = "striped", full_width = FALSE)| Peso_Atteso | Limite_Inf | Limite_Sup |
|---|---|---|
| 3251.76 | 2782.4 | 3721.13 |
L’analisi ha evidenziato come l’utilizzo di un approccio logico, integrato da effetti di secondo ordine e un’attenta diagnostica degli outlier, porti a un modello robusto (\(R^2\) elevato). L’esclusione a priori di variabili clinicamente non rilevanti ai fini predittivi (ospedale, tipo di parto) ha permesso di ottenere stime dei coefficienti affidabili e pronte per un potenziale utilizzo previsionale pre-parto.