L’obiettivo di questo studio è sviluppare un modello statistico capace di prevedere con precisione il peso neonatale alla nascita, utilizzando dati clinici raccolti da tre ospedali. Il progetto si propone di migliorare la gestione delle gravidanze ad alto rischio, ottimizzare l’allocazione delle risorse ospedaliere e garantire esiti più favorevoli per la salute neonatale.

Analisi preliminari.

Nella prima fase, esploreremo le variabili attraverso un’analisi descrittiva per comprenderne la distribuzione e identificare eventuali outlier o anomalie.

Iniziamo col descrivere le caratteristiche delle nostre variabili

Età della madre: Categoria di tipo quantitativo continuo, rappresenta l’età della madre in anni.
Numero di gravidanze: Categoria di tipo quantitativo discreto, rappresenta il numero di gravidanze della madre.
Fumo materno: Categoria di tipo qualitativo binario (dummy), con valori 0 (non fumatrice) e 1 (fumatrice).
Durata della gravidanza: Categoria di tipo quantitativo continuo, rappresenta la durata della gravidanza in settimane.
Peso del neonato: Categoria di tipo quantitativo continuo, rappresenta il peso del neonato alla nascita in grammi.
Lunghezza e diametro del cranio: Categoria di tipo quantitativo continuo, rappresenta la lunghezza e la circonferenza del cranio del neonato, misurabile tramite ecografie durante la gravidanza.
Tipo di parto: Categoria di tipo qualitativo nominale, con valori ‘naturale’ o ‘cesareo’.
Ospedale di nascita: Categoria di tipo qualitativo nominale, con valori che rappresentano gli ospedali 1, 2 o 3.
Sesso del neonato: Categoria di tipo qualitativo nominale, con valori ‘M’ (maschio) o ‘F’ (femmina).

colSums(is.na(dataset))
##   Anni.madre N.gravidanze    Fumatrici   Gestazione         Peso    Lunghezza 
##            0            0            0            0            0            0 
##       Cranio   Tipo.parto     Ospedale        Sesso 
##            0            0            0            0
summary(dataset)
##    Anni.madre     N.gravidanze       Fumatrici        Gestazione   
##  Min.   : 0.00   Min.   : 0.0000   Min.   :0.0000   Min.   :25.00  
##  1st Qu.:25.00   1st Qu.: 0.0000   1st Qu.:0.0000   1st Qu.:38.00  
##  Median :28.00   Median : 1.0000   Median :0.0000   Median :39.00  
##  Mean   :28.16   Mean   : 0.9812   Mean   :0.0416   Mean   :38.98  
##  3rd Qu.:32.00   3rd Qu.: 1.0000   3rd Qu.:0.0000   3rd Qu.:40.00  
##  Max.   :46.00   Max.   :12.0000   Max.   :1.0000   Max.   :43.00  
##       Peso        Lunghezza         Cranio    Tipo.parto Ospedale   Sesso   
##  Min.   : 830   Min.   :310.0   Min.   :235   Ces: 728   osp1:816   F:1256  
##  1st Qu.:2990   1st Qu.:480.0   1st Qu.:330   Nat:1772   osp2:849   M:1244  
##  Median :3300   Median :500.0   Median :340              osp3:835           
##  Mean   :3284   Mean   :494.7   Mean   :340                                 
##  3rd Qu.:3620   3rd Qu.:510.0   3rd Qu.:350                                 
##  Max.   :4930   Max.   :565.0   Max.   :390
str(dataset)
## '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  : Factor w/ 2 levels "Ces","Nat": 2 2 2 2 2 2 2 2 1 1 ...
##  $ Ospedale    : Factor w/ 3 levels "osp1","osp2",..: 3 1 2 2 3 2 3 1 2 2 ...
##  $ Sesso       : Factor w/ 2 levels "F","M": 2 1 2 2 1 1 1 2 1 1 ...
dataset$Fumatrici <- as.factor(dataset$Fumatrici)

