Introduzione

Il progetto mira a sviluppare un modello statistico per prevedere il peso dei neonati alla nascita utilizzando variabili cliniche raccolte da tre ospedali. Questo modello aiuterà Neonatal Health Solutions a migliorare le previsioni cliniche, ottimizzare le risorse ospedaliere e identificare fattori di rischio critici come il fumo materno e le nascite premature.

Caricamento dataset e librerie

# Caricamento delle librerie necessarie
library(tidyverse)
library(ggplot2)
library(gghalves)
library(dplyr)
library(ineq)
library(knitr)
library(moments)
library(kableExtra)
library(car)
library(caret)
library(corrplot)
# Caricamento del dataset
data <- read.csv("C:/Users/eapol/OneDrive/Desktop/PROFESSION AI CORSO/R STATISTICA INFERENZIALE/PROGETTO/neonati.csv", stringsAsFactors = FALSE)

Anteprima dati

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
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" ...
summary(data)
##    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       
##  Min.   : 830   Min.   :310.0   Min.   :235   Length:2500       
##  1st Qu.:2990   1st Qu.:480.0   1st Qu.:330   Class :character  
##  Median :3300   Median :500.0   Median :340   Mode  :character  
##  Mean   :3284   Mean   :494.7   Mean   :340                     
##  3rd Qu.:3620   3rd Qu.:510.0   3rd Qu.:350                     
##  Max.   :4930   Max.   :565.0   Max.   :390                     
##    Ospedale            Sesso          
##  Length:2500        Length:2500       
##  Class :character   Class :character  
##  Mode  :character   Mode  :character  
##                                       
##                                       
##

Preparazione dei dati

Codifica variabili categoriali

data$Tipo.parto <- as.factor(data$Tipo.parto)
data$Sesso <- as.factor(data$Sesso)
data$Ospedale <- as.factor(data$Ospedale)

Feature Engineering

Si aggiunge una variabile per idetificare i neonati prematuri (settimane di gestazione < 37)

data$Prematuro <- ifelse(data$Gestazione < 37, 1, 0)
data$Prematuro <- as.factor(data$Prematuro)

Analisi esplorativa (EDA)

Distribuzione del Peso Neonatale

ggplot(data, aes(x = Peso)) +
  geom_histogram(binwidth = 100, fill = "blue", color = "black", alpha = 0.7) +
  labs(title = "Distribuzione del Peso Neonatale", x = "Peso (grammi)", y = "Frequenza")

L’istogramma mostra che la distribuzione del peso alla nascita è grossomodo simile a una normale, con una leggera asimmetria verso valori leggermente più bassi della media. La maggior parte dei neonati ha un peso compreso tra 3000 e 3500 grammi, con una concentrazione intorno a 3200-3300 g. I valori molto bassi o molto elevati sono rari, indicando che la variabilità più comune si concentra intorno a una media superiore ai 3000 g.

Matrice di correlazione

Abbiamo calcolato e visualizzato la matrice di correlazione per identificare le relazioni tra le variabili numeriche.

variabili_numeriche <- data[, c("Anni.madre", "N.gravidanze", "Gestazione", "Peso", "Lunghezza", "Cranio")]

# Matrice di scatterplot
pairs(variabili_numeriche, 
      main = "Matrice di Scatterplot delle Variabili Numeriche")

#3.3 Calcolo della matrice di correlazione
# Calcolo della matrice di correlazione
matrice_correlazione <- cor(variabili_numeriche)

# Visualizzazione della matrice di correlazione
print(matrice_correlazione)
##               Anni.madre N.gravidanze Gestazione        Peso   Lunghezza
## Anni.madre    1.00000000   0.38063184 -0.1356671 -0.02247017 -0.06349157
## N.gravidanze  0.38063184   1.00000000 -0.1014919  0.00240730 -0.06040371
## Gestazione   -0.13566714  -0.10149194  1.0000000  0.59176872  0.61892045
## Peso         -0.02247017   0.00240730  0.5917687  1.00000000  0.79603676
## Lunghezza    -0.06349157  -0.06040371  0.6189204  0.79603676  1.00000000
## Cranio        0.01607670   0.03900707  0.4608289  0.70480151  0.60334097
##                  Cranio
## Anni.madre   0.01607670
## N.gravidanze 0.03900707
## Gestazione   0.46082894
## Peso         0.70480151
## Lunghezza    0.60334097
## Cranio       1.00000000
# Visualizzazione della matrice di correlazione
corrplot(matrice_correlazione, method = "circle")

