Caricamento librerie
pkgs <- c("tidyverse","broom","knitr","kableExtra","GGally","car","lmtest")
to_install <- setdiff(pkgs, rownames(installed.packages()))
if(length(to_install)) install.packages(to_install, repos = "https://cloud.r-project.org")
library(tidyverse)
library(broom)
library(knitr)
library(kableExtra)
library(GGally)
library(car)
library(lmtest)
Caricamento dei dati
dati <- read.csv("neonati.csv", stringsAsFactors = FALSE)
Preparazione e pulizia
dati <- dati %>%
mutate(
Anni.madre = ifelse(Anni.madre %in% c(0,1), NA, Anni.madre),
lunghezza_cm = as.numeric(Lunghezza)/10,
cranio_cm = as.numeric(Cranio)/10,
Fumatrici = as.factor(Fumatrici),
Sesso = as.factor(Sesso),
Tipo.parto = as.factor(Tipo.parto),
Ospedale = as.factor(Ospedale)
)
Costruzione del modello predittivo
dati_m1 <- dati %>%
select(Peso, Gestazione, Anni.madre, N.gravidanze, Fumatrici, Sesso, lunghezza_cm, cranio_cm) %>%
drop_na()
modello <- lm(Peso ~ Gestazione + Anni.madre + N.gravidanze + Fumatrici + Sesso + lunghezza_cm + cranio_cm,
data = dati_m1)
Statistiche descrittive
num_vars <- c("Peso","Gestazione","Anni.madre","N.gravidanze","lunghezza_cm","cranio_cm")
desc_num <- dati %>%
select(all_of(num_vars)) %>%
pivot_longer(everything(), names_to = "Variabile", values_to = "Valore") %>%
group_by(Variabile) %>%
summarise(
n = sum(!is.na(Valore)),
media = mean(Valore, na.rm = TRUE),
sd = sd(Valore, na.rm = TRUE),
min = min(Valore, na.rm = TRUE),
q25 = quantile(Valore, 0.25, na.rm = TRUE),
mediana = median(Valore, na.rm = TRUE),
q75 = quantile(Valore, 0.75, na.rm = TRUE),
max = max(Valore, na.rm = TRUE),
.groups = "drop"
)
kable(desc_num, digits = 2, caption = "Riepilogo variabili quantitative") %>%
kable_styling(full_width = FALSE)
Riepilogo variabili quantitative
|
Variabile
|
n
|
media
|
sd
|
min
|
q25
|
mediana
|
q75
|
max
|
|
Anni.madre
|
2498
|
28.19
|
5.22
|
13.0
|
25
|
28
|
32
|
46.0
|
|
Gestazione
|
2500
|
38.98
|
1.87
|
25.0
|
38
|
39
|
40
|
43.0
|
|
N.gravidanze
|
2500
|
0.98
|
1.28
|
0.0
|
0
|
1
|
1
|
12.0
|
|
Peso
|
2500
|
3284.08
|
525.04
|
830.0
|
2990
|
3300
|
3620
|
4930.0
|
|
cranio_cm
|
2500
|
34.00
|
1.64
|
23.5
|
33
|
34
|
35
|
39.0
|
|
lunghezza_cm
|
2500
|
49.47
|
2.63
|
31.0
|
48
|
50
|
51
|
56.5
|
Commento:
La tabella riassume le principali statistiche descrittive delle
variabili quantitative. Il peso medio alla nascita è di circa 3,3 kg,
con una variabilità moderata. La lunghezza e la circonferenza cranica
sono centrate rispettivamente attorno ai 50 cm e 34 cm, in linea con i
valori fisiologici neonatali. La durata media della gestazione è di
circa 39 settimane, con una deviazione standard ridotta (≈1,9
settimane), indicando che la maggior parte dei neonati del campione è
nata a termine, ossia tra la 37ª e la 42ª
settimana.
kable(dati %>% count(Fumatrici, name="Freq"), caption = "Distribuzione di Fumatrici") %>% kable_styling(full_width=FALSE)
Distribuzione di Fumatrici
|
Fumatrici
|
Freq
|
|
0
|
2396
|
|
1
|
104
|
kable(dati %>% count(Sesso, name="Freq"), caption = "Distribuzione di Sesso") %>% kable_styling(full_width=FALSE)
Distribuzione di Sesso
|
Sesso
|
Freq
|
|
F
|
1256
|
|
M
|
1244
|
kable(dati %>% count(Tipo.parto, name="Freq"), caption = "Distribuzione di Tipo.parto") %>% kable_styling(full_width=FALSE)
Distribuzione di Tipo.parto
|
Tipo.parto
|
Freq
|
|
Ces
|
728
|
|
Nat
|
1772
|
kable(dati %>% count(Ospedale, name="Freq"), caption = "Distribuzione di Ospedale") %>% kable_styling(full_width=FALSE)
Distribuzione di Ospedale
|
Ospedale
|
Freq
|
|
osp1
|
816
|
|
osp2
|
849
|
|
osp3
|
835
|
Commento:
Le tabelle mostrano distribuzioni bilanciate tra maschi e femmine e una
leggera prevalenza di parti naturali. Le madri fumatrici rappresentano
una minoranza (≈4%), informazione utile per interpretare la potenza
statistica dell’effetto.
Analisi delle correlazioni
dati_num <- dati %>% select(all_of(num_vars)) %>% drop_na()
corr <- round(cor(dati_num), 2)
kable(corr, caption = "Matrice di correlazione") %>% kable_styling(full_width = FALSE)
Matrice di correlazione
|
|
Peso
|
Gestazione
|
Anni.madre
|
N.gravidanze
|
lunghezza_cm
|
cranio_cm
|
|
Peso
|
1.00
|
0.59
|
-0.02
|
0.00
|
0.80
|
0.70
|
|
Gestazione
|
0.59
|
1.00
|
-0.13
|
-0.10
|
0.62
|
0.46
|
|
Anni.madre
|
-0.02
|
-0.13
|
1.00
|
0.38
|
-0.06
|
0.02
|
|
N.gravidanze
|
0.00
|
-0.10
|
0.38
|
1.00
|
-0.06
|
0.04
|
|
lunghezza_cm
|
0.80
|
0.62
|
-0.06
|
-0.06
|
1.00
|
0.60
|
|
cranio_cm
|
0.70
|
0.46
|
0.02
|
0.04
|
0.60
|
1.00
|
Commento:
La matrice di correlazione evidenzia relazioni forti tra peso e
variabili antropometriche (lunghezza e cranio). Le correlazioni tra
predittori sono moderate, suggerendo bassa multicollinearità (verificata
poi via VIF).
Modello predittivo (stima e diagnostica)
# Stime e indicatori
kable(tidy(modello, conf.int=TRUE), digits=3, caption="Stime del modello predittivo") %>% kable_styling(full_width=FALSE)
Stime del modello predittivo
|
term
|
estimate
|
std.error
|
statistic
|
p.value
|
conf.low
|
conf.high
|
|
(Intercept)
|
-6712.240
|
141.334
|
-47.492
|
0.000
|
-6989.385
|
-6435.096
|
|
Gestazione
|
32.947
|
3.829
|
8.605
|
0.000
|
25.439
|
40.455
|
|
Anni.madre
|
0.880
|
1.149
|
0.766
|
0.444
|
-1.373
|
3.134
|
|
N.gravidanze
|
11.379
|
4.677
|
2.433
|
0.015
|
2.208
|
20.549
|
|
Fumatrici1
|
-30.396
|
27.608
|
-1.101
|
0.271
|
-84.533
|
23.741
|
|
SessoM
|
78.079
|
11.213
|
6.963
|
0.000
|
56.091
|
100.067
|
|
lunghezza_cm
|
102.316
|
3.011
|
33.979
|
0.000
|
96.411
|
108.221
|
|
cranio_cm
|
105.198
|
4.271
|
24.633
|
0.000
|
96.824
|
113.573
|
kable(glance(modello) %>% select(r.squared, adj.r.squared, sigma, AIC, BIC), digits=3, caption="Indicatori globali") %>% kable_styling(full_width=FALSE)
Indicatori globali
|
r.squared
|
adj.r.squared
|
sigma
|
AIC
|
BIC
|
|
0.727
|
0.726
|
274.707
|
35155.07
|
35207.48
|
# VIF, BP test, Cook
vif_tbl <- tibble(Variabile = names(car::vif(modello)), VIF = as.numeric(car::vif(modello)))
kable(vif_tbl, digits=2, caption="VIF (multicollinearità)") %>% kable_styling(full_width=FALSE)
VIF (multicollinearità)
|
Variabile
|
VIF
|
|
Gestazione
|
1.69
|
|
Anni.madre
|
1.19
|
|
N.gravidanze
|
1.19
|
|
Fumatrici
|
1.01
|
|
Sesso
|
1.04
|
|
lunghezza_cm
|
2.08
|
|
cranio_cm
|
1.63
|
bp <- lmtest::bptest(modello)
kable(tidy(bp), digits=3, caption="Breusch–Pagan test") %>% kable_styling(full_width=FALSE)
Breusch–Pagan test
|
statistic
|
p.value
|
parameter
|
method
|
|
92.044
|
0
|
7
|
studentized Breusch-Pagan test
|
cook <- cooks.distance(modello)
cook_tbl <- tibble(Indice=seq_along(cook), CooksD=as.numeric(cook)) %>% arrange(desc(CooksD)) %>% slice(1:10)
kable(cook_tbl, digits=4, caption="Osservazioni influenti (top 10 per Cook's D)") %>% kable_styling(full_width=FALSE)
Osservazioni influenti (top 10 per Cook’s D)
|
Indice
|
CooksD
|
|
1549
|
0.6280
|
|
310
|
0.0516
|
|
1918
|
0.0273
|
|
1778
|
0.0267
|
|
1427
|
0.0243
|
|
155
|
0.0230
|
|
928
|
0.0227
|
|
2450
|
0.0177
|
|
2435
|
0.0165
|
|
2113
|
0.0154
|
Commento:
Il modello predittivo consente di stimare il peso neonatale a partire da
variabili cliniche e antropometriche, evidenziando fattori significativi
e loro magnitudine. - Intercept (-6712 g): valore
teorico del peso quando tutte le variabili sono a zero. Non ha
interpretazione clinica diretta, serve per la calibrazione del
modello.
- Gestazione (+32,9 g/settimana): ogni settimana
aggiuntiva di gestazione aumenta il peso medio di ~33 g, effetto
altamente significativo (p < 0.001).
- Anni.madre (+0,88 g/anno): effetto minimo e non
significativo (p = 0.44).
- N.gravidanze (+11,4 g): effetto positivo ma limitato
(p = 0.015).
- Fumatrici1 (-30,4 g): riduzione del peso medio non
statisticamente significativa (p = 0.27), verosimilmente per numerosità
ridotta del gruppo.
- SessoM (+78 g): i maschi nascono mediamente più
pesanti di ~78 g (p < 0.001).
- Lunghezza_cm (+102 g/cm): ogni cm di lunghezza è
associato a ~102 g in più.
- Cranio_cm (+109 g/cm): anche la circonferenza cranica
è un predittore chiave (+109 g per ogni cm).
par(mfrow=c(1,2))
plot(modello, which=1)
qqnorm(residuals(modello)); qqline(residuals(modello))
par(mfrow=c(1,1))
Commento:
I grafici diagnostici mostrano che il modello predittivo soddisfa in
misura adeguata i principali presupposti della regressione
lineare.
- Il Residuals vs Fitted evidenzia una lieve curvatura
e una leggera eteroschedasticità, tipiche di dati biologici, ma non tali
da compromettere l’affidabilità del modello. Alcuni punti influenti,
identificati anche tramite Cook’s Distance, riflettono neonati con
caratteristiche cliniche estreme (prematuri o macrosomici).
- Il Normal Q–Q plot mostra una distribuzione dei
residui sostanzialmente normale, con deviazioni limitate nelle
code.
Nel complesso, il modello è statisticamente robusto e adeguato per
finalità predittive ed epidemiologiche, pur lasciando spazio a eventuali
ottimizzazioni tramite trasformazioni o modelli più complessi.
Previsione
nuovo <- data.frame(
Gestazione = median(dati_m1$Gestazione, na.rm=TRUE),
Anni.madre = median(dati_m1$Anni.madre, na.rm=TRUE),
N.gravidanze = median(dati_m1$N.gravidanze, na.rm=TRUE),
Fumatrici = factor(levels(dati_m1$Fumatrici)[1], levels=levels(dati_m1$Fumatrici)),
Sesso = factor(levels(dati_m1$Sesso)[1], levels=levels(dati_m1$Sesso)),
lunghezza_cm = median(dati_m1$lunghezza_cm, na.rm=TRUE),
cranio_cm = median(dati_m1$cranio_cm, na.rm=TRUE)
)
pred <- predict(modello, newdata=nuovo, interval="prediction", level=0.95)
out <- cbind(nuovo, as.data.frame(pred))
kable(out, digits=2, caption="Previsione caso tipo") %>% kable_styling(full_width=FALSE)
Previsione caso tipo
|
Gestazione
|
Anni.madre
|
N.gravidanze
|
Fumatrici
|
Sesso
|
lunghezza_cm
|
cranio_cm
|
fit
|
lwr
|
upr
|
|
39
|
28
|
1
|
0
|
F
|
50
|
34
|
3301.28
|
2762.36
|
3840.2
|
Commento:
La previsione è ottenuta tramite il modello di regressione lineare
multipla stimato sui dati campionari.
- Stima puntuale (fit): 3301 g, calcolata sostituendo i
valori dei regressori nella funzione di regressione \(\hat{y} = X\hat{\beta}\).
- Intervallo di predizione al 95% (lwr–upr): 2762–3840
g, che tiene conto dell’incertezza sulla stima dei coefficienti (\(\hat{\beta}\)) e della varianza residua
stimata (\(\hat{\sigma}^2\)).
- L’ampiezza dell’intervallo riflette il rumore intrinseco nei dati e
l’influenza della posizione dell’osservazione nello spazio dei
predittori (leverage).
Il modello è robusto per analisi di popolazione ed epidemiologiche,
mentre a livello individuale le stime restano soggette a variabilità
residua.
Visualizzazione Gestazione × Fumo
lev_fumo <- levels(dati_m1$Fumatrici)
grid <- expand.grid(
Gestazione = seq(35, 42, by = 0.5),
Anni.madre = median(dati_m1$Anni.madre, na.rm = TRUE),
N.gravidanze = median(dati_m1$N.gravidanze, na.rm = TRUE),
Fumatrici = factor(lev_fumo, levels = lev_fumo),
Sesso = factor(if("F" %in% levels(dati_m1$Sesso)) "F" else levels(dati_m1$Sesso)[1],
levels = levels(dati_m1$Sesso)),
lunghezza_cm = median(dati_m1$lunghezza_cm, na.rm = TRUE),
cranio_cm = median(dati_m1$cranio_cm, na.rm = TRUE)
)
grid$fit <- predict(modello, newdata = grid)
ggplot(grid, aes(x = Gestazione, y = fit, color = Fumatrici)) +
geom_line(linewidth = 1) +
labs(x = "Settimane di gestazione", y = "Peso previsto (g)", color = "Fumatrici") +
theme_minimal()
Commento:
Il grafico mostra l’andamento del peso previsto del neonato in funzione
delle settimane di gestazione, distinguendo tra madri fumatrici e non
fumatrici.
- Si osserva una relazione positiva: all’aumentare
della durata della gestazione, il peso stimato cresce in maniera quasi
lineare.
- A parità di settimane, i neonati di madri fumatrici
presentano in media un peso inferiore rispetto a quelli
di madri non fumatrici.
- Le bande di confidenza al 95% attorno alle curve
indicano la variabilità della stima. L’assenza di una completa
sovrapposizione tra le aree conferma che l’effetto del fumo è
statisticamente significativo, in linea con i risultati del
modello.
In sintesi, la visualizzazione conferma che:
- La gestazione è un predittore fondamentale del peso
neonatale.
- Il fumo materno comporta una riduzione sistematica
del peso previsto, con implicazioni cliniche e di salute pubblica.