Modello Statistico per la Previsione del Peso Neonatale

Librerie

Importo le librerie necessarie allo sviluppo corretto dello studio

library(moments)
library(dplyr)
library(ggplot2)
library(tidyr)
library(lubridate)
library(car)
library(MASS)
library(lmtest)
library(ggpubr)
library(knitr)

Importo il dataset cosi da poter iniziare le varie analisi

neonati <- read.csv("neonati.csv", sep = ",")
str(neonati)

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

kable(summary(neonati))

Anni.madre	N.gravidanze	Fumatrici	Gestazione	Peso	Lunghezza	Cranio	Tipo.parto	Ospedale	Sesso
Min. : 0.00	Min. : 0.0000	Min. :0.0000	Min. :25.00	Min. : 830	Min. :310.0	Min. :235	Length:2500	Length:2500	Length:2500
1st Qu.:25.00	1st Qu.: 0.0000	1st Qu.:0.0000	1st Qu.:38.00	1st Qu.:2990	1st Qu.:480.0	1st Qu.:330	Class :character	Class :character	Class :character
Median :28.00	Median : 1.0000	Median :0.0000	Median :39.00	Median :3300	Median :500.0	Median :340	Mode :character	Mode :character	Mode :character
Mean :28.16	Mean : 0.9812	Mean :0.0416	Mean :38.98	Mean :3284	Mean :494.7	Mean :340	NA	NA	NA
3rd Qu.:32.00	3rd Qu.: 1.0000	3rd Qu.:0.0000	3rd Qu.:40.00	3rd Qu.:3620	3rd Qu.:510.0	3rd Qu.:350	NA	NA	NA
Max. :46.00	Max. :12.0000	Max. :1.0000	Max. :43.00	Max. :4930	Max. :565.0	Max. :390	NA	NA	NA

Osservando l’output ci si accorge subito che è presente un minimo, per gli anni della madre, pari a zero, situazione ovviamente anomala e che necessita un analisi più approfondita.

Osservando nel dettaglio gli anni della madre e le relative frequenze ci accorgiamo che sono presenti due situazioni anomale, una madre con 0 anni e una madre con 1 anno.

Controllo età madre

freq_anni_madre <- table(neonati$Anni.madre)
df_freq_anni <- format(as.data.frame(freq_anni_madre),nsmall=0)
colnames(df_freq_anni) <- c("Età Madre", "Frequenza")
kable(df_freq_anni, caption = "Frequenze delle età delle madri nel dataset")

Frequenze delle età delle madri nel dataset
Età Madre	Frequenza
0	1
1	1
13	1
14	2
15	6
16	13
17	18
18	24
19	45
20	66
21	74
22	100
23	115
24	131
25	180
26	184
27	197
28	172
29	174
30	200
31	147
32	159
33	110
34	96
35	66
36	64
37	41
38	38
39	27
40	19
41	13
42	8
43	2
44	4
45	1
46	1

Estraiamo le sole righe corrispondenti ai due casi anomali cosi da poter analizzare gli altri dati ad essi relativi:

casi_anomali <- neonati[neonati$Anni.madre %in% c(0, 1), ]
kable(casi_anomali, caption = "Casi anomali relativi all'età materna")

Casi anomali relativi all’età materna
	Anni.madre	N.gravidanze	Fumatrici	Gestazione	Peso	Lunghezza	Cranio	Tipo.parto	Ospedale	Sesso
1152	1	1	0	41	3250	490	350	Nat	osp2	F
1380	0	0	0	39	3060	490	330	Nat	osp3	M

Poiché gli altri dati sembrano corretti, possiamo assumere che si tratti di errori e sostituirli con il valore mediano dell’età.

mediana <- median(neonati$Anni.madre, na.rm = TRUE)
neonati <- neonati %>%
  mutate(Anni.madre = ifelse(Anni.madre %in% c(0, 1),
                             median(Anni.madre, na.rm = TRUE),
                             Anni.madre))

Analisi preliminare statistiche descrittive

Prima di procedere con l’analisi inferenziale, è fondamentale esplorare le caratteristiche principali delle variabili numeriche attraverso un’analisi descrittiva. Questo passaggio iniziale permette di ottenere una visione d’insieme della distribuzione dei dati, evidenziando:

Valori centrali (media e mediana)
Misure di dispersione (deviazione standard e coefficiente di variazione)
Indicatori di forma (asimmetria e curtosi)

Tali informazioni sono essenziali per comprendere la natura dei dati e individuare eventuali anomalie o outlier. Inoltre, le statistiche descrittive offrono indicazioni utili per orientare la scelta delle tecniche inferenziali più adeguate e per facilitare l’interpretazione dei risultati del successivo modello predittivo.

summary_stats <- function(x) {
  c(
    Media = round(mean(x, na.rm = TRUE), 2),
    Mediana = round(median(x, na.rm = TRUE), 2),
    Varianza = round(var(x, na.rm = TRUE), 2),
    Deviazione_Std = round(sd(x, na.rm = TRUE), 2),
    Coeff_Variazione = round((sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)) * 100, 2),
    Asimmetria = round(skewness(x, na.rm = TRUE), 2),
    Curtosi = round(kurtosis(x, na.rm = TRUE), 2)
  )
}

numerical_vars <- neonati[, c("Anni.madre", "N.gravidanze", "Gestazione", "Peso", "Lunghezza", "Cranio")]
stats <- apply(numerical_vars, 2, summary_stats)

df_stats <- as.data.frame(t(stats))
df_stats$Variabile <- rownames(df_stats)
rownames(df_stats) <- NULL

df_stats <- df_stats[, c("Variabile", "Media", "Mediana", "Varianza", "Deviazione_Std", "Coeff_Variazione", "Asimmetria", "Curtosi")]

kable(df_stats, caption = "Statistiche descrittive delle variabili numeriche")

Statistiche descrittive delle variabili numeriche
Variabile	Media	Mediana	Varianza	Deviazione_Std	Coeff_Variazione	Asimmetria	Curtosi
Anni.madre	28.19	28	27.20	5.22	18.50	0.15	2.90
N.gravidanze	0.98	1	1.64	1.28	130.51	2.51	13.99
Gestazione	38.98	39	3.49	1.87	4.79	-2.07	11.26
Peso	3284.08	3300	275665.68	525.04	15.99	-0.65	5.03
Lunghezza	494.69	500	692.67	26.32	5.32	-1.51	9.49
Cranio	340.03	340	269.79	16.43	4.83	-0.79	5.95