La matrice di scatterplot permette di osservare le relazioni bivariate tra tutte le variabili numeriche. È evidente una forte correlazione positiva tra Peso e le misure antropometriche (Lunghezza, Cranio) e tra Peso e Gestazione. Man mano che aumentano le settimane di gravidanza, la Lunghezza e il diametro del Cranio del neonato, il Peso tende ad aumentare. Al contrario, l’età materna e il numero di gravidanze precedenti non mostrano pattern chiari con il Peso, suggerendo un impatto meno significativo di questi fattori. Inoltre, la densità dei punti e l’assenza di pattern fortemente non lineari confermano, come vedremo successivamente, l’utilità di un modello lineare come punto di partenza.

Test delle ipotesi

# Tabella di contingenza tra Ospedale e Tipo.parto
t_parti <- table(data$Ospedale, data$Tipo.parto)

# Test chi-quadrato
test_chi <- chisq.test(t_parti)

# Output dei risultati
test_chi
## 
##  Pearson's Chi-squared test
## 
## data:  t_parti
## X-squared = 1.0972, df = 2, p-value = 0.5778
# Ipotesi: la media del peso del campione è 3200 g (valore noto/population mean)
# One-sample t-test per il peso
t_test_peso <- t.test(data$Peso, mu = 3200)
t_test_peso
## 
##  One Sample t-test
## 
## data:  data$Peso
## t = 8.0071, df = 2499, p-value = 1.782e-15
## alternative hypothesis: true mean is not equal to 3200
## 95 percent confidence interval:
##  3263.490 3304.672
## sample estimates:
## mean of x 
##  3284.081
# Ipotesi: la media della lunghezza del campione è 500 mm
# One-sample t-test per la lunghezza
t_test_lunghezza <- t.test(data$Lunghezza, mu = 500)
t_test_lunghezza
## 
##  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 eseguito un one-sample t-test confrontando la media del peso del campione con un valore di riferimento di 3200 g (indicativo). Il test risulta significativo (p < 0.001), indicando che il peso medio del nostro campione (3284 g) è significativamente diverso (e maggiore) rispetto allo standard considerato. Allo stesso modo, confrontando la media della lunghezza (494.7 mm) con una lunghezza di riferimento di 500 mm, il test mostra una differenza significativa (p < 0.001). Se non disponiamo di valori di riferimento ufficiali, questi test vanno interpretati con cautela, in quanto l’ipotesi nulla è basata su dati non comprovati da fonti esterne.

# Test t per Peso tra Maschi (M) e Femmine (F)
t_test_peso_sesso <- t.test(Peso ~ Sesso, data = data)
t_test_peso_sesso
## 
##  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
# Test t per Lunghezza tra Maschi (M) e Femmine (F)
t_test_lunghezza_sesso <- t.test(Lunghezza ~ Sesso, data = data)
t_test_lunghezza_sesso
## 
##  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
# Test t per Cranio tra Maschi (M) e Femmine (F)
t_test_cranio_sesso <- t.test(Cranio ~ Sesso, data = data)
t_test_cranio_sesso
## 
##  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

Peso neonatale e fumo materno

Il boxplot confronta il Peso neonatale tra madri fumatrici e non. Visivamente, i neonati di madri non fumatrici sembrano pesare mediamente di più. Tuttavia, il test t non mostra una differenza statisticamente significativa (p > 0.05). Ciò può significare che l’effetto del fumo, se presente, è troppo piccolo per essere rilevato nel campione, oppure che altri fattori confondenti riducono il suo impatto osservato sul Peso.

boxplot(Peso ~ Fumatrici, data = data,
        main = "Peso Neonatale vs Fumo Materno",
        xlab = "Fumatrici",
        ylab = "Peso (grammi)",
        col = c("lightgreen", "lightpink"))

