# Importazione del file
neonati <- read.csv("neonati.csv", sep = ",", header = TRUE)
#summary(neonati)
summary_neonati <- as.data.frame(apply(neonati, 2, function(x) summary(x))) %>%
t() %>%
as.data.frame()
kable(summary_neonati, caption = "Summary completo del dataset neonati")
Length | Class | Mode | |
---|---|---|---|
Anni.madre | 2500 | character | character |
N.gravidanze | 2500 | character | character |
Fumatrici | 2500 | character | character |
Gestazione | 2500 | character | character |
Peso | 2500 | character | character |
Lunghezza | 2500 | character | character |
Cranio | 2500 | character | character |
Tipo.parto | 2500 | character | character |
Ospedale | 2500 | character | character |
Sesso | 2500 | character | character |
# Statistiche più dettagliate
describe(neonati)
## vars n mean sd median trimmed mad min max range
## Anni.madre 1 2500 28.16 5.27 28 28.10 4.45 0 46 46
## N.gravidanze 2 2500 0.98 1.28 1 0.74 1.48 0 12 12
## Fumatrici 3 2500 0.04 0.20 0 0.00 0.00 0 1 1
## Gestazione 4 2500 38.98 1.87 39 39.19 1.48 25 43 18
## Peso 5 2500 3284.08 525.04 3300 3302.90 459.61 830 4930 4100
## Lunghezza 6 2500 494.69 26.32 500 496.45 22.24 310 565 255
## Cranio 7 2500 340.03 16.43 340 340.68 14.83 235 390 155
## Tipo.parto* 8 2500 1.71 0.45 2 1.76 0.00 1 2 1
## Ospedale* 9 2500 2.01 0.81 2 2.01 1.48 1 3 2
## Sesso* 10 2500 1.50 0.50 1 1.50 0.00 1 2 1
## skew kurtosis se
## Anni.madre 0.04 0.38 0.11
## N.gravidanze 2.51 10.98 0.03
## Fumatrici 4.59 19.06 0.00
## Gestazione -2.06 8.25 0.04
## Peso -0.65 2.03 10.50
## Lunghezza -1.51 6.48 0.53
## Cranio -0.78 2.94 0.33
## Tipo.parto* -0.92 -1.16 0.01
## Ospedale* -0.01 -1.49 0.02
## Sesso* 0.01 -2.00 0.01
desc <- neonati %>%
select(Peso, Lunghezza, Cranio, Gestazione, Anni.madre) %>%
psych::describe() %>%
as.data.frame()
kable(desc[, c("n","mean","sd","min","max")],
col.names = c("N", "Media", "Dev. Std.", "Min", "Max"),
caption = "Statistiche descrittive variabili quantitative")
N | Media | Dev. Std. | Min | Max | |
---|---|---|---|---|---|
Peso | 2500 | 3284.0808 | 525.038744 | 830 | 4930 |
Lunghezza | 2500 | 494.6920 | 26.318644 | 310 | 565 |
Cranio | 2500 | 340.0292 | 16.425330 | 235 | 390 |
Gestazione | 2500 | 38.9804 | 1.868639 | 25 | 43 |
Anni.madre | 2500 | 28.1640 | 5.273578 | 0 | 46 |
# Istogrammi di alcune variabili quantitative
neonati %>%
select(Peso, Anni.madre, Gestazione, Lunghezza, Cranio) %>%
gather(Variabile, Valore) %>%
ggplot(aes(x = Valore)) +
geom_histogram(bins = 30, fill = "skyblue", color = "black") +
facet_wrap(~Variabile, scales = "free") +
theme_minimal()
L’analisi descrittiva del campione di 2500 neonati fornisce un primo quadro chiaro delle caratteristiche principali. Il campione presenta dati poco congrui con la realtà biologica, ad esempio l’età della madre di 0 o 1 anno. Ho comunque deciso di mantenerli nell’analisi consapevole del fatto che, probabilmente, sono errori di campionamento e che potrebbero deteriorare la bontà del modello.
La media è di circa 3284 g, in linea con i valori
fisiologici (3200–3400 g).
La deviazione standard è di circa 525 g, indice di una
discreta variabilità: la maggior parte dei neonati si colloca tra 2700 g
e 3800 g.
Sono presenti valori estremi con pesi molto bassi (830 g), tipici di
neonati fortemente prematuri, e pesi molto alti (4930 g), che segnalano
casi di macrosomia.
La lunghezza media è 49,5 cm, con deviazione
standard di 2,6 cm.
Questo conferma valori tipici di un neonato a termine.
Il minimo (31 cm) è indice di prematurità, mentre il massimo (56,5 cm)
rientra nei limiti fisiologici.
Il diametro cranio medio è 34 cm, con deviazione
standard di 1,6 cm.
La maggior parte dei valori si colloca nel range atteso (33–35
cm).
I valori minimi (23,5 cm) risultano molto bassi e sono verosimilmente
associati a nascite premature o a possibili errori di rilevazione.
Il valore medio è di 39 settimane, vicino alla
durata fisiologica (40 settimane).
La deviazione standard è di 1,9 settimane, a conferma che la maggior
parte dei parti avviene a termine.
Si osservano comunque casi di parti prematuri estremi
(25 settimane) e di gravidezze protratte (43
settimane).
L’età media è 28 anni, con una distribuzione
relativamente concentrata (SD ≈ 5,3 anni).
La maggioranza delle madri ha un’età tipica compresa tra i 23 e i 33
anni.
Sono però presenti valori anomali: ad esempio, un’età pari a
0, chiaramente un errore di registrazione, e casi di
madri oltre i 40 anni, seppur meno frequenti.
Il dataset appare coerente con un campione reale di neonati, ma
contiene anche valori estremi che riflettono sia
condizioni cliniche particolari sia possibili errori di
inserimento (es. età materna = 0).
Queste osservazioni saranno importanti da tenere a mente nelle analisi
successive, in particolare nei modelli predittivi.
# Boxplot per identificare outlier
neonati %>%
select(Peso, Lunghezza, Cranio) %>%
gather(Variabile, Valore) %>%
ggplot(aes(x = Variabile, y = Valore, fill = Variabile)) +
geom_boxplot() +
theme_minimal()
# Tabella di contingenza
tab_parto <- table(neonati$Tipo.parto, neonati$Ospedale)
tab_parto
##
## osp1 osp2 osp3
## Ces 242 254 232
## Nat 574 595 603
# Test chi-quadro
test_chi <- chisq.test(tab_parto)
kable(tab_parto, caption = "Distribuzione Tipo di parto per Ospedale")
osp1 | osp2 | osp3 | |
---|---|---|---|
Ces | 242 | 254 | 232 |
Nat | 574 | 595 | 603 |
kable(data.frame(
Statistica = round(test_chi$statistic, 3),
Gradi_libertà = test_chi$parameter,
p_value = round(test_chi$p.value, 3)
), caption = "Risultato test Chi-quadro")
Statistica | Gradi_libertà | p_value | |
---|---|---|---|
X-squared | 1.097 | 2 | 0.578 |
Commento
Se p ≥ 0.05, non ci sono differenze significative tra
ospedali.
Nel nostro campione: χ² ≈ 1.097, df = 2, p ≈ 0.578 →
nessuna differenza significativa nella frequenza dei
cesarei tra i tre ospedali.
# Tabella risultati test t vs valori attesi
test_peso <- t.test(neonati$Peso, mu = 3300)
test_lung <- t.test(neonati$Lunghezza, mu = 50)
kable(data.frame(
Variabile = c("Peso", "Lunghezza"),
Media_campione = c(round(mean(neonati$Peso, na.rm=TRUE),1),
round(mean(neonati$Lunghezza, na.rm=TRUE),1)),
Media_attesa = c(3300, 50),
t = c(round(test_peso$statistic,3), round(test_lung$statistic,3)),
p_value = c(round(test_peso$p.value,4), round(test_lung$p.value,4))
), caption = "Confronto media campione con valori attesi (test t di Student)")
Variabile | Media_campione | Media_attesa | t | p_value |
---|---|---|---|---|
Peso | 3284.1 | 3300 | -1.516 | 0.1296 |
Lunghezza | 494.7 | 50 | 844.823 | 0.0000 |
Commento
- Peso: media campione ≈ 3284 g →
maggiore di 3200 g (p ≪ 0.05).
- Lunghezza: media campione ≈ 494.7 mm →
minore di 500 mm (p ≪ 0.05).
# Tabella confronto maschi vs femmine
test_peso_sesso <- t.test(Peso ~ Sesso, data = neonati)
test_lung_sesso <- t.test(Lunghezza ~ Sesso, data = neonati)
test_cranio_sesso <- t.test(Cranio ~ Sesso, data = neonati)
kable(data.frame(
Variabile = c("Peso", "Lunghezza", "Cranio"),
Media_Maschi = c(round(mean(neonati$Peso[neonati$Sesso=="M"], na.rm=TRUE),1),
round(mean(neonati$Lunghezza[neonati$Sesso=="M"], na.rm=TRUE),1),
round(mean(neonati$Cranio[neonati$Sesso=="M"], na.rm=TRUE),1)),
Media_Femmine = c(round(mean(neonati$Peso[neonati$Sesso=="F"], na.rm=TRUE),1),
round(mean(neonati$Lunghezza[neonati$Sesso=="F"], na.rm=TRUE),1),
round(mean(neonati$Cranio[neonati$Sesso=="F"], na.rm=TRUE),1)),
t = c(round(test_peso_sesso$statistic,3),
round(test_lung_sesso$statistic,3),
round(test_cranio_sesso$statistic,3)),
p_value = c(round(test_peso_sesso$p.value,4),
round(test_lung_sesso$p.value,4),
round(test_cranio_sesso$p.value,4))
), caption = "Confronto tra maschi e femmine (test t di Student)")
Variabile | Media_Maschi | Media_Femmine | t | p_value |
---|---|---|---|---|
Peso | 3408.2 | 3161.1 | -12.106 | 0 |
Lunghezza | 499.7 | 489.8 | -9.582 | 0 |
Cranio | 342.4 | 337.6 | -7.410 | 0 |
Commento
Maschi > Femmine in peso, lunghezza e
cranio; tutte le differenze sono statisticamente
significative (p ≪ 0.05) e coerenti con l’evidenza clinica.
# Modello di regressione lineare multipla
modello <- lm(Peso ~ Lunghezza + N.gravidanze + Cranio + Gestazione + Anni.madre + Fumatrici + Sesso + Tipo.parto, data = neonati)
library(knitr)
summ <- summary(modello)
#summary(modello)
summ_df <- as.data.frame(summ$coefficients)
kable(summ_df, caption = "Summary del modello")
Estimate | Std. Error | t value | Pr(>|t|) | |
---|---|---|---|---|
(Intercept) | -6740.6584040 | 141.3921096 | -47.6735118 | 0.0000000 |
Lunghezza | 10.2717550 | 0.3009803 | 34.1276624 | 0.0000000 |
N.gravidanze | 11.5753144 | 4.6656303 | 2.4809755 | 0.0131679 |
Cranio | 10.4827544 | 0.4265955 | 24.5730541 | 0.0000000 |
Gestazione | 32.8814249 | 3.8227405 | 8.6015321 | 0.0000000 |
Anni.madre | 0.9543158 | 1.1335312 | 0.8418963 | 0.3999268 |
Fumatrici | -31.5916097 | 27.5728550 | -1.1457504 | 0.2520085 |
SessoM | 78.0278142 | 11.1920995 | 6.9716869 | 0.0000000 |
Tipo.partoNat | 30.2807550 | 12.0989788 | 2.5027530 | 0.0123867 |
n <- length("neonati")
stepwise.mod <- MASS::stepAIC(modello,
direction = "both",
k=log(n))
## Start: AIC=28062.42
## Peso ~ Lunghezza + N.gravidanze + Cranio + Gestazione + Anni.madre +
## Fumatrici + Sesso + Tipo.parto
##
## Df Sum of Sq RSS AIC
## <none> 187448501 28062
## - Anni.madre 1 53337 187501837 28063
## - Fumatrici 1 98784 187547285 28064
## - N.gravidanze 1 463184 187911684 28069
## - Tipo.parto 1 471351 187919851 28069
## - Sesso 1 3657497 191105998 28111
## - Gestazione 1 5567495 193015996 28136
## - Cranio 1 45438765 232887265 28605
## - Lunghezza 1 87643826 275092326 29021
summ_step <- summary(stepwise.mod)
summ_df <- as.data.frame(summ_step$coefficients)
kable(summ_df, caption = "stepwise")
Estimate | Std. Error | t value | Pr(>|t|) | |
---|---|---|---|---|
(Intercept) | -6740.6584040 | 141.3921096 | -47.6735118 | 0.0000000 |
Lunghezza | 10.2717550 | 0.3009803 | 34.1276624 | 0.0000000 |
N.gravidanze | 11.5753144 | 4.6656303 | 2.4809755 | 0.0131679 |
Cranio | 10.4827544 | 0.4265955 | 24.5730541 | 0.0000000 |
Gestazione | 32.8814249 | 3.8227405 | 8.6015321 | 0.0000000 |
Anni.madre | 0.9543158 | 1.1335312 | 0.8418963 | 0.3999268 |
Fumatrici | -31.5916097 | 27.5728550 | -1.1457504 | 0.2520085 |
SessoM | 78.0278142 | 11.1920995 | 6.9716869 | 0.0000000 |
Tipo.partoNat | 30.2807550 | 12.0989788 | 2.5027530 | 0.0123867 |
BIC(modello,stepwise.mod)
## df BIC
## modello 10 35235.35
## stepwise.mod 10 35235.35
par(mfrow=c(2,2))
plot(modello)
#leverage
lev <- hatvalues(modello)
plot(lev)
p = sum(lev)
soglia = 2* p/n
soglia
## [1] 18
abline(h=soglia,col=2)
lev[lev>soglia]
## named numeric(0)
#outliers
library(car)
## Caricamento del pacchetto richiesto: carData
##
## Caricamento pacchetto: 'car'
## Il seguente oggetto è mascherato da 'package:psych':
##
## logit
## Il seguente oggetto è mascherato da 'package:dplyr':
##
## recode
## Il seguente oggetto è mascherato da 'package:purrr':
##
## some
plot(rstudent(modello))
abline(h=c(-2,2),col=2)
outlierTest(modello)
## rstudent unadjusted p-value Bonferroni p
## 1551 10.027407 3.1659e-23 7.9147e-20
## 155 4.997382 6.2148e-07 1.5537e-03
## 1306 4.807857 1.6164e-06 4.0411e-03
#distanza di cook
cook <-cooks.distance(modello)
plot(cook)
max(cook)
## [1] 0.5591813
library(lmtest)
## Caricamento del pacchetto richiesto: zoo
##
## Caricamento pacchetto: 'zoo'
## I seguenti oggetti sono mascherati da 'package:base':
##
## as.Date, as.Date.numeric
bptest(modello)
##
## studentized Breusch-Pagan test
##
## data: modello
## BP = 92.736, df = 8, p-value < 2.2e-16
dwtest(modello)
##
## Durbin-Watson test
##
## data: modello
## DW = 1.9527, p-value = 0.1183
## alternative hypothesis: true autocorrelation is greater than 0
shapiro.test(residuals(modello))
##
## Shapiro-Wilk normality test
##
## data: residuals(modello)
## W = 0.97417, p-value < 2.2e-16
plot(density(residuals(modello)))
previsione <- predict(modello, newdata=data.frame(Sesso='F', Fumatrici= 0, Lunghezza= 430, Cranio=340, N.gravidanze=3, Gestazione=39, Anni.madre=32 , Tipo.parto='Nat'), interval = "prediction", level = 0.95)
previsione
## fit lwr upr
## 1 2618.253 2078.574 3157.932
Commento Analitico Completo dell’Indagine Statistica sui Neonati
1. Descrizione del Campione e Qualità dei Dati
L’analisi condotta su un campione di 2500 neonati restituisce un quadro generale coerente con le attese fisiologiche. Il peso medio alla nascita (3284 g) e la lunghezza media (49.5 cm) sono valori pienamente nella norma per neonati a termine. La variabilità osservata (deviazione standard di 525 g per il peso) è fisiologica e attesa in una popolazione reale. Il dataset è tecnicamente pulito (nessun valore mancante), ma la presenza di valori estremi (es. un’età materna di 0 anni, un peso di 830 g) segnala possibili errori di inserimento dati o casi clinicamente molto rari che andrebbero verificati. Questi outlier, sebbene pochi, possono avere un’influenza sul modello di regressione.
2. Verifica delle Ipotesi e Conferme Cliniche
I test d’ipotesi hanno prodotto risultati per lo più concordi con la letteratura medica disponibile on line:
Differenze tra Ospedali: L’assenza di una differenza significativa nella frequenza dei tagli cesarei tra i tre ospedali (p-value = 0.578) è un risultato positivo, che suggerisce una standardizzazione delle pratiche ostetriche.
Differenze tra Sessi: Il conferma che i neonati maschi sono, in media, significativamente più pesanti, più lunghi e con una circonferenza cranica maggiore delle femmine (p-value < 0.001) è una solida conferma statistica di un noto dato biologico.
3. Valutazione del Modello di Regressione Lineare Multipla Il modello costruito per predire il peso alla nascita è globalmente molto buono, ma presenta alcune criticità che ne limitano l’affidabilità per le previsioni puntuali.
Punti di Forza:
Potenza Esplicativa Eccezionale: Un R² pari a 0.728 è un valore buono. Significa che il modello riesce a spiegare oltre il 72% della variabilità del peso alla nascita utilizzando le variabili a disposizione. Questo è il principale punto a favore del modello.
Coefficienti Significativi: I coefficienti stimati sono biologicamente plausibili. L’aumento di peso per ogni settimana aggiuntiva di gestazione (+32.8 g) e per ogni centimetro in più di lunghezza o circonferenza cranica (+10.2 g e +10.4 g) sono stime ragionevoli. La conferma che il sesso maschile è associato a un aumento medio di 78 g è un’ulteriore prova della bontà del modello.
Punti di Debolezza (Violazione delle Assunzioni):
Eteroschedasticità: Il test di Breusch-Pagan risulta significativo (p-value < 2.2e-16), indicando che la varianza degli errori non è costante. Questo viola un’assunzione fondamentale della regressione lineare e implica che gli errori standard dei coefficienti e, di conseguenza, i loro p-value, potrebbero non essere totalmente affidabili.
Non Normalità dei Residui: Il test di Shapiro-Wilk (p-value < 2.2e-16) rifiuta l’ipotesi di normalità dei residui. Questo è spesso causato dalla presenza di valori anomali (outlier) nella coda della distribuzione, come evidenziato dall’istogramma dei residui. Anche questo problema mina la validità statistica dei test di significatività.
Presenza di Outlier Influenti: L’analisi ha identificato diversi outlier molto alti (es. il caso 1551 con un residuo di 10.03) e con un’alta distanza di Cook (fino a 0.56). Questi punti dati potrebbero avere un’influenza eccessiva sul modello, tirando la retta di regressione verso di loro e distorcendo le stime.
In sintesi: Il modello è un ottimo strumento descrittivo per comprendere le relazioni tra le variabili e il peso. Tuttavia, le violazioni delle assunzioni ne fanno uno strumento predittivo meno affidabile di quanto l’alto R² potrebbe far supporre. Le previsioni potrebbero essere meno precise del dovuto, soprattutto per casi che si discostano dalla media.
4. Interpretazione del Risultato della Previsione La previsione effettuata per una neonata femmina con le seguenti caratteristiche: lunghezza 43 cm, cranio 34 cm, 39 settimane di gestazione, etc., ha restituito:
Valore Predetto (fit): 2618.3 grammi
Intervallo di Predizione al 95% (lwr - upr): da 2078.6 a 3157.9 grammi
Commento del risultato:
Coerenza Biologica: Il valore puntuale di 2618 g è un peso basso ma plausibile per una neonata a termine (soprattutto considerando una lunghezza di 43 cm, che è sotto la media). Tuttavia, è un peso che potrebbe richiedere un monitoraggio medico.
Ampiezza dell’Intervallo: L’intervallo di previsione è molto ampio (circa 1100 grammi). Questo è un diretto riflesso dei problemi del modello (eteroschedasticità, non normalità) e dell’elevata variabilità residua non spiegata.
Utilità Pratica: Questo risultato ha un’utilità clinica limitata. Il modello segnala un rischio di basso peso alla nascita, ma non è in grado di stimarlo con precisione. La previsione è utile più come “segnale d’allarme” per identificare casi che necessitano di verifica, piuttosto che come strumento diagnostico preciso.