Fisiologicamente il primo parto può coincidere con il primo ciclo,non prima, il minimo anni madre 0 è sicuramente un valore erratto.Allo stesso modo una gravidanza di una donna pari o inferiore a 14 risulta un valore errato.Identifichiamo i valori anomali e li eliminiamo dal nostro campione

colore_punti <- ifelse(dataset$Anni.madre < 14, "darkred", "lightblue")
plot(dataset$Anni.madre, pch=20, col=colore_punti, bg=colore_punti,
     main="Grafico con evidenza degli outliers", xlab="Indice delle osservazioni", ylab="Anni della madre")

neonati <- subset(dataset, Anni.madre > 14)
colore_punti <- ifelse(neonati$Anni.madre < 14, "darkred", "lightblue")
plot(neonati$Anni.madre, pch=20, col=colore_punti, bg=colore_punti,
     main="Grafico normalizzato", xlab="Indice delle osservazioni", ylab="Anni della madre")

visualizziamo graficamente anche come si distribuiscono le altre variabili per cercare di identificare altre anomalie.

# Crea gli scatterplot
plot(jitter(neonati$Peso, factor = 0.5), pch=20, col="black", main = "Peso")

plot(jitter(neonati$Anni.madre, factor = 0.5), pch=20, col="lightblue3", main = "Anni Madre")

plot(jitter(neonati$N.gravidanze, factor = 0.5), pch=20, col="grey3", main = "Numero Gravidanze")

plot(jitter(neonati$Gestazione, factor = 0.2), pch=20, col="darkgrey", main = "Gestazione")

plot(jitter(neonati$Lunghezza, factor = 0.2), pch=20, col="blue3", main = "Lunghezza")

plot(jitter(neonati$Cranio, factor = 0.2), pch=20, col="blue1", main = "Cranio")

Dall’osservazione grafica, considerando una singola variabile alla volta, non siamo in grado di identificare anomalie dovute ad errori.
Proviamo a confrontare la combinazione delle principarli variabili:

plot(neonati$Gestazione, neonati$Peso, pch=21, col="royalblue3")

plot(neonati$Lunghezza, neonati$Peso, pch=20, col="royalblue4")

n <- nrow(neonati)

Notiamo subito un numero di osservazioni molto bassa legate a gestazione prossime alle 25 settimane, i dati sembrano essere pochi e concentrati verso il limite inferiore di peso (1000g o meno). Questo potrebbe riflettere un fenomeno reale (prematurità estrema). Punti isolati e outliers: Si possono osservare alcuni punti lontani dal resto dei dati, ad esempio per pesi superiori a 5000g o molto inferiori rispetto alla media in determinate settimane. Potrebbero essere veri outlier o errori di registrazione.

In base alla nostra esperienza clinica possiamo affermare con ragionevole certezza che un neonato di circa 4500g con una lunghezza di circa 320mm è un dato anomalo, prima di escluderlo dal campione verifichiamo anche la settimana in cui idealmente tale osservazione ricade

anomalia <- which(neonati$Lunghezza<350 & neonati$Peso > 4000)

kable(neonati[1546, ],caption = "Informazioni sull'Osservazione Anomala (ID 1546)")
Informazioni sull’Osservazione Anomala (ID 1546)
Anni.madre N.gravidanze Fumatrici Gestazione Peso Lunghezza Cranio Tipo.parto Ospedale Sesso
1551 35 1 0 38 4370 315 374 Nat osp3 F

Si ritiene tale valore anomalo e presumibilmente un errore di rilevazione, escludiamo tale osservazione dal nostro campione.

neonati <- neonati[-1546, ]
#Salviamo il numero di righe del nostro dataset nella variabile n

n <- nrow(neonati)

Verifica della bontà del campione scelto (Peso e Lunghezza)