# Test t per campioni indipendenti
test_t <- t.test(Peso ~ Fumatrici, data = data)

# Visualizzazione dei risultati del test
print(test_t)
## 
##  Welch Two Sample t-test
## 
## data:  Peso by Fumatrici
## t = 1.034, df = 114.1, p-value = 0.3033
## alternative hypothesis: true difference in means between group 0 and group 1 is not equal to 0
## 95 percent confidence interval:
##  -45.61354 145.22674
## sample estimates:
## mean in group 0 mean in group 1 
##        3286.153        3236.346

Risultati del test t:

  • Media gruppo non fumatrici: 3286 g

  • Media gruppo fumatrici: 3236 g

  • Valore p: 0.303 (non significativo)

Relazione tra età materna e peso natale

# Relazione tra età materna e peso neonatale
ggplot(data, aes(x = Anni.madre, y = Peso)) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", se = FALSE, color = "red") +
  labs(title = "Relazione tra Età Materna e Peso Neonatale",
       x = "Età della Madre (anni)",
       y = "Peso del Neonato (grammi)")

Il grafico della relazione tra l’Età materna e il Peso neonatale non mostra un trend chiaro: la linea di regressione è quasi orizzontale, indicando un effetto minimo o nullo dell’età della madre sul peso alla nascita. I punti sono distribuiti in modo abbastanza uniforme lungo l’asse dell’età, suggerendo che l’impatto di questo fattore è trascurabile rispetto ad altri predittori più fortemente correlati al peso.

# Analisi del numero di gravidanze precedenti
ggplot(data, aes(x = as.factor(N.gravidanze), y = Peso)) +
  geom_boxplot() +
  labs(title = "Peso Neonatale rispetto al Numero di Gravidanze Precedenti",
       x = "Numero di Gravidanze Precedenti",
       y = "Peso del Neonato (grammi)")

Questo boxplot illustra come varia la distribuzione del Peso neonatale al variare del numero di gravidanze precedenti della madre. Si nota una certa variabilità, ma non si osserva un pattern lineare o costante: aumenti o diminuzioni nella mediana del Peso all’aumentare del numero di gravidanze non sono chiaramente definiti. Potrebbe esserci un leggero incremento del Peso con gravidanze multiple, ma la presenza di pochi casi estremi in classi elevate di N.gravidanze rende difficile una conclusione chiara.

Modello di regressione lineare multipla

Costruzione del Modello

Costruiamo un modello di regressione lineare che include tutte le variabili disponibili. I risultati principali mostrano che: - Variabili significative includono Gestazione, Lunghezza, Cranio e Sesso. - Variabili non significative, come Anni della madre, vengono rimosse nel modello raffinato.

modello <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Lunghezza + Cranio + Tipo.parto + Ospedale + Sesso, data = data)
summary(modello)
## 
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + 
##     Lunghezza + Cranio + Tipo.parto + Ospedale + Sesso, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1124.40  -181.66   -14.42   160.91  2611.89 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -6738.4762   141.3087 -47.686  < 2e-16 ***
## Anni.madre        0.8921     1.1323   0.788   0.4308    
## N.gravidanze     11.2665     4.6608   2.417   0.0157 *  
## Fumatrici       -30.1631    27.5386  -1.095   0.2735    
## Gestazione       32.5696     3.8187   8.529  < 2e-16 ***
## Lunghezza        10.2945     0.3007  34.236  < 2e-16 ***
## Cranio           10.4707     0.4260  24.578  < 2e-16 ***
## Tipo.partoNat    29.5254    12.0844   2.443   0.0146 *  
## Ospedaleosp2    -11.2095    13.4379  -0.834   0.4043    
## Ospedaleosp3     28.0958    13.4957   2.082   0.0375 *  
## SessoM           77.5409    11.1776   6.937 5.08e-12 ***
## ---
## 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.2 on 10 and 2489 DF,  p-value: < 2.2e-16

  • Gestazione (p < 0.001): Un aumento di una settimana di gestazione porta a un incremento medio di 32.6 g nel peso.

  • Lunghezza (p < 0.001): Ogni millimetro in più di lunghezza aumenta il peso di 10.3 g.

  • Cranio (p < 0.001): Ogni millimetro in più nel diametro craniale aumenta il peso di 10.4 g.

  • Sesso (M) (p < 0.001): I maschi pesano in media 77.5 g in più rispetto alle femmine.

  • Qualità del Modello R²: 0.7289 (72.9% della varianza del peso spiegata dal modello).

  • Errore standard dei residui: 273.9 g.

