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: Misura dell’età in anni.
  • Numero di gravidanze: Quante gravidanze ha avuto la madre.
  • Fumo materno: Un indicatore binario (0=non fumatrice, 1=fumatrice).
  • Durata della gravidanza: Numero di settimane di gestazione.
  • Peso del neonato: Peso alla nascita in grammi.
  • Lunghezza e diametro del cranio: Lunghezza del neonato e diametro craniale, misurabili anche durante la gravidanza tramite ecografie.
  • Tipo di parto: Naturale o cesareo.
  • Ospedale di nascita: Ospedale 1, 2 o 3.
  • Sesso del neonato: Maschio (M) o femmina (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 librerie e dati

library(tidyverse)
## Warning: il pacchetto 'ggplot2' è stato creato con R versione 4.4.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.2     ✔ tibble    3.2.1
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.0.4     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(car)
## Warning: il pacchetto 'car' è stato creato con R versione 4.4.3
## Caricamento del pacchetto richiesto: carData
## Warning: il pacchetto 'carData' è stato creato con R versione 4.4.3
## 
## Caricamento pacchetto: 'car'
## 
## Il seguente oggetto è mascherato da 'package:dplyr':
## 
##     recode
## 
## Il seguente oggetto è mascherato da 'package:purrr':
## 
##     some
library(MASS)
## 
## Caricamento pacchetto: 'MASS'
## 
## Il seguente oggetto è mascherato da 'package:dplyr':
## 
##     select
library(lmtest)
## Warning: il pacchetto 'lmtest' è stato creato con R versione 4.4.3
## Caricamento del pacchetto richiesto: zoo
## Warning: il pacchetto 'zoo' è stato creato con R versione 4.4.3
## 
## Caricamento pacchetto: 'zoo'
## 
## I seguenti oggetti sono mascherati da 'package:base':
## 
##     as.Date, as.Date.numeric
library(moments)
library(ggplot2)
library(caret)
## Warning: il pacchetto 'caret' è stato creato con R versione 4.4.3
## Caricamento del pacchetto richiesto: lattice
## 
## Caricamento pacchetto: 'caret'
## 
## Il seguente oggetto è mascherato da 'package:purrr':
## 
##     lift
library(plotly)
## Warning: il pacchetto 'plotly' è stato creato con R versione 4.4.3
## 
## Caricamento pacchetto: 'plotly'
## 
## Il seguente oggetto è mascherato da 'package:MASS':
## 
##     select
## 
## Il seguente oggetto è mascherato da 'package:ggplot2':
## 
##     last_plot
## 
## Il seguente oggetto è mascherato da 'package:stats':
## 
##     filter
## 
## Il seguente oggetto è mascherato da 'package:graphics':
## 
##     layout
# Importazione dati
data <- read.csv("neonati.csv")
str(data)
## 'data.frame':    2500 obs. of  10 variables:
##  $ Anni.madre  : int  26 21 34 28 20 32 26 25 22 23 ...
##  $ N.gravidanze: int  0 2 3 1 0 0 1 0 1 0 ...
##  $ Fumatrici   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Gestazione  : int  42 39 38 41 38 40 39 40 40 41 ...
##  $ Peso        : int  3380 3150 3640 3690 3700 3200 3100 3580 3670 3700 ...
##  $ Lunghezza   : int  490 490 500 515 480 495 480 510 500 510 ...
##  $ Cranio      : int  325 345 375 365 335 340 345 349 335 362 ...
##  $ Tipo.parto  : chr  "Nat" "Nat" "Nat" "Nat" ...
##  $ Ospedale    : chr  "osp3" "osp1" "osp2" "osp2" ...
##  $ Sesso       : chr  "M" "F" "M" "M" ...
head(data)
##   Anni.madre N.gravidanze Fumatrici Gestazione Peso Lunghezza Cranio Tipo.parto
## 1         26            0         0         42 3380       490    325        Nat
## 2         21            2         0         39 3150       490    345        Nat
## 3         34            3         0         38 3640       500    375        Nat
## 4         28            1         0         41 3690       515    365        Nat
## 5         20            0         0         38 3700       480    335        Nat
## 6         32            0         0         40 3200       495    340        Nat
##   Ospedale Sesso
## 1     osp3     M
## 2     osp1     F
## 3     osp2     M
## 4     osp2     M
## 5     osp3     F
## 6     osp2     F
# Pulizia: sostituisco valori sospetti nell'età madre

data$Anni.madre[data$Anni.madre < 13] <- median(data$Anni.madre[data$Anni.madre >= 13])

# Gestione missing: eliminazione righe con NA
data <- na.omit(data)

# Conversione di variabili categoriche in fattori 

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

# Statistiche descrittive generali
summary_stats <- data %>%
  summarise(across(where(is.numeric), list(media = mean, mediana = median, sd = sd, IQR = IQR)))
summary_stats
##   Anni.madre_media Anni.madre_mediana Anni.madre_sd Anni.madre_IQR
## 1           28.186                 28      5.215121              7
##   N.gravidanze_media N.gravidanze_mediana N.gravidanze_sd N.gravidanze_IQR
## 1             0.9812                    1        1.280587                1
##   Gestazione_media Gestazione_mediana Gestazione_sd Gestazione_IQR Peso_media
## 1          38.9804                 39      1.868639              2   3284.081
##   Peso_mediana  Peso_sd Peso_IQR Lunghezza_media Lunghezza_mediana Lunghezza_sd
## 1         3300 525.0387      630         494.692               500     26.31864
##   Lunghezza_IQR Cranio_media Cranio_mediana Cranio_sd Cranio_IQR
## 1            30     340.0292            340  16.42533         20
# Istogramma del peso
ggplot(data, aes(Peso)) + 
geom_histogram(binwidth = 100, fill="skyblue", color="black") +
labs(title="Distribuzione del peso", x="Peso (g)", y="Frequenza")

# 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.

3. Statistiche descrittive avanzate

numeric_vars <- data[, sapply(data, is.numeric)]
skewness_vals <- sapply(numeric_vars, skewness)
kurtosis_vals <- sapply(numeric_vars, kurtosis)

summary(numeric_vars)
##    Anni.madre     N.gravidanze       Gestazione         Peso     
##  Min.   :13.00   Min.   : 0.0000   Min.   :25.00   Min.   : 830  
##  1st Qu.:25.00   1st Qu.: 0.0000   1st Qu.:38.00   1st Qu.:2990  
##  Median :28.00   Median : 1.0000   Median :39.00   Median :3300  
##  Mean   :28.19   Mean   : 0.9812   Mean   :38.98   Mean   :3284  
##  3rd Qu.:32.00   3rd Qu.: 1.0000   3rd Qu.:40.00   3rd Qu.:3620  
##  Max.   :46.00   Max.   :12.0000   Max.   :43.00   Max.   :4930  
##    Lunghezza         Cranio   
##  Min.   :310.0   Min.   :235  
##  1st Qu.:480.0   1st Qu.:330  
##  Median :500.0   Median :340  
##  Mean   :494.7   Mean   :340  
##  3rd Qu.:510.0   3rd Qu.:350  
##  Max.   :565.0   Max.   :390
skewness_vals
##   Anni.madre N.gravidanze   Gestazione         Peso    Lunghezza       Cranio 
##    0.1512083    2.5142541   -2.0653133   -0.6470308   -1.5146991   -0.7850527
kurtosis_vals
##   Anni.madre N.gravidanze   Gestazione         Peso    Lunghezza       Cranio 
##     2.896723    13.989406    11.258150     5.031532     9.487174     5.946206

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 (parti <37 settimane).

3. Analisi esplorativa

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 ora 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.

4. Verifica ipotesi campione vs popolazione

shapiro.test(data$Peso)
## 
##  Shapiro-Wilk normality test
## 
## data:  data$Peso
## W = 0.97066, p-value < 2.2e-16
t.test(data$Peso, mu=3300)
## 
##  One Sample t-test
## 
## data:  data$Peso
## t = -1.516, df = 2499, p-value = 0.1296
## alternative hypothesis: true mean is not equal to 3300
## 95 percent confidence interval:
##  3263.490 3304.672
## sample estimates:
## mean of x 
##  3284.081
shapiro.test(data$Lunghezza)
## 
##  Shapiro-Wilk normality test
## 
## data:  data$Lunghezza
## W = 0.90941, p-value < 2.2e-16
t.test(data$Lunghezza, mu=500)
## 
##  One Sample t-test
## 
## data:  data$Lunghezza
## t = -10.084, df = 2499, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 500
## 95 percent confidence interval:
##  493.6598 495.7242
## sample estimates:
## mean of x 
##   494.692

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.

5. Differenze tra i sessi

t.test(Peso ~ Sesso, data = data)
## 
##  Welch Two Sample t-test
## 
## data:  Peso by Sesso
## t = -12.106, df = 2490.7, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
##  -287.1051 -207.0615
## sample estimates:
## mean in group F mean in group M 
##        3161.132        3408.215
wilcox.test(Peso ~ Sesso, data = data)
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Peso by Sesso
## W = 538641, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0
t.test(Lunghezza ~ Sesso, data = data)
## 
##  Welch Two Sample t-test
## 
## data:  Lunghezza by Sesso
## t = -9.582, df = 2459.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
##  -11.929470  -7.876273
## sample estimates:
## mean in group F mean in group M 
##        489.7643        499.6672
t.test(Cranio ~ Sesso, data = data)
## 
##  Welch Two Sample t-test
## 
## data:  Cranio by Sesso
## t = -7.4102, df = 2491.4, p-value = 1.718e-13
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
##  -6.089912 -3.541270
## sample estimates:
## mean in group F mean in group M 
##        337.6330        342.4486

L’analisi delle differenze tra i sessi mostra che i neonati maschi presentano valori medi significativamente maggiori rispetto alle femmine in tutte e tre le variabili analizzate: peso (+247 g), lunghezza (+10 mm) e diametro cranico (+4.8 mm). I risultati sono confermati sia da test parametrici (t-test) che non parametrici (Wilcoxon), con p-value < 0.001 in tutti i casi.

6. Parti cesarei 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.5778

Il 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.

7. Regressione lineare completa

data$Fumatrici <- factor(data$Fumatrici, labels = c("No", "Sì"))
mod_full <- lm(Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso + Anni.madre + Tipo.parto + Fumatrici + Ospedale, data = data)
summary(mod_full)
## 
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + 
##     Sesso + Anni.madre + Tipo.parto + Fumatrici + Ospedale, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1123.3  -181.2   -14.6   160.7  2612.6 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -6735.1677   141.3977 -47.633  < 2e-16 ***
## Gestazione       32.5265     3.8179   8.520  < 2e-16 ***
## Lunghezza        10.2951     0.3007  34.237  < 2e-16 ***
## Cranio           10.4725     0.4261  24.580  < 2e-16 ***
## N.gravidanze     11.4118     4.6665   2.445   0.0145 *  
## SessoM           77.5473    11.1779   6.938 5.07e-12 ***
## Anni.madre        0.7983     1.1463   0.696   0.4862    
## Tipo.partoNat    29.5027    12.0848   2.441   0.0147 *  
## FumatriciSì     -30.1567    27.5396  -1.095   0.2736    
## Ospedaleosp2    -11.2216    13.4388  -0.835   0.4038    
## Ospedaleosp3     28.0984    13.4972   2.082   0.0375 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 273.9 on 2489 degrees of freedom
## Multiple R-squared:  0.7289, Adjusted R-squared:  0.7278 
## F-statistic: 669.1 on 10 and 2489 DF,  p-value: < 2.2e-16

8. Selezione del miglior modello con BIC

mod_inter <- lm(Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio + N.gravidanze + Sesso + Tipo.parto, data = data)
mod_step <- stepAIC(mod_full, direction = "both", k = log(nrow(data)))
## Start:  AIC=28139.46
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso + 
##     Anni.madre + Tipo.parto + Fumatrici + Ospedale
## 
##                Df Sum of Sq       RSS   AIC
## - Anni.madre    1     36392 186809099 28132
## - Fumatrici     1     89979 186862686 28133
## - Ospedale      2    686397 187459103 28133
## - Tipo.parto    1    447233 187219939 28138
## - N.gravidanze  1    448762 187221469 28138
## <none>                      186772707 28140
## - Sesso         1   3611588 190384294 28180
## - Gestazione    1   5446558 192219264 28204
## - Cranio        1  45338051 232110758 28675
## - Lunghezza     1  87959790 274732497 29096
## 
## Step:  AIC=28132.12
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso + 
##     Tipo.parto + Fumatrici + Ospedale
## 
##                Df Sum of Sq       RSS   AIC
## - Fumatrici     1     90897 186899996 28126
## - Ospedale      2    692738 187501837 28126
## - Tipo.parto    1    448222 187257321 28130
## <none>                      186809099 28132
## - N.gravidanze  1    633756 187442855 28133
## + Anni.madre    1     36392 186772707 28140
## - Sesso         1   3618736 190427835 28172
## - Gestazione    1   5412879 192221978 28196
## - Cranio        1  45588236 232397335 28670
## - Lunghezza     1  87950050 274759149 29089
## 
## Step:  AIC=28125.51
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso + 
##     Tipo.parto + Ospedale
## 
##                Df Sum of Sq       RSS   AIC
## - Ospedale      2    701680 187601677 28119
## - Tipo.parto    1    440684 187340680 28124
## <none>                      186899996 28126
## - N.gravidanze  1    610840 187510837 28126
## + Fumatrici     1     90897 186809099 28132
## + Anni.madre    1     37311 186862686 28133
## - Sesso         1   3602797 190502794 28165
## - Gestazione    1   5346781 192246777 28188
## - Cranio        1  45632149 232532146 28664
## - Lunghezza     1  88355030 275255027 29086
## 
## Step:  AIC=28119.23
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso + 
##     Tipo.parto
## 
##                Df Sum of Sq       RSS   AIC
## - Tipo.parto    1    463870 188065546 28118
## <none>                      187601677 28119
## - N.gravidanze  1    651066 188252743 28120
## + Ospedale      2    701680 186899996 28126
## + Fumatrici     1     99840 187501837 28126
## + Anni.madre    1     43845 187557831 28127
## - Sesso         1   3649259 191250936 28160
## - Gestazione    1   5444109 193045786 28183
## - Cranio        1  45758101 233359778 28657
## - Lunghezza     1  88054432 275656108 29074
## 
## Step:  AIC=28117.58
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso
## 
##                Df Sum of Sq       RSS   AIC
## <none>                      188065546 28118
## - N.gravidanze  1    623141 188688687 28118
## + Tipo.parto    1    463870 187601677 28119
## + Ospedale      2    724866 187340680 28124
## + Fumatrici     1     91892 187973654 28124
## + Anni.madre    1     45044 188020502 28125
## - Sesso         1   3655292 191720838 28158
## - Gestazione    1   5464853 193530399 28181
## - Cranio        1  46108583 234174130 28658
## - Lunghezza     1  87632762 275698308 29066
summary(mod_step)
## 
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + 
##     Sesso, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1149.44  -180.81   -15.58   163.64  2639.72 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -6681.1445   135.7229 -49.226  < 2e-16 ***
## Gestazione      32.3321     3.7980   8.513  < 2e-16 ***
## Lunghezza       10.2486     0.3006  34.090  < 2e-16 ***
## Cranio          10.5402     0.4262  24.728  < 2e-16 ***
## N.gravidanze    12.4750     4.3396   2.875  0.00408 ** 
## SessoM          77.9927    11.2021   6.962 4.26e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 274.6 on 2494 degrees of freedom
## Multiple R-squared:  0.727,  Adjusted R-squared:  0.7265 
## F-statistic:  1328 on 5 and 2494 DF,  p-value: < 2.2e-16
BIC(mod_step)
## [1] 35220.1

La selezione automatica del modello tramite criterio BIC ha eliminato le variabili età della madre, fumo materno e ospedale, che non risultavano significative. Il modello finale include 6 variabili:

  • 3 quantitative: gestazione, lunghezza e diametro cranico
  • 2 categoriche: sesso e tipo di parto
  • 1 discreta: numero di gravidanze

Il nuovo modello mantiene un R² del 72.8%, con un errore medio di circa 274 grammi. È quindi parco e robusto e presenta un buon compromesso tra accuratezza e semplicità.

9. Diagnostica del modello

par(mfrow=c(2,2))
plot(mod_step)

shapiro.test(residuals(mod_step))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(mod_step)
## W = 0.97408, p-value < 2.2e-16
bptest(mod_step)
## 
##  studentized Breusch-Pagan test
## 
## data:  mod_step
## BP = 90.253, df = 5, p-value < 2.2e-16
dwtest(mod_step)
## 
##  Durbin-Watson test
## 
## data:  mod_step
## DW = 1.9535, p-value = 0.1224
## alternative hypothesis: true autocorrelation is greater than 0
vif(mod_step)
##   Gestazione    Lunghezza       Cranio N.gravidanze        Sesso 
##     1.669189     2.074689     1.624465     1.023475     1.040054

10. Validazione con Cross-validation (10-fold)

set.seed(123)
train_control <- trainControl(method = "cv", number = 10)
model_cv <- train(Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio + N.gravidanze + Sesso + Tipo.parto,
                  data = data, method = "lm", trControl = train_control)
model_cv
## Linear Regression 
## 
## 2500 samples
##    7 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 2250, 2249, 2251, 2250, 2250, 2250, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   274.5361  0.7242996  211.1565
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

Il modello sviluppato si è dimostrato affidabile e performante sia in termini statistici che predittivi. Innanzitutto, l’R² pari a 0.724 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. Per 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.

11. Valori influenti

cooksd <- cooks.distance(mod_step)
plot(cooksd, main="Cook's Distance")
abline(h = 4/(nrow(data)-length(coef(mod_step))-1), col="red")

L’analisi della Cook’s Distance ha evidenziato una singola osservazione influente che potrebbe alterare significativamente i risultati della regressione

12. Predizione con caso ipotetico

nuovo_neonato <- data.frame(
  Gestazione = 39,
  Lunghezza = 500,
  Cranio = 340,
  N.gravidanze = 3,
  Sesso = "F",
  Anni.madre = 30,
  Tipo.parto = "Nat",
  Fumatrici = "No",
  Ospedale = "osp1"
)
predict(mod_step, newdata = nuovo_neonato, interval = "prediction")
##        fit      lwr      upr
## 1 3325.181 2786.181 3864.182

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à.

13. Osservazioni finali

ggplot(data, aes(x = Gestazione, y = Peso, color = Fumatrici)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "lm", se = FALSE) +
  labs(title = "Interazione Fumo e Settimane Gestazione sul Peso")
## `geom_smooth()` using formula = 'y ~ x'

ggplot(data, aes(x = Lunghezza, y = Peso)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "lm")
## `geom_smooth()` using formula = 'y ~ x'

Grafici aggiuntivi

# Boxplot Peso per Tipo di Parto e Ospedale
boxplot_plot <- ggplot(data, aes(x = Ospedale, y = Peso, fill = Tipo.parto)) +
  geom_boxplot() +
  labs(title = "Boxplot del Peso per Tipo di Parto e Ospedale", x = "Ospedale", y = "Peso (g)") +
  theme_minimal()
boxplot_plot

# 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()
## `summarise()` has grouped output by 'Gest_bin'. You can override using the
## `.groups` argument.
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, è stato evidenziato (vedi secondo diagramma di dispersione con linea di regressione) che esiste una forte relazione positiva tra lunghezza e peso. La linea mostra una tendenza chiara: più è lungo il neonato, maggiore sarà il suo peso. I punti sono abbastanza vicini alla linea, quindi il modello predittivo molto preciso per queste due variabili. Pochi outlier in alto e in basso: dati estremi ma rari. A supporto di ciò, se da una parte i boxplot suggeriscono che nè il tipo di parto, nè l’ospedale hanno un impatto sostanziale sul peso alla nascita, la heatmap mostra un chiaro effetto sia della durata della gravidanza che del fumo materno sul peso neonatale, confermando 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.