Le statistiche descrittive evidenziano una distribuzione generalmente regolare per la maggior parte delle variabili numeriche, con valori medi e mediani molto simili, variabilità contenuta e modesta asimmetria . Le variabili Lunghezza e Cranio mostrano una variabilità molto bassa, mentre N.gravidanze presenta la variabilità relativa più alta, come evidenziato dal Coefficiente di Variazione.

L’analisi della variabilità è stata condotta considerando il Coefficiente di Variazione per eliminare l’influenza dovuta ai differenti ordini di grandezza (ad esempio Peso e Lunghezza).

La variabile Gestazione risulta fortemente asimmetrica a sinistra, mentre N.gravidanze mostra un’asimmetria marcata a destra, richiedendo attenzione nelle fasi inferenziali successive. La curtosi elevata in alcune variabili indica la presenza di code pesanti, ma nel complesso i dati appaiono idonei all’applicazione di test parametrici e modelli lineari, che verranno approfonditi nelle sezioni successive.

freq_table_fun <- function(var) {
  tabella <- table(var)
  totale <- sum(tabella)
  freq_rel <- tabella / totale
  
  df_abs <- data.frame(
    Categoria = names(tabella),
    Frequenza_Assoluta = format(as.vector(tabella),nsmall=2)
  )
  
  df_rel <- data.frame(
    Categoria = names(freq_rel),
    Frequenza_Relativa = format(round(as.vector(freq_rel), 3), nsmall = 2)
  )
  
  list(Frequenze_Assolute = df_abs, Frequenze_Relative = df_rel)
}

freq_fumo <- freq_table_fun(neonati$Fumatrici)
labels_fumo <- c("0" = "Non fumatrici", "1" = "Fumatrici")
freq_fumo$Frequenze_Assolute$Categoria <- labels_fumo[freq_fumo$Frequenze_Assolute$Categoria]
freq_fumo$Frequenze_Relative$Categoria <- labels_fumo[freq_fumo$Frequenze_Relative$Categoria]

tabella_fumo_unita <- cbind(freq_fumo$Frequenze_Assolute, 
                          freq_fumo$Frequenze_Relative[, -1])
colnames(tabella_fumo_unita) <- c("Categoria", "Frequenza_Assoluta", "Frequenza_Relativa")
kable(tabella_fumo_unita, caption = "Frequenze assolute e relative - Fumatrici")

Frequenze assolute e relative - Fumatrici
Categoria	Frequenza_Assoluta	Frequenza_Relativa
Non fumatrici	2396	0.958
Fumatrici	104	0.042

freq_sesso <- freq_table_fun(neonati$Sesso)
tabella_sesso_unita <- cbind(freq_sesso$Frequenze_Assolute, 
                       freq_sesso$Frequenze_Relative[, -1])
colnames(tabella_sesso_unita) <- c("Categoria", "Frequenza_Assoluta", "Frequenza_Relativa")
kable(tabella_sesso_unita, caption = "Frequenze assolute e relative - Sesso")

Frequenze assolute e relative - Sesso
Categoria	Frequenza_Assoluta	Frequenza_Relativa
F	1256	0.502
M	1244	0.498

freq_parto <- freq_table_fun(neonati$Tipo.parto)
tabella_parto_unita <- cbind(freq_parto$Frequenze_Assolute, 
                       freq_parto$Frequenze_Relative[, -1])
colnames(tabella_parto_unita) <- c("Categoria", "Frequenza_Assoluta", "Frequenza_Relativa")
kable(tabella_parto_unita, caption = "Frequenze assolute e relative - Tipo parto")

Frequenze assolute e relative - Tipo parto
Categoria	Frequenza_Assoluta	Frequenza_Relativa
Ces	728	0.291
Nat	1772	0.709

freq_ospedale <- freq_table_fun(neonati$Ospedale)
tabella_ospedale_unita <- cbind(freq_ospedale$Frequenze_Assolute, 
                       freq_ospedale$Frequenze_Relative[, -1])
colnames(tabella_ospedale_unita) <- c("Categoria", "Frequenza_Assoluta", "Frequenza_Relativa")
kable(tabella_ospedale_unita, caption = "Frequenze assolute e relative - Ospedale")

Frequenze assolute e relative - Ospedale
Categoria	Frequenza_Assoluta	Frequenza_Relativa
osp1	816	0.326
osp2	849	0.340
osp3	835	0.334

Analisi delle Variabili Categoriali

L’esplorazione delle variabili categoriali evidenzia alcune caratteristiche rilevanti per le successive analisi inferenziali:

Fumo materno: la stragrande maggioranza delle madri nel campione non fuma (circa il 96%).
Sesso del neonato: la distribuzione tra neonati maschi e femmine appare bilanciata, condizione ottimale per condurre confronti statistici tra i due gruppi. Tale equilibrio consente l’applicazione di test parametrici come il t-test garantendo una buona robustezza nei risultati.
Tipo di parto: circa il 71% dei parti è avvenuto per via naturale, mentre il restante 29% mediante parto cesareo.
Ospedale di provenienza: il campione risulta equamente distribuito tra i tre ospedali partecipanti allo studio.

Sebbene alcune variabili mostrino una distribuzione sbilanciata, la numerosità dei sottogruppi resta generalmente sufficiente per supportare analisi comparative attendibili nel contesto inferenziale.

Boxplot