Modello con Interazioni

# Aggiungiamo un termine di interazione tra Gestazione e Fumatrici
modello_interazione <- lm(Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio, data = data)
summary(modello_interazione)
## 
## Call:
## lm(formula = Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio, 
##     data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1105.74  -184.29   -13.72   167.14  2620.98 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -6789.3469   136.7107 -49.662   <2e-16 ***
## Gestazione              32.2388     3.8632   8.345   <2e-16 ***
## Fumatrici              521.3624   765.0499   0.681    0.496    
## Lunghezza               10.4112     0.3024  34.433   <2e-16 ***
## Cranio                  10.7854     0.4283  25.180   <2e-16 ***
## Gestazione:Fumatrici   -13.8705    19.4735  -0.712    0.476    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 277.7 on 2494 degrees of freedom
## Multiple R-squared:  0.7208, Adjusted R-squared:  0.7202 
## F-statistic:  1288 on 5 and 2494 DF,  p-value: < 2.2e-16
# Valutiamo se l'interazione è significativa

Questo grafico mostra come l’andamento del Peso in funzione della Gestazione differisca tra madri fumatrici e non. Sebbene le linee di regressione sembrino leggermente divergere, l’analisi statistica non ha evidenziato un’interazione significativa. In altre parole, l’effetto del fumo non modifica sostanzialmente la relazione tra settimane di gestazione e peso neonatale, almeno nei limiti di questo dataset.

Diagnostica del modello

Analisi dei residui

# Grafici diagnostici del modello
par(mfrow = c(2, 2))
plot(modello)

I grafici diagnostici dei residui permettono di valutare l’adeguatezza del modello lineare. Il Q-Q plot mostra che la distribuzione dei residui non segue perfettamente la normalità (come confermato dallo Shapiro-Wilk test), con code leggermente più pesanti del previsto. Tuttavia, l’assenza di pattern marcati nel grafico Residui vs Fitted indica che la relazione lineare è ragionevolmente appropriata. Il plot Scale-Location non evidenzia gravi problemi di eterogeneità della varianza, e il grafico Residui vs Leverage non mostra un numero preoccupante di punti altamente influenti. Complessivamente, il modello sembra stabile, anche se non perfetto.

Test di normalità dei residui

# Test di Shapiro-Wilk per i residui
shapiro.test(residuals(modello))
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(modello)
## W = 0.97415, p-value < 2.2e-16
  • Normalità dei residui: Il test di Shapiro-Wilk rifiuta l’ipotesi di normalità dei residui (p < 0.05). Pertanto i residui non sono normalmente distribuiti.

I risultati del test di Shapiro-Wilk indicano che i residui del modello non seguono una distribuzione normale. Questa violazione dell’assunzione di normalità potrebbe rendere meno affidabili alcune inferenze, specialmente per quanto riguarda gli intervalli di confidenza e i test di significatività dei coefficienti. Tuttavia, data l’elevata numerosità campionaria (2500 osservazioni), l’approssimazione asintotica fornita dal Teorema del Limite Centrale attenua parzialmente questo problema. In altre parole, con un campione così ampio, la regressione lineare rimane comunque abbastanza robusta anche in presenza di residui non perfettamente normali.