Verifichiamo la significatività dei dati del campione rispetto alla popolazione, in Italia un bambino pesa in media alla nascita 3,3kg con qualche differenza tra maschi e femmine (i maschi pesano circa 150 grammi in più), mentre non ci sono particolari differenze per quanto riguarda la lunghezza, pari mediamente a 50 centimetri. ( Fonte https://www.ospedalebambinogesu.it/)

Saggiamo l’ipotesi che i valori della media di peso e lunghezza del nostro dataset siano significativamente uguali a quelli della popolazione.

shapiro.test(neonati$Peso)  # Controlla la normalità
## 
##  Shapiro-Wilk normality test
## 
## data:  neonati$Peso
## W = 0.97055, p-value < 2.2e-16
qqnorm(neonati$Peso)        # Q-Q plot
qqline(neonati$Peso)        # Linea di riferimento

print(shapiro.test(neonati$Peso))
## 
##  Shapiro-Wilk normality test
## 
## data:  neonati$Peso
## W = 0.97055, p-value < 2.2e-16
kable("il peso approssima una distribuzione normale,per questo utilizzeremo lo t test")
x
il peso approssima una distribuzione normale,per questo utilizzeremo lo t test 
# Eseguiamo lo T-test Dato che non conosco la devizione standard della popolazione
test <- t.test(neonati$Peso,
       mu = 3300,
       conf.level = 0.95,
       alternative = "two.sided")
p_valuePeso <- test$p.value
print(p_valuePeso)
## [1] 0.1225962

Il P-Value è pari a 0.12. Non rifiutiamo l’ipotesi nulla. La media del campione non è significativamente diversa da 330

Ripetiamo l’analisi considerando ora la Lunghezza:

shapiro.test(neonati$Lunghezza)  # Controlla la normalità
## 
##  Shapiro-Wilk normality test
## 
## data:  neonati$Lunghezza
## W = 0.91542, p-value < 2.2e-16
qqnorm(neonati$Lunghezza)        # Q-Q plot
qqline(neonati$Lunghezza)        # Linea di riferimento

test <- t.test(neonati$Lunghezza,
               mu = 500,
               conf.level = 0.95,
               alternative = "two.sided")
p_valueLunghezza <- test$p.value
print(p_valueLunghezza)
## [1] 4.388815e-23

Il P-Value è pari a 4.388815 × 10⁻²³. Non rifiutiamo l’ipotesi nulla. La media del campione non è significativamente diversa da 500

Verifica della condizione:in alcuni ospedali si fanno più parti cesarei

kable(combined_table, 
      caption = "Tabella Combinata: Tipo di Parto vs Ospedale (Valori Assoluti e Percentuali)")
Tabella Combinata: Tipo di Parto vs Ospedale (Valori Assoluti e Percentuali)
osp1 osp2 osp3
Ces 241 (30%) 254 (30%) 232 (28%)
Nat 574 (70%) 592 (70%) 601 (72%) 
ggplot(data = neonati, aes(x = Ospedale, fill = Tipo.parto)) +
  geom_bar(position = "dodge") +
  labs(title = "Confronto tra Tipo di Parto e Ospedale", 
       x = "Ospedale", y = "Numero di Parto", 
       fill = "Tipo di Parto") +
  theme_minimal()

test_chi_square <-chi_square_test <- chisq.test(contingency_tableParto)

print(test_chi_square)
## 
##  Pearson's Chi-squared test
## 
## data:  contingency_tableParto
## X-squared = 1.0629, df = 2, p-value = 0.5878

il numero di parti cesarei o naturali non sembra essere condizionato dall’ospedale.Il risultato del test del chi-quadro suggerisce che non c’è evidenza di una relazione significativa tra il tipo di parto e l’ospedale.

Verifica della condizione:Le misure antropometriche sono significativamente diverse tra i due sessi

boxplot_sesso <- neonati %>%
  pivot_longer(
    cols = c(Peso, Lunghezza, Cranio),  
    names_to = "Misura",                
    values_to = "Valore") %>%
  ggplot(aes(x = Sesso, y = Valore, fill = Sesso)) +
  geom_boxplot() +
  facet_wrap(~Misura, scales = "free_y") +
  scale_fill_manual(values = c("F" = "lightpink", "M" = "lightblue")) +  # Personalizzazione colori
  theme_minimal() +
  labs(
    title = "Distribuzione delle Misure Antropometriche per Sesso",
    x = "Sesso",
    y = "Valore"
  )
print(boxplot_sesso)

kable(tabella_riassuntiva)
Misura Sesso Minimo Q1 Mediana Media Q3 Massimo
Cranio F 235 330 340 337.6042 348 390
Cranio M 265 334 343 342.4303 352 390
Lunghezza F 310 480 490 489.9194 505 565
Lunghezza M 320 490 500 499.6825 515 560
Peso F 830 2900 3160 3160.4166 3470 4930
Peso M 980 3150 3430 3408.2998 3720 4810

I test mostrano differenze statisticamente significative tra i sessi per tutte le misure antropometriche:

I maschi tendono ad avere peso e lunghezza mediamente maggiori.

Saggiamo quanto detto con un test d’ipotesi:

t_test_peso_sesso <- t.test(Peso ~ Sesso, data = neonati, alternative = "two.sided", conf.level = 0.95)

t_test_peso_sesso 
## 
##  Welch Two Sample t-test
## 
## data:  Peso by Sesso
## t = -12.133, df = 2485.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:
##  -287.9467 -207.8196
## sample estimates:
## mean in group F mean in group M 
##        3160.417        3408.300

Non si ha bisogno di un valore di riferimento come mu perché si sta confrontando le medie dei due gruppi. Il test eseguito per la variabile peso rafforza quanto affermato in precedenza, valori di T pari a -12.13 e un p-value inferiore a 2.2×10−16 dimsostrano che si rifiuta l’ipotesi nulla e si può affermare che il peso tra i neonati e neonate è significativamente diverso

# Test t per confrontare la lunghezza media tra maschi e femmine
t_test_lunghezza_sesso <- t.test(Lunghezza ~ Sesso, data = neonati, alternative = "two.sided", conf.level = 0.95)

# Visualizzare i risultati
t_test_lunghezza_sesso
## 
##  Welch Two Sample t-test
## 
## data:  Lunghezza by Sesso
## t = -9.5125, df = 2462.6, 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.775709  -7.750532
## sample estimates:
## mean in group F mean in group M 
##        489.9194        499.6825

Il test eseguito per la variabile lunghezza rafforza quanto affermato in precedenza, valori di T pari a -9.52 e un p-value inferiore a 2.2×10−16 dimsostrano che si rifiuta l’ipotesi nulla e si può affermare che la lunghezza tra i neonati e neonate è significativamente diversa

Creazione del Modello di Regressione

Procediamo alla realizzazione della matrice di correlazione sul dataset 

panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor=0.8, ...)
{
  par(usr = c(0, 1, 0, 1))
  r <- abs(cor(x, y))
  txt <- format(c(r, 0.123456789), digits = digits)[1]
  txt <- paste0(prefix, txt)
  if(r>=0.1) cex.cor <- 1.4
  text(0.5, 0.5, txt, cex = cex.cor)
  
}


