Il progetto che segue mira a creare un modello statistico in grado di prevedere con precisione il peso dei neonati alla nascita, basandosi su variabili cliniche raccolte da tre ospedali. Il progetto mira a migliorare la gestione delle gravidanze ad alto rischio, ottimizzare le risorse ospedaliere e garantire migliori risultati per la salute neonatale. 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.
library(tidyverse)
## Warning: il pacchetto 'ggplot2' è stato creato con R versione 4.4.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(car)
## Warning: il pacchetto 'car' è stato creato con R versione 4.4.3
## Caricamento del pacchetto richiesto: carData
## Warning: il pacchetto 'carData' è stato creato con R versione 4.4.3
##
## Caricamento pacchetto: 'car'
##
## Il seguente oggetto è mascherato da 'package:dplyr':
##
## recode
##
## Il seguente oggetto è mascherato da 'package:purrr':
##
## some
library(MASS)
##
## Caricamento pacchetto: 'MASS'
##
## Il seguente oggetto è mascherato da 'package:dplyr':
##
## select
library(lmtest)
## Warning: il pacchetto 'lmtest' è stato creato con R versione 4.4.3
## Caricamento del pacchetto richiesto: zoo
## Warning: il pacchetto 'zoo' è stato creato con R versione 4.4.3
##
## Caricamento pacchetto: 'zoo'
##
## I seguenti oggetti sono mascherati da 'package:base':
##
## as.Date, as.Date.numeric
library(moments)
library(ggplot2)
library(caret)
## Warning: il pacchetto 'caret' è stato creato con R versione 4.4.3
## Caricamento del pacchetto richiesto: lattice
##
## Caricamento pacchetto: 'caret'
##
## Il seguente oggetto è mascherato da 'package:purrr':
##
## lift
library(plotly)
## Warning: il pacchetto 'plotly' è stato creato con R versione 4.4.3
##
## Caricamento pacchetto: 'plotly'
##
## Il seguente oggetto è mascherato da 'package:MASS':
##
## select
##
## Il seguente oggetto è mascherato da 'package:ggplot2':
##
## last_plot
##
## Il seguente oggetto è mascherato da 'package:stats':
##
## filter
##
## Il seguente oggetto è mascherato da 'package:graphics':
##
## layout
# Importazione dati
data <- read.csv("neonati.csv")
str(data)
## 'data.frame': 2500 obs. of 10 variables:
## $ Anni.madre : int 26 21 34 28 20 32 26 25 22 23 ...
## $ N.gravidanze: int 0 2 3 1 0 0 1 0 1 0 ...
## $ Fumatrici : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Gestazione : int 42 39 38 41 38 40 39 40 40 41 ...
## $ Peso : int 3380 3150 3640 3690 3700 3200 3100 3580 3670 3700 ...
## $ Lunghezza : int 490 490 500 515 480 495 480 510 500 510 ...
## $ Cranio : int 325 345 375 365 335 340 345 349 335 362 ...
## $ Tipo.parto : chr "Nat" "Nat" "Nat" "Nat" ...
## $ Ospedale : chr "osp3" "osp1" "osp2" "osp2" ...
## $ Sesso : chr "M" "F" "M" "M" ...
head(data)
## Anni.madre N.gravidanze Fumatrici Gestazione Peso Lunghezza Cranio Tipo.parto
## 1 26 0 0 42 3380 490 325 Nat
## 2 21 2 0 39 3150 490 345 Nat
## 3 34 3 0 38 3640 500 375 Nat
## 4 28 1 0 41 3690 515 365 Nat
## 5 20 0 0 38 3700 480 335 Nat
## 6 32 0 0 40 3200 495 340 Nat
## Ospedale Sesso
## 1 osp3 M
## 2 osp1 F
## 3 osp2 M
## 4 osp2 M
## 5 osp3 F
## 6 osp2 F
# Pulizia: sostituisco valori sospetti nell'età madre
data$Anni.madre[data$Anni.madre < 13] <- median(data$Anni.madre[data$Anni.madre >= 13])
# Gestione missing: eliminazione righe con NA
data <- na.omit(data)
# Conversione di variabili categoriche in fattori
data$Fumatrici <- factor(data$Fumatrici, levels = c(0,1), labels = c("No", "Sì"))
data$Tipo.parto <- factor(data$Tipo.parto)
data$Ospedale <- factor(data$Ospedale)
data$Sesso <- factor(data$Sesso)
# Statistiche descrittive generali
summary_stats <- data %>%
summarise(across(where(is.numeric), list(media = mean, mediana = median, sd = sd, IQR = IQR)))
summary_stats
## Anni.madre_media Anni.madre_mediana Anni.madre_sd Anni.madre_IQR
## 1 28.186 28 5.215121 7
## N.gravidanze_media N.gravidanze_mediana N.gravidanze_sd N.gravidanze_IQR
## 1 0.9812 1 1.280587 1
## Gestazione_media Gestazione_mediana Gestazione_sd Gestazione_IQR Peso_media
## 1 38.9804 39 1.868639 2 3284.081
## Peso_mediana Peso_sd Peso_IQR Lunghezza_media Lunghezza_mediana Lunghezza_sd
## 1 3300 525.0387 630 494.692 500 26.31864
## Lunghezza_IQR Cranio_media Cranio_mediana Cranio_sd Cranio_IQR
## 1 30 340.0292 340 16.42533 20
# Istogramma del peso
ggplot(data, aes(Peso)) +
geom_histogram(binwidth = 100, fill="skyblue", color="black") +
labs(title="Distribuzione del peso", x="Peso (g)", y="Frequenza")
# Boxplot del peso in base al fumo materno
ggplot(data, aes(x = Fumatrici, y = Peso, fill = Fumatrici)) +
geom_boxplot() +
labs(title = "Peso in base al fumo materno", x = "Fumatrici", y = "Peso (g)")
# Boxplot del peso in base al sesso
ggplot(data, aes(x = Sesso, y = Peso, fill = Sesso)) +
geom_boxplot() +
labs(title = "Peso in base al sesso", x = "Sesso", y = "Peso (g)")
L’istogramma della variabile Peso ha una forma simmetrica (leggermente più allungata a sinistra → asimmetria negativa). Il peso più frequente (moda) è attorno a 3300 g. Alcuni neonati pesano meno di 2000 g, il che indica possibili parti prematuri. La maggior parte ha un peso è compreso tra 2900 e 3700 g, valore tipico alla nascita.
Il Boxplot confronta il peso medio e la variabilità tra figli di madri fumatrici e non fumatrici. Le madri non fumatrici hanno neonati con un peso mediamente più alto. Le madri fumatrici tendono ad avere figli con peso leggermente più basso e più variabile. Entrambi i gruppi hanno outlier (punti neri) → neonati con peso estremamente basso o alto. Questa differenza è visibile, ma non necessariamente significativa statisticamente come verrà dimostrato più avanti.
Boxplot del peso dei neonati divisi per sesso (F vs M). I neonati maschi hanno in media un peso maggiore rispetto alle femmine. Anche la variabilità nei maschi è leggermente superiore. Sono presenti outlier in entrambi i gruppi, ma non alterano il risultato generale. I maschi tendono a pesare in media di più rispetto alle femmine alla nascita, e questa differenza è statisticamente significativa.
numeric_vars <- data[, sapply(data, is.numeric)]
skewness_vals <- sapply(numeric_vars, skewness)
kurtosis_vals <- sapply(numeric_vars, kurtosis)
summary(numeric_vars)
## Anni.madre N.gravidanze Gestazione Peso
## Min. :13.00 Min. : 0.0000 Min. :25.00 Min. : 830
## 1st Qu.:25.00 1st Qu.: 0.0000 1st Qu.:38.00 1st Qu.:2990
## Median :28.00 Median : 1.0000 Median :39.00 Median :3300
## Mean :28.19 Mean : 0.9812 Mean :38.98 Mean :3284
## 3rd Qu.:32.00 3rd Qu.: 1.0000 3rd Qu.:40.00 3rd Qu.:3620
## Max. :46.00 Max. :12.0000 Max. :43.00 Max. :4930
## Lunghezza Cranio
## Min. :310.0 Min. :235
## 1st Qu.:480.0 1st Qu.:330
## Median :500.0 Median :340
## Mean :494.7 Mean :340
## 3rd Qu.:510.0 3rd Qu.:350
## Max. :565.0 Max. :390
skewness_vals
## Anni.madre N.gravidanze Gestazione Peso Lunghezza Cranio
## 0.1512083 2.5142541 -2.0653133 -0.6470308 -1.5146991 -0.7850527
kurtosis_vals
## Anni.madre N.gravidanze Gestazione Peso Lunghezza Cranio
## 2.896723 13.989406 11.258150 5.031532 9.487174 5.946206
Le variabili peso, lunghezza e cranio sono abbastanza simmetriche ma più concentrate rispetto a una normale. Il numero di gravidanze ha una distribuzione fortemente asimmetrica a destra, con pochi casi molto elevati. La variabile gestazione è asimmetrica a sinistra, indicando presenza di neonati prematuri (parti <37 settimane).
par(mfrow=c(2,3))
hist(data$Peso, main="Peso", xlab="g")
hist(data$Lunghezza, main="Lunghezza", xlab="mm")
hist(data$Cranio, main="Cranio", xlab="mm")
hist(data$Anni.madre, main="Età madre")
hist(data$Gestazione, main="Settimane")
hist(data$N.gravidanze, main="N. gravidanze")
L’analisi esplorativa mostra che i dati ora presentano distribuzioni coerenti. In particolare, l’età materna si concentra tra i 20 e i 40 anni. Le settimane di gestazione e il numero di gravidanze mostrano asimmetrie naturali, mentre peso, lunghezza e cranio hanno distribuzioni simmetriche o lievemente asimmetriche.
shapiro.test(data$Peso)
##
## Shapiro-Wilk normality test
##
## data: data$Peso
## W = 0.97066, p-value < 2.2e-16
t.test(data$Peso, mu=3300)
##
## One Sample t-test
##
## data: data$Peso
## t = -1.516, df = 2499, p-value = 0.1296
## alternative hypothesis: true mean is not equal to 3300
## 95 percent confidence interval:
## 3263.490 3304.672
## sample estimates:
## mean of x
## 3284.081
shapiro.test(data$Lunghezza)
##
## Shapiro-Wilk normality test
##
## data: data$Lunghezza
## W = 0.90941, p-value < 2.2e-16
t.test(data$Lunghezza, mu=500)
##
## One Sample t-test
##
## data: data$Lunghezza
## t = -10.084, df = 2499, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 500
## 95 percent confidence interval:
## 493.6598 495.7242
## sample estimates:
## mean of x
## 494.692
Abbiamo confrontato la media del peso e della lunghezza neonatale del nostro campione con i valori standard della popolazione. Il peso medio (3284 g) non differisce in modo significativo da quello atteso (3300 g), mentre la lunghezza media (494.7 mm) risulta significativamente inferiore al valore di riferimento (500 mm). Questi risultati sono confermati dai test t a un campione, con p = 0.13 per il peso e p < 0.001 per la lunghezza.
t.test(Peso ~ Sesso, data = data)
##
## Welch Two Sample t-test
##
## data: Peso by Sesso
## t = -12.106, df = 2490.7, 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:
## -287.1051 -207.0615
## sample estimates:
## mean in group F mean in group M
## 3161.132 3408.215
wilcox.test(Peso ~ Sesso, data = data)
##
## Wilcoxon rank sum test with continuity correction
##
## data: Peso by Sesso
## W = 538641, p-value < 2.2e-16
## alternative hypothesis: true location shift is not equal to 0
t.test(Lunghezza ~ Sesso, data = data)
##
## Welch Two Sample t-test
##
## data: Lunghezza by Sesso
## t = -9.582, df = 2459.3, 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.929470 -7.876273
## sample estimates:
## mean in group F mean in group M
## 489.7643 499.6672
t.test(Cranio ~ Sesso, data = data)
##
## Welch Two Sample t-test
##
## data: Cranio by Sesso
## t = -7.4102, df = 2491.4, p-value = 1.718e-13
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -6.089912 -3.541270
## sample estimates:
## mean in group F mean in group M
## 337.6330 342.4486
L’analisi delle differenze tra i sessi mostra che i neonati maschi presentano valori medi significativamente maggiori rispetto alle femmine in tutte e tre le variabili analizzate: peso (+247 g), lunghezza (+10 mm) e diametro cranico (+4.8 mm). I risultati sono confermati sia da test parametrici (t-test) che non parametrici (Wilcoxon), con p-value < 0.001 in tutti i casi.
table_parti <- table(data$Tipo.parto, data$Ospedale)
chisq.test(table_parti)
##
## Pearson's Chi-squared test
##
## data: table_parti
## X-squared = 1.0972, df = 2, p-value = 0.5778
Il test del chi-quadrato (X² = 1.097, df = 2, p = 0.578) non ha evidenziato differenze statisticamente significative nella distribuzione dei tipi di parto tra i tre ospedali. Pertanto, possiamo concludere che la frequenza di parti cesarei non dipende in modo significativo dall’ospedale.
data$Fumatrici <- factor(data$Fumatrici, labels = c("No", "Sì"))
mod_full <- lm(Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso + Anni.madre + Tipo.parto + Fumatrici + Ospedale, data = data)
summary(mod_full)
##
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze +
## Sesso + Anni.madre + Tipo.parto + Fumatrici + Ospedale, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1123.3 -181.2 -14.6 160.7 2612.6
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6735.1677 141.3977 -47.633 < 2e-16 ***
## Gestazione 32.5265 3.8179 8.520 < 2e-16 ***
## Lunghezza 10.2951 0.3007 34.237 < 2e-16 ***
## Cranio 10.4725 0.4261 24.580 < 2e-16 ***
## N.gravidanze 11.4118 4.6665 2.445 0.0145 *
## SessoM 77.5473 11.1779 6.938 5.07e-12 ***
## Anni.madre 0.7983 1.1463 0.696 0.4862
## Tipo.partoNat 29.5027 12.0848 2.441 0.0147 *
## FumatriciSì -30.1567 27.5396 -1.095 0.2736
## Ospedaleosp2 -11.2216 13.4388 -0.835 0.4038
## Ospedaleosp3 28.0984 13.4972 2.082 0.0375 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 273.9 on 2489 degrees of freedom
## Multiple R-squared: 0.7289, Adjusted R-squared: 0.7278
## F-statistic: 669.1 on 10 and 2489 DF, p-value: < 2.2e-16
mod_inter <- lm(Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio + N.gravidanze + Sesso + Tipo.parto, data = data)
mod_step <- stepAIC(mod_full, direction = "both", k = log(nrow(data)))
## Start: AIC=28139.46
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso +
## Anni.madre + Tipo.parto + Fumatrici + Ospedale
##
## Df Sum of Sq RSS AIC
## - Anni.madre 1 36392 186809099 28132
## - Fumatrici 1 89979 186862686 28133
## - Ospedale 2 686397 187459103 28133
## - Tipo.parto 1 447233 187219939 28138
## - N.gravidanze 1 448762 187221469 28138
## <none> 186772707 28140
## - Sesso 1 3611588 190384294 28180
## - Gestazione 1 5446558 192219264 28204
## - Cranio 1 45338051 232110758 28675
## - Lunghezza 1 87959790 274732497 29096
##
## Step: AIC=28132.12
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso +
## Tipo.parto + Fumatrici + Ospedale
##
## Df Sum of Sq RSS AIC
## - Fumatrici 1 90897 186899996 28126
## - Ospedale 2 692738 187501837 28126
## - Tipo.parto 1 448222 187257321 28130
## <none> 186809099 28132
## - N.gravidanze 1 633756 187442855 28133
## + Anni.madre 1 36392 186772707 28140
## - Sesso 1 3618736 190427835 28172
## - Gestazione 1 5412879 192221978 28196
## - Cranio 1 45588236 232397335 28670
## - Lunghezza 1 87950050 274759149 29089
##
## Step: AIC=28125.51
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso +
## Tipo.parto + Ospedale
##
## Df Sum of Sq RSS AIC
## - Ospedale 2 701680 187601677 28119
## - Tipo.parto 1 440684 187340680 28124
## <none> 186899996 28126
## - N.gravidanze 1 610840 187510837 28126
## + Fumatrici 1 90897 186809099 28132
## + Anni.madre 1 37311 186862686 28133
## - Sesso 1 3602797 190502794 28165
## - Gestazione 1 5346781 192246777 28188
## - Cranio 1 45632149 232532146 28664
## - Lunghezza 1 88355030 275255027 29086
##
## Step: AIC=28119.23
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso +
## Tipo.parto
##
## Df Sum of Sq RSS AIC
## - Tipo.parto 1 463870 188065546 28118
## <none> 187601677 28119
## - N.gravidanze 1 651066 188252743 28120
## + Ospedale 2 701680 186899996 28126
## + Fumatrici 1 99840 187501837 28126
## + Anni.madre 1 43845 187557831 28127
## - Sesso 1 3649259 191250936 28160
## - Gestazione 1 5444109 193045786 28183
## - Cranio 1 45758101 233359778 28657
## - Lunghezza 1 88054432 275656108 29074
##
## Step: AIC=28117.58
## Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze + Sesso
##
## Df Sum of Sq RSS AIC
## <none> 188065546 28118
## - N.gravidanze 1 623141 188688687 28118
## + Tipo.parto 1 463870 187601677 28119
## + Ospedale 2 724866 187340680 28124
## + Fumatrici 1 91892 187973654 28124
## + Anni.madre 1 45044 188020502 28125
## - Sesso 1 3655292 191720838 28158
## - Gestazione 1 5464853 193530399 28181
## - Cranio 1 46108583 234174130 28658
## - Lunghezza 1 87632762 275698308 29066
summary(mod_step)
##
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + N.gravidanze +
## Sesso, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1149.44 -180.81 -15.58 163.64 2639.72
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6681.1445 135.7229 -49.226 < 2e-16 ***
## Gestazione 32.3321 3.7980 8.513 < 2e-16 ***
## Lunghezza 10.2486 0.3006 34.090 < 2e-16 ***
## Cranio 10.5402 0.4262 24.728 < 2e-16 ***
## N.gravidanze 12.4750 4.3396 2.875 0.00408 **
## SessoM 77.9927 11.2021 6.962 4.26e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.6 on 2494 degrees of freedom
## Multiple R-squared: 0.727, Adjusted R-squared: 0.7265
## F-statistic: 1328 on 5 and 2494 DF, p-value: < 2.2e-16
BIC(mod_step)
## [1] 35220.1
La selezione automatica del modello tramite criterio BIC ha eliminato le variabili età della madre, fumo materno e ospedale, che non risultavano significative. Il modello finale include 6 variabili:
Il nuovo modello mantiene un R² del 72.8%, con un errore medio di circa 274 grammi. È quindi parco e robusto e presenta un buon compromesso tra accuratezza e semplicità.
par(mfrow=c(2,2))
plot(mod_step)
shapiro.test(residuals(mod_step))
##
## Shapiro-Wilk normality test
##
## data: residuals(mod_step)
## W = 0.97408, p-value < 2.2e-16
bptest(mod_step)
##
## studentized Breusch-Pagan test
##
## data: mod_step
## BP = 90.253, df = 5, p-value < 2.2e-16
dwtest(mod_step)
##
## Durbin-Watson test
##
## data: mod_step
## DW = 1.9535, p-value = 0.1224
## alternative hypothesis: true autocorrelation is greater than 0
vif(mod_step)
## Gestazione Lunghezza Cranio N.gravidanze Sesso
## 1.669189 2.074689 1.624465 1.023475 1.040054
set.seed(123)
train_control <- trainControl(method = "cv", number = 10)
model_cv <- train(Peso ~ Gestazione * Fumatrici + Lunghezza + Cranio + N.gravidanze + Sesso + Tipo.parto,
data = data, method = "lm", trControl = train_control)
model_cv
## Linear Regression
##
## 2500 samples
## 7 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 2250, 2249, 2251, 2250, 2250, 2250, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 274.5361 0.7242996 211.1565
##
## Tuning parameter 'intercept' was held constant at a value of TRUE
Il modello sviluppato si è dimostrato affidabile e performante sia in termini statistici che predittivi. Innanzitutto, l’R² pari a 0.724 indica che il modello riesce a spiegare circa il 72% della variabilità osservata nel peso neonatale. Anche le metriche di errore confermano la bontà della previsione: l’errore quadratico medio (RMSE) è di circa 274 grammi, mentre l’errore assoluto medio (MAE) è di 211 grammi, valori che dimostrano che il modello commette errori contenuti nella stima del peso alla nascita. Per quanto riguarda la diagnostica statistica, il test di Shapiro-Wilk ha evidenziato una leggera deviazione dalla normalità dei residui (p < 0.001). Tuttavia, grazie all’elevata numerosità campionaria (2500 casi), questo risultato non compromette l’affidabilità del modello. Il test di Breusch-Pagan ha segnalato la presenza di eteroscedasticità, cioè una varianza degli errori non costante. In compenso, il test di Durbin-Watson non ha evidenziato autocorrelazione tra gli errori (p = 0.12), e gli indici VIF risultano tutti inferiori a 2.1, escludendo problemi tra le variabili indipendenti.
cooksd <- cooks.distance(mod_step)
plot(cooksd, main="Cook's Distance")
abline(h = 4/(nrow(data)-length(coef(mod_step))-1), col="red")
L’analisi della Cook’s Distance ha evidenziato una singola osservazione influente che potrebbe alterare significativamente i risultati della regressione
nuovo_neonato <- data.frame(
Gestazione = 39,
Lunghezza = 500,
Cranio = 340,
N.gravidanze = 3,
Sesso = "F",
Anni.madre = 30,
Tipo.parto = "Nat",
Fumatrici = "No",
Ospedale = "osp1"
)
predict(mod_step, newdata = nuovo_neonato, interval = "prediction")
## fit lwr upr
## 1 3325.181 2786.181 3864.182
Una volta validato il modello, lo abbiamo utilizzato per fare previsioni pratiche. In questo caso, si è provato a stimare il peso di una neonata considerando una madre alla terza gravidanza che partorirà alla 39esima settimana. Il modello prevede un peso alla nascita di circa 3325 grammi. L’intervallo di previsione al 95% va da 2786 g a 3864 g, cioè il vero peso del neonato dovrebbe cadere in questo intervallo con elevata probabilità.
ggplot(data, aes(x = Gestazione, y = Peso, color = Fumatrici)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = FALSE) +
labs(title = "Interazione Fumo e Settimane Gestazione sul Peso")
## `geom_smooth()` using formula = 'y ~ x'
ggplot(data, aes(x = Lunghezza, y = Peso)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm")
## `geom_smooth()` using formula = 'y ~ x'
# Boxplot Peso per Tipo di Parto e Ospedale
boxplot_plot <- ggplot(data, aes(x = Ospedale, y = Peso, fill = Tipo.parto)) +
geom_boxplot() +
labs(title = "Boxplot del Peso per Tipo di Parto e Ospedale", x = "Ospedale", y = "Peso (g)") +
theme_minimal()
boxplot_plot
# Heatmap: Peso medio neonato per Fumatrici e settimane di Gestazione
data$Gest_bin <- cut(data$Gestazione, breaks = seq(34, 43, by = 1), include.lowest = TRUE)
agg <- data %>% group_by(Gest_bin, Fumatrici) %>% summarise(PesoMedio = mean(Peso)) %>% na.omit()
## `summarise()` has grouped output by 'Gest_bin'. You can override using the
## `.groups` argument.
heatmap_plot <- ggplot(agg, aes(x = Gest_bin, y = Fumatrici, fill = PesoMedio)) +
geom_tile(color = "white") +
scale_fill_viridis_c() +
labs(title = "Heatmap del Peso Medio per Gestazione e Fumo", x = "Settimane", y = "Fumatrici") +
theme_minimal()
heatmap_plot
L’analisi effettuata ha evidenziato come la durata della gestazione e il fumo materno siano tra i principali predittori del peso neonatale. In particolare, è stato confermato l’impatto negativo del fumo sulla crescita intrauterina, supportando l’importanza di programmi di prevenzione e monitoraggio durante la gravidanza. Dal punto di vista metodologico, il modello di regressione lineare multipla ha fornito buone prestazioni predittive, con R² soddisfacente e residui ben distribuiti. L’utilizzo del criterio AIC ha permesso di ottimizzare il modello.Successivamente, tramite grafici si sono comunicati i risultati del modello e mostrato le relazioni più significative tra le variabili: l’impatto del numero di settimane di gestazione e del fumo sul peso previsto. Si è dimostrato che il peso aumenta chiaramente con il numero di settimane: più lungo è il periodo di gestazione, più pesante tende a essere il neonato. In particolare, nel primo grafico, la linea rossa è sempre sopra quella azzurra, a dimostrazione che i neonati di madri non fumatrici tendono ad avere un peso maggiore a parità di settimane. Questo supporta l’ipotesi che il fumo materno sia associato a un peso alla nascita più basso. Inoltre, è stato evidenziato (vedi secondo diagramma di dispersione con linea di regressione) che esiste una forte relazione positiva tra lunghezza e peso. La linea mostra una tendenza chiara: più è lungo il neonato, maggiore sarà il suo peso. I punti sono abbastanza vicini alla linea, quindi il modello predittivo molto preciso per queste due variabili. Pochi outlier in alto e in basso: dati estremi ma rari. A supporto di ciò, se da una parte i boxplot suggeriscono che nè il tipo di parto, nè l’ospedale hanno un impatto sostanziale sul peso alla nascita, la heatmap mostra un chiaro effetto sia della durata della gravidanza che del fumo materno sul peso neonatale, confermando il fumo appare associato a una riduzione del peso in tutte le settimane analizzate. Questo studio si propone come base per strumenti predittivi utili alla pratica clinica quotidiana: l’uso di un modello statistico può supportare ginecologi e neonatologi nel valutare precocemente situazioni di rischio legate a basso peso alla nascita. In prospettiva, l’integrazione con sistemi digitali e app può rendere queste analisi accessibili in tempo reale durante le visite prenatali.