Poiché i residui non sono normali, e se questa problematica si volesse affrontare in maniera più rigorosa, si potrebbero adottare diverse strategie. Ad esempio, si potrebbero applicare trasformazioni (logaritmica, radice quadrata) sui dati per migliorare la simmetria della distribuzione dei residui. In alternativa, si possono utilizzare metodi robusti alla violazione delle assunzioni classiche della regressione lineare (quali regressioni quantiliche o modelli non parametrici) per valutare la stabilità dei risultati. Con 2500 osservazioni, l’approssimazione asintotica rende comunque accettabile l’uso dei metodi standard, ma in un contesto di ricerca clinica di alta precisione, considerare questi approcci alternativi potrebbe fornire inferenze più affidabili e meno sensibili a deviazioni dalla normalità.

Verifica della multicollinearità

# Calcolo del Variance Inflation Factor (VIF)
vif(modello)
##                  GVIF Df GVIF^(1/(2*Df))
## Anni.madre   1.187454  1        1.089704
## N.gravidanze 1.186428  1        1.089233
## Fumatrici    1.007392  1        1.003689
## Gestazione   1.695810  1        1.302233
## Lunghezza    2.085755  1        1.444214
## Cranio       1.630796  1        1.277026
## Tipo.parto   1.004242  1        1.002119
## Ospedale     1.004071  2        1.001016
## Sesso        1.040643  1        1.020119
  • Multicollinearità: Il VIF (Variance Inflation Factor) mostra che non ci sono problemi di collinearità tra le variabili (tutti i valori sono < 5).

Raffinamento del modello

Creiamo un modello raffinato rimuovendo le variabili non significative. Confrontiamo i modelli utilizzando AIC e BIC, metriche che valutano il compromesso tra accuratezza e complessità. ### Rimozione della variabili non significative Rimuoviamo le variabili non significative nel modello iniziale, anche se non statisticamente significativa (p=0.273), la variabile Fumatrici è clinicamente importante per analizzare l’effetto del fumo sul peso neonatale, pertanto non viene eliminata (noto fattore di rischio).

# Creazione di un modello raffinato rimuovendo variabili non significative
modello_raffinato <- lm(Peso ~ Gestazione + Lunghezza + Cranio + Fumatrici, data = data)

# Sommario del modello raffinato
summary(modello_raffinato)
## 
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + Fumatrici, 
##     data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1106.20  -183.72   -13.46   167.10  2621.03 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -6777.3182   135.6503 -49.962   <2e-16 ***
## Gestazione     31.8727     3.8284   8.325   <2e-16 ***
## Lunghezza      10.4140     0.3023  34.449   <2e-16 ***
## Cranio         10.7880     0.4283  25.190   <2e-16 ***
## Fumatrici     -23.2035    27.8670  -0.833    0.405    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 277.7 on 2495 degrees of freedom
## Multiple R-squared:  0.7207, Adjusted R-squared:  0.7203 
## F-statistic:  1610 on 4 and 2495 DF,  p-value: < 2.2e-16

Confronto tra modelli

AIC() e BIC() calcolano rispettivamente l’Akaike Information Criterion e il Bayesian Information Criterion.

Un valore AIC o BIC più basso indica un modello migliore in termini di compromesso tra accuratezza e complessità.

# Confronto dei modelli usando AIC e BIC
AIC(modello, modello_raffinato)
##                   df      AIC
## modello           12 35171.95
## modello_raffinato  6 35234.30
BIC(modello, modello_raffinato)
##                   df      BIC
## modello           12 35241.84
## modello_raffinato  6 35269.24
summary(cars)
##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00

Selezione del modello ottimale

### Selezione Stepwise del Modello