pairs(x=neonati[,1:10],lower.panel=panel.cor, upper.panel=panel.smooth)

Dalla matrice di correlazione possiamo vedere che i regressori che hanno una correlazione importante con la variabile Peso sono: Lunghezza, Cranio, Gestazione e in piccola parte Sesso. La variabile Fumo risulta non essere statisticamente rilevante ma nonostate ciò la inseriremo nel primo modello con tutte le variabili al pari degli altri regressori non significativi

model1 <- lm(Peso~Anni.madre+N.gravidanze+Fumatrici+Gestazione+Lunghezza+Cranio+Tipo.parto+Ospedale+Sesso, data = neonati)
# Riepilogo del modello
summary(model1)
## 
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + 
##     Lunghezza + Cranio + Tipo.parto + Ospedale + Sesso, data = neonati)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1136.97  -181.35   -13.45   159.70  1407.28 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -6728.2252   138.9222 -48.432  < 2e-16 ***
## Anni.madre        0.5497     1.1313   0.486  0.62711    
## N.gravidanze     12.4577     4.5839   2.718  0.00662 ** 
## Fumatrici1      -27.3340    27.0381  -1.011  0.31214    
## Gestazione       29.7683     3.7607   7.916 3.67e-15 ***
## Lunghezza        10.9316     0.3023  36.164  < 2e-16 ***
## Cranio            9.8593     0.4233  23.290  < 2e-16 ***
## Tipo.partoNat    29.6117    11.8729   2.494  0.01269 *  
## Ospedaleosp2    -11.6421    13.2089  -0.881  0.37820    
## Ospedaleosp3     25.2401    13.2608   1.903  0.05711 .  
## SessoM           77.6921    10.9838   7.073 1.96e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 268.9 on 2483 degrees of freedom
## Multiple R-squared:  0.7387, Adjusted R-squared:  0.7377 
## F-statistic: 702.1 on 10 and 2483 DF,  p-value: < 2.2e-16

