Modello Predittivo del Peso Neonatale
Maria Gentiluomo
2025-05-04
Introduzione
Il progetto che segue mira a creare un modello statistico in grado di prevedere con precisione il peso dei neonati alla nascita, basandosi su variabili cliniche raccolte da tre ospedali. Il progetto mira a migliorare la gestione delle gravidanze ad alto rischio, ottimizzare le risorse ospedaliere e garantire migliori risultati per la salute neonatale. Per costruire il modello predittivo, abbiamo raccolto dati su 2500 neonati provenienti da tre ospedali. Le variabili raccolte includono:
- Età della madre (quantitativa su scala di rapporto): anni.
- Numero di gravidanze (discreta).
- Fumo materno (qualitativa nominale binaria): 0 = non fumatrice, 1 = fumatrice.
- Durata della gravidanza (quantitativa su scala di rapporto): settimane.
- Peso del neonato (quantitativa su scala di rapporto): grammi.
- Lunghezza e diametro cranico (quantitative su scala di rapporto): centimetri.
- Tipo di parto (qualitativa nominale): naturale o cesareo.
- Ospedale (qualitativa nominale): ospedale 1, 2 o 3.
- Sesso (qualitativa binaria nominale): M o F.
L’obiettivo principale è identificare quali di queste variabili sono più predittive del peso alla nascita, con un focus particolare sull’impatto del fumo materno e delle settimane di gestazione, che potrebbero indicare nascite premature.
1. Caricamento dati e pulizia
data <- read.csv("neonati.csv")
data$Anni.madre[data$Anni.madre < 13] <- median(data$Anni.madre[data$Anni.madre >= 13])
data <- na.omit(data)
data$Fumatrici <- factor(data$Fumatrici, levels = c(0,1), labels = c("No", "Sì"))
data$Tipo.parto <- factor(data$Tipo.parto)
data$Ospedale <- factor(data$Ospedale)
data$Sesso <- factor(data$Sesso)2. Statistiche descrittive
# Sono state selezionate solo variabili numeriche per riepilogo statistico
summary_table <- data %>%
select(where(is.numeric)) %>%
summarise(
across(everything(), list(
Min = ~min(., na.rm = TRUE),
Q1 = ~quantile(., 0.25, na.rm = TRUE),
Median = ~median(., na.rm = TRUE),
Mean = ~mean(., na.rm = TRUE),
Q3 = ~quantile(., 0.75, na.rm = TRUE),
Max = ~max(., na.rm = TRUE)
), .names = "{.col}_{.fn}")
) %>%
pivot_longer(cols = everything(),
names_to = c("Variabile", "Statistica"),
names_sep = "_") %>%
pivot_wider(names_from = Statistica, values_from = value)
summary_table <- summary_table %>% mutate(across(where(is.numeric), ~round(., 2)))
# Riepilogo tabella ordinata
kable(summary_table, caption = "Statistiche descrittive delle variabili numeriche") %>%
kable_styling(full_width = FALSE)| Variabile | Min | Q1 | Median | Mean | Q3 | Max |
|---|---|---|---|---|---|---|
| Anni.madre | 13 | 25 | 28 | 28.19 | 32 | 46 |
| N.gravidanze | 0 | 0 | 1 | 0.98 | 1 | 12 |
| Gestazione | 25 | 38 | 39 | 38.98 | 40 | 43 |
| Peso | 830 | 2990 | 3300 | 3284.08 | 3620 | 4930 |
| Lunghezza | 310 | 480 | 500 | 494.69 | 510 | 565 |
| Cranio | 235 | 330 | 340 | 340.03 | 350 | 390 |
La tabella riassume le variabili numeriche del dataset attraverso le principali statistiche descrittive: valore minimo, primo quartile, mediana, media, terzo quartile e massimo. Questi valori aiutano a comprendere la distribuzione e la variabilità delle misure alla nascita.
# Istogramma della variabile Peso
p1 <- ggplot(data, aes(Peso)) +
geom_histogram(binwidth = 100, fill="skyblue", color="black") +
labs(title="Distribuzione del Peso", x="Peso (g)", y="Frequenza")
p1
# Boxplot del peso in base al fumo materno
ggplot(data, aes(x = Fumatrici, y = Peso, fill = Fumatrici)) +
geom_boxplot() +
labs(title = "Peso in base al fumo materno", x = "Fumatrici", y = "Peso (g)")
# Boxplot del peso in base al sesso
ggplot(data, aes(x = Sesso, y = Peso, fill = Sesso)) +
geom_boxplot() +
labs(title = "Peso in base al sesso", x = "Sesso", y = "Peso (g)")
L’istogramma della variabile Peso ha una forma simmetrica (leggermente più allungata a sinistra → asimmetria negativa). Il peso più frequente (moda) è attorno a 3300 g. Alcuni neonati pesano meno di 2000 g, il che indica possibili parti prematuri. La maggior parte ha un peso compreso tra 2900 e 3700 g, valore tipico alla nascita.
Il Boxplot confronta il peso medio e la variabilità tra figli di madri fumatrici e non fumatrici. Le madri non fumatrici hanno neonati con un peso mediamente più alto. Le madri fumatrici tendono ad avere figli con peso leggermente più basso e più variabile. Entrambi i gruppi hanno outlier (punti neri) → neonati con peso estremamente basso o alto. Questa differenza è visibile, ma non necessariamente significativa statisticamente come verrà dimostrato più avanti.
Boxplot del peso dei neonati divisi per sesso (F vs M). I neonati maschi hanno in media un peso maggiore rispetto alle femmine. Anche la variabilità nei maschi è leggermente superiore. Sono presenti outlier in entrambi i gruppi, ma non alterano il risultato generale. I maschi tendono a pesare in media di più rispetto alle femmine alla nascita, e questa differenza è statisticamente significativa.
Asimmetria e Curtosi
Per approfondire la forma delle distribuzioni delle variabili numeriche, abbiamo calcolato l’asimmetria (skewness) e la curtosi. Questi indicatori aiutano a comprendere eventuali deviazioni dalla simmetria e dalla normalità teorica.
numeric_vars <- data %>% select(where(is.numeric))
skew_vals <- sapply(numeric_vars, skewness)
kurt_vals <- sapply(numeric_vars, kurtosis)
shape_stats <- data.frame(
Variabile = names(numeric_vars),
Asimmetria = round(skew_vals, 2),
Curtosi = round(kurt_vals, 2)
)
kable(shape_stats, caption = "Asimmetria e Curtosi delle variabili numeriche") %>%
kable_styling(full_width = FALSE)| Variabile | Asimmetria | Curtosi | |
|---|---|---|---|
| Anni.madre | Anni.madre | 0.15 | 2.90 |
| N.gravidanze | N.gravidanze | 2.51 | 13.99 |
| Gestazione | Gestazione | -2.07 | 11.26 |
| Peso | Peso | -0.65 | 5.03 |
| Lunghezza | Lunghezza | -1.51 | 9.49 |
| Cranio | Cranio | -0.79 | 5.95 |
Le variabili peso, lunghezza e cranio sono abbastanza simmetriche ma più concentrate rispetto a una normale. Il numero di gravidanze ha una distribuzione fortemente asimmetrica a destra, con pochi casi molto elevati. La variabile gestazione è asimmetrica a sinistra, indicando presenza di neonati prematuri.
3. Analisi esplorativa e Correlazioni tra variabili numeriche
par(mfrow=c(2,3))
hist(data$Peso, main="Peso", xlab="g")
hist(data$Lunghezza, main="Lunghezza", xlab="mm")
hist(data$Cranio, main="Cranio", xlab="mm")
hist(data$Anni.madre, main="Età madre")
hist(data$Gestazione, main="Settimane")
hist(data$N.gravidanze, main="N. gravidanze")
L’analisi esplorativa mostra che i dati presentano distribuzioni coerenti. In particolare, l’età materna si concentra tra i 20 e i 40 anni. Le settimane di gestazione e il numero di gravidanze mostrano asimmetrie naturali, mentre peso, lunghezza e cranio hanno distribuzioni simmetriche o lievemente asimmetriche.
cor_matrix <- cor(select(data, where(is.numeric)))
kable(round(cor_matrix, 2), caption = "Matrice di correlazione") %>%
kable_styling(full_width = F)| Anni.madre | N.gravidanze | Gestazione | Peso | Lunghezza | Cranio | |
|---|---|---|---|---|---|---|
| Anni.madre | 1.00 | 0.38 | -0.13 | -0.02 | -0.06 | 0.02 |
| N.gravidanze | 0.38 | 1.00 | -0.10 | 0.00 | -0.06 | 0.04 |
| Gestazione | -0.13 | -0.10 | 1.00 | 0.59 | 0.62 | 0.46 |
| Peso | -0.02 | 0.00 | 0.59 | 1.00 | 0.80 | 0.70 |
| Lunghezza | -0.06 | -0.06 | 0.62 | 0.80 | 1.00 | 0.60 |
| Cranio | 0.02 | 0.04 | 0.46 | 0.70 | 0.60 | 1.00 |
La matrice di correlazione tra le variabili numeriche ci permette di identificare relazioni lineari tra le diverse misure rilevate nel dataset. I valori di correlazione vanno da -1 (correlazione negativa perfetta) a +1 (correlazione positiva perfetta), con 0 che indica assenza di relazione.
Dall’analisi si osserva che:
Il peso del neonato è fortemente correlato con la lunghezza (r = 0.80) e con il diametro cranico (r = 0.70): questo significa che, in media, neonati più lunghi e con cranio più ampio tendono a pesare di più. Queste variabili appaiono quindi molto promettenti come predittori.
La gestazione mostra una correlazione positiva moderata con il peso (r = 0.59), coerente con l’idea che più lunga è la gravidanza, maggiore è il peso del neonato.
La correlazione tra età della madre e peso è praticamente nulla (r = -0.02), così come quella tra numero di gravidanze e peso (r = 0.00), suggerendo che queste variabili non sono utili da sole per prevedere il peso alla nascita.
Anche tra le variabili indipendenti non emergono correlazioni eccessivamente alte (nessuna > 0.8), indicando che non c’è rischio di collinearità elevata che possa distorcere i risultati del modello.
4. Verifica ipotesi su valori di popolazione
Abbiamo confrontato la media del peso e della lunghezza neonatale del nostro campione con i valori standard della popolazione. Il peso medio (3284 g) non differisce in modo significativo da quello atteso (3300 g), mentre la lunghezza media (494.7 mm) risulta significativamente inferiore al valore di riferimento (500 mm). Questi risultati sono confermati dai test t a un campione, con p = 0.13 per il peso e p < 0.001 per la lunghezza.
t_test_results <- tibble(
Variabile = c("Peso", "Lunghezza"),
MediaCampione = round(c(mean(data$Peso), mean(data$Lunghezza)), 2),
TestStat = round(c(t.test(data$Peso, mu = 3300)$statistic,
t.test(data$Lunghezza, mu = 500)$statistic), 2),
P_value = round(c(t.test(data$Peso, mu = 3300)$p.value,
t.test(data$Lunghezza, mu = 500)$p.value), 4)
)
kable(t_test_results, caption = "Test t per confronto con media di popolazione") %>%
kable_styling(full_width = FALSE)| Variabile | MediaCampione | TestStat | P_value |
|---|---|---|---|
| Peso | 3284.08 | -1.52 | 0.1296 |
| Lunghezza | 494.69 | -10.08 | 0.0000 |
Fonte valori di popolazione: ospedalebambinogesu.it (articolo intitolato “Da 0 a 30 giorni: come si presenta e come cresce” dove vengono riportati peso medio=3300 g e lunghezza media=50 cm).
Test non parametrico: confronto del peso tra i sessi
Oltre al test t, è stato condotto anche un test di Wilcoxon per confrontare il peso tra maschi e femmine, in modo da validare i risultati anche in presenza di deviazioni dalla normalità.
wilcox_test <- wilcox.test(Peso ~ Sesso, data = data)
tibble(
Test = "Wilcoxon rank-sum",
W = round(wilcox_test$statistic, 2),
P_value = round(wilcox_test$p.value, 4)
) %>%
kable(caption = "Test di Wilcoxon per il confronto del Peso tra Sesso F e M") %>%
kable_styling(full_width = FALSE)| Test | W | P_value |
|---|---|---|
| Wilcoxon rank-sum | 538640.5 | 0 |
Il test di Wilcoxon rank-sum ha confermato l’esistenza di una differenza significativa nel peso alla nascita tra maschi e femmine (W = 538641, p < 0.001). Questo risultato, coerente con quanto emerso dal test t, rafforza l’evidenza che i neonati di sesso maschile tendono a presentare un peso superiore rispetto alle femmine, anche senza assumere la normalità delle distribuzioni.
5. Parti cesari per ospedale
table_parti <- table(data$Tipo.parto, data$Ospedale)
chisq.test(table_parti)##
## Pearson's Chi-squared test
##
## data: table_parti
## X-squared = 1.0972, df = 2, p-value = 0.5778Il test del chi-quadrato (X² = 1.097, df = 2, p = 0.578) non ha evidenziato differenze statisticamente significative nella distribuzione dei tipi di parto tra i tre ospedali. Pertanto, possiamo concludere che la frequenza di parti cesarei non dipende in modo significativo dall’ospedale.
6. Regressione lineare e selezione modello
# Aggiunta effetto quadratico e interazione
Gest2 <- data$Gestazione^2
# Modello base con sole variabili cliniche predittive
mod_base <- lm(Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso + Fumatrici, data = data)
# Modello con effetto quadratico e interazione, escludendo Ospedale e Tipo.parto
mod_quad <- lm(Peso ~ Gestazione + Gest2 + Lunghezza + Cranio + N.gravidanze + Sesso + Fumatrici + Gestazione:Fumatrici, data = data)
# Modello custom semplificato (senza interazione)
mod_custom <- lm(Peso ~ Gest2 + Lunghezza + Cranio + N.gravidanze + Sesso, data = data)
# Modello finale con stepAIC (senza Tipo.parto né Ospedale)
mod_step <- stepAIC(mod_quad, direction = "both", k = log(nrow(data)))## Start: AIC=28132.93
## Peso ~ Gestazione + Gest2 + Lunghezza + Cranio + N.gravidanze +
## Sesso + Fumatrici + Gestazione:Fumatrici
##
## Df Sum of Sq RSS AIC
## - Gestazione:Fumatrici 1 131651 187587020 28127
## - Gest2 1 428671 187884041 28131
## <none> 187455370 28133
## - N.gravidanze 1 660297 188115667 28134
## - Sesso 1 3490496 190945866 28171
## - Cranio 1 46442683 233898053 28679
## - Lunghezza 1 86950897 274406266 29078
##
## Step: AIC=28126.86
## Peso ~ Gestazione + Gest2 + Lunghezza + Cranio + N.gravidanze +
## Sesso + Fumatrici
##
## Df Sum of Sq RSS AIC
## - Fumatrici 1 84652 187671672 28120
## - Gestazione 1 193737 187780757 28122
## - Gest2 1 386634 187973654 28124
## <none> 187587020 28127
## - N.gravidanze 1 654199 188241219 28128
## + Gestazione:Fumatrici 1 131651 187455370 28133
## - Sesso 1 3442817 191029837 28165
## - Cranio 1 46451021 234038041 28672
## - Lunghezza 1 86964157 274551177 29071
##
## Step: AIC=28120.16
## Peso ~ Gestazione + Gest2 + Lunghezza + Cranio + N.gravidanze +
## Sesso
##
## Df Sum of Sq RSS AIC
## - Gestazione 1 200094 187871765 28115
## - Gest2 1 393875 188065546 28118
## <none> 187671672 28120
## - N.gravidanze 1 632219 188303891 28121
## + Fumatrici 1 84652 187587020 28127
## - Sesso 1 3426378 191098049 28158
## - Cranio 1 46500703 234172375 28666
## - Lunghezza 1 87399773 275071444 29068
##
## Step: AIC=28115
## Peso ~ Gest2 + Lunghezza + Cranio + N.gravidanze + Sesso
##
## Df Sum of Sq RSS AIC
## <none> 187871765 28115
## - N.gravidanze 1 630973 188502738 28116
## + Gestazione 1 200094 187671672 28120
## + Fumatrici 1 91008 187780757 28122
## - Sesso 1 3592323 191464088 28155
## - Gest2 1 5658634 193530399 28181
## - Cranio 1 46389582 234261347 28659
## - Lunghezza 1 88923843 276795608 29076Confronto tra modelli
model_compare <- data.frame(
Modello = c("Base", "Quadratico", "Custom", "Stepwise"),
AIC = c(AIC(mod_base), AIC(mod_quad), AIC(mod_custom), AIC(mod_step)),
BIC = c(BIC(mod_base), BIC(mod_quad), BIC(mod_custom), BIC(mod_step)),
R2 = c(summary(mod_base)$r.squared, summary(mod_quad)$r.squared, summary(mod_custom)$r.squared, summary(mod_step)$r.squared)
)
model_compare_rounded <- model_compare
model_compare_rounded[, -1] <- round(model_compare_rounded[, -1], 2)
kable(model_compare_rounded, caption = "Confronto tra modelli") %>%
kable_styling()| Modello | AIC | BIC | R2 |
|---|---|---|---|
| Base | 35180.11 | 35226.70 | 0.73 |
| Quadratico | 35177.21 | 35235.45 | 0.73 |
| Custom | 35176.75 | 35217.52 | 0.73 |
| Stepwise | 35176.75 | 35217.52 | 0.73 |
7. Interpretazione dei coefficienti
mod_step_tidy <- tidy(mod_step)
mod_step_tidy$estimate <- round(mod_step_tidy$estimate, 2)
mod_step_tidy$p.value <- round(mod_step_tidy$p.value, 4)
kable(mod_step_tidy[, c("term", "estimate", "p.value")],
caption = "Stime dei coefficienti del modello finale") %>%
kable_styling(full_width = FALSE)| term | estimate | p.value |
|---|---|---|
| (Intercept) | -6100.64 | 0.0000 |
| Gest2 | 0.44 | 0.0000 |
| Lunghezza | 10.26 | 0.0000 |
| Cranio | 10.56 | 0.0000 |
| N.gravidanze | 12.55 | 0.0038 |
| SessoM | 77.33 | 0.0000 |
I coefficienti stimati dal modello di regressione lineare multipla forniscono una misura dell’effetto medio di ciascuna variabile indipendente sul peso neonatale, mantenendo costanti le altre. L’intercetta (-6100.64) rappresenta il valore atteso del peso quando tutte le variabili esplicative sono pari a zero, ma non ha una reale interpretazione pratica in questo contesto.
Il termine Gest2, cioè il quadrato delle settimane di gestazione, ha un coefficiente positivo pari a 0.44: ciò indica che l’effetto della gestazione sul peso non è lineare, e che a gestazioni più avanzate corrisponde un incremento del peso a un tasso crescente. Le variabili lunghezza e cranio sono fortemente predittive: ogni millimetro in più di lunghezza alla nascita è associato a un incremento medio di 10.26 grammi, mentre ogni millimetro in più del diametro cranico è associato a 10.56 grammi in più nel peso.
La variabile numero di gravidanze ha un effetto positivo ma più modesto: ogni gravidanza in più è associata in media a +12.55 grammi nel peso del neonato. Il coefficiente è decimale perché rappresenta un effetto medio stimato, anche se la variabile è discreta.
Infine, la variabile SessoM è una dummy che assume valore 1 se il neonato è maschio, 0 se femmina. Il coefficiente positivo di 77.33 indica che, a parità di condizioni, i maschi pesano in media circa 77 grammi in più rispetto alle femmine. Tutti i coefficienti riportati sono statisticamente significativi (p < 0.05), a conferma della loro rilevanza nel modello.
8. Diagnostica del modello
Valutiamo ora la qualità e validità statistica del modello finale (mod_step) attraverso l’analisi dei residui e dei principali test diagnostici.
par(mfrow=c(2,2))
plot(mod_step)
shapiro.test(residuals(mod_step))##
## Shapiro-Wilk normality test
##
## data: residuals(mod_step)
## W = 0.97407, p-value < 2.2e-16bptest(mod_step)##
## studentized Breusch-Pagan test
##
## data: mod_step
## BP = 90.858, df = 5, p-value < 2.2e-16dwtest(mod_step)##
## Durbin-Watson test
##
## data: mod_step
## DW = 1.9529, p-value = 0.1191
## alternative hypothesis: true autocorrelation is greater than 0vif(mod_step)## Gest2 Lunghezza Cranio N.gravidanze Sesso
## 1.630173 2.049668 1.620750 1.023558 1.040354Per quanto riguarda la diagnostica statistica, il test di Shapiro-Wilk ha evidenziato una leggera deviazione dalla normalità dei residui (p < 0.001). Tuttavia, grazie all’elevata numerosità campionaria (2500 casi), questo risultato non compromette l’affidabilità del modello. Il test di Breusch-Pagan ha segnalato la presenza di eteroscedasticità, cioè una varianza degli errori non costante. In compenso, il test di Durbin-Watson non ha evidenziato autocorrelazione tra gli errori (p = 0.12), e gli indici VIF risultano tutti inferiori a 2.1, escludendo problemi tra le variabili indipendenti.
9. Osservazioni influenti e outlier
cooksd <- cooks.distance(mod_step)
plot(cooksd, main="Cook's Distance")
abline(h = 4/(nrow(data)-length(coef(mod_step))-1), col="red")
indice_influente <- which.max(cooksd)
kable(data[indice_influente, ], caption = paste("Osservazione più influente (ID:", indice_influente, ")")) %>%
kable_styling(full_width = F)| Anni.madre | N.gravidanze | Fumatrici | Gestazione | Peso | Lunghezza | Cranio | Tipo.parto | Ospedale | Sesso | |
|---|---|---|---|---|---|---|---|---|---|---|
| 1551 | 35 | 1 | No | 38 | 4370 | 315 | 374 | Nat | osp3 | F |
L’osservazione ID 1551 risulta essere la più influente secondo la distanza di Cook. Si tratta di un caso atipico in cui il peso del neonato è molto elevato (4370g), ma la lunghezza è insolitamente bassa (315mm), una combinazione rara o potenzialmente frutto di errore di registrazione. Questo tipo di osservazioni può alterare significativamente i coefficienti del modello e va valutato attentamente nella fase di diagnostica.
# Residui standardizzati
resid_std <- rstandard(mod_step)
outliers <- which(abs(resid_std) > 3)
if(length(outliers) > 0) {
kable(data[outliers, ], caption = "Osservazioni con residui standardizzati > |3|") %>% kable_styling()
}| Anni.madre | N.gravidanze | Fumatrici | Gestazione | Peso | Lunghezza | Cranio | Tipo.parto | Ospedale | Sesso | |
|---|---|---|---|---|---|---|---|---|---|---|
| 119 | 31 | 0 | No | 40 | 3410 | 550 | 372 | Nat | osp2 | M |
| 130 | 30 | 2 | No | 39 | 4240 | 485 | 352 | Nat | osp2 | M |
| 155 | 30 | 0 | No | 36 | 3610 | 410 | 330 | Nat | osp1 | M |
| 310 | 40 | 3 | No | 28 | 1560 | 420 | 379 | Nat | osp3 | F |
| 791 | 30 | 1 | No | 41 | 4440 | 510 | 335 | Nat | osp3 | M |
| 1036 | 26 | 0 | No | 40 | 4330 | 500 | 355 | Nat | osp3 | F |
| 1268 | 28 | 1 | No | 40 | 3790 | 460 | 332 | Nat | osp2 | F |
| 1293 | 30 | 3 | No | 38 | 4600 | 485 | 380 | Nat | osp1 | M |
| 1306 | 23 | 0 | No | 41 | 4900 | 510 | 352 | Nat | osp2 | F |
| 1399 | 42 | 2 | No | 38 | 2560 | 525 | 349 | Ces | osp2 | M |
| 1541 | 30 | 0 | No | 38 | 4540 | 530 | 343 | Ces | osp3 | M |
| 1551 | 35 | 1 | No | 38 | 4370 | 315 | 374 | Nat | osp3 | F |
| 1553 | 30 | 4 | No | 35 | 4520 | 520 | 360 | Nat | osp2 | F |
| 1635 | 32 | 2 | No | 39 | 3430 | 445 | 322 | Ces | osp1 | F |
| 1694 | 23 | 1 | No | 36 | 3850 | 460 | 334 | Ces | osp3 | F |
| 1920 | 26 | 0 | Sì | 39 | 4930 | 550 | 350 | Ces | osp2 | F |
| 2023 | 27 | 1 | No | 39 | 4650 | 510 | 354 | Nat | osp2 | M |
| 2115 | 35 | 1 | No | 32 | 1890 | 500 | 309 | Nat | osp2 | F |
| 2195 | 38 | 1 | No | 40 | 3980 | 480 | 335 | Nat | osp1 | F |
| 2219 | 37 | 1 | No | 39 | 2500 | 490 | 352 | Ces | osp1 | M |
| 2225 | 27 | 0 | No | 35 | 3140 | 465 | 290 | Nat | osp2 | F |
| 2315 | 24 | 0 | No | 42 | 2800 | 520 | 340 | Ces | osp2 | M |
10. Validazione
# Validazione con arrotondamento dei risultati
set.seed(123)
train_control <- trainControl(method = "cv", number = 10)
model_cv <- train(Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso,
data = data, method = "lm", trControl = train_control)
cv_results <- model_cv$results
cv_results <- round(cv_results[, c("RMSE", "Rsquared", "MAE")], 2)
kable(cv_results, caption = "Risultati della validazione incrociata (10-fold)") %>%
kable_styling()| RMSE | Rsquared | MAE |
|---|---|---|
| 274.86 | 0.72 | 211.26 |
Il modello sviluppato si è dimostrato affidabile e performante sia in termini statistici che predittivi. Innanzitutto, l’R² pari a 0.72 indica che il modello riesce a spiegare circa il 72% della variabilità osservata nel peso neonatale. Anche le metriche di errore confermano la bontà della previsione: l’errore quadratico medio (RMSE) è di circa 274 grammi, mentre l’errore assoluto medio (MAE) è di 211 grammi, valori che dimostrano che il modello commette errori contenuti nella stima del peso alla nascita.
11. Predizione caso ipotetico
Una volta validato il modello, lo abbiamo utilizzato per fare previsioni pratiche. In questo caso, si è provato a stimare il peso di una neonata considerando una madre alla terza gravidanza che partorirà alla 39esima settimana. Il modello prevede un peso alla nascita di circa 3325 grammi. L’intervallo di previsione al 95% va da 2786 g a 3864 g, cioè il vero peso del neonato dovrebbe cadere in questo intervallo con elevata probabilità.
nuovo_neonato <- data.frame(
Gestazione = 39,
Gest2 = 39^2,
Lunghezza = 500,
Cranio = 340,
N.gravidanze = 3,
Sesso = "F"
)
predict(mod_step, newdata = nuovo_neonato, interval = "prediction")## fit lwr upr
## 1 3324.245 2785.522 3862.96712. Visualizzazioni
# Interazione Gestazione x Fumo
p2 <- ggplot(data, aes(x = Gestazione, y = Peso, color = Fumatrici)) +
geom_point(alpha = 0.5) +
geom_smooth(method = "lm", se = FALSE) +
labs(title = "Effetto combinato di Gestazione e Fumo sul Peso", x = "Settimane di Gestazione", y = "Peso (g)")
p2
# Andamento peso previsto
gest_pred <- data.frame(Gestazione = seq(min(data$Gestazione), max(data$Gestazione), 1))
gest_pred$Gest2 <- gest_pred$Gestazione^2
gest_pred$Lunghezza <- mean(data$Lunghezza)
gest_pred$Cranio <- mean(data$Cranio)
gest_pred$N.gravidanze <- 1
gest_pred$Sesso <- "F"
pred <- predict(mod_step, newdata = gest_pred, interval = "confidence")
gest_pred$fit <- pred[, "fit"]
gest_pred$lwr <- pred[, "lwr"]
gest_pred$upr <- pred[, "upr"]
ggplot(gest_pred, aes(x = Gestazione, y = fit)) +
geom_line(color = "blue", size = 1.1) +
geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.2) +
labs(title = "Effetto della Gestazione sul Peso Previsto", x = "Settimane", y = "Peso stimato (g)")
# Heatmap: Peso medio neonato per Fumatrici e settimane di Gestazione
data$Gest_bin <- cut(data$Gestazione, breaks = seq(34, 43, by = 1), include.lowest = TRUE)
agg <- data %>% group_by(Gest_bin, Fumatrici) %>% summarise(PesoMedio = mean(Peso)) %>% na.omit()
heatmap_plot <- ggplot(agg, aes(x = Gest_bin, y = Fumatrici, fill = PesoMedio)) +
geom_tile(color = "white") +
scale_fill_viridis_c() +
labs(title = "Heatmap del Peso Medio per Gestazione e Fumo", x = "Settimane", y = "Fumatrici") +
theme_minimal()
heatmap_plot
Conclusioni
L’analisi effettuata ha evidenziato come la durata della gestazione e il fumo materno siano tra i principali predittori del peso neonatale. In particolare, è stato confermato l’impatto negativo del fumo sulla crescita intrauterina, supportando l’importanza di programmi di prevenzione e monitoraggio durante la gravidanza. Dal punto di vista metodologico, il modello di regressione lineare multipla ha fornito buone prestazioni predittive, con R² soddisfacente e residui ben distribuiti. L’utilizzo del criterio AIC ha permesso di ottimizzare il modello.Successivamente, tramite grafici si sono comunicati i risultati del modello e mostrato le relazioni più significative tra le variabili: l’impatto del numero di settimane di gestazione e del fumo sul peso previsto. Si è dimostrato che il peso aumenta chiaramente con il numero di settimane: più lungo è il periodo di gestazione, più pesante tende a essere il neonato. In particolare, nel primo grafico, la linea rossa è sempre sopra quella azzurra, a dimostrazione che i neonati di madri non fumatrici tendono ad avere un peso maggiore a parità di settimane. Questo supporta l’ipotesi che il fumo materno sia associato a un peso alla nascita più basso. Inoltre, il secondo grafico mostra come il peso previsto alla nascita aumenti in modo accelerato con l’avanzare delle settimane di gestazione: la linea blu, infatti, rappresenta il peso stimato in grammi in funzione del numero di settimane di gestazione; l’area grigia attorno alla linea indica l’intervallo di confidenza al 95%: in questo intervallo ci si aspetta che cada la vera media del peso previsto. Infine,la heatmap mostra un chiaro effetto sia della durata della gravidanza che del fumo materno sul peso neonatale, confermando come il fumo appare associato a una riduzione del peso in tutte le settimane analizzate. Questo studio si propone come base per strumenti predittivi utili alla pratica clinica quotidiana: l’uso di un modello statistico può supportare ginecologi e neonatologi nel valutare precocemente situazioni di rischio legate a basso peso alla nascita. In prospettiva, l’integrazione con sistemi digitali e app può rendere queste analisi accessibili in tempo reale durante le visite prenatali.