# Utilizzo della selezione stepwise basata sull'AIC
modello_stepwise <- step(modello, direction = "both", trace = FALSE)
summary(modello_stepwise)
## 
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Lunghezza + Cranio + 
##     Tipo.parto + Ospedale + Sesso, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1113.18  -181.16   -16.58   161.01  2620.19 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   -6707.4293   135.9438 -49.340  < 2e-16 ***
## N.gravidanze     12.3619     4.3325   2.853  0.00436 ** 
## Gestazione       31.9909     3.7896   8.442  < 2e-16 ***
## Lunghezza        10.3086     0.3004  34.316  < 2e-16 ***
## Cranio           10.4922     0.4254  24.661  < 2e-16 ***
## Tipo.partoNat    29.2803    12.0817   2.424  0.01544 *  
## Ospedaleosp2    -11.0227    13.4363  -0.820  0.41209    
## Ospedaleosp3     28.6408    13.4886   2.123  0.03382 *  
## SessoM           77.4412    11.1756   6.930 5.36e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 273.9 on 2491 degrees of freedom
## Multiple R-squared:  0.7287, Adjusted R-squared:  0.7278 
## F-statistic: 836.3 on 8 and 2491 DF,  p-value: < 2.2e-16
# Confronto del modello stepwise con il modello precedente
AIC(modello, modello_stepwise)
##                  df      AIC
## modello          12 35171.95
## modello_stepwise 10 35169.79
BIC(modello, modello_stepwise)
##                  df      BIC
## modello          12 35241.84
## modello_stepwise 10 35228.03

Validazione del modello

Per valutare le performance del modello, il dataset viene suddiviso in un set di training (80%) e un set di test (20%). Questa tecnica permette di addestrare il modello su una porzione dei dati e verificarne la capacità predittiva su dati non utilizzati durante l’addestramento. ### Divisione del dataset

# Impostazione del seed per la riproducibilità
set.seed(123)

# Creazione dell'indice per il training set (80% dei dati)
indice_train <- createDataPartition(data$Peso, p = 0.8, list = FALSE)

# Creazione dei dataset di training e di test
dati_train <- data[indice_train, ]
dati_test <- data[-indice_train, ]

Addestramento modello sul training set

Il modello di regressione viene addestrato utilizzando solo il set di training. In questo modello, abbiamo incluso le variabili più significative identificate nella fase precedente: Gestazione, Lunghezza, Cranio e Fumatrici.

I risultati mostrano che:

  • Gestazione: Ogni settimana aggiuntiva di gestazione aumenta il peso neonatale di circa 33.8 g (p < 0.001).

  • Lunghezza: Ogni millimetro in più di lunghezza contribuisce con 10.1 g (p < 0.001).

  • Cranio: Il diametro craniale aggiunge 10.9 g per ogni millimetro (p < 0.001).

  • Fumatrici: Sebbene non significativa (p ≈ 0.146), è inclusa per la sua rilevanza clinica.

# Modello addestrato sul training set
modello_train <- lm(Peso ~ Gestazione + Lunghezza + Cranio + Fumatrici, data = dati_train)

# Sommario del modello
summary(modello_train)
## 
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + Fumatrici, 
##     data = dati_train)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1027.07  -186.22   -13.41   170.49  2559.40 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -6716.6090   151.3830 -44.368  < 2e-16 ***
## Gestazione     33.8157     4.2911   7.880 5.32e-15 ***
## Lunghezza      10.0984     0.3410  29.614  < 2e-16 ***
## Cranio         10.8589     0.4816  22.546  < 2e-16 ***
## Fumatrici     -45.5756    31.3626  -1.453    0.146    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 280.8 on 1997 degrees of freedom
## Multiple R-squared:  0.7166, Adjusted R-squared:  0.716 
## F-statistic:  1262 on 4 and 1997 DF,  p-value: < 2.2e-16

Valutazione sul test set

Una volta addestrato il modello, lo validiamo utilizzando il set di test. Due metriche principali vengono calcolate:

  1. Mean Squared Error (MSE): La media degli errori quadratici fornisce una misura della precisione predittiva del modello. Nel nostro caso, l’MSE è 70,547 g².

  2. Coefficiente di Determinazione (R²): Indica la proporzione della varianza del peso neonatale spiegata dal modello. Con un valore di R² ≈ 0.737, il modello spiega il 73.7% della variabilità del peso.

# Previsione sul test set
previsioni <- predict(modello_train, newdata = dati_test)

# Calcolo del Mean Squared Error (MSE)
mse <- mean((dati_test$Peso - previsioni)^2)

# Calcolo dell'R-squared
ss_tot <- sum((dati_test$Peso - mean(dati_test$Peso))^2)
ss_res <- sum((dati_test$Peso - previsioni)^2)
r_squared <- 1 - (ss_res / ss_tot)