Nella tabella dei coefficienti vengono mostrate le stime dei coefficienti beta di tutte le variabili che rappresentano gli effetti marginali di ogni singola variabile sulla variabile risposta Per ogni stima bisogna concentrarsi su segno, valore e significatività.

Il R-squared (Multiple R-squared) di 0.7387 suggerisce che il modello spiega circa il 74% della variabilità nel peso del neonato, il che è un buon risultato.

Migliorare il modello

Il modello di regressione individuato è in grado di spiegare il 74% della variabilità ma risulta essere un modello pesante con diverse variabili regressorie con impatto marginale oppure quasi nullo. Proveremo a migliorare il modello

Creiamo il model2 che avrà tutte le variabili tranne quelle che risultano non statisticamente rilevanti e vediamo che differenze ci sono rispetto a quello completo.

model2 <- lm(Peso~N.gravidanze+Gestazione+Lunghezza+Cranio+Sesso, data = neonati)
# Riepilogo del modello
summary(model2)
## 
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Lunghezza + Cranio + 
##     Sesso, data = neonati)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1165.65  -180.13   -12.61   163.33  1410.68 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -6683.5939   133.2707 -50.151  < 2e-16 ***
## N.gravidanze    13.1481     4.2614   3.085  0.00206 ** 
## Gestazione      29.6378     3.7392   7.926 3.38e-15 ***
## Lunghezza       10.8897     0.3022  36.040  < 2e-16 ***
## Cranio           9.9184     0.4234  23.424  < 2e-16 ***
## SessoM          78.1027    11.0050   7.097 1.66e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 269.5 on 2488 degrees of freedom
## Multiple R-squared:  0.737,  Adjusted R-squared:  0.7365 
## F-statistic:  1395 on 5 and 2488 DF,  p-value: < 2.2e-16

Il R-squared (Multiple R-squared) di 0.737 suggerisce che il modello spiega circa il 74% della variabilità nel peso del neonato, il che è ottimo risultato considerando la riduzione dealle variabili.

Proviamo a ridurre ancora la complessità del modello escludendo altre variabili regressorie che hanno meno impatto come N.gravidanze

model3 <- lm(Peso ~ Lunghezza + Cranio + Sesso+Gestazione, data = neonati)

# Riepilogo del modello
summary(model3)
## 
## Call:
## lm(formula = Peso ~ Lunghezza + Cranio + Sesso + Gestazione, 
##     data = neonati)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1153.7  -182.7   -14.9   164.0  1391.1 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -6651.8461   133.1001 -49.976  < 2e-16 ***
## Lunghezza      10.8407     0.3023  35.866  < 2e-16 ***
## Cranio         10.0590     0.4217  23.853  < 2e-16 ***
## SessoM         79.2928    11.0171   7.197 8.10e-13 ***
## Gestazione     28.5356     3.7285   7.653 2.78e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 270 on 2489 degrees of freedom
## Multiple R-squared:  0.736,  Adjusted R-squared:  0.7356 
## F-statistic:  1735 on 4 and 2489 DF,  p-value: < 2.2e-16