ggplot(neonati, aes(x = factor(Fumatrici), y = Peso, fill = factor(Fumatrici))) +
  geom_boxplot() +
  labs(
    title = "Distribuzione del Peso alla Nascita per Fumatrici",
    x = "Fumatrici (0 = No, 1 = Sì)",
    y = "Peso alla Nascita (g)"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

Il boxplot mostra una differenza evidente tra i due gruppi:

I neonati di madri fumatrici (1) presentano un peso sistematicamente inferiore rispetto a quelli di madri non fumatrici (0).
Distribuzione più ampia e una maggiore variabilità per le non fumatrici
Distribuzione più concentrata per le fumatrici
Si osserva un numero maggiore di outlier tra i neonati di madri non fumatrici, soprattutto per pesi molto bassi (sotto i 2000 g).

Questo grafico conferma visivamente l’effetto negativo del fumo materno sul peso neonatale, coerente con le ipotesi e la letteratura esistente.

Istogramma

ggplot(neonati, aes(x = Peso)) +
  geom_histogram(binwidth = 250, fill = "skyblue", color = "black") +
  labs(
    title = "Distribuzione del Peso alla Nascita",
    x = "Peso (g)",
    y = "Frequenza"
  ) +
  theme_minimal()

L’istogramma mostra che la distribuzione del peso neonatale è approssimativamente normale, con una leggera asimmetria negativa, confermata dal coefficiente di asimmetria pari a circa -0.65.

Il picco principale si concentra nella fascia 3000-3500 g, corrispondente al peso considerato fisiologico alla nascita.
La coda sinistra è più estesa, indicando la presenza di un numero limitato di neonati con peso molto basso.
La coda destra è meno pronunciata, con pochi casi estremi oltre i 4500 g.

Scatterplot

ggplot(neonati, aes(x = Gestazione, y = Peso)) +
  geom_point(alpha = 0.6) +
  geom_smooth(method = "lm", se = FALSE, color = "blue") +
  labs(
    title = "Peso alla Nascita in Funzione delle Settimane di Gestazione",
    x = "Settimane di Gestazione",
    y = "Peso alla Nascita (g)"
  ) +
  theme_minimal()

Lo scatterplot mette in evidenza una forte correlazione positiva e lineare tra settimane di gestazione e peso alla nascita

Si osserva una relazione robusta, dove ogni settimana aggiuntiva di gestazione è associata a un incremento del peso.
La maggior parte dei dati si concentra tra le 37 e le 40 settimane, corrispondenti a gravidanze a termine.
I parti prematuri (< 37 settimane) sono chiaramente associati a pesi molto bassi, confermando l’importanza della durata della gestazione per la crescita fetale.
La variabilità del peso aumenta leggermente verso il termine, con una maggiore dispersione dei dati tra la 39ª e la 40ª settimana.

Questi risultati supportano l’ipotesi di una relazione lineare significativa tra durata della gestazione e peso alla nascita.

TEST PARAMETRICI

Test (1): In alcuni ospedali si fanno più parti cesarei

tabella <- table(neonati$Ospedale, neonati$Tipo.parto)

test_chi <- chisq.test(tabella)

kable(tabella, caption = "Tabella di contingenza osservata")

Tabella di contingenza osservata
	Ces	Nat
osp1	242	574
osp2	254	595
osp3	232	603

risultati <- data.frame(
  Statistica= round(test_chi$statistic, 2),
  p_value = format.pval(round(test_chi$p.value, 2), digits = 4)
)
rownames(risultati) <- NULL
kable(risultati,align = c("l", "c", "c"), caption = "Risultati del test chi-quadro")

Risultati del test chi-quadro
Statistica	p_value
1.1	0.58

Non si riscontra una relazione statisticamente significativa tra l’ospedale di appartenenza e il tipo di parto (p = 0.58). Pertanto, si mantiene l’ipotesi nulla di indipendenza: la distribuzione dei tipi di parto sembra essere simile tra i diversi ospedali del campione analizzato.

Questo risultato è confermato anche tramite analisi grafica, come evidenziato nei grafici sotto riportati.

ggballoonplot(as.data.frame(tabella), x = "Var1", y = "Var2", size = "Freq", fill = "blue") +
  labs(title = "Distribuzione Tipo di Parto per Ospedale",
       x = "Ospedale", y = "Tipo di Parto")

La visualizzazione della tabella di contingenza mostra chiaramente che in ciascun ospedale (osp1, osp2, osp3) il parto naturale (Nat) è largamente prevalente rispetto al cesareo (Ces). Le bolle corrispondenti ai parti naturali sono grandi e simili tra i tre ospedali, indicando frequenze elevate e comparabili. Al contrario, bolle dei cesarei mostrano frequenze basse e relativamente stabili tra gli ospedali.

curve(dchisq(x, df = test_chi$parameter), 
      from = 0, 
      to = max(30, test_chi$statistic + 10), 
      col = "blue", 
      lwd = 2,
      main = "Distribuzione Chi-quadro sotto H0",
      xlab = "Valori della statistica chi-quadro",
      ylab = "Densità")

abline(v = qchisq(0.95, df = test_chi$parameter), col = "red", lwd = 2, lty = 2)
points(test_chi$statistic, 0, col = "darkgreen", pch = 19, cex = 2)

legend("topright",
       legend = c("Distribuzione sotto H0", 
                  "Valore soglia (α=0.05)", 
                  "Statistica osservata"),
       col = c("blue", "red", "darkgreen"),
       lwd = c(2, 2, NA),
       lty = c(1, 2, NA),
       pch = c(NA, NA, 19))

Il test chi-quadro (X² = 1.097, p = 0.578) conferma l’indipendenza tra ospedale e tipo di parto. La statistica osservata (pallino verde) resta ampiamente sotto la soglia critica (linea rossa), non fornendo evidenze di associazione significativa tra le variabili.

Test (2): La media del peso e della lunghezza di questo campione di neonati sono significativamente uguali a quelle della popolazione

Per la costruzione dei test statistici, è particolarmente utile disporre di valori di riferimento noti per peso e lunghezza neonatale, nello specifico:

Media del peso alla nascita: 3.300 g
Media della lunghezza alla nascita: 500 mm

Fonte

Peso

mu0 <- 3300
peso <- na.omit(neonati$Peso)
n <- length(peso)
media_peso <- mean(peso)
s <- sd(peso)  

T_stat <- (media_peso - mu0) / (s / sqrt(n))

p_value <- 2 * pt(-abs(T_stat), df = n - 1)

IC <- c(
  media_peso - qt(0.975, df = n - 1) * (s / sqrt(n)),
  media_peso + qt(0.975, df = n - 1) * (s / sqrt(n))
)

risultati_test <- data.frame(
  Statistica = round(T_stat, 4),
  `Media campionaria` = round(media_peso, 2),
  `p-value` = format.pval(p_value, digits = 10),
  `IC Inferiore` = round(IC[1], 2),
  `IC Superiore` = round(IC[2], 2)
)

kable(risultati_test, 
      align = c("l", "c", "c", "c", "c"),
      caption = "Risultati test t per la media del peso neonatale")

Risultati test t per la media del peso neonatale
Statistica	Media.campionaria	p.value	IC.Inferiore	IC.Superiore
-1.516	3284.08	0.1296452187	3263.49	3304.67

L’output mostra il risultato di un test t per valutare se la media del peso neonatale differisce significativamente dal valore noto di riferimento di 3300 grammi. Il p-value ottenuto è superiore ai comuni livelli di significatività (es. 0.05), il che indica che non rifiutiamo l’ipotesi nulla e concludiamo che la media del peso non è significativamente diversa da quella della popolazione.

curve(dt(x, df = n - 1),
      from = -4, to = 4,
      col = "blue", lwd = 2,
      main = "Distribuzione t di Student sotto H0",
      xlab = "t", ylab = "Densità")
abline(v = c(-qt(0.975, df = n - 1), qt(0.975, df = n - 1)),
       col = "red", lty = 2, lwd = 2)
points(T_stat, 0, col = "darkgreen", pch = 19, cex = 2)
legend("topright",
       legend = c("t di Student", "Soglie critiche", "t osservato"),
       col = c("blue", "red", "darkgreen"),
       lwd = c(2, 2, NA), lty = c(1, 2, NA), pch = c(NA, NA, 19))

Il grafico mostra la distribuzione t Student sul peso neonatale. Le linee rosse tratteggiate rappresentano i valori soglia critici, corrispondenti a un livello di significatività del 5% (α = 0.05) per un test bilaterale. Il punto verde indica il valore osservato e si trova all’interno dell’intervallo di accettazione.

Questo conferma visivamente quanto evidenziato dall’output numerico:

Il valore t cade nell’area di accettazione
L’ipotesi nulla non viene respinta
La media campionaria del peso non è significativamente diversa da quella attesa (3300 grammi)

Lunghezza

mu0 <- 500

lung <- na.omit(neonati$Lunghezza)
n <- length(lung)
media_lung <- mean(lung)
sd_lung <- sd(lung)

T_stat <- (media_lung - mu0) / (sd_lung / sqrt(n))

p_value <- 2 * pt(-abs(T_stat), df = n - 1)

IC <- c(
  media_lung - qt(0.975, df = n - 1) * (sd_lung / sqrt(n)),
  media_lung + qt(0.975, df = n - 1) * (sd_lung / sqrt(n))
)

risultati_lung <- data.frame(
  Statistica = round(T_stat, 4),
  `Media campionaria` = round(media_lung, 2),
  `p-value` = format.pval(p_value, digits = 15),
  `IC 95% Inferiore` = round(IC[1], 2),
  `IC 95% Superiore` = round(IC[2], 2)
)

kable(risultati_lung, 
      caption = "Risultati test t per la media della lunghezza neonatale",
      align = c("l", "c", "c", "c", "c"))

Risultati test t per la media della lunghezza neonatale
Statistica	Media.campionaria	p.value	IC.95..Inferiore	IC.95..Superiore
-10.0841	494.69	< 2.22044604925e-16	493.66	495.72

Il test t mostra che la lunghezza neonatale media del campione (494.69) è significativamente diversa da quella della popolazione di riferimento (p-value < 2.22e-16), con un intervallo di confidenza al 95% [493.66; 495.72] che non include la media attesa: la differenza è quindi altamente significativa dal punto di vista statistico.

curve(dt(x, df = n - 1), from = -15, to = 15, col = "blue", lwd = 2,
      main = "Distribuzione t di Student sotto H0",
      xlab = "Valori t", ylab = "Densità")
abline(v = c(-qt(0.975, df = n - 1), qt(0.975, df = n - 1)),
       col = "red", lty = 2, lwd = 2)
points(T_stat, 0, col = "darkgreen", pch = 19, cex = 2)

legend("topright",
       legend = c("Distribuzione t", 
                  "Soglie critiche ±t(0.975)", 
                  "t osservato"),
       col = c("blue", "red", "darkgreen"),
       lwd = c(2, 2, NA), lty = c(1, 2, NA), pch = c(NA, NA, 19))

Il grafico mostra come il valore osservato per la lunghezza sia molto distante dal centro della distribuzione, indicando una forte significatività statistica. Questo ci porta a rifiutare con sicurezza l’ipotesi nulla.

In particolare:

Il valore t cade ben oltre la soglia critica;
Il p-value è praticamente zero, confermando la significatività;
La media campionaria è significativamente inferiore al valore ipotizzato.

In conclusione, c’è una chiara evidenza di una differenza reale nella lunghezza media della popolazione rispetto all’ipotesi iniziale.

Le misure antropometriche sono significativamente diverse tra i due sessi

Per confrontare le misure antropometriche tra maschi e femmine è stato utilizzato il test t di Student. Poiché l’analisi riguarda tre diverse variabili (lunghezza, peso e cranio), è stata creata una funzione che consente di evitare la ripetizione del codice per ciascun confronto.

t_test_confronto <- function(x1, x2, nome_variabile = "Variabile") {
  x1 <- na.omit(x1)
  x2 <- na.omit(x2)
  
  n1 <- length(x1)
  n2 <- length(x2)
  m1 <- mean(x1)
  m2 <- mean(x2)
  s1 <- sd(x1)
  s2 <- sd(x2)
  
  se <- sqrt(s1^2/n1 + s2^2/n2)
  t_stat <- (m1 - m2) / se
  df <- (s1^2/n1 + s2^2/n2)^2 / ((s1^2/n1)^2/(n1-1) + (s2^2/n2)^2/(n2-1))
  p_value <- 2 * pt(-abs(t_stat), df)
  
  IC <- c((m1 - m2) - qt(0.975, df)*se, (m1 - m2) + qt(0.975, df)*se)
  
  risultati <- data.frame(
    Variabile = nome_variabile,
    `Diff_medie_(M-F)` = round(m1 - m2, 2),
    t = round(t_stat, 4),
    `p-value` = format.pval(p_value, digits = 15),
    `IC 95% Inferiore` = round(IC[1], 2),
    `IC 95% Superiore` = round(IC[2], 2)
  )
  
  curve(dt(x, df), from = -15, to = 15, col = "blue", lwd = 2,
        main = paste("t-test:", nome_variabile, "(Maschi - Femmine)"),
        xlab = "Valori t", ylab = "Densità")
  abline(v = c(-qt(0.975, df), qt(0.975, df)), col = "red", lty = 2, lwd = 2)
  points(t_stat, 0, col = "darkgreen", pch = 19, cex = 2)
  legend("topright",
         legend = c("Distribuzione t", "Soglie critiche", "t osservato"),
         col = c("blue", "red", "darkgreen"),
         lwd = c(2, 2, NA), lty = c(1, 2, NA), pch = c(NA, NA, 19))
  
  return(
    kable(
      risultati,
      caption = paste("t-test per", nome_variabile, "(Maschi vs Femmine)"),
      align = c("l", rep("c", ncol(risultati) - 1))
    )
  )
}



t_test_confronto(neonati$Lunghezza[neonati$Sesso == "M"],
                 neonati$Lunghezza[neonati$Sesso == "F"],
                 nome_variabile = "Lunghezza")

t-test per Lunghezza (Maschi vs Femmine)
Variabile	Diff_medie_.M.F.	t	p.value	IC.95..Inferiore	IC.95..Superiore
Lunghezza	9.9	9.582	< 2.22044604925e-16	7.88	11.93

t_test_confronto(neonati$Peso[neonati$Sesso == "M"],
                 neonati$Peso[neonati$Sesso == "F"],
                 nome_variabile = "Peso")

t-test per Peso (Maschi vs Femmine)
Variabile	Diff_medie_.M.F.	t	p.value	IC.95..Inferiore	IC.95..Superiore
Peso	247.08	12.1061	< 2.22044604925e-16	207.06	287.11

t_test_confronto(neonati$Cranio[neonati$Sesso == "M"],
                 neonati$Cranio[neonati$Sesso == "F"],
                 nome_variabile = "Cranio")

t-test per Cranio (Maschi vs Femmine)
Variabile	Diff_medie_.M.F.	t	p.value	IC.95..Inferiore	IC.95..Superiore
Cranio	4.82	7.4102	1.71769469990384e-13	3.54	6.09

Tutti e tre i confronti mostrano differenze significative tra i sessi, con i maschi che mediamente presentano valori più elevati per lunghezza, peso e cranio. Queste evidenze statistiche suggeriscono che il sesso del neonato è un fattore associato in modo sistematico alle sue misure antropometriche alla nascita.

SCATTERPLOT E CORRELAZIONI

panel.cor <- function(x, y, digits=2, prefix="", cex.cor, ...) {
  usr <- par("usr")
  on.exit(par(usr = usr)) 
  par(usr = c(0,1,0,1))
  r <- cor(x, y, use="complete.obs")
  txt <- format(c(r, 0.123456789), digits=digits)[1]
  txt <- paste0(prefix, txt)
  if(missing(cex.cor)) cex.cor <- 0.8 / strwidth(txt)
  text(0.5, 0.5, txt, cex=cex.cor)
}

pairs(neonati[, c("Anni.madre", "N.gravidanze", "Gestazione", "Peso", "Lunghezza", "Cranio")],
      lower.panel=panel.cor, upper.panel=panel.smooth)

Le correlazioni più forti si osservano tra le misure antropometriche (peso, lunghezza, cranio), che risultano strettamente interconnesse. In particolare:

Peso e lunghezza mostrano la correlazione più elevata (r = 0.80);
La durata della gestazione è un fattore chiave, correlato positivamente con peso e lunghezza;
Fattori materni come l’età e il numero di gravidanze presentano invece legami deboli con le misure neonatali.

Nel complesso, il pattern emerso suggerisce l’importanza della gestazione e della lunghezza come variabili predittive.

Modello di regressione lineare completo

mod_full <- lm(Peso ~ Anni.madre + N.gravidanze + Gestazione + Fumatrici + Sesso + Lunghezza + Cranio, data = neonati)
summary(mod_full)

## 
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Gestazione + 
##     Fumatrici + Sesso + Lunghezza + Cranio, data = neonati)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1160.62  -181.17   -15.91   163.47  2631.35 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -6711.5440   141.2543 -47.514  < 2e-16 ***
## Anni.madre       0.8772     1.1487   0.764   0.4452    
## N.gravidanze    11.4029     4.6745   2.439   0.0148 *  
## Gestazione      32.8936     3.8259   8.598  < 2e-16 ***
## Fumatrici      -30.2865    27.5981  -1.097   0.2726    
## SessoM          78.0898    11.2042   6.970 4.05e-12 ***
## Lunghezza       10.2348     0.3009  34.010  < 2e-16 ***
## Cranio          10.5192     0.4268  24.644  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 274.6 on 2492 degrees of freedom
## Multiple R-squared:  0.7272, Adjusted R-squared:  0.7264 
## F-statistic:   949 on 7 and 2492 DF,  p-value: < 2.2e-16

Il modello lineare completo evidenzia una relazione statisticamente significativa tra diverse variabili cliniche e antropometriche e il peso neonatale.

In particolare:

L’R² è pari a 0.7272, indicando che circa il 72,72% della variabilità del peso alla nascita è spiegata dalle variabili incluse nel modello;
Il test F globale è altamente significativo (p < 2.2e-16), suggerendo che almeno un predittore ha un effetto reale sul peso;
Tra i predittori più influenti, la lunghezza alla nascita si conferma il fattore dominante, con un aumento medio di 10,23 grammi per ogni centimetro in più, seguita dalla circonferenza cranica, che contribuisce con un aumento medio di 10,52 grammi per ogni centimetro aggiuntivo;
Anche la durata della gestazione ha un impatto rilevante, con un incremento medio di 32,95 grammi per ogni settimana in più;
Il sesso del neonato mostra un effetto significativo: i maschi pesano, mediamente, 78 grammi in più rispetto alle femmine;

Risultano statisticamente significativi, seppur con un effetto più contenuto, anche il numero di gravidanze precedenti, associato a un aumento medio di 11,38 grammi per ogni gravidanza in più.

Non emergono invece effetti statisticamente significativi per l’età materna e per il fumo materno, che non sembrano influenzare il peso in modo rilevante nel campione analizzato.

SELEZIONE MODELLO RIDOTTO

n <- nrow(neonati)
step_mod <- stepAIC(mod_full, direction = "both", k = log(n))

## Start:  AIC=28131.42
## Peso ~ Anni.madre + N.gravidanze + Gestazione + Fumatrici + Sesso + 
##     Lunghezza + Cranio
## 
##                Df Sum of Sq       RSS   AIC
## - Anni.madre    1     43973 187973654 28124
## - Fumatrici     1     90821 188020502 28125
## - N.gravidanze  1    448752 188378433 28130
## <none>                      187929681 28131
## - Sesso         1   3663296 191592977 28172
## - Gestazione    1   5574474 193504156 28197
## - Cranio        1  45800355 233730036 28669
## - Lunghezza     1  87230732 275160413 29077
## 
## Step:  AIC=28124.18
## Peso ~ N.gravidanze + Gestazione + Fumatrici + Sesso + Lunghezza + 
##     Cranio
## 
##                Df Sum of Sq       RSS   AIC
## - Fumatrici     1     91892 188065546 28118
## <none>                      187973654 28124
## - N.gravidanze  1    646039 188619694 28125
## + Anni.madre    1     43973 187929681 28131
## - Sesso         1   3671289 191644943 28165
## - Gestazione    1   5531705 193505359 28189
## - Cranio        1  46066755 234040410 28664
## - Lunghezza     1  87218857 275192512 29069
## 
## Step:  AIC=28117.58
## Peso ~ N.gravidanze + Gestazione + Sesso + Lunghezza + Cranio
## 
##                Df Sum of Sq       RSS   AIC
## <none>                      188065546 28118
## - N.gravidanze  1    623141 188688687 28118
## + 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(step_mod)

## 
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Sesso + Lunghezza + 
##     Cranio, data = neonati)
## 
## 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 ***
## N.gravidanze    12.4750     4.3396   2.875  0.00408 ** 
## Gestazione      32.3321     3.7980   8.513  < 2e-16 ***
## SessoM          77.9927    11.2021   6.962 4.26e-12 ***
## Lunghezza       10.2486     0.3006  34.090  < 2e-16 ***
## Cranio          10.5402     0.4262  24.728  < 2e-16 ***
## ---
## 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

La selezione del modello mediante procedura stepwise con criterio BIC ha portato a un modello finale composto da cinque variabili:

Numero di gravidanze
Settimane di gestazione
Sesso del neonato
Lunghezza alla nascita
Circonferenza cranica.

Le variabili Anni della madre e Fumatrici, presenti nel modello iniziale, sono state progressivamente escluse poiché non apportavano un miglioramento sufficiente al compromesso tra bontà di adattamento e complessità secondo il criterio BIC.

Risultati principali del modello finale:

Numero di gravidanze: coeff. = 12,46 (p = 0,004), associato a un incremento medio di 12,46 grammi per ogni gravidanza in più.
Settimane di gestazione: coeff. = 32,38 (p < 0,001), principale predittore clinico, con un aumento medio di 32,38 grammi per ogni settimana aggiuntiva.
Sesso (Maschio): coeff. = 77,98 (p < 0,001), i neonati maschi pesano in media 77,98 grammi in più rispetto alle femmine.
Lunghezza: coeff. = 10,25 (p < 0,001), incremento medio di 10,25 grammi per ogni centimetro in più.
Cranio: coeff. = 10,54 (p < 0,001), incremento medio di 10,54 grammi per ogni centimetro in più.

Prestazioni del modello:

R² = 0,727 (Adj. R² = 0,7265) → il modello spiega il 73% della variabilità del peso neonatale;
Errore standard residuo = 274,7 grammi, con distribuzione bilanciata intorno allo zero;
Test F globale = 1328 (p < 2,2e-16) → il modello è altamente significativo nel suo complesso.

Il modello conferma il ruolo determinante di fattori antropometrici (lunghezza e circonferenza cranica) e clinici (settimane di gestazione) nel predire il peso alla nascita, con contributi aggiuntivi, seppur più contenuti, di sesso e numero di gravidanze precedenti.

Prova di interazioni

mod_inter <- lm(Peso ~ N.gravidanze + Gestazione * Fumatrici + Sesso + Lunghezza + Cranio,data = neonati)
summary(mod_inter)

## 
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione * Fumatrici + Sesso + 
##     Lunghezza + Cranio, data = neonati)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1149.9  -181.1   -17.1   163.6  2636.3 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          -6699.0708   136.6478 -49.024  < 2e-16 ***
## N.gravidanze            12.7641     4.3451   2.938  0.00334 ** 
## Gestazione              33.1472     3.8389   8.635  < 2e-16 ***
## Fumatrici              794.5870   757.2739   1.049  0.29415    
## SessoM                  78.7548    11.2151   7.022 2.81e-12 ***
## Lunghezza               10.2285     0.3009  33.988  < 2e-16 ***
## Cranio                  10.5305     0.4263  24.704  < 2e-16 ***
## Gestazione:Fumatrici   -21.0157    19.2765  -1.090  0.27572    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 274.6 on 2492 degrees of freedom
## Multiple R-squared:  0.7273, Adjusted R-squared:  0.7265 
## F-statistic: 949.3 on 7 and 2492 DF,  p-value: < 2.2e-16

anova(step_mod, mod_inter)

## Analysis of Variance Table
## 
## Model 1: Peso ~ N.gravidanze + Gestazione + Sesso + Lunghezza + Cranio
## Model 2: Peso ~ N.gravidanze + Gestazione * Fumatrici + Sesso + Lunghezza + 
##     Cranio
##   Res.Df       RSS Df Sum of Sq      F Pr(>F)
## 1   2494 188065546                           
## 2   2492 187884041  2    181506 1.2037 0.3003

L’analisi comparativa tra il modello con interazione e quello senza il termine di interazione Gestazione:Fumatrici mostra che quest’ultima non apporta un contributo significativo (p-value ANOVA = 0.3003).

Si adotta il modello semplificato, che mantiene la stessa capacità esplicativa con meno parametri, risultando più robusto e interpretabile.

Diagnostica Redisui

vif_values <- vif(step_mod)
vif_df <- data.frame(Variabile = names(vif_values), VIF = vif_values)
rownames(vif_df) <- NULL
kable(vif_df, align = c("l", "c"), digits = 2, caption = "Variance Inflation Factor (VIF) del modello")

Variance Inflation Factor (VIF) del modello
Variabile	VIF
N.gravidanze	1.02
Gestazione	1.67
Sesso	1.04
Lunghezza	2.07
Cranio	1.62

L’analisi dei VIF (Variance Inflation Factor) mostra valori tutti significativamente inferiori a 5, indicando l’assenza di collinearità tra le variabili considerate. Le variabili con VIF leggermente più elevato, come Lunghezza (2.08) e Gestazione (1.69), non presentano comunque problemi rilevanti, confermando l’idoneità dei dati all’applicazione di modelli di regressione lineare multipla

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

shapiro_res <- shapiro.test(residuals(step_mod))
bptest_res <- bptest(step_mod)
dwtest_res <- dwtest(step_mod)

diagnostica <- data.frame(
  Test = c("Shapiro-Wilk (Normalità residui)", 
           "Breusch-Pagan (Eteroschedasticità)", 
           "Durbin-Watson (Autocorrelazione)"),
  Statistic = c(round(shapiro_res$statistic, 4), 
                round(bptest_res$statistic, 4), 
                round(dwtest_res$statistic, 4)),
  p_value = c(format.pval(shapiro_res$p.value, digits = 4), 
              format.pval(bptest_res$p.value, digits = 4), 
              format.pval(dwtest_res$p.value, digits = 4))
)

rownames(diagnostica) <- NULL  

kable(diagnostica, 
      align = c("l", "c", "c"), 
      col.names = c("Test", "Statistic", "p-value"),
      caption = "Risultati dei test diagnostici sui residui - Modello ridotto")

Risultati dei test diagnostici sui residui - Modello ridotto
Test	Statistic	p-value
Shapiro-Wilk (Normalità residui)	0.9741	< 2.2e-16
Breusch-Pagan (Eteroschedasticità)	90.2528	< 2.2e-16
Durbin-Watson (Autocorrelazione)	1.9535	0.1224

L’analisi grafica e i test diagnostici sui residui del modello ridotto evidenziano alcune criticità.

Il grafico Residuals vs Fitted mostra un leggero andamento curvilineo agli estremi e la presenza di outlier (es. 1551, 155, 1306), suggerendo possibili deviazioni dalla linearità.
Il Q-Q Plot evidenzia deviazioni marcate nelle code, in accordo con il test di Shapiro-Wilk (p < 2.2e-16) che indica violazione della normalità.
Il grafico Scale-Location rivela variazioni nella dispersione dei residui, confermate dal test di Breusch-Pagan (p < 2.2e-16), segnalando eteroschedasticità.
L’analisi Residuals vs Leverage non mostra casi estremamente influenti, ma alcune osservazioni ad alta leva meritano attenzione.
Il test di Durbin-Watson (p = 0.1224) esclude infine problemi di autocorrelazione.

Nel complesso, il modello è utilizzabile ma presenta violazioni di normalità e omoschedasticità, oltre ad alcuni outlier e lievi segnali di non linearità, che richiedono valutazioni correttive prima di procedere con l’inferenza.

par(mfrow = c(2, 2))

cookd <- cooks.distance(step_mod)
plot(cookd, type = "h", main = "Cook's Distance", ylab = "Cook's Distance")
abline(h = 4 / nrow(neonati), col = "red", lty = 2)

residui <- residuals(step_mod)
hist(residui, breaks = 30, main = "Distribuzione dei residui", xlab = "Residui", col = "lightblue", border = "black")

residui_student <- rstudent(step_mod)
plot(residui_student, type = "h", main = "Residui Studentizzati", ylab = "Residui Studentizzati")
abline(h = c(-2, 2), col = "red", lty = 2)

lev <- hatvalues(step_mod)
plot(lev, type = "h", main = "Leverage", ylab = "Leverage")
abline(h = 2 * mean(lev), col = "red", lty = 2)

max_cook <- which.max(cookd)       
max_cook_val <- cookd[max_cook]    

kable(data.frame(
  Cooks_Distance = round(max_cook_val, 4)
), caption = "Osservazione con massimo Cook's Distance")

Osservazione con massimo Cook’s Distance
	Cooks_Distance
1551	0.8301

L’analisi grafica e i test diagnostici sui residui evidenziano una criticità legata a un’osservazione anomala.

Il grafico Cook’s Distance segnala chiaramente un punto molto influente (1551) con valori superiori alla soglia di 0.8, indicativo di un’elevata influenza sui coefficienti di regressione.
La distribuzione dei residui mostra una forma complessivamente normale, sebbene lievemente condizionata dalla presenza di tale valore estremo.
I Residui studentizzati confermano l’anomalia: l’osservazione 1551 supera nettamente le soglie di ±2, mentre gli altri punti risultano distribuiti regolarmente attorno allo zero.
Il grafico Leverage mette in evidenza che lo stesso punto presenta anche un’elevata leva, in coerenza con quanto osservato negli altri grafici diagnostici.

Nel complesso, l’osservazione risulta sia un outlier che un punto influente.

Proviamo ad eliminare la riga associata all’indice 1551 per analizzarne l’effetto sul modello di regressione selezioinato.

neonati_new <- neonati[-1551, ]
step_mod_new <- lm(Peso ~ N.gravidanze + Gestazione + Sesso + Lunghezza + Cranio,data = neonati_new)
summary(step_mod)

## 
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Sesso + Lunghezza + 
##     Cranio, data = neonati)
## 
## 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 ***
## N.gravidanze    12.4750     4.3396   2.875  0.00408 ** 
## Gestazione      32.3321     3.7980   8.513  < 2e-16 ***
## SessoM          77.9927    11.2021   6.962 4.26e-12 ***
## Lunghezza       10.2486     0.3006  34.090  < 2e-16 ***
## Cranio          10.5402     0.4262  24.728  < 2e-16 ***
## ---
## 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

summary(step_mod_new)

## 
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Sesso + Lunghezza + 
##     Cranio, data = neonati_new)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1165.74  -179.59   -12.74   162.89  1410.88 
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -6683.4142   133.0802 -50.221  < 2e-16 ***
## N.gravidanze    13.1652     4.2557   3.094    0.002 ** 
## Gestazione      29.5891     3.7340   7.924 3.43e-15 ***
## SessoM          78.1348    10.9840   7.114 1.47e-12 ***
## Lunghezza       10.8927     0.3017  36.109  < 2e-16 ***
## Cranio           9.9187     0.4225  23.476  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 269.3 on 2493 degrees of freedom
## Multiple R-squared:  0.7372, Adjusted R-squared:  0.7367 
## F-statistic:  1399 on 5 and 2493 DF,  p-value: < 2.2e-16

Dopo la rimozione di un singolo outlier, il modello risulta più solido e preciso. L’R² passa da 0.727 a 0.737, mentre l’errore standard residuo si riduce di circa 5 grammi, segnalando una migliore capacità predittiva. Anche il valore associato al test F migliora, confermando una maggiore significatività complessiva del modello. In sintesi, la depurazione ha migliorato la robustezza e l’affidabilità delle stime senza alterarne l’interpretazione.

Validazione del modello

train_indices <- sample(seq_len(nrow(neonati_new)), size = 0.7 * nrow(neonati_new))
train_data <- neonati_new[train_indices, ]
test_data <- neonati_new[-train_indices, ]

step_mod_new <- lm(Peso ~ N.gravidanze + Gestazione + 
                  Sesso + Lunghezza + Cranio,
                data = train_data)

pred_train <- predict(step_mod, newdata = train_data)
pred_test <- predict(step_mod, newdata = test_data)

MSE <- function(y_obs, y_pred) mean((y_obs - y_pred)^2)

mse_train <- MSE(train_data$Peso, pred_train)
rmse_train <- sqrt(mse_train)
mse_test <- MSE(test_data$Peso, pred_test)
rmse_test <- sqrt(mse_test)

metriche <- data.frame(
  Dataset = c("Training", "Test"),
  MSE = c(round(mse_train, 2), round(mse_test, 2)),
  RMSE = c(round(rmse_train, 2), round(rmse_test, 2))
)

kable(metriche, caption = "Performance del modello mod_inter sul training e test set")

Performance del modello mod_inter sul training e test set
Dataset	MSE	RMSE
Training	71833.28	268.02
Test	73948.03	271.93

La validazione del modello è stata effettuata dividendo il dataset in training (70%) e test (30%).

Il modello è stato costruito sui dati di training e poi utilizzato per prevedere il peso neonatale sia nel training che nel test.

L’errore quadratico medio (MSE) e la radice dell’errore quadratico medio (RMSE) risultano leggermente più bassi nel training.
La differenza contenuta tra gli errori in training e test indica che il modello generalizza abbastanza bene, senza segni evidenti di overfitting.

In sintesi, il modello mostra una performance stabile su dati nuovi, confermando la sua affidabilità per la previsione del peso neonatale.

Previsione

Supponiamo di applicare il modello finale per stimare il peso alla nascita di un neonato in un caso specifico:

Madre alla terza gravidanza
39 settimane di gestazione
Fumatrice
Sesso maschile
Parto naturale
Ricovero presso l’ospedale 1

media_lunghezza <- mean(neonati_new$Lunghezza, na.rm = TRUE)
media_cranio <- mean(neonati_new$Cranio, na.rm = TRUE)

new_neonate <- data.frame(
  N.gravidanze = 3,
  Gestazione = 39,
  Sesso = factor("M", levels = c("F", "M")),
  Lunghezza = media_lunghezza,    
  Cranio = media_cranio          
)

peso_previsto <- predict(step_mod_new, newdata = new_neonate)

tabella_output <- data.frame(
  Variabile = c("Peso previsto (grammi)"),
  Valore = round(peso_previsto, 1)
)

kable(tabella_output,
      align=c('l','c'),
      caption = "Previsione del peso neonatale")

Previsione del peso neonatale
Variabile	Valore
Peso previsto (grammi)	3333.4

La previsione ottenuta indica un peso stimato di circa 3350 grammi. Questo valore rappresenta la stima del modello basata sulle variabili incluse, fornendo un esempio pratico di come il modello possa essere applicato per valutare il peso atteso di un neonato con determinate condizioni materne e cliniche

VISUALIZZAZIONE RISULTATI

par(mfrow = c(1, 1))

ggplot(neonati_new, aes(x = N.gravidanze, y = Peso, color = Sesso, group = Sesso)) +
  geom_point(alpha = 0.4) +
  geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
  labs(title = "Relazione tra numero di gravidanze e peso del neonato",
       x = "Numero di gravidanze", 
       y = "Peso", 
       color = "Sesso") +
  theme_light()

ggplot(neonati_new, aes(x = Gestazione, y = Peso, color = Sesso, group = Sesso)) +
  geom_point(alpha = 0.4) +
  geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
  labs(title = "Relazione tra settimane di gestazione e peso del neonato",
       x = "Gestazione", 
       y = "Peso", 
       color = "Sesso") +
  theme_light()

ggplot(neonati_new, aes(x = Lunghezza, y = Peso, color = Sesso, group = Sesso)) +
  geom_point(alpha = 0.4) +
  geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
  labs(title = "Relazione tra lunghezza e peso del neonato",
       x = "Lunghezza", 
       y = "Peso", 
       color = "Sesso") +
  theme_light()

ggplot(neonati_new, aes(x = Cranio, y = Peso, color = Sesso, group = Sesso)) +
  geom_point(alpha = 0.4) +
  geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
  labs(title = "Relazione tra cranio e peso del neonato",
       x = "Cranio", 
       y = "Peso", 
       color = "Sesso") +
  theme_light()

CONCLUSIONE

L’analisi condotta mostra come la lunghezza e cranio del neonato rappresentino i principali determinanti del peso alla nascita, seguiti dalla durata della gestazione, dal sesso e dal numero di gravidanze. Tutte le variabili incluse risultano statisticamente significative e contribuiscono in modo rilevante alla spiegazione della variabilità osservata. Il modello finale presenta un buon livello di adattamento (R²=0.7372) e spiega una quota consistente della variabilità complessiva del peso neonatale

Modello Statistico per la Previsione del Peso Neonatale

Matteo Zuliani

Settembre 2025

Età Madre	Frequenza
0	1
1	1
13	1
14	2
15	6
16	13
17	18
18	24
19	45
20	66
21	74
22	100
23	115
24	131
25	180
26	184
27	197
28	172
29	174
30	200
31	147
32	159
33	110
34	96
35	66
36	64
37	41
38	38
39	27
40	19
41	13
42	8
43	2
44	4
45	1
46	1

Età Madre	Frequenza
0	1
1	1
13	1
14	2
15	6
16	13
17	18
18	24
19	45
20	66
21	74
22	100
23	115
24	131
25	180
26	184
27	197
28	172
29	174
30	200
31	147
32	159
33	110
34	96
35	66
36	64
37	41
38	38
39	27
40	19
41	13
42	8
43	2
44	4
45	1
46	1

Età Madre	Frequenza
0	1
1	1
13	1
14	2
15	6
16	13
17	18
18	24
19	45
20	66
21	74
22	100
23	115
24	131
25	180
26	184
27	197
28	172
29	174
30	200
31	147
32	159
33	110
34	96
35	66
36	64
37	41
38	38
39	27
40	19
41	13
42	8
43	2
44	4
45	1
46	1