# Visualizzazione dei risultati
cat("Mean Squared Error (MSE):", mse, "\n")
## Mean Squared Error (MSE): 70546.92
cat("Coefficiente di determinazione (R²):", r_squared, "\n")
## Coefficiente di determinazione (R²): 0.7365072

Il modello validato mostra buone prestazioni, con un R² superiore al 70% sia nel training che nel test set. Questo risultato indica che il modello è generalizzabile, ovvero è in grado di fare previsioni accurate anche su dati nuovi.

Applicazione pratica del modello

Previsione di un caso specifico

Supponiamo di voler prevedere il peso di una neonata considerando:

  • Madre alla terza gravidanza

  • Non fumatrice

  • Parto alla 39esima settimana

  • Valori medi per Lunghezza e Cranio

# Calcolo dei valori medi di Lunghezza e Cranio
lunghezza_media <- mean(data$Lunghezza)
cranio_medio <- mean(data$Cranio)

# Creazione del nuovo caso
nuovo_caso <- data.frame(
  Gestazione = 39,
  Lunghezza = lunghezza_media,
  Cranio = cranio_medio,
  Fumatrici = 0
)

# Previsione del peso
peso_previsto <- predict(modello_raffinato, newdata = nuovo_caso)

# Visualizzazione del risultato
cat("Il peso previsto del neonato è:", round(peso_previsto, 2), "grammi\n")
## Il peso previsto del neonato è: 3285.67 grammi

Visualizzazione dei risultati

Grafico dei valori predetti vs osservati

# Grafico Predetto vs Osservato sul test set
plot(dati_test$Peso, previsioni, 
     xlab = "Peso Osservato (grammi)", 
     ylab = "Peso Predetto (grammi)", 
     main = "Valori Predetti vs Valori Osservati",
     pch = 16, col = "blue")
abline(a = 0, b = 1, col = "red", lwd = 2)

Il grafico dei Valori Predetti vs Valori Osservati illustra la capacità del modello di riprodurre i dati reali. I punti si distribuiscono intorno alla linea y = x, indicando che le previsioni sono spesso vicine ai valori osservati. Questo conferma l’elevata proporzione di varianza spiegata (R² > 0.7) e suggerisce che il modello è in grado di fornire stime del peso neonatale relativamente accurate.

Visualizzazioni aggiuntive

### Impatto delle Settimane di Gestazione sul Peso Neonatale