Proviamo ad aggiungere un effetto quadratico, saggiamo l’importanza della lunghezza sul nostro modello di regressione. Tuttavia il modello non sembra migliorare

model4 <- lm(Peso ~ I(Lunghezza^2) + Cranio + Sesso+Gestazione, data = neonati)

# Riepilogo del modello

summary(model4)
## 
## Call:
## lm(formula = Peso ~ I(Lunghezza^2) + Cranio + Sesso + Gestazione, 
##     data = neonati)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1161.18  -182.76   -13.85   165.40  1355.80 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)    -4.201e+03  1.427e+02 -29.440  < 2e-16 ***
## I(Lunghezza^2)  1.126e-02  3.081e-04  36.549  < 2e-16 ***
## Cranio          1.012e+01  4.171e-01  24.250  < 2e-16 ***
## SessoM          7.613e+01  1.095e+01   6.951 4.62e-12 ***
## Gestazione      3.189e+01  3.651e+00   8.734  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 268.2 on 2489 degrees of freedom
## Multiple R-squared:  0.7395, Adjusted R-squared:  0.739 
## F-statistic:  1766 on 4 and 2489 DF,  p-value: < 2.2e-16

Proviamo ad aggiungere un effetto quadratico solo alla gestazione,l’aumento di peso è più marcato nei mesi finali della gestazione

model5 <- lm(Peso ~ Lunghezza + Cranio + Sesso+I(Gestazione^2), data = neonati)

# Riepilogo del modello

summary(model5)
## 
## Call:
## lm(formula = Peso ~ Lunghezza + Cranio + Sesso + I(Gestazione^2), 
##     data = neonati)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1151.00  -182.56   -15.71   165.21  1395.21 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -6.139e+03  1.216e+02 -50.503  < 2e-16 ***
## Lunghezza        1.085e+01  3.002e-01  36.133  < 2e-16 ***
## Cranio           1.007e+01  4.211e-01  23.925  < 2e-16 ***
## SessoM           7.870e+01  1.101e+01   7.146 1.17e-12 ***
## I(Gestazione^2)  3.887e-01  4.959e-02   7.839 6.68e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 269.8 on 2489 degrees of freedom
## Multiple R-squared:  0.7363, Adjusted R-squared:  0.7359 
## F-statistic:  1738 on 4 and 2489 DF,  p-value: < 2.2e-16

Il R-squared (Multiple R-squared) dei vari modelli continua ad assestarsi attorno al 0.729 suggerendo che i modelli spiegano circa il 73% della variabilità nel peso del neonato, il che è ottimo risultato considerando la riduzione dealle variabili rispetto al modello iniziale .

Selezione del Modello Ottimale

Proviamo ad utilizzare altri criteri di valutazione, AIC e BIC. Il modello con i criteri di informazione più bassi è di solito il modello migliore. Tra i due criteri di valutazione ( AIC e BIC ), propenderemo per dare più affidabilità al criterio BIC, dato che rispetto all’AIC previlegia modelli con minor variabili.

kable(results_table_Model, caption = "Confronto tra AIC e BIC dei modelli")
Confronto tra AIC e BIC dei modelli
Model AIC BIC
model1 34995.46 35065.32
model2 35001.53 35042.29
model3 35009.06 35043.99
model4 34976.57 35011.50
model5 35006.25 35041.18

In questo caso il criterio di informazione di Akaike (AIC) e di Bayes (BIC) convergono, sceglieremo il Model3 e andremo ora a saggiare la diagnostica dei residui subito dopo aver valutato anche andiamo l’MSE, l’RMSE e il MAE

