library(knitr)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(moments)
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
library(lmtest)
## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
neonati <-read.csv("neonati.csv", sep=",")
# Pre-processing dei dati
neonati2 <- subset(neonati, !(neonati$Anni.madre %in% c(0, 1)))
neonati2$Fumatrici <- factor(neonati2$Fumatrici,
levels = c(0, 1),
labels = c("Non fumatrice", "Fumatrice"))
neonati2$Tipo.parto <- factor(neonati2$Tipo.parto)
neonati2$Ospedale <- factor(neonati2$Ospedale)
neonati2$Sesso <- factor(neonati2$Sesso,
levels = c("F", "M"),
labels = c("Femmina", "Maschio"))
# 1) Analisi descrittiva delle variabili continue (summary + sd)
vars_continue <- c("Anni.madre", "N.gravidanze", "Gestazione", "Peso", "Lunghezza", "Cranio")
summary_cont <- neonati2 %>%
select(all_of(vars_continue)) %>%
summary() %>%
as.data.frame()
# Tabella riassuntiva (media, min, max, quartili, ecc.)
kable(summary_cont, caption = "Statistiche descrittive delle variabili continue")
| Var1 | Var2 | Freq |
|---|---|---|
| Anni.madre | Min. :13.00 | |
| Anni.madre | 1st Qu.:25.00 | |
| Anni.madre | Median :28.00 | |
| Anni.madre | Mean :28.19 | |
| Anni.madre | 3rd Qu.:32.00 | |
| Anni.madre | Max. :46.00 | |
| N.gravidanze | Min. : 0.0000 | |
| N.gravidanze | 1st Qu.: 0.0000 | |
| N.gravidanze | Median : 1.0000 | |
| N.gravidanze | Mean : 0.9816 | |
| N.gravidanze | 3rd Qu.: 1.0000 | |
| N.gravidanze | Max. :12.0000 | |
| Gestazione | Min. :25.00 | |
| Gestazione | 1st Qu.:38.00 | |
| Gestazione | Median :39.00 | |
| Gestazione | Mean :38.98 | |
| Gestazione | 3rd Qu.:40.00 | |
| Gestazione | Max. :43.00 | |
| Peso | Min. : 830 | |
| Peso | 1st Qu.:2990 | |
| Peso | Median :3300 | |
| Peso | Mean :3284 | |
| Peso | 3rd Qu.:3620 | |
| Peso | Max. :4930 | |
| Lunghezza | Min. :310.0 | |
| Lunghezza | 1st Qu.:480.0 | |
| Lunghezza | Median :500.0 | |
| Lunghezza | Mean :494.7 | |
| Lunghezza | 3rd Qu.:510.0 | |
| Lunghezza | Max. :565.0 | |
| Cranio | Min. :235 | |
| Cranio | 1st Qu.:330 | |
| Cranio | Median :340 | |
| Cranio | Mean :340 | |
| Cranio | 3rd Qu.:350 | |
| Cranio | Max. :390 |
# Calcolo delle deviazioni standard delle continue
sd_vals <- sapply(neonati2[, vars_continue],
sd, na.rm = TRUE)
kable(data.frame(Variabile = names(sd_vals), Deviazione_Standard = round(sd_vals, 2)),
caption = "Deviazioni standard delle variabili continue")
| Variabile | Deviazione_Standard | |
|---|---|---|
| Anni.madre | Anni.madre | 5.22 |
| N.gravidanze | N.gravidanze | 1.28 |
| Gestazione | Gestazione | 1.87 |
| Peso | Peso | 525.23 |
| Lunghezza | Lunghezza | 26.33 |
| Cranio | Cranio | 16.43 |
# 2) Analisi descrittiva delle categoriche (frequenze percentuali)
vars_categoria <- c("Fumatrici", "Tipo.parto", "Ospedale", "Sesso")
for(var in vars_categoria){
freq_table <- as.data.frame(prop.table(table(neonati2[[var]], useNA = "ifany")) * 100)
colnames(freq_table) <- c(var, "Percentuale")
print(kable(freq_table, caption = paste("Distribuzione (%) di", var)))
}
##
##
## Table: Distribuzione (%) di Fumatrici
##
## |Fumatrici | Percentuale|
## |:-------------|-----------:|
## |Non fumatrice | 95.836669|
## |Fumatrice | 4.163331|
##
##
## Table: Distribuzione (%) di Tipo.parto
##
## |Tipo.parto | Percentuale|
## |:----------|-----------:|
## |Ces | 29.14331|
## |Nat | 70.85669|
##
##
## Table: Distribuzione (%) di Ospedale
##
## |Ospedale | Percentuale|
## |:--------|-----------:|
## |osp1 | 32.66613|
## |osp2 | 33.94716|
## |osp3 | 33.38671|
##
##
## Table: Distribuzione (%) di Sesso
##
## |Sesso | Percentuale|
## |:-------|-----------:|
## |Femmina | 50.24019|
## |Maschio | 49.75981|
Le madri del campione hanno in media 28 anni (range 13-46). Il peso medio dei neonati è 3.28kg. Le madri partoriscono in media alla 39esima settimana, con un minimo di 25 settimane di gestazione (parti estremamente prematuri-come stabilito dalla World Health Organization-https://www.who.int/news-room/fact-sheets/detail/preterm-birth) e un massimo di 43.
Il 4,16% delle madri risulta fumatrice, mentre la distribuzione dei parti nei tre ospedali è pressochè omogenea (un terzo dei parti per ciascuno);notiamo anche che un terzo dei parti è cesareo e il resto naturale; il campione inoltre è diviso omogeneamente tra maschi (49.76%) e femmine (50.24%)
num_vars <- c("Anni.madre", "N.gravidanze", "Gestazione", "Peso", "Lunghezza", "Cranio")
for (v in num_vars) {
x <- neonati2[[v]]
bp <- boxplot(x, main = paste("Boxplot di", v), ylab = v)
if(length(bp$out) > 0) {
tbl <- sort(table(bp$out), decreasing=TRUE)
cat("\nOutlier nella variabile", v, ":\n")
print(tbl)
ol_idx <- which(x %in% bp$out)
cat("Primi 10 indici degli outlier:", head(ol_idx, 10), "\n\n")
} else {
cat("\nNessun outlier nella variabile", v, "\n")
}
hist(x, main = paste("Istogramma di", v), xlab = v)
}
##
## Outlier nella variabile Anni.madre :
##
## 44 14 43 13 45 46
## 4 2 2 1 1 1
## Primi 10 indici degli outlier: 138 205 230 260 335 855 1075 1106 1530 2024
##
## Outlier nella variabile N.gravidanze :
##
## 3 4 5 6 8 10 9 7 11 12
## 150 48 21 11 8 3 2 1 1 1
## Primi 10 indici degli outlier: 3 13 15 18 40 47 78 88 89 96
##
## Outlier nella variabile Gestazione :
##
## 33 34 32 31 30 28 29 27 25 26
## 18 16 9 8 5 4 3 2 1 1
## Primi 10 indici degli outlier: 15 67 101 106 117 131 206 249 305 310
##
## Outlier nella variabile Peso :
##
## 1280 1750 2000 930 1170 1500 1780 1970 1980 2040 4600 4720 830 900 980 990
## 3 3 3 2 2 2 2 2 2 2 2 2 1 1 1 1
## 1140 1180 1190 1285 1300 1340 1370 1390 1410 1430 1450 1550 1560 1580 1600 1615
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 1620 1690 1720 1730 1770 1800 1840 1850 1890 1900 1950 1960 4580 4620 4650 4680
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 4690 4700 4760 4810 4900 4930
## 1 1 1 1 1 1
## Primi 10 indici degli outlier: 101 106 126 206 295 310 312 322 368 378
##
## Outlier nella variabile Lunghezza :
##
## 430 410 420 390 400 370 380 405 355 360 560 310 315 320 325 340 345 385 425 565
## 10 8 8 5 4 3 3 3 2 2 2 1 1 1 1 1 1 1 1 1
## Primi 10 indici degli outlier: 101 106 155 206 304 310 312 322 378 445
##
## Outlier nella variabile Cranio :
##
## 390 290 295 273 276 277 280 292 298 382 235 245 253 254 265 266 267 270 272 274
## 4 3 3 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
## 275 278 285 287 289 293 294 297 299 381 383 384 385 386
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## Primi 10 indici degli outlier: 15 34 101 106 131 151 190 205 206 312
Tramite utilizzo di boxplot individuiamo gli outlier per ciascuna variabile numerica,analizzando i risultati:
-Anni.madre: gli outlier rilevati sono per lo più valori molto bassi (13, 14 anni) o molto alti (43-46 anni), rispetto alla media attesa per l’età materna. -N.gravidanze: presenza di molti valori outlier per il valore 3, 4 e valori superiori. -Gestazione: outlier sia tra le gestazioni molto brevi (<30 settimane), sia per quelle più lunghe (oltre 33 settimane). -Peso/Lunghezza/Cranio: i valori anomali identificati sono principalmente quelli molto bassi o molto alti, potenzialmente associati a casi di neonati pretermine o con peso maggiore della media.
Per quanto riguarda gli istogrammi: - L’istogramma dell’età delle madri mostra una distribuzione approssimativamente simmetrica e di tipo normale, con la fascia più rappresentata tra i 25 e i 30 anni. Le età delle madri variano dai 15 ai 45 anni, ma la maggior parte dei valori si concentra tra i 20 e i 35 anni. Sono presenti pochi casi estremi sia tra le madri molto giovani sia tra quelle più anziane. - L’istogramma del numero di gravidanze mostra una distribuzione fortemente asimmetrica a destra (positivamente asimmetrica), con la maggior parte delle persone che ha avuto una o nessuna gravidanza. Il numero di gravidanze pari a zero e uno sono nettamente i valori più frequenti. Sono presenti alcuni casi con un numero elevato di gravidanze (fino a 12), ma questi rappresentano delle eccezioni (outlier) e costituiscono una porzione molto ridotta del campione. - L’istogramma mostra la distribuzione delle settimane di gestazione. La maggior parte dei valori si concentra tra le 37 e le 41 settimane, con un picco intorno alle 39-40 settimane, che corrisponde alla durata tipica di una gravidanza a termine. Sono presenti pochi casi con gestazioni inferiori alle 37 settimane (possibili parti pretermine) e pochissimi valori oltre le 41 settimane. La distribuzione è asimmetrica negativa (asimmetria a sinistra), con una lunga coda verso valori più bassi dovuta a pochi casi di gestazioni molto precoci, che possono rappresentare outlier o situazioni cliniche particolari. In generale, l’istogramma conferma che la maggior parte dei casi rientra nella norma ostetrica. - La distribuzione del peso alla nascita è quasi simmetrica, con la maggior parte dei valori tra 2.500 e 4.000 grammi. I pesi più comuni sono tra 3.000 e 3.500 grammi, mentre pochi casi risultano particolarmente bassi o elevati rispetto alla media. - La distribuzione della lunghezza è concentrata tra 470 e 520, con la maggior parte dei casi intorno a 490-500. La coda verso sinistra indica la presenza di alcuni valori più bassi, probabilmente outlier, ma la maggior parte dei dati risulta allineata ai valori centrali. - La distribuzione delle misure craniche è abbastanza simmetrica e centrata tra 320 e 360, con la maggior parte dei valori tra 330 e 350. Sono presenti pochi casi isolati con valori più bassi o più alti, possibili outlier, ma in generale i dati sono concentrati attorno ai valori tipici per la popolazione analizzata.
Saggiamo l’ipotesi che in alcuni ospedali si facciano più parti cesarei di altri
H₀: la frequenza di parti cesarei è la stessa in tutti gli ospedali (indipendenza). H₁: la frequenza di parti cesarei varia tra ospedali (dipendenza).
tabella_parti <- table(neonati2$Ospedale, neonati2$Tipo.parto)
attese_tabella <- tabella_parti
margin.table(tabella_parti,1)
##
## osp1 osp2 osp3
## 816 848 834
margin.table(tabella_parti,2)
##
## Ces Nat
## 728 1770
n =margin.table(tabella_parti)
n
## [1] 2498
for(i in 1:nrow(tabella_parti)){
for(j in 1:ncol(tabella_parti)){
attese_tabella[i,j] <-(margin.table(tabella_parti,1)[i]*margin.table(tabella_parti,2)[j])/n
}
}
attese_tabella
##
## Ces Nat
## osp1 237.8094 578.1906
## osp2 247.1353 600.8647
## osp3 243.0552 590.9448
#CALCOLO DELLA STATISTICA TEST X^2 E TEST DI INDIPENDENZA
# statistica test: sommatoria di (freq. osservate-freq. attese)^2/freq.attese
osservate <- tabella_parti
x_quadro <- sum((osservate- attese_tabella)^2/attese_tabella)
x_quadro
## [1] 1.082984
test.indipendenza <- chisq.test(tabella_parti)
test.indipendenza
##
## Pearson's Chi-squared test
##
## data: tabella_parti
## X-squared = 1.083, df = 2, p-value = 0.5819
In questo step è stato effettuato un test di indipendenza del Chi Quadrato tra “ospedale” e “tipo di parto” (cesareo/naturale), il cui risultato (X² = 1.083, p-value = 0.5819 mostra che non abbiamo evidenza per rifiutare l’ipotesi nulla (di indipendenza tra le variabili) e per affermare che la probabilità di parto cesareo vari tra i diversi ospedali. Quindi l’ipotesi che “in alcuni ospedali si fanno più parti cesarei” non è supportata dai dati.
Saggiamo l’ipotesi che la media del peso e della lunghezza di questo campione di neonati sono significativamente uguali a quelle della popolazione 1)Media del peso:“Secondo dati ufficiali, il peso medio alla nascita di un neonato sano è di circa 3300 grammi¹.”Ospedale Pediatrico Bambino Gesù (2024), “Da 0 a 30 giorni: come si presenta e come cresce”, disponibile su: [https://www.ospedalebambinogesu.it/da-0-a-30-giorni-come-si-presenta-e-come-cresce-80012/#:~:text=In%20media%20il%20peso%20nascita,pari%20mediamente%20a%2050%20centimetri.]
H₀: media campione = media popolazione H₁: media campione ≠ media popolazione
t.test(neonati2$Peso,
mu = 3300,
conf.level = 0.95,
alternative = "two.sided")
##
## One Sample t-test
##
## data: neonati2$Peso
## t = -1.505, df = 2497, p-value = 0.1324
## alternative hypothesis: true mean is not equal to 3300
## 95 percent confidence interval:
## 3263.577 3304.791
## sample estimates:
## mean of x
## 3284.184
È stato effettuato un test t per un campione con media teorica 3300g. Il p-value ottenuto (0.13) è superiore alla soglia di significatività del 5%, pertanto non si rifiuta l’ipotesi nulla. Si deduce che il peso medio dei neonati nel campione (3284g, IC95%: 3263.6–3304.8) non è significativamente diverso dalla media segnalata nella popolazione di riferimento (fonte: Ospedale Pediatrico Bambino Gesù, 2021¹).
1)Media della lunghezza:“Secondo dati ufficiali, la lunghezza media alla nascita di un neonato sano è di circa 500 mm¹.”Ospedale Pediatrico Bambino Gesù (2024), “Da 0 a 30 giorni: come si presenta e come cresce”, disponibile su: [https://www.ospedalebambinogesu.it/da-0-a-30-giorni-come-si-presenta-e-come-cresce-80012/#:~:text=In%20media%20il%20peso%20nascita,pari%20mediamente%20a%2050%20centimetri.]
H₀: media campione = media popolazione H₁: media campione ≠ media popolazione
t.test(neonati2$Lunghezza,
mu = 500,
conf.level = 0.95,
alternative = "two.sided")
##
## One Sample t-test
##
## data: neonati2$Lunghezza
## t = -10.069, df = 2497, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 500
## 95 percent confidence interval:
## 493.6628 495.7287
## sample estimates:
## mean of x
## 494.6958
Il test t effettuato per confrontare la lunghezza media alla nascita del campione con il valore di riferimento di 500 mm mostra una differenza statisticamente significativa (p < 2.2×10⁻¹⁶). Pertanto, la lunghezza media dei neonati osservati nel nostro campione è significativamente inferiore rispetto alla popolazione di riferimento.
Saggiamo l’ipotesi che le misure antropometriche (peso,lunghezza,cranio) siano significativamente diverse tra i due sessi
Test t per differenza tra medie tra campioni indipendenti H₀: misure antropometriche neonati maschi = misure antropometriche neonate femmine H₁: misure antropometriche neonati maschi ≠ misure antropometriche neonate femmine
table(neonati2$Sesso)
##
## Femmina Maschio
## 1255 1243
#c boxplot condizionato
boxplot(Peso~Sesso, data=neonati2)
#statistiche di sintesi condizionate ai due sessi
summary(neonati2$Peso[neonati2$Sesso == "Maschio"])
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 980 3150 3430 3408 3720 4810
summary(neonati2$Peso[neonati2$Sesso == "Femmina"])
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 830 2900 3160 3161 3470 4930
t.test(Peso~Sesso,
data=neonati2)
##
## Welch Two Sample t-test
##
## data: Peso by Sesso
## t = -12.115, df = 2488.7, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Femmina and group Maschio is not equal to 0
## 95 percent confidence interval:
## -287.4841 -207.3844
## sample estimates:
## mean in group Femmina mean in group Maschio
## 3161.061 3408.496
# boxplot condizionato
boxplot(Lunghezza~Sesso, data=neonati2)
#statistiche di sintesi condizionate ai due sessi
summary(neonati2$Lunghezza[neonati2$Sesso == "Maschio"])
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 320.0 490.0 500.0 499.7 515.0 560.0
summary(neonati2$Lunghezza[neonati2$Sesso == "Femmina"])
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 310.0 480.0 490.0 489.8 505.0 565.0
t.test(Lunghezza~Sesso,
data=neonati2)
##
## Welch Two Sample t-test
##
## data: Lunghezza by Sesso
## t = -9.5823, df = 2457.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Femmina and group Maschio is not equal to 0
## 95 percent confidence interval:
## -11.939001 -7.882672
## sample estimates:
## mean in group Femmina mean in group Maschio
## 489.7641 499.6750
# boxplot condizionato
boxplot(Cranio~Sesso, data=neonati2)
#statistiche di sintesi condizionate ai due sessi
summary(neonati2$Cranio[neonati2$Sesso == "Maschio"])
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 265.0 334.0 343.0 342.5 352.0 390.0
summary(neonati2$Cranio[neonati2$Sesso == "Femmina"])
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 235.0 330.0 340.0 337.6 348.0 390.0
t.test(Cranio~Sesso,
data=neonati2)
##
## Welch Two Sample t-test
##
## data: Cranio by Sesso
## t = -7.4366, df = 2489.4, p-value = 1.414e-13
## alternative hypothesis: true difference in means between group Femmina and group Maschio is not equal to 0
## 95 percent confidence interval:
## -6.110504 -3.560417
## sample estimates:
## mean in group Femmina mean in group Maschio
## 337.6231 342.4586
Per confrontare le misure antropometriche medie alla nascita tra i due sessi svolgiamo dei test che confrontino uno alla volta le misure d’interesse (ovvero peso, lunghezza del neonato e diametro craniale) e analizziamo i risultati: in tutti e tre i casi il valore del p-value ottenuto (p-value < 2.2e-16, p-value < 2.2e-16, p-value = 1.414e-13) ci porta a rifiutare l’ipotesi nulla e ci conduce ad affermare che vi è una differenza significativa tra i gruppi di neonati maschi e femmine per quanto riguarda le misure antropometriche oggetto di verifica. In particolare, i neonati maschi presentano valori medi più elevati rispetto alle femmine sia per il peso che per la lunghezza e il diametro craniale.
Creazione del Modello di Regressione Verrà sviluppato un modello di regressione lineare multipla che includa tutte le variabili rilevanti
# 1. Normalità Peso
skewness(neonati2$Peso)
## [1] -0.6474036
kurtosis(neonati2$Peso) - 3
## [1] 2.028753
qqnorm(neonati2$Peso); qqline(neonati2$Peso)
hist(neonati2$Peso)
shapiro.test(neonati2$Peso)
##
## Shapiro-Wilk normality test
##
## data: neonati2$Peso
## W = 0.97068, p-value < 2.2e-16
# 2. Matrice di correlazione
num_vars_ <- neonati2[sapply(neonati2, is.numeric)]
round(cor(num_vars_, use = "pairwise.complete.obs"), 2)
## Anni.madre N.gravidanze Gestazione Peso Lunghezza Cranio
## Anni.madre 1.00 0.38 -0.13 -0.02 -0.06 0.02
## N.gravidanze 0.38 1.00 -0.10 0.00 -0.06 0.04
## Gestazione -0.13 -0.10 1.00 0.59 0.62 0.46
## Peso -0.02 0.00 0.59 1.00 0.80 0.70
## Lunghezza -0.06 -0.06 0.62 0.80 1.00 0.60
## Cranio 0.02 0.04 0.46 0.70 0.60 1.00
#3.Scatterplot
num_var_names <- names(num_vars_)[names(num_vars_) != "Peso"]
par(mfrow=c(2,3))
for (var in num_var_names) {
plot(neonati2[[var]], neonati2$Peso,
xlab=var, ylab="Peso", main=paste("Peso vs", var), pch=20)
}
par(mfrow=c(1,1))
# 4. Linear model
neonati2$Sesso <- as.factor(neonati2$Sesso)
neonati2$Fumatrici <- as.factor(neonati2$Fumatrici)
mod1 <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Cranio + Lunghezza + Sesso, data = neonati2)
summary(mod1)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione +
## Cranio + Lunghezza + Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1160.6 -181.3 -15.7 163.6 2630.7
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6712.2405 141.3339 -47.492 < 2e-16 ***
## Anni.madre 0.8803 1.1491 0.766 0.444
## N.gravidanze 11.3789 4.6767 2.433 0.015 *
## FumatriciFumatrice -30.3958 27.6080 -1.101 0.271
## Gestazione 32.9472 3.8288 8.605 < 2e-16 ***
## Cranio 10.5198 0.4271 24.633 < 2e-16 ***
## Lunghezza 10.2316 0.3011 33.979 < 2e-16 ***
## SessoMaschio 78.0787 11.2132 6.963 4.24e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2490 degrees of freedom
## Multiple R-squared: 0.7272, Adjusted R-squared: 0.7264
## F-statistic: 948.3 on 7 and 2490 DF, p-value: < 2.2e-16
# 4. Multicollinearità
vif(mod1)
## Anni.madre N.gravidanze Fumatrici Gestazione Cranio Lunghezza
## 1.189264 1.187447 1.006692 1.694331 1.628987 2.079749
## Sesso
## 1.040493
1.Normalità della variabile Ho verificato la normalità della variabile “Peso” analizzando diversi indicatori: La skewness è -0,65, indicando una lieve asimmetria a sinistra. La curtosi è 2,03, quindi la distribuzione risulta più concentrata attorno alla media e con code più pronunciate rispetto a una normale. Il test di Shapiro-Wilk fornisce un p-value molto basso (< 2.2e-16), che porta a rifiutare l’ipotesi nulla di normalità. Anche dal QQ plot e dall’istogramma si osservano deviazioni dalla retta teorica e dalla forma della normale. Conclusione: la variabile Peso nel campione analizzato NON è distribuita normalmente.
2.Matrice di correlazione Tramite analisi della matrice di correlazione vediamo che Peso, Lunghezza e Cranio sono fortemente correlate tra loro, come atteso, dato che rappresentano le dimensioni del neonato. Anche il numero di settimane di Gestazione è moderatamente correlato con la variabile Peso, indicando che una gravidanza più lunga si associa a neonati più grandi e pesanti. Il numero di gravidanze avute dalla madre precedentemente non mostra avere una correlazione significativa con il peso del neonato, così come l’età della madre.
3.Scatterplot Accompagniamoo all’analisi tramite matrice di correlazione un’analisi grafica tramite scatterplot per saggiare la presenza di eventuali relazioni non lineari tra le variabili. Tramite questa analisi grafica vediamo che l’età della madre (Anni.madre) non sembra avere una relazione lineaare o evidente con il peso del neonato (i punti infatti sono dispersi in verticale senza un pattern evidente), così come anche il numero di gravidanze. Vediamo invece un chiaro andamento positivo per le variabili Gestazione, Lunghezza e Cranio, il cui aumento è correlato in tutti e tre i casi a un aumento della variabile risposta peso.
4.Modello lineare Abbiamo stimato un modello di regressione lineare in cui il Peso del neonato è la variabile dipendente, mentre tra le variabili indipendenti consideriamo: età della madre (Anni.madre), numero di gravidanze precedenti (N.gravidanze), stato di Fumatrici, settimane di gestazione (Gestazione), circonferenza cranica (Cranio), lunghezza del neonato (Lunghezza) e sesso del neonato (Sesso).
Il modello spiega il 72,7% della variabilità osservata nel peso dei neonati (Multiple R-squared = 0,727), mentre l’Adjusted R-squared (0,726) conferma la solidità del modello. Analizzando i coefficienti nella tabella “Coefficients” si osserva che: -La variabile “Anni.madre” non risulta statisticamente significativa. -La variabile “N.gravidanze” mostra una relazione significativa: ogni gravidanza in più si associa a un incremento medio di +11,4 grammi nel peso del neonato. -La variabile “Fumatrici” non risulta statisticamente significativa. -La variabile “Gestazione” è altamente significativa: ogni settimana in più di gestazione è associata a un incremento medio di 33 grammi nel peso del neonato. -Le variabili “Cranio” e “Lunghezza” sono entrambe fortemente significative e simili nell’effetto: ogni millimetro in più nella misura del cranio o della lunghezza porta a un aumento medio del peso di 10 grammi. -Per la variabile “Sesso”, i maschi pesano in media 78 grammi in più rispetto alle femmine, differenza altamente significativa.
4.Analisi della multicollinearità Analizzando il VIF tra i regressori ritroviamo tutti valori compresi tra 1 e 5, che indicano l’assenza di problemi di multicollinearità tra i predittori.
5.Diagnostica residui Sarà effettuata dopo la selezione del modello finale.
Selezione del Modello Ottimale
# --- Modello base (tutti gli effetti principali) ---
mod_base <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Cranio + Lunghezza + Sesso, data = neonati2)
summary(mod_base)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione +
## Cranio + Lunghezza + Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1160.6 -181.3 -15.7 163.6 2630.7
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6712.2405 141.3339 -47.492 < 2e-16 ***
## Anni.madre 0.8803 1.1491 0.766 0.444
## N.gravidanze 11.3789 4.6767 2.433 0.015 *
## FumatriciFumatrice -30.3958 27.6080 -1.101 0.271
## Gestazione 32.9472 3.8288 8.605 < 2e-16 ***
## Cranio 10.5198 0.4271 24.633 < 2e-16 ***
## Lunghezza 10.2316 0.3011 33.979 < 2e-16 ***
## SessoMaschio 78.0787 11.2132 6.963 4.24e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2490 degrees of freedom
## Multiple R-squared: 0.7272, Adjusted R-squared: 0.7264
## F-statistic: 948.3 on 7 and 2490 DF, p-value: < 2.2e-16
# --- Stepwise (selezione automatica variabili) ---
# Stepwise AIC
modello_stepwise_AIC <- step(mod_base)
## Start: AIC=28064.05
## Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Cranio +
## Lunghezza + Sesso
##
## Df Sum of Sq RSS AIC
## - Anni.madre 1 44292 187949505 28063
## - Fumatrici 1 91474 187996688 28063
## <none> 187905214 28064
## - N.gravidanze 1 446756 188351970 28068
## - Sesso 1 3658879 191564093 28110
## - Gestazione 1 5587942 193493156 28135
## - Cranio 1 45789523 233694736 28607
## - Lunghezza 1 87128339 275033553 29014
##
## Step: AIC=28062.64
## Peso ~ N.gravidanze + Fumatrici + Gestazione + Cranio + Lunghezza +
## Sesso
##
## Df Sum of Sq RSS AIC
## - Fumatrici 1 92548 188042054 28062
## <none> 187949505 28063
## - N.gravidanze 1 643981 188593487 28069
## - Sesso 1 3666800 191616305 28109
## - Gestazione 1 5544825 193494331 28133
## - Cranio 1 46056754 234006260 28608
## - Lunghezza 1 87116561 275066067 29012
##
## Step: AIC=28061.87
## Peso ~ N.gravidanze + Gestazione + Cranio + Lunghezza + Sesso
##
## Df Sum of Sq RSS AIC
## <none> 188042054 28062
## - N.gravidanze 1 621053 188663107 28068
## - Sesso 1 3650790 191692844 28108
## - Gestazione 1 5477493 193519547 28132
## - Cranio 1 46098547 234140601 28608
## - Lunghezza 1 87532691 275574744 29015
summary(modello_stepwise_AIC)
##
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Cranio + Lunghezza +
## Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1149.37 -180.98 -15.57 163.69 2639.09
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6681.7251 135.8036 -49.201 < 2e-16 ***
## N.gravidanze 12.4554 4.3416 2.869 0.00415 **
## Gestazione 32.3827 3.8008 8.520 < 2e-16 ***
## Cranio 10.5410 0.4265 24.717 < 2e-16 ***
## Lunghezza 10.2455 0.3008 34.059 < 2e-16 ***
## SessoMaschio 77.9807 11.2111 6.956 4.47e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2492 degrees of freedom
## Multiple R-squared: 0.727, Adjusted R-squared: 0.7265
## F-statistic: 1327 on 5 and 2492 DF, p-value: < 2.2e-16
AIC(modello_stepwise_AIC)
## [1] 35152.89
# Stepwise BIC
modello_stepwise_BIC <- step(mod_base, k = log(nrow(neonati2)))
## Start: AIC=28110.64
## Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Cranio +
## Lunghezza + Sesso
##
## Df Sum of Sq RSS AIC
## - Anni.madre 1 44292 187949505 28103
## - Fumatrici 1 91474 187996688 28104
## - N.gravidanze 1 446756 188351970 28109
## <none> 187905214 28111
## - Sesso 1 3658879 191564093 28151
## - Gestazione 1 5587942 193493156 28176
## - Cranio 1 45789523 233694736 28648
## - Lunghezza 1 87128339 275033553 29054
##
## Step: AIC=28103.4
## Peso ~ N.gravidanze + Fumatrici + Gestazione + Cranio + Lunghezza +
## Sesso
##
## Df Sum of Sq RSS AIC
## - Fumatrici 1 92548 188042054 28097
## <none> 187949505 28103
## - N.gravidanze 1 643981 188593487 28104
## - Sesso 1 3666800 191616305 28144
## - Gestazione 1 5544825 193494331 28168
## - Cranio 1 46056754 234006260 28643
## - Lunghezza 1 87116561 275066067 29047
##
## Step: AIC=28096.81
## Peso ~ N.gravidanze + Gestazione + Cranio + Lunghezza + Sesso
##
## Df Sum of Sq RSS AIC
## <none> 188042054 28097
## - N.gravidanze 1 621053 188663107 28097
## - Sesso 1 3650790 191692844 28137
## - Gestazione 1 5477493 193519547 28161
## - Cranio 1 46098547 234140601 28637
## - Lunghezza 1 87532691 275574744 29044
summary(modello_stepwise_BIC)
##
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Cranio + Lunghezza +
## Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1149.37 -180.98 -15.57 163.69 2639.09
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6681.7251 135.8036 -49.201 < 2e-16 ***
## N.gravidanze 12.4554 4.3416 2.869 0.00415 **
## Gestazione 32.3827 3.8008 8.520 < 2e-16 ***
## Cranio 10.5410 0.4265 24.717 < 2e-16 ***
## Lunghezza 10.2455 0.3008 34.059 < 2e-16 ***
## SessoMaschio 77.9807 11.2111 6.956 4.47e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2492 degrees of freedom
## Multiple R-squared: 0.727, Adjusted R-squared: 0.7265
## F-statistic: 1327 on 5 and 2492 DF, p-value: < 2.2e-16
BIC(modello_stepwise_BIC)
## [1] 35193.65
# --- Modelli con INTERAZIONI ---
mod_inter_FumGest <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici * Gestazione + Cranio + Lunghezza + Sesso, data = neonati2)
summary(mod_inter_FumGest)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici * Gestazione +
## Cranio + Lunghezza + Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1159.92 -182.47 -16.54 164.21 2630.79
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6728.7262 142.1541 -47.334 < 2e-16 ***
## Anni.madre 0.8587 1.1492 0.747 0.4550
## N.gravidanze 11.4565 4.6771 2.449 0.0144 *
## FumatriciFumatrice 785.9930 757.7101 1.037 0.2997
## Gestazione 33.4900 3.8616 8.673 < 2e-16 ***
## Cranio 10.5150 0.4271 24.621 < 2e-16 ***
## Lunghezza 10.2260 0.3012 33.956 < 2e-16 ***
## SessoMaschio 78.6576 11.2256 7.007 3.12e-12 ***
## FumatriciFumatrice:Gestazione -20.7952 19.2877 -1.078 0.2811
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2489 degrees of freedom
## Multiple R-squared: 0.7273, Adjusted R-squared: 0.7265
## F-statistic: 830 on 8 and 2489 DF, p-value: < 2.2e-16
mod_inter_CranioSesso <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Cranio * Sesso + Lunghezza, data = neonati2)
summary(mod_inter_CranioSesso)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione +
## Cranio * Sesso + Lunghezza, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1162.73 -180.32 -12.79 164.08 2643.15
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6605.7984 175.0400 -37.739 <2e-16 ***
## Anni.madre 0.8774 1.1491 0.764 0.445
## N.gravidanze 11.3837 4.6766 2.434 0.015 *
## FumatriciFumatrice -30.9586 27.6131 -1.121 0.262
## Gestazione 33.1340 3.8330 8.644 <2e-16 ***
## Cranio 10.1828 0.5379 18.932 <2e-16 ***
## SessoMaschio -160.1359 231.3822 -0.692 0.489
## Lunghezza 10.2321 0.3011 33.981 <2e-16 ***
## Cranio:SessoMaschio 0.7001 0.6792 1.031 0.303
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2489 degrees of freedom
## Multiple R-squared: 0.7273, Adjusted R-squared: 0.7265
## F-statistic: 829.9 on 8 and 2489 DF, p-value: < 2.2e-16
mod_inter_both <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici * Gestazione + Cranio * Sesso + Lunghezza, data = neonati2)
summary(mod_inter_both)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici * Gestazione +
## Cranio * Sesso + Lunghezza, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1162.03 -181.09 -13.27 164.11 2642.98
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6624.3697 175.9182 -37.656 <2e-16 ***
## Anni.madre 0.8563 1.1492 0.745 0.4563
## N.gravidanze 11.4595 4.6770 2.450 0.0143 *
## FumatriciFumatrice 768.4520 757.9082 1.014 0.3107
## Gestazione 33.6613 3.8654 8.708 <2e-16 ***
## Cranio 10.1857 0.5379 18.938 <2e-16 ***
## SessoMaschio -154.1336 231.4468 -0.666 0.5055
## Lunghezza 10.2266 0.3012 33.958 <2e-16 ***
## FumatriciFumatrice:Gestazione -20.3624 19.2924 -1.055 0.2913
## Cranio:SessoMaschio 0.6841 0.6794 1.007 0.3140
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2488 degrees of freedom
## Multiple R-squared: 0.7275, Adjusted R-squared: 0.7265
## F-statistic: 737.9 on 9 and 2488 DF, p-value: < 2.2e-16
# --- Modelli con TERMINI QUADRATICI ---
mod_quad_Gest <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + I(Gestazione^2) + Cranio + Lunghezza + Sesso, data = neonati2)
summary(mod_quad_Gest)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione +
## I(Gestazione^2) + Cranio + Lunghezza + Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1156.17 -180.94 -12.86 165.35 2653.21
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4674.5897 898.9006 -5.200 2.15e-07 ***
## Anni.madre 0.9647 1.1487 0.840 0.4011
## N.gravidanze 11.3362 4.6727 2.426 0.0153 *
## FumatriciFumatrice -29.1462 27.5898 -1.056 0.2909
## Gestazione -80.9545 49.7706 -1.627 0.1040
## I(Gestazione^2) 1.5209 0.6626 2.295 0.0218 *
## Cranio 10.6154 0.4287 24.760 < 2e-16 ***
## Lunghezza 10.3373 0.3044 33.964 < 2e-16 ***
## SessoMaschio 75.8332 11.2462 6.743 1.92e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.5 on 2489 degrees of freedom
## Multiple R-squared: 0.7278, Adjusted R-squared: 0.7269
## F-statistic: 831.8 on 8 and 2489 DF, p-value: < 2.2e-16
mod_quad_Cranio <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Cranio + I(Cranio^2) + Lunghezza + Sesso, data = neonati2)
summary(mod_quad_Cranio)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione +
## Cranio + I(Cranio^2) + Lunghezza + Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1149.20 -180.11 -13.11 163.84 2614.94
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 22.74338 1153.17847 0.020 0.9843
## Anni.madre 0.83436 1.14146 0.731 0.4649
## N.gravidanze 11.72359 4.64577 2.523 0.0117 *
## FumatriciFumatrice -26.52752 27.43138 -0.967 0.3336
## Gestazione 39.38957 3.95766 9.953 < 2e-16 ***
## Cranio -31.61019 7.17249 -4.407 1.09e-05 ***
## I(Cranio^2) 0.06232 0.01059 5.884 4.54e-09 ***
## Lunghezza 10.47425 0.30193 34.691 < 2e-16 ***
## SessoMaschio 73.20524 11.16896 6.554 6.77e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 272.9 on 2489 degrees of freedom
## Multiple R-squared: 0.731, Adjusted R-squared: 0.7301
## F-statistic: 845.3 on 8 and 2489 DF, p-value: < 2.2e-16
mod_quad_both <- lm(Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + I(Gestazione^2) + Cranio + I(Cranio^2) + Lunghezza + Sesso, data = neonati2)
summary(mod_quad_both)
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione +
## I(Gestazione^2) + Cranio + I(Cranio^2) + Lunghezza + Sesso,
## data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1150.71 -181.23 -15.68 162.22 2591.43
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -353.41469 1175.59400 -0.301 0.7637
## Anni.madre 0.74911 1.14227 0.656 0.5120
## N.gravidanze 11.83569 4.64473 2.548 0.0109 *
## FumatriciFumatrice -26.81444 27.42277 -0.978 0.3283
## Gestazione 142.55339 63.31577 2.251 0.0244 *
## I(Gestazione^2) -1.35905 0.83247 -1.633 0.1027
## Cranio -40.73257 9.09033 -4.481 7.77e-06 ***
## I(Cranio^2) 0.07569 0.01339 5.655 1.74e-08 ***
## Lunghezza 10.43183 0.30295 34.434 < 2e-16 ***
## SessoMaschio 74.16639 11.18074 6.633 4.01e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 272.8 on 2488 degrees of freedom
## Multiple R-squared: 0.7312, Adjusted R-squared: 0.7303
## F-statistic: 752.2 on 9 and 2488 DF, p-value: < 2.2e-16
# --- Confronto tra modelli ---
AIC(mod_base, mod_inter_FumGest, mod_inter_CranioSesso, mod_inter_both, mod_quad_Gest, mod_quad_Cranio, mod_quad_both)
## df AIC
## mod_base 9 35155.07
## mod_inter_FumGest 10 35155.90
## mod_inter_CranioSesso 10 35156.00
## mod_inter_both 11 35156.88
## mod_quad_Gest 10 35151.78
## mod_quad_Cranio 10 35122.56
## mod_quad_both 11 35121.88
BIC(mod_base, mod_inter_FumGest, mod_inter_CranioSesso,mod_inter_both, mod_quad_Gest, mod_quad_Cranio, mod_quad_both)
## df BIC
## mod_base 9 35207.48
## mod_inter_FumGest 10 35214.13
## mod_inter_CranioSesso 10 35214.23
## mod_inter_both 11 35220.94
## mod_quad_Gest 10 35210.02
## mod_quad_Cranio 10 35180.79
## mod_quad_both 11 35185.94
Come richiesto, sono stati testati modelli con interazioni e termini quadratici per indagare possibili relazioni complesse: - Si è ipotizzato che il legame tra fumo e peso potesse variare in funzione della durata della gestazione, mentre la relazione tra circonferenza cranica e peso potesse essere diversa per maschi e femmine. -I termini quadratici sono stati introdotti per testare la presenza di effetti non lineari di Gestazione e Cranio sul Peso, ipotizzando che l’associazione potesse non essere perfettamente lineare.
Tuttavia, data la limitata significatività statistica e lo scarso miglioramento del criterio informativo, si è scelto il modello più parsimonioso selezionato tramite AIC/BIC.
Tra i diversi modelli testati, il modello stepwise con N.gravidanze, Gestazione, Cranio, Lunghezza e Sesso risulta il più adatto: tutte le variabili sono significative, R² ≈ 0.727 e Residual SE = 274.7 g. Modelli più complessi con interazioni o termini quadratici migliorano solo marginalmente la spiegazione della variabilità, ma aumentano la complessità e includono parametri non significativi, quindi non sono preferibili.
mod_finale <- lm(formula = Peso ~ N.gravidanze + Gestazione + Cranio + Lunghezza +
Sesso, data = neonati2)
# Multiple R-squared
summary(mod_finale)
##
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Cranio + Lunghezza +
## Sesso, data = neonati2)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1149.37 -180.98 -15.57 163.69 2639.09
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6681.7251 135.8036 -49.201 < 2e-16 ***
## N.gravidanze 12.4554 4.3416 2.869 0.00415 **
## Gestazione 32.3827 3.8008 8.520 < 2e-16 ***
## Cranio 10.5410 0.4265 24.717 < 2e-16 ***
## Lunghezza 10.2455 0.3008 34.059 < 2e-16 ***
## SessoMaschio 77.9807 11.2111 6.956 4.47e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.7 on 2492 degrees of freedom
## Multiple R-squared: 0.727, Adjusted R-squared: 0.7265
## F-statistic: 1327 on 5 and 2492 DF, p-value: < 2.2e-16
# RMSE
# Calcolo residui
residui <- residuals(mod_finale)
# Calcolo RMSE
rmse <- sqrt(mean(residui^2))
print(rmse)
## [1] 274.3666
#Analisi dei residui
# Test di normalità dei residui
shapiro.test(residuals(mod_finale))
##
## Shapiro-Wilk normality test
##
## data: residuals(mod_finale)
## W = 0.97414, p-value < 2.2e-16
# Test di omoschedasticità (Breusch-Pagan)
bptest(mod_finale)
##
## studentized Breusch-Pagan test
##
## data: mod_finale
## BP = 90.297, df = 5, p-value < 2.2e-16
# Test di indipendenza (Durbin-Watson)
dwtest(mod_finale)
##
## Durbin-Watson test
##
## data: mod_finale
## DW = 1.9532, p-value = 0.1209
## alternative hypothesis: true autocorrelation is greater than 0
#.Istogramma dei Residui
hist(residui, main="Istogramma dei residui", xlab="Residui")
#b.Residui vs Fitted
plot(fitted(mod_finale), residui, main="Residui vs Fitted",
xlab="Valori Predetti", ylab="Residui")
abline(h=0, col="red")
#c.QQ-plot dei Residui
qqnorm(residui)
qqline(residui)
#d.Analisi di Valori Influenziali
# Leverage
plot(hatvalues(mod_finale), main="Leverage", ylab="Hat-values")
# Cook's distance
plot(cooks.distance(mod_finale), main="Cook's Distance", ylab="Cook's Distance")
abline(h = 4/(nrow(neonati2)-length(coef(mod_finale))), col="red", lty=2)
Il modello finale risulta così specificato: Peso = -6.681 +
12.45·N.gravidanze + 32.38·Gestazione + 10.54·Cranio + 10.25·Lunghezza +
77.98·SessoMaschio. Tutte le variabili risultano fortemente
significative. Il modello spiega il 72.7% della variabilità del peso (R²
= 0.727) e presenta un errore quadratico medio (RMSE) di circa 274g,
indicando una buona capacità predittiva.
L’analisi dei residui mostra una sostanziale normalità, ma segnala una lieve eteroschedasticità (non perfetta costanza della varianza dei residui) emersa dal test di Breusch-Pagan e dalla dispersione nel grafico “Residui vs Fitted”. Il Q-Q plot mostra che la maggior parte dei residui segue la distribuzione normale, con solo alcune deviazioni agli estremi. Per questo motivo, si suggerisce cautela nell’interpretazione di intervalli di confidenza e test delle ipotesi, consigliando l’eventuale utilizzo di errori standard robusti.
L’analisi dei valori influenti, tramite leverage e Cook’s distance, non evidenzia la presenza di osservazioni eccessivamente influenti: - L’analisi del leverage mostra che la grande maggioranza delle osservazioni ha valori molto bassi, con solo poche che si distinguono leggermente senza però raggiungere soglie di attenzione. Questo indica che non ci sono dati con eccessivo potere di influenza sulla stima del modello.
cooksD <- cooks.distance(mod_finale)
# Troviamo l'indice con il valore massimo
which.max(cooksD)
## 1551
## 1549
# valore:
max(cooksD)
## [1] 0.8297645
neonati2[1549, ]
## Anni.madre N.gravidanze Fumatrici Gestazione Peso Lunghezza Cranio
## 1551 35 1 Non fumatrice 38 4370 315 374
## Tipo.parto Ospedale Sesso
## 1551 Nat osp3 Femmina
L’analisi della Cook’s Distance ha individuato un’unica osservazione (riga 1551) potenzialmente influente. L’osservazione corrisponde a un neonato macrosomico (peso alla nascita superiore ai 4300g); tuttavia, tale valore rientra nel range della fisiologia neonatale e non è imputabile a errore di inserimento. Si è deciso di mantenere l’osservazione in analisi, segnalando comunque la sua presenza nei risultati.
Previsioni e Risultati Una volta validato il modello, lo useremo per fare previsioni pratiche. Ad esempio, potremo stimare il peso di una neonata considerando una madre alla terza gravidanza che partorirà alla 39esima settimana.
Per stimare il peso alla nascita di una neonata figlia di una madre alla terza gravidanza che partorirà alla 39esima settimana, abbiamo proceduto come segue. Abbiamo inserito nei regressori noti i valori specificati (“N.gravidanze” = 3, “Gestazione” = 39, “Sesso” = Femmina). Per le variabili continue di cui non disponevamo informazioni specifiche (“Cranio” e “Lunghezza”), abbiamo utilizzato il valore medio osservato nel nostro campione
# Media per le variabili continue
media_cranio <- mean(neonati2$Cranio, na.rm = TRUE)
media_lunghezza <- mean(neonati2$Lunghezza, na.rm = TRUE)
# Creazione nuovo caso
nuovi_dati <- data.frame(
N.gravidanze = 3,
Gestazione = 39,
Cranio = media_cranio,
Lunghezza = media_lunghezza,
Sesso = "Femmina"
)
# Previsione puntuale e intervallo di confidenza
stima <- predict(mod_finale, nuovi_dati, interval = "confidence")
# Output leggibile
print(round(stima, 2))
## fit lwr upr
## 1 3271.18 3247.84 3294.52
La stima del peso alla nascita per una neonata, figlia di una madre alla terza gravidanza che partorisce alla 39esima settimana di gestazione, considerando valori medi per cranio (340.03 mm) e lunghezza (494.69 mm) e valori standard per le restanti variabili, è pari a 3271,18 grammi. L’intervallo di confidenza al 95% della previsione è compreso tra 3105,40 e 3437,23 grammi, a indicare l’incertezza associata al modello nella stima individuale.
4. Visualizzazioni
# dataframe con valori osservati e predetti
dati_mod <- data.frame(
Osservato = neonati2$Peso,
Predetto = predict(mod_finale, neonati2)
)
# Grafico
library(ggplot2)
ggplot(dati_mod, aes(x=Osservato, y=Predetto)) +
geom_point(alpha=0.5, color="darkblue") +
geom_abline(intercept=0, slope=1, linetype="dashed", color="red") +
labs(
title = "Valori osservati vs predetti dal modello",
x = "Peso osservato (g)",
y = "Peso predetto (g)"
) +
theme_minimal()
Nella figura seguente viene presentato il grafico di dispersione tra i
valori di peso osservati e quelli predetti dal modello di regressione.
La presenza della maggior parte dei punti in prossimità della bisettrice
(linea rossa tratteggiata) suggerisce che il modello è in grado di
stimare efficacemente il peso alla nascita. Si osserva inoltre una
maggiore dispersione per valori estremi.
dati_mod$residuo <- dati_mod$Osservato - dati_mod$Predetto
ggplot(dati_mod, aes(x=residuo)) +
geom_histogram(bins=30, fill="dodgerblue", color="white") +
labs(
title = "Distribuzione dei residui del modello",
x = "Residuo (Osservato - Predetto)",
y = "Frequenza"
) +
theme_minimal()
Il grafico mostra la distribuzione dei residui (ossia la differenza tra
peso osservato e predetto) prodotti dal modello di regressione. La forma
grossolanamente simmetrica attorno allo zero suggerisce che il modello
non presenta bias evidenti (ossia non sovra- o sottostima
sistematicamente il peso). La maggior parte dei residui si distribuisce
tra -1000 e +1000 grammi, indicando che le previsioni del modello sono
nella maggior parte dei casi abbastanza vicine ai valori osservati.
library(broom)
coefs <- tidy(mod_finale)
ggplot(coefs[-1, ], aes(x=reorder(term, estimate), y=estimate)) +
geom_col(fill="steelblue") +
coord_flip() +
labs(
title = "Stima dei coefficienti delle variabili nel modello",
x = "Variabile esplicativa",
y = "Valore coefficiente"
) +
theme_minimal()
Il grafico mostra la stima dei coefficienti delle principali variabili esplicative nel modello di regressione. Tra queste, la variabile con maggiore impatto positivo sul peso alla nascita è il sesso maschile, che comporta un aumento previsto di 78 grammi rispetto alle femmine. Anche la durata della gestazione ha un effetto rilevante: ogni settimana aggiuntiva di gestazione contribuisce a un aumento medio di 33 grammi. Le altre variabili considerate (“numero di gravidanze”, circonferenza cranica, lunghezza del neonato alla nascita) risultano avere un impatto positivo, ma inferiore rispetto alle precedenti.
Relazioni più significative tra le variabili 1. Relazione tra settimane di gestazione e peso
ggplot(neonati2, aes(x = Gestazione, y = Peso)) +
geom_point(alpha = 0.5) +
geom_smooth(method = "lm", color = "blue") +
labs(
title = "Relazione tra settimane di gestazione e peso alla nascita",
x = "Settimane di gestazione",
y = "Peso alla nascita (g)"
) +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
Il grafico mostra la relazione diretta tra la durata della gestazione e il peso alla nascita. È evidente una tendenza positiva: i neonati nati a termine o comunque con un numero maggiore di settimane di gestazione hanno in media un peso maggiore rispetto ai nati pretermine. La dispersione dei punti suggerisce che, oltre alla gestazione, altri fattori influenzano il peso, ma la settimana di gestazione resta una delle variabili più rilevanti per spiegare la variabilità del peso alla nascita.
Effetto del fumo sul peso alla nascita
ggplot(neonati2, aes(x = as.factor(Fumatrici), y = Peso, fill = as.factor(Fumatrici))) +
geom_boxplot(alpha = 0.7) +
labs(
title = "Impatto del fumo materno sul peso alla nascita",
x = "Fumo materno (0=No, 1=Sì)",
y = "Peso alla nascita (g)"
) +
scale_fill_manual(values = c("#0099F8", "#FC7C00")) +
theme_minimal()
Abbiamo eseguito un’analisi esplorativa della relazione tra peso alla nascita e fumo materno, osservando visivamente una differenza tra figli di madri fumatrici e non fumatrici. Tuttavia, questa differenza non è risultata significativa nella regressione multipla che tiene conto di altre variabili (ad es. settimane di gestazione) e la variabile “Fumatrici” è stata quindi esclusa dal modello finale.
In conclusione, l’analisi dei dati condotta ha evidenziato come alcune variabili cliniche, in particolare la durata della gestazione (settimane), il numero di gravidanze, la circonferenza cranica e la lunghezza del neonato, influenzino in modo differenziato il peso alla nascita: l’effetto risulta moderato per la durata della gestazione e il numero di gravidanze, mentre è più marcato per circonferenza e lunghezza neonatale. Questi risultati forniscono a Neonatal Health Solutions importanti indicazioni per la valutazione precoce del rischio e la personalizzazione dei protocolli di monitoraggio maternità e neonatale. Pur nella validità dei risultati ottenuti, il modello è comunque limitato dal campione disponibile e dall’assenza di alcune possibili variabili confondenti. Futuri approfondimenti potranno includere fattori genetici e socio-demografici per migliorare ulteriormente la capacità predittiva degli strumenti sviluppati.