ggplot(data, aes(x = Gestazione, y = Peso)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm", se = TRUE, color = "blue") +
  labs(title = "Impatto delle Settimane di Gestazione sul Peso Neonatale",
       x = "Settimane di Gestazione",
       y = "Peso del Neonato (grammi)")

### Interazione tra Fumo Materno e Gestazione

ggplot(data, aes(x = Gestazione, y = Peso, color = as.factor(Fumatrici))) +
  geom_point(alpha = 0.5) +
  geom_smooth(method = "lm", se = FALSE) +
  labs(title = "Peso Neonatale: Interazione tra Fumo Materno e Gestazione",
       x = "Settimane di Gestazione",
       y = "Peso del Neonato (grammi)",
       color = "Fumatrici")

Il grafico evidenzia una relazione nettamente positiva tra le Settimane di Gestazione e il Peso neonatale. Aumentando le settimane di gestazione, il peso cresce in modo quasi lineare, come mostrato dalla retta di regressione. L’intervallo di confidenza attorno alla retta è relativamente stretto, indicando una stima piuttosto precisa di questo effetto.

Visualizzazione variabili

# Estrazione dei coefficienti dal modello
coefficients <- summary(modello_raffinato)$coefficients

# Creazione di un dataframe per i coefficienti
coeff_df <- data.frame(
  Variabile = rownames(coefficients),
  Coefficiente = coefficients[, "Estimate"]
)

# Rimozione dell'intercetta
coeff_df <- coeff_df[-1, ]

# Grafico dei coefficienti
barplot(coeff_df$Coefficiente, names.arg = coeff_df$Variabile,
        main = "Importanza delle Variabili nel Modello",
        ylab = "Valore del Coefficiente",
        col = "darkgreen", las = 2)

Questo barplot mostra l’influenza stimata di ciascuna variabile selezionata nel modello finale sul peso neonatale. L’asse verticale rappresenta il valore del coefficiente di regressione: valori positivi indicano che l’aumento della variabile corrisponde a un incremento nel peso previsto, mentre valori negativi suggeriscono una riduzione.

Come si vede, la Gestazione ha il coefficiente più elevato, indicando che ogni settimana aggiuntiva di gravidanza incrementa significativamente il peso del neonato. Anche Lunghezza e Cranio hanno un impatto positivo e rilevante: ad ogni millimetro in più di lunghezza o diametro craniale si associa un aumento apprezzabile del peso. Al contrario, la variabile Fumatrici mostra un coefficiente negativo, ma di entità minore e non statisticamente significativo, segnalando che, pur essendo considerata rilevante clinicamente, il fumo materno non ha un effetto evidente sul peso alla nascita all’interno di questo dataset.

In sintesi, il grafico facilita la comprensione dell’importanza relativa dei predittori chiave (Gestazione, Lunghezza, Cranio) rispetto ad altri fattori meno influenti.

# Modello con interazione tra Gestazione e Fumatrici
modello_interazione <- lm(Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio, data = data)
summary(modello_interazione)
## 
## Call:
## lm(formula = Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio, 
##     data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1105.74  -184.29   -13.72   167.14  2620.98 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -6789.3469   136.7107 -49.662   <2e-16 ***
## Gestazione              32.2388     3.8632   8.345   <2e-16 ***
## Fumatrici              521.3624   765.0499   0.681    0.496    
## Lunghezza               10.4112     0.3024  34.433   <2e-16 ***
## Cranio                  10.7854     0.4283  25.180   <2e-16 ***
## Gestazione:Fumatrici   -13.8705    19.4735  -0.712    0.476    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 277.7 on 2494 degrees of freedom
## Multiple R-squared:  0.7208, Adjusted R-squared:  0.7202 
## F-statistic:  1288 on 5 and 2494 DF,  p-value: < 2.2e-16

Analisi di effetti non lineari

# Aggiunta di un termine quadratico per Gestazione
data$Gestazione2 <- data$Gestazione^2

# Modello con termine quadratico
modello_non_lineare <- lm(Peso ~ Gestazione + Gestazione2 + Lunghezza + Cranio + Fumatrici, data = data)
summary(modello_non_lineare)
## 
## Call:
## lm(formula = Peso ~ Gestazione + Gestazione2 + Lunghezza + Cranio + 
##     Fumatrici, data = data)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1169.91  -182.66   -14.07   166.66  2649.49 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -4258.4314   906.0448  -4.700 2.74e-06 ***
## Gestazione   -108.5278    50.0806  -2.167  0.03032 *  
## Gestazione2     1.8739     0.6665   2.812  0.00497 ** 
## Lunghezza      10.5365     0.3050  34.544  < 2e-16 ***
## Cranio         10.9041     0.4297  25.378  < 2e-16 ***
## Fumatrici     -21.7566    27.8332  -0.782  0.43448    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 277.3 on 2494 degrees of freedom
## Multiple R-squared:  0.7216, Adjusted R-squared:  0.721 
## F-statistic:  1293 on 5 and 2494 DF,  p-value: < 2.2e-16

L’inclusione di un termine quadratico per la Gestazione (Gestazione²) nel modello evidenzia che l’effetto di questa variabile sul peso non è perfettamente lineare: il coefficiente del termine quadratico risulta significativo (p < 0.01). Ciò suggerisce che l’incremento di peso non cresce costantemente con le settimane di gestazione, ma potrebbe seguire una curva leggermente più complessa. Tuttavia, l’aumento di R² ottenuto aggiungendo il termine quadratico è minimo e non giustifica pienamente la maggiore complessità del modello. Pertanto, se l’obiettivo è mantenere un modello parsimonioso e facilmente interpretabile, si potrebbe preferire la versione lineare, a meno che non vi siano motivazioni cliniche o teoriche solide per conservare il termine quadratico.