kable(metrics_table, caption = "Confronto tra le metriche dei modelli")
Confronto tra le metriche dei modelli
Model MSE RMSE MAE
model1 71995.64 268.3200 208.8612
model2 72461.14 269.1861 209.9016
model3 72738.39 269.7006 210.3216
model4 71797.08 267.9498 209.0188
model5 72656.42 269.5485 210.1906 
# Residui
residuals <- residuals(model3)

# Valori predetti
fitted_values <- fitted(model3)
plot(model3)

shapiro.test(residuals(model3))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(model3)
## W = 0.98872, p-value = 3.898e-13
bptest(model3) 
## 
##  studentized Breusch-Pagan test
## 
## data:  model3
## BP = 9.508, df = 4, p-value = 0.04958
dwtest(model3)
## 
##  Durbin-Watson test
## 
## data:  model3
## DW = 1.9568, p-value = 0.1399
## alternative hypothesis: true autocorrelation is greater than 0

Interpretazione dei Risultati:

A questo punto è importante identificare i valori influenti che sono outlier. Tali valori sono le osservazioni 155, 1306,1399 e 310. Tali osservazioni richiedono un analisi ad hoc per capire se possono essere ritenuti errori oppure no.

##       rstudent unadjusted p-value Bonferroni p
## 155   5.197759         2.1810e-07   0.00054394
## 1306  4.887089         1.0885e-06   0.00271460
## 1399 -4.293281         1.8280e-05   0.04558900
##       rstudent unadjusted p-value Bonferroni p
## 155   5.197759         2.1810e-07   0.00054394
## 1306  4.887089         1.0885e-06   0.00271460
## 1399 -4.293281         1.8280e-05   0.04558900
Informazioni sull’Osservazione da attenzionare
Anni.madre N.gravidanze Fumatrici Gestazione Peso Lunghezza Cranio Tipo.parto Ospedale Sesso
155 30 0 0 36 3610 410 330 Nat osp1 M
1306 23 0 0 41 4900 510 352 Nat osp2 F
1399 42 2 0 38 2560 525 349 Ces osp2 M

Previsioni e risultati

Andiamo ora a stimare il peso di una neonata considerando una madre alla terza gravidanza (quindi N.gravidanze=2), non fumatrice, che partorirà alla 39esima settimana

predizione_peso <- predict(model3, dati.test_nenonata)
predizione_peso
##        1 
## 3244.867

Il peso stimato per la neonata di una madre non fumatrice alla 39^ settimana secondo il modello 3 è pari a 3,244Kg

Impicazioni grafiche

Di seguiti mostriamo 3 dei grafici maggiormente rappresentativi. Due mostrano la relazione tra Peso e due tra le variabili maggiormente significative, Lunghezza e gestazione. Il terzo invece mostra la distribuzione del peso neonatale tra madri fumatrici e non fumatrici,lo scopo di quest’ultimo grafico è quello di voler documentare un aspetto che, pur non statisticamente rilevante,ma tenuto in considerazione in ottica di saggiare l’effetto del fumo sulla salute umana. Sarà oggetto di studi separati approfondire la questione.

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'

boxplot_fumo_sesso

Conclusioni

Questo progetto di analisi statistica ha portato allo sviluppo di un modello predittivo affidabile per stimare il peso dei neonati, identificando i principali fattori che influenzano tale variabile e le loro interazioni. L’analisi ha evidenziato come la durata della gestazione, il sesso del neonato siano i principali determinanti del peso alla nascita, con un modello in grado di spiegare circa il 73% della variabilità osservata. In termini pratici,la previsione del peso della neonata per una madre non fumatrice alla 39^ settimana, secondo il nostro modello di regressione lineare, ha prodotto un risultato di 3,254 kg. Questo peso è all’interno dei range normali per neonati a termine. Il modello ha incluso variabili come la lunghezza, la circonferenza cranica e il numero di gravidanze, tutte rilevanti per la stima del peso. Tuttavia, va sottolineato che altre variabili, non incluse nel modello, potrebbero influenzare il peso della neonata. Per migliorare la precisione delle previsioni, sarebbe utile esplorare ulteriori variabili e testare modelli più complessi.