Importo il dataset csv e controllo la eventuale presenza di dati mancanti.
dati <- read.csv("neonati.csv", stringsAsFactors = T, sep = ",")
colSums(is.na(dati))
## Anni.madre N.gravidanze Fumatrici Gestazione Peso Lunghezza
## 0 0 0 0 0 0
## Cranio Tipo.parto Ospedale Sesso
## 0 0 0 0
nrow(dati)
## [1] 2500
Per costruire il modello predittivo, abbiamo raccolto dati su 2500 neonati provenienti da tre ospedali. Le variabili raccolte includono:
L’obiettivo principale è identificare quali di queste variabili sono più predittive del peso alla nascita, con un focus particolare sull’impatto del fumo materno e delle settimane di gestazione, che potrebbero indicare nascite premature.
| Anni.madre | N.gravidanze | Gestazione | Peso | Lunghezza | Cranio | |
|---|---|---|---|---|---|---|
| mean | 28.16 | 0.98 | 38.98 | 3284.08 | 494.69 | 340.03 |
| Q.0% | 0.00 | 0.00 | 25.00 | 830.00 | 310.00 | 235.00 |
| Q.25% | 25.00 | 0.00 | 38.00 | 2990.00 | 480.00 | 330.00 |
| Q.50% | 28.00 | 1.00 | 39.00 | 3300.00 | 500.00 | 340.00 |
| Q.75% | 32.00 | 1.00 | 40.00 | 3620.00 | 510.00 | 350.00 |
| Q.100% | 46.00 | 12.00 | 43.00 | 4930.00 | 565.00 | 390.00 |
| sd | 5.27 | 1.28 | 1.87 | 525.04 | 26.32 | 16.43 |
| cv | 18.72 | 130.51 | 4.79 | 15.99 | 5.32 | 4.83 |
| range | 46.00 | 12.00 | 18.00 | 4100.00 | 255.00 | 155.00 |
| min | 0.00 | 0.00 | 25.00 | 830.00 | 310.00 | 235.00 |
| max | 46.00 | 12.00 | 43.00 | 4930.00 | 565.00 | 390.00 |
| skewness | 0.04 | 2.51 | -2.07 | -0.65 | -1.51 | -0.79 |
| curtosi | 3.38 | 13.99 | 11.26 | 5.03 | 9.49 | 5.95 |
Nota: nonostante nel testo sia scritto esplicitamente che le misure del cranio riguardano il diametro e non sia specificata l’unità di misura, suppongo vi sia un errore visto che il raffronto con le tabulazioni in letteratura delle dimensioni in mm del diametro craniale sono molto minori, mentre quelle relative alla circonferenza risultano più compatibili con i dati presenti nel nostro campione. Lavoreremo su questi dati trattandoli come circonferenza del cranio
E’ necessaria una analisi preventiva del dataset per verificare la presenza di alcune misurazioni estreme anomale frutto di errori. Sicuramente si vede subito un dato anomalo legato all’età della madre che ha come minimo 0 anni. Eliminiamo i dati che hanno età troppo bassa e proseguiamo a controllare il resto.
dati <- subset(dati, Anni.madre > 10)
Verifico graficamente se gli altri dati mostrano evidenti misurazioni estreme.
attach(dati)
par(mfrow=c(1,2))
plot(Anni.madre, pch=20, col = "LightBlue")
plot(N.gravidanze, pch=20, col = "LightBlue")
par(mfrow=c(1,2))
plot(Gestazione, pch=20, col = "LightBlue")
plot(Peso, pch=20, col = "LightBlue")
par(mfrow=c(1,2))
plot(Lunghezza, pch=20,col = "LightBlue")
plot(Cranio, pch=20, col = "LightBlue")
I grafici mostrano alcuni dati lontani dal valore medio ma non escludibili a priori come errore di misurazione.
Possiamo verificare se ci sono dati anomali anche nella correlazione tra le diverse variabili.
par(mfrow=c(2,2))
plot(Peso, Lunghezza, pch=20, col = "LightBlue")
plot(Peso, Cranio, pch=20, col = "LightBlue")
plot(Peso, Gestazione, pch=20, col = "LightBlue")
plot(Anni.madre, N.gravidanze, pch=20, col = "LightBlue")
C’è un dato evidentemente anomalo nel rapporto peso-lunghezza, che mostra un peso alto nonostante una lunghezza bassa. Verifichiamo questo dato:
which(Peso>4000 & Lunghezza<350)
## [1] 1549
dati <- dati[-1549, ]
Per il resto i grafici incrociati mostrano dei possibili dati anomali soprattutto nel rapporto Peso del neondato-Dimensione del cranio, che possono però evidenziare delle anomalie nel neonato più che definire un evidente errore di misurazione.
Come ultima analisi descrittiva dei dati possiamo visualizzare la distribuzione delle variabili quantitative.
par(mfrow=c(1,2))
hist(Anni.madre, ylim = c(0,500), main = "", xlab = "Età della madre", ylab = "Frequenza", col = "LightBlue")
hist(N.gravidanze, ylim = c(0,2000), main = "", xlab = "Numero gravidanze precedenti", ylab = "Frequenza", col = "LightBlue")
par(mfrow=c(1,2))
hist(Gestazione,ylim = c(0,700), xlim = c(25, 45), main = "", xlab = "Settimane di gestazione", ylab = "Frequenza", col = "LightBlue")
hist(Peso, main = "", xlab = "Peso alla nascita", ylab = "Frequenza", col = "LightBlue")
par(mfrow=c(1,2))
hist(Lunghezza, ylim = c(0,1000), main = "", xlab = "Lunghezza del neonato", ylab = "Frequenza",col = "LightBlue")
hist(Cranio, ylim = c(0,700), xlim = c(220,400), main = "", xlab = "Dimensione del cranio", ylab = "Frequenza",col = "LightBlue")
Nalle curve di distribuzione sono resi evidenti i dati di curtosi e skewness tabulati nella tabella precedente: - la distribuzione della età della madre è estremamente simmetrica. La distribuzione relativa al numero di gravidanze è invece asimmetrica positiva, mentre tutti le altre distribuzioni mostrano una asimmetria negativa. Gli inidici di curtosi positivi per tutte le variabili misurano delle distribuzioni leptocurtiche.
Studio anche le variabili qualitative.
attach(dati)
tab1 <- as.data.frame(table(Fumatrici))
tab1$Fumatrici <- c("Non fumatrici", "Fumatrici")
tab1$freq_rel <- round(table(Fumatrici)/length(Fumatrici)*100,2)
tab2 <- as.data.frame(table(Tipo.parto))
tab2$freq_rel <- round(table(Tipo.parto)/length(Tipo.parto)*100,2)
tab3 <- as.data.frame(table(Ospedale))
tab3$freq_rel <- round(table(Ospedale)/length(Ospedale)*100,2)
tab4 <- as.data.frame(table(Sesso))
tab4$freq_rel <- round(table(Sesso)/length(Sesso)*100,2)
| Categoria | Frequenza | Frequenza relativa |
|---|---|---|
| Non fumatrici | 2393 | 95.84 |
| Fumatrici | 104 | 4.16 |
| Categoria | Frequenza | Frequenza relativa |
|---|---|---|
| Ces | 728 | 29.15 |
| Nat | 1769 | 70.85 |
| Categoria | Frequenza | Frequenza relativa |
|---|---|---|
| osp1 | 816 | 32.68 |
| osp2 | 848 | 33.96 |
| osp3 | 833 | 33.36 |
| Categoria | Frequenza | Frequenza relativa |
|---|---|---|
| F | 1254 | 50.22 |
| M | 1243 | 49.78 |
Per le variabili qualitative possiamo vedere una distribuzione di valori molto dissimile per le variabili Fumatrici e Tipo di parto, mentre un forte equilibrio nelle variabili Ospedale e Sesso.
In ultimo ricompilo la tabella degli indici di posizione del dataframe da cui sono stati tolti i valori estremi
| Anni.madre | N.gravidanze | Fumatrici | Gestazione | Peso | Lunghezza | Cranio | |
|---|---|---|---|---|---|---|---|
| mean | 28.18 | 0.98 | 0.04 | 38.98 | 3283.75 | 494.77 | 340.02 |
| Q.0% | 13.00 | 0.00 | 0.00 | 25.00 | 830.00 | 310.00 | 235.00 |
| Q.25% | 25.00 | 0.00 | 0.00 | 38.00 | 2990.00 | 480.00 | 330.00 |
| Q.50% | 28.00 | 1.00 | 0.00 | 39.00 | 3300.00 | 500.00 | 340.00 |
| Q.75% | 32.00 | 1.00 | 0.00 | 40.00 | 3620.00 | 510.00 | 350.00 |
| Q.100% | 46.00 | 12.00 | 1.00 | 43.00 | 4930.00 | 565.00 | 390.00 |
| sd | 5.22 | 1.28 | 0.20 | 1.87 | 524.88 | 26.09 | 16.42 |
| cv | 18.51 | 130.53 | 479.78 | 4.80 | 15.98 | 5.27 | 4.83 |
| range | 33.00 | 12.00 | 1.00 | 18.00 | 4100.00 | 255.00 | 155.00 |
| min | 13.00 | 0.00 | 0.00 | 25.00 | 830.00 | 310.00 | 235.00 |
| max | 46.00 | 12.00 | 1.00 | 43.00 | 4930.00 | 565.00 | 390.00 |
| skewness | 0.15 | 2.51 | 4.59 | -2.07 | -0.65 | -1.43 | -0.79 |
| curtosi | 2.90 | 13.98 | 22.05 | 11.26 | 5.03 | 8.95 | 5.95 |
verifica_parto <-round(prop.table(table(Ospedale, Tipo.parto), margin = 1)*100,2)
| Ospedale | Cesareo | Naturale |
|---|---|---|
| osp1 | 29.66 | 70.34 |
| osp2 | 29.95 | 70.05 |
| osp3 | 27.85 | 72.15 |
Dalla tabella precedenti non si evidenziano particolari differenze tra i tre ospedali, se non una lievissima variazione nell’osp3. Possiamo utilizzare il test del Chi Quadro
chisq.test(verifica_parto)
##
## Pearson's Chi-squared test
##
## data: verifica_parto
## X-squared = 0.1254, df = 2, p-value = 0.9392
Il p value del Test di 0.93 è di molto maggiore della soglia di accettazione di 0.05 per cui non si può affermare che ci sia una correlazione tra il numero di parti cesarei e l’ospedale in cui viene e effettuato il parto.
Ci proponiamo di verificare se la media del peso e della lunghezza di questo campione di neonati siano significativamente uguali a quelle della popolazione.
https://www.who.int/tools/child-growth-standards/standards/weight-for-age
Il link precedente rimanda al sito della World Health Organization da cui abbiamo estratto le tabulazioni riguardanti peso e lunghezza dei neonati in ogni settimana del primo anno di vita.
Le seguenti due sono le tabelle relative al peso.
Effettuiamo il test T di student per verificare l’ipotesi di uguaglianza tra il campione e la popolazione.
t_test_F_peso = t.test(Peso[dati$Sesso == "F"],
mu = 3200,
conf.level = 0.95,
alternative = "two.sided")
t_test_M_peso = t.test(Peso[dati$Sesso == "M"],
mu = 3300,
conf.level = 0.95,
alternative = "two.sided")
##
## One Sample t-test
##
## data: Peso[dati$Sesso == "F"]
## t = -2.6883, df = 1253, p-value = 0.007276
## alternative hypothesis: true mean is not equal to 3200
## 95 percent confidence interval:
## 3130.978 3189.217
## sample estimates:
## mean of x
## 3160.097
##
## One Sample t-test
##
## data: Peso[dati$Sesso == "M"]
## t = 7.7447, df = 1242, p-value = 1.978e-14
## alternative hypothesis: true mean is not equal to 3300
## 95 percent confidence interval:
## 3381.012 3435.979
## sample estimates:
## mean of x
## 3408.496
Le seguenti due tabelle sono relative alla lunghezza.
Test t di student per i valori di lunghezza:
t_test_F_lunghezza = t.test(Lunghezza[dati$Sesso == "F"],
mu = 491,
conf.level = 0.95,
alternative = "two.sided")
t_test_M_lunghezza = t.test(Lunghezza[dati$Sesso == "M"],
mu = 499,
conf.level = 0.95,
alternative = "two.sided")
##
## One Sample t-test
##
## data: Lunghezza[dati$Sesso == "F"]
## t = -1.4323, df = 1253, p-value = 0.1523
## alternative hypothesis: true mean is not equal to 491
## 95 percent confidence interval:
## 488.4016 491.4054
## sample estimates:
## mean of x
## 489.9035
##
## One Sample t-test
##
## data: Lunghezza[dati$Sesso == "M"]
## t = 0.98965, df = 1242, p-value = 0.3225
## alternative hypothesis: true mean is not equal to 499
## 95 percent confidence interval:
## 498.3369 501.0131
## sample estimates:
## mean of x
## 499.675
I Test t di Student effettuati per peso e lunghezza sui campioni di neonati maschi e femmine mostrano tutti e quattro dei valori di p value molto bassi, che quindi portano in tutti e quattro i casi a rifiutare l’ipotesi nulla di somiglianza tra campione e popolazione. Viene invece accettata l’ipotesi alternativa di differenza significatica del campione dai valori della popolazione neonatale complessiva.
Ci proponiamo in ultimo di verificare se le misure antropometriche sono significativamente diverse tra i due sessi. Analizziamo perciò peso, lunghezza e dimensione del cranio in rapporto al sesso del neonato.
par(mfrow=c(1,3))
boxplot(Peso~Sesso, col = "LightBlue", main = "Peso")
boxplot(Lunghezza~Sesso, col = "LightBlue", main = "Lunghezza")
boxplot(Cranio~Sesso, col = "LightBlue", main = "Dimensione del cranio", ylab = "Cranio")
I boxplot mostrano delle distribuzioni di dati differenti per i maschi e per le femmine. Possiamo visualizzare questo anche in una tabulazione dei valori medi e verificare l’ipotesi con il test t di Student.
tab_antrop <- dati %>%
group_by(Sesso) %>%
summarize(
peso_medio = round(mean(Peso),2),
lunghezza_media= round(mean(Lunghezza),2),
dimensione_cranio_medio = round(mean(Cranio),2)
)
| Sesso | peso_medio | lunghezza_media | dimensione_cranio_medio |
|---|---|---|---|
| F | 3160.1 | 489.90 | 337.59 |
| M | 3408.5 | 499.67 | 342.46 |
##
## Welch Two Sample t-test
##
## data: Peso by Sesso
## t = -12.17, df = 2487.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -288.4204 -208.3762
## sample estimates:
## mean in group F mean in group M
## 3160.097 3408.496
##
## Welch Two Sample t-test
##
## data: Lunghezza by Sesso
## t = -9.5303, df = 2464.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -11.782029 -7.760913
## sample estimates:
## mean in group F mean in group M
## 489.9035 499.6750
##
## Welch Two Sample t-test
##
## data: Cranio by Sesso
## t = -7.4855, df = 2488.6, p-value = 9.835e-14
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -6.138779 -3.590159
## sample estimates:
## mean in group F mean in group M
## 337.5941 342.4586
Tutti e tre i t test mostrano un p value molto basso e ci portano a selezionare per tutte e tre le variabili l’ipotesi alternativa di differenza significativa tra le misure antropometriche dei neonati dei due sessi.
Ci proponiamo di trovare un modello di regressione lineare multipla che includa le variabili rilevanti. In questo modo, potremo quantificare l’impatto di ciascuna variabile indipendente sul peso del neonato ed eventuali interazioni.
Facciamo innanzitutto un test sulla distribuzione della variabile di output Peso per verificare cha abbia distribuzione normale e non produca effetti significativi nel calcolo dei residui.
| Peso | |
|---|---|
| mean | 3283.75 |
| Q.0% | 830.00 |
| Q.25% | 2990.00 |
| Q.50% | 3300.00 |
| Q.75% | 3620.00 |
| Q.100% | 4930.00 |
| sd | 524.88 |
| cv | 15.98 |
| range | 4100.00 |
| min | 830.00 |
| max | 4930.00 |
| skewness | -0.65 |
| curtosi | 5.03 |
Gli indicatori statistici del Peso ci mostrano una distribuzione leptocurtica con leggera asimmetria negativa.
shapiro.test(Peso)
##
## Shapiro-Wilk normality test
##
## data: Peso
## W = 0.97056, p-value < 2.2e-16
I p value del test di Shapiro Wilk è molto basso, e quindi ci porta ad accettare la distribuzione del Peso come normale.
Parte deterministica del modello Iniziamo visualizzando la matrice di correlazione di tutte le variabili:
Possiamo sviluppare il modello di regressione valutando i coefficienti di regressione Beta, che rappresentano gli effetti marginali di ogni singola variabile sulla variabile Peso.
##
## Call:
## lm(formula = Peso ~ Anni.madre + N.gravidanze + Gestazione +
## Fumatrici + Lunghezza + Cranio + Sesso)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1173.53 -179.25 -13.31 162.38 1407.71
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6704.9105 138.5985 -48.377 < 2e-16 ***
## Anni.madre 0.6050 1.1272 0.537 0.59153
## N.gravidanze 12.4548 4.5873 2.715 0.00667 **
## Gestazione 30.0838 3.7655 7.989 2.05e-15 ***
## Fumatrici -27.3365 27.0750 -1.010 0.31276
## Lunghezza 10.8757 0.3022 35.988 < 2e-16 ***
## Cranio 9.9053 0.4233 23.402 < 2e-16 ***
## SessoM 78.2423 10.9960 7.116 1.45e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 269.4 on 2489 degrees of freedom
## Multiple R-squared: 0.7373, Adjusted R-squared: 0.7366
## F-statistic: 998.1 on 7 and 2489 DF, p-value: < 2.2e-16
| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | -6704.91049 | 138.59849 | -48.37650 | 0.00000 |
| Anni.madre | 0.60495 | 1.12719 | 0.53669 | 0.59153 |
| N.gravidanze | 12.45484 | 4.58734 | 2.71505 | 0.00667 |
| Gestazione | 30.08384 | 3.76550 | 7.98933 | 0.00000 |
| Fumatrici | -27.33646 | 27.07504 | -1.00966 | 0.31276 |
| Lunghezza | 10.87569 | 0.30220 | 35.98788 | 0.00000 |
| Cranio | 9.90532 | 0.42327 | 23.40217 | 0.00000 |
| SessoM | 78.24227 | 10.99599 | 7.11552 | 0.00000 |
I coefficienti ci indicano come variabili signficative il tempo di Gestazione, la Lunghezza del neonato, la dimensione del Cranio e il Sesso del neonato. Dalla matrice di correlazione possiamo vedere anche graficamente la correlazione tra Peso e Gestazione, Lunghezza e Cranio. Le curve di fit create automaticamente nella matrice sembrano indicare dei comportamenti non lineari che potrebbero essere però dovuti ad over fitting e che potremo verificare nella procedura stepwise.
L’R quadro aggiustato è di 0.7366 che ci indica un buon modello di descrizione dei dati.
Stepwise: vediamo di migliorare il modello attraverso la procedura stepwise.
##
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Lunghezza + Cranio +
## Sesso)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1165.68 -179.74 -12.42 162.92 1410.68
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6683.8326 133.1602 -50.194 < 2e-16 ***
## N.gravidanze 13.1448 4.2576 3.087 0.00204 **
## Gestazione 29.6341 3.7369 7.930 3.27e-15 ***
## Lunghezza 10.8899 0.3019 36.077 < 2e-16 ***
## Cranio 9.9192 0.4227 23.465 < 2e-16 ***
## SessoM 78.1376 10.9929 7.108 1.53e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 269.3 on 2491 degrees of freedom
## Multiple R-squared: 0.7372, Adjusted R-squared: 0.7367
## F-statistic: 1398 on 5 and 2491 DF, p-value: < 2.2e-16
Togliendo le due variabili l’R quadro aggiustato è cresciuto a 0.7367
##
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + Sesso)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1153.75 -182.01 -14.88 163.78 1391.18
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6652.115 132.990 -50.020 < 2e-16 ***
## Gestazione 28.533 3.726 7.657 2.69e-14 ***
## Lunghezza 10.841 0.302 35.903 < 2e-16 ***
## Cranio 10.059 0.421 23.893 < 2e-16 ***
## SessoM 79.321 11.005 7.208 7.51e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 269.8 on 2492 degrees of freedom
## Multiple R-squared: 0.7362, Adjusted R-squared: 0.7358
## F-statistic: 1739 on 4 and 2492 DF, p-value: < 2.2e-16
L’R quadro aggiustato è calato da 0.7367 a 0.7358 ma ci lascia un modello con quattro variabili (Gestazione, Lunghezza, Cranio e Sesso) tutte molto significative. mod3 potrebbe essere un buon modello.
##
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + Sesso +
## I(Lunghezza^2))
##
## Residuals:
## Min 1Q Median 3Q Max
## -1163.66 -182.74 -12.38 164.68 1307.78
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.666e+03 7.603e+02 -2.192 0.028481 *
## Gestazione 3.644e+01 3.880e+00 9.391 < 2e-16 ***
## Lunghezza -1.137e+01 3.348e+00 -3.395 0.000698 ***
## Cranio 1.030e+01 4.189e-01 24.577 < 2e-16 ***
## SessoM 7.358e+01 1.094e+01 6.723 2.19e-11 ***
## I(Lunghezza^2) 2.288e-02 3.436e-03 6.659 3.38e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.5 on 2491 degrees of freedom
## Multiple R-squared: 0.7408, Adjusted R-squared: 0.7403
## F-statistic: 1424 on 5 and 2491 DF, p-value: < 2.2e-16
Con il termine quadratico relativo alla lunghezza l’R quadro aggiustato
cresce a 0.7403 e non si vede perdita di sigificatività di altre
variabili.
##
## Call:
## lm(formula = Peso ~ Gestazione + Cranio + Sesso + poly(Lunghezza,
## 2))
##
## Residuals:
## Min 1Q Median 3Q Max
## -1163.66 -182.74 -12.38 164.68 1307.78
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1673.8583 197.6607 -8.468 < 2e-16 ***
## Gestazione 36.4395 3.8803 9.391 < 2e-16 ***
## Cranio 10.2953 0.4189 24.577 < 2e-16 ***
## SessoM 73.5847 10.9444 6.723 2.19e-11 ***
## poly(Lunghezza, 2)1 13576.7873 398.9042 34.035 < 2e-16 ***
## poly(Lunghezza, 2)2 1888.3743 283.5889 6.659 3.38e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.5 on 2491 degrees of freedom
## Multiple R-squared: 0.7408, Adjusted R-squared: 0.7403
## F-statistic: 1424 on 5 and 2491 DF, p-value: < 2.2e-16
Verifico anche il termine quadratico con Gestazione
##
## Call:
## lm(formula = Peso ~ Gestazione + Cranio + Sesso + poly(Lunghezza,
## 2) + I(Gestazione^2))
##
## Residuals:
## Min 1Q Median 3Q Max
## -1174.11 -184.47 -12.53 163.22 1307.85
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4654.2522 1265.6807 -3.677 0.000241 ***
## Gestazione 194.3051 66.3329 2.929 0.003429 **
## Cranio 10.2454 0.4190 24.450 < 2e-16 ***
## SessoM 74.7566 10.9452 6.830 1.06e-11 ***
## poly(Lunghezza, 2)1 13202.2085 428.3852 30.819 < 2e-16 ***
## poly(Lunghezza, 2)2 2498.7550 381.8715 6.543 7.27e-11 ***
## I(Gestazione^2) -2.0729 0.8695 -2.384 0.017201 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.2 on 2490 degrees of freedom
## Multiple R-squared: 0.7414, Adjusted R-squared: 0.7408
## F-statistic: 1190 on 6 and 2490 DF, p-value: < 2.2e-16
L’aggiunta di un termine quadratico per gestazione mostra invece una sigificatività sotto al limite ma non incisiva e porta invece a far calare il coefficiente di sigifcatività di Gestazione. Scartiamo il mod5.
##
## Call:
## lm(formula = Peso ~ Gestazione + Cranio + Sesso + poly(Lunghezza,
## 2) + Lunghezza + Gestazione:Lunghezza)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1175.45 -184.34 -11.54 166.47 1302.13
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1598.0934 206.6423 -7.734 1.51e-14 ***
## Gestazione 103.1573 53.2721 1.936 0.052929 .
## Cranio 10.2658 0.4195 24.471 < 2e-16 ***
## SessoM 74.4364 10.9642 6.789 1.41e-11 ***
## poly(Lunghezza, 2)1 20192.6018 5283.5724 3.822 0.000136 ***
## poly(Lunghezza, 2)2 2554.4653 601.4744 4.247 2.25e-05 ***
## Lunghezza NA NA NA NA
## Gestazione:Lunghezza -0.1381 0.1099 -1.256 0.209331
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.5 on 2490 degrees of freedom
## Multiple R-squared: 0.741, Adjusted R-squared: 0.7403
## F-statistic: 1187 on 6 and 2490 DF, p-value: < 2.2e-16
L’interazione Gestazione/Lunghezza non produce miglioramenti nel modello.
##
## Call:
## lm(formula = Peso ~ Gestazione + Cranio + Sesso + poly(Lunghezza,
## 2) + Lunghezza + Cranio:Lunghezza)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1160.4 -182.1 -13.3 165.6 1368.8
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.729e+03 1.996e+02 -8.661 < 2e-16 ***
## Gestazione 3.680e+01 3.883e+00 9.479 < 2e-16 ***
## Cranio -2.118e+00 6.475e+00 -0.327 0.7436
## SessoM 7.276e+01 1.095e+01 6.647 3.67e-11 ***
## poly(Lunghezza, 2)1 2.896e+03 5.574e+03 0.520 0.6034
## poly(Lunghezza, 2)2 9.257e+02 5.757e+02 1.608 0.1079
## Lunghezza NA NA NA NA
## Cranio:Lunghezza 2.530e-02 1.317e-02 1.921 0.0548 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.3 on 2490 degrees of freedom
## Multiple R-squared: 0.7412, Adjusted R-squared: 0.7406
## F-statistic: 1188 on 6 and 2490 DF, p-value: < 2.2e-16
L’interazione Cranio/Lunghezza non produce miglioramenti nel modello.
##
## Call:
## lm(formula = Peso ~ Gestazione + Cranio + Sesso + poly(Lunghezza,
## 2) + Lunghezza + Sesso:Lunghezza)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1160.65 -182.62 -12.86 166.26 1294.38
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1677.7177 197.8126 -8.481 < 2e-16 ***
## Gestazione 36.4897 3.8819 9.400 < 2e-16 ***
## Cranio 10.3025 0.4192 24.579 < 2e-16 ***
## SessoM 190.9612 213.5338 0.894 0.371
## poly(Lunghezza, 2)1 13706.0909 462.9878 29.604 < 2e-16 ***
## poly(Lunghezza, 2)2 1921.2943 289.8662 6.628 4.15e-11 ***
## Lunghezza NA NA NA NA
## SessoM:Lunghezza -0.2371 0.4308 -0.550 0.582
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.5 on 2490 degrees of freedom
## Multiple R-squared: 0.7408, Adjusted R-squared: 0.7402
## F-statistic: 1186 on 6 and 2490 DF, p-value: < 2.2e-16
Anche l’interazione Sesso/Lunghezza non produce miglioramenti nel modello.
Criteri di informazione di Akaike (AIC) e Bayes (BIC) per confronto dei modelli: utilizziamo i criteri AIC e BIC di confronto tra i modelli per vedere quale sia il più efficiente, e il modello VIF
| df | AIC | |
|---|---|---|
| mod1 | 9 | 35043.32 |
| mod2 | 7 | 35040.64 |
| mod3 | 6 | 35048.18 |
| mod4 | 7 | 35006.12 |
| mod5 | 8 | 35002.43 |
| mod6 | 8 | 35007.82 |
| df | BIC | |
|---|---|---|
| mod1 | 9 | 35095.73 |
| mod2 | 7 | 35081.40 |
| mod3 | 6 | 35083.12 |
| mod4 | 7 | 35046.88 |
| mod5 | 8 | 35049.01 |
| mod6 | 8 | 35054.40 |
| GVIF | Df | GVIF^(1/(2*Df)) | |
|---|---|---|---|
| Gestazione | 1.835138 | 1 | 1.354672 |
| Cranio | 1.650092 | 1 | 1.284559 |
| Sesso | 1.044984 | 1 | 1.022245 |
| poly(Lunghezza, 2) | 2.391268 | 2 | 1.243532 |
Il mod4 sembra essere il più efficace in entrambi i criteri di verifica e i valori del test vif non mostrano problemi di collinearità avendo tutti valori inferiori a 5.
## Start: AIC=28001.73
## Peso ~ Anni.madre + N.gravidanze + Gestazione + Fumatrici + Lunghezza +
## Cranio + Sesso
##
## Df Sum of Sq RSS AIC
## - Anni.madre 1 20903 180645287 27994
## - Fumatrici 1 73977 180698361 27995
## - N.gravidanze 1 534941 181159325 28001
## <none> 180624384 28002
## - Sesso 1 3674222 184298606 28044
## - Gestazione 1 4632038 185256422 28057
## - Cranio 1 39743276 220367660 28491
## - Lunghezza 1 93986157 274610541 29040
##
## Step: AIC=27994.19
## Peso ~ N.gravidanze + Gestazione + Fumatrici + Lunghezza + Cranio +
## Sesso
##
## Df Sum of Sq RSS AIC
## - Fumatrici 1 74619 180719906 27987
## <none> 180645287 27994
## - N.gravidanze 1 712872 181358159 27996
## + Anni.madre 1 20903 180624384 28002
## - Sesso 1 3679797 184325084 28037
## - Gestazione 1 4617826 185263113 28049
## - Cranio 1 39918188 220563475 28485
## - Lunghezza 1 93992253 274637540 29032
##
## Step: AIC=27987.4
## Peso ~ N.gravidanze + Gestazione + Lunghezza + Cranio + Sesso
##
## Df Sum of Sq RSS AIC
## <none> 180719906 27987
## - N.gravidanze 1 691520 181411426 27989
## + Fumatrici 1 74619 180645287 27994
## + Anni.madre 1 21545 180698361 27995
## - Sesso 1 3665488 184385394 28030
## - Gestazione 1 4562528 185282434 28042
## - Cranio 1 39945921 220665827 28478
## - Lunghezza 1 94424525 275144431 29029
##
## Call:
## lm(formula = Peso ~ N.gravidanze + Gestazione + Lunghezza + Cranio +
## Sesso)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1165.68 -179.74 -12.42 162.92 1410.68
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6683.8326 133.1602 -50.194 < 2e-16 ***
## N.gravidanze 13.1448 4.2576 3.087 0.00204 **
## Gestazione 29.6341 3.7369 7.930 3.27e-15 ***
## Lunghezza 10.8899 0.3019 36.077 < 2e-16 ***
## Cranio 9.9192 0.4227 23.465 < 2e-16 ***
## SessoM 78.1376 10.9929 7.108 1.53e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 269.3 on 2491 degrees of freedom
## Multiple R-squared: 0.7372, Adjusted R-squared: 0.7367
## F-statistic: 1398 on 5 and 2491 DF, p-value: < 2.2e-16
| df | AIC | |
|---|---|---|
| mod4 | 7 | 35006.12 |
| stepwise.MOD | 7 | 35040.64 |
| df | BIC | |
|---|---|---|
| mod4 | 7 | 35046.88 |
| stepwise.MOD | 7 | 35081.40 |
Selezione del modello Visto che in entrambi i test il valore più basso è legato al modello costruito manualmente con la procedura stepwise, confermiamo la selezione del modello 4 come migliore per descrivere il comportamento della variabile peso in relazione alle altre del nostro campione. mod4 ha come variabili correlate Gestazione, Cranio, Sesso e un polinomio di secondo grado della variabile Lunghezza.
##
## Call:
## lm(formula = Peso ~ Gestazione + Cranio + Sesso + poly(Lunghezza,
## 2))
##
## Residuals:
## Min 1Q Median 3Q Max
## -1163.66 -182.74 -12.38 164.68 1307.78
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1673.8583 197.6607 -8.468 < 2e-16 ***
## Gestazione 36.4395 3.8803 9.391 < 2e-16 ***
## Cranio 10.2953 0.4189 24.577 < 2e-16 ***
## SessoM 73.5847 10.9444 6.723 2.19e-11 ***
## poly(Lunghezza, 2)1 13576.7873 398.9042 34.035 < 2e-16 ***
## poly(Lunghezza, 2)2 1888.3743 283.5889 6.659 3.38e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 267.5 on 2491 degrees of freedom
## Multiple R-squared: 0.7408, Adjusted R-squared: 0.7403
## F-statistic: 1424 on 5 and 2491 DF, p-value: < 2.2e-16
Per valutare la bontà del modello possiamo controllare i valori di R^2, R^2 aggiustato e del Root Mean Square Error. Calcoliamo RMSE
data.frame <- dati
prediction <- predict(mod4, newdata = dati)
RMSE = sqrt(mean((dati$Peso-prediction)^2))
round(RMSE,4)
## [1] 267.1725
I valori di R^2 indicano che il modello descrive con una bontà del 74.03% l’andamento dei dati, mentre l’RMSE ci dice che l’errore medio tra predizione del modello e dati misurati sulla variabile peso è di circa 267 g (su un valore medio di Peso di 3283 g).
Parte erratica del modello Ricordiamo che dai dati iniziali abbiamo già eliminato 3 misurazioni: due per età errata della madre (0 e 2 anni), e una per una valutazione anomala del rapporto peso lunghezza
Proseguo valutando i residui del modello:
Verifichiamo queste osservazioni anche in maniera più dettagliata
Valori di leva
lev <-hatvalues(mod4)
plot(lev, pch = 20, col = "LightBlue")
p = sum(lev)
soglia = 2*p/nrow(dati)
abline(h = soglia, col = "Red")
length(lev[lev>soglia])
## [1] 137
Sono state osservate 137 osservazioni sopra il valore di soglia.
Valori outliers
plot(rstudent(mod4), pch = 20, col = "LightBlue")
abline(h = c(-2,2), col = "Red")
outlierTest(mod4)
## rstudent unadjusted p-value Bonferroni p
## 155 4.934357 8.5724e-07 0.0021405
## 1305 4.864857 1.2169e-06 0.0030385
## 1397 -4.370966 1.2877e-05 0.0321550
## 1691 4.331301 1.5410e-05 0.0384790
Nonostante il numero di outliers sia superiore, con il test t e la correzione di Bonferroni sono stati evidenziati solamente 4 osservazioni molto distanti dai valori di soglia.
Possiamo considerare Outliers e Leverage in contemporanea valutando la distanza di Cook:
cook <- cooks.distance(mod4)
plot(cook, pch = 20, col = "LightBlue")
max(cook)
## [1] 0.06576053
Il massimo della distanza di Cook è di 0.06, molto al di sotto della soglia di allarme di 0.5, per cui valutiamo che le misure estreme non siano realmente così influenti nella valutazione dei residui.
In ultimo facciamo i test di Breusch-Pagan e di Durbin-Watson per la omoschedasticità e la autocorrelazione.
bptest(mod4)
##
## studentized Breusch-Pagan test
##
## data: mod4
## BP = 13.578, df = 5, p-value = 0.01853
dwtest(mod4)
##
## Durbin-Watson test
##
## data: mod4
## DW = 1.9519, p-value = 0.1145
## alternative hypothesis: true autocorrelation is greater than 0
shapiro.test(residuals(mod4))
##
## Shapiro-Wilk normality test
##
## data: residuals(mod4)
## W = 0.98968, p-value = 1.982e-12
Risultati dei test:
Il modello 4 risulta in definitiva un modello abbastanza affidabile anche se con alcune imprecisioni le cui cause si possono studiare più approfonditamente. Va osservato che nel modello le variabili più rilevanti nella previsione del peso neonatale sono quelle antropometiche (Lunghezza, dimensione del cranio) più il sesso del bambino;solamente le settimane di gestazione sono misurabili senza una osservazione ecografica del feto. In più evidenziamo come le variabili legate alla madre (Fumatrice e gravidanze precedenti) risultino poco influenti, e quindi escluse dal modello, nella previsione del peso. Come ci si poteva aspettare in ultimo le variabili legate a questioni esterne alla crescita del feto come la scelta dell’ospedale o le metodologie mediche per il parto non hanno influenza sul peso.
Utilizziamo il modello selezionato per effettuare delle previsioni di peso.
Previsione 1
Valutiamo la previsione del peso di una neonata considerando una madre alla terza gravidanza che partorirà alla 39esima settimana.
Estraiamo i valori dai dati complessivi che verificano queste caratteristiche e ne tabuliamo alcuni valori di posizione come confronto con quello che il modello predirrà:
filtro <- dati[N.gravidanze == 3 & Gestazione == 39 & Sesso == "F", ]
filtro_tab <- filtro %>%
summarize(
peso_medio = round(mean(Peso),2),
peso_mediano = round(median(Peso),2),
peso_min = round(min(Peso),2),
peso_max = round(max(Peso),2)
)
| peso_medio | peso_mediano | peso_min | peso_max |
|---|---|---|---|
| 3248.82 | 3250 | 2680 | 3880 |
Previsione modello
test1 <- data.frame(N.gravidanze = 3, Gestazione = 39, Lunghezza = mean(Lunghezza), Cranio = mean(Cranio), Sesso = "F")
predict(mod4, newdata = test1)
## 1
## 3232.285
Il modello ci da un previsione di 3232 g circa per il peso di una neonata Femmina alla 39esima settimana, terza gravidanza della madre.
Previsione 2
Facciamo una previsione partendo da una misurazione che contenga tutte le variabili del nostro modello:
Non ci sono dati nel dataset iniziale che verifichino queste quattro condizioni.
Previsione modello
test1 <- data.frame(Gestazione = 27, Lunghezza = 510, Cranio = 348, Sesso = "M")
predict(mod4, newdata = test1)
## 1
## 3127.825
La previsione del modello è di 3127g per un neonato maschio alla 27esima settimana, con dimensioni antropometriche 510mm lunghezza e 348mm dimensione del cranio.
Utilizziamo rappresentazioni grafiche per mettere in evidenza il comportamento del modello e alcune dipendenze sostanziali tra variabili.
I due scatterplot 3D sono utili per vedere graficamente la dipendenza
del peso dalle variabili che abbiamo evidenziato come più influenti nel
modello sviluppato.
## `geom_smooth()` using formula = 'y ~ x'
Il grafico mette in evidenza l’aumento di peso neonatale al crescere
delle settimane di gestazione. L’aspetto da evidenziare è la differente
inclinazione legata alla variabile Fumatrice, che mostra un aumento di
peso meno marcato per il campione di madri Fumatrici. Il dato può essere
interessante, anche se nel nostro modello abbiamo evidenzziato come sia
marginale. Inoltre il campione di madri fumatrici rappresenta il 4.16%
del totale delle misurazioni, quindi un numero piccolo che può essere
insufficiente per evidenziare in maniera esaustiva un differente
andamento tra Fumatrici e non Fumatrici. Infatti nella tabulazione del
Modello1 (modello iniziale che conteneva tutte le variabili) il p-value
associato alla variabili Fumatrici era di 0.31, confermando il fatto che
l’effetto che si può vedere non può essere considerato statisticamente
significativo.
## `geom_smooth()` using formula = 'y ~ x'
Il grafico moette in evidenza la differenza di peso tra maschi e femmine
al crescere del tempo di gestazione. E’ subito evidente come le due
linee di plot abbiano la stessa pendenza, ma intercette e valori più
alti per i maschi. La differenza di andamento è quella che ci ha portato
ad inserire la variabile Sesso come siginificativa nel modello.
## `geom_smooth()` using formula = 'y ~ x'
Nel modello abbiamo incluso la varibile Lunghezza come polinomio
quadratico. Il grafico mostra proprio l’andamento del Peso in funzione
dalla Lunghezza al quadrato e la retta di plot in rosso conferma
graficamente il legame tra queste due grandezze.
I due grafici precedenti mostrano l’andamento del Peso in funzione
dell’Età della madre e del Numero di gravidanze. Sono due variabili che
non abbiamo incluso nel modello come variabili significative nella
valutazione del Peso; i due scatter plot non mostrano dipendenze
evidenti e quindi confermano la valutazione del modello.
L’ultimo grafico mette a confronto le previsioni di peso estratte dal
modello con quelle misurate nel database. Si può vedere il buon accordo
del modello, soprattutto per le misurazioni di peso attorno al valore
medio. Si può vedere forse una leggera sottostima del modello rispetto
ai dati misurati per valori di peso molto alti.
Il modello costruito si presta ad essere un buon modello per descrivere il comportamento del peso neonatale soprattutto per i valori centrali della crescita del neonato. Durante l’analisi preliminare abbiamo verificato come le tecniche ospedaliere dei tre siti in analisi siano già abbastanza omologate, aspetto fondamentale per poter studiare bene i dati e poter implementare metodologie comuni di lavoro. Sempre all’interno dell’analisi preliminare abbiamo valutato la differenza delle misure antropometriche del neonato tra i due sessi. Proprio le variabili antropometriche sono quelle che abbiamo determinato essere significative per lo sviluppo del modello. Nel modello infatti abbiamo selezionato Lunghezza, dimensione del Cranio, Sesso e settimane di Gestazione. Attreverso queste variabili il modello ha una variabilità spiegata del 74%. Lo sviluppo del modello aveva come scopo il miglioramento delle delle previsioni cliniche ospedaliere in modo da poter evidenziare anomalie e fattori di rischio, e proprio grazie ad una capacità di predizione buona per neonati in salute il modello può aiutarci (abbiamo eliminato nella verifica iniziale dei dati tre valori che mostravano misurazioni anomale, probabilemente date da errori di inserimento o anomalie nei neonati). Per valutare nel dettaglio l’effetto e la provenienza di eventuali anomalie rispetto al modello atteso servirebbe fare una anlisi specifica delle variazioni introdotte nel modello dalle variabili escluse, che pur non avendo effetti significativi nella stima del peso possono essere utili per determinare eventuali variazioni non sostanziali al peso e quindi alla salute del neonato.