Modello_neonatale
Filo
2025-01-19
Carico il dataset dei neonati dal percorso specificato
neonati <- read.csv("/Users/filomena/Desktop/1 esercizio con r/neonati.csv")# Installazione e caricamento dei pacchetti necessari
necessary_packages <- c(
"ggplot2", "broom", "caret", "dplyr", "corrplot", "tidyr", "MASS", "mgcv", "lattice", "car"
)
installed_packages <- rownames(installed.packages())
for (pkg in necessary_packages) {
if (!pkg %in% installed_packages) {
install.packages(pkg, dependencies = TRUE)
}
}
lapply(necessary_packages, library, character.only = TRUE)## Loading required package: lattice##
## 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## corrplot 0.95 loaded##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## select## Loading required package: nlme##
## Attaching package: 'nlme'## The following object is masked from 'package:dplyr':
##
## collapse## This is mgcv 1.9-1. For overview type 'help("mgcv-package")'.## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recode## [[1]]
## [1] "ggplot2" "stats" "graphics" "grDevices" "utils" "datasets"
## [7] "methods" "base"
##
## [[2]]
## [1] "broom" "ggplot2" "stats" "graphics" "grDevices" "utils"
## [7] "datasets" "methods" "base"
##
## [[3]]
## [1] "caret" "lattice" "broom" "ggplot2" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
##
## [[4]]
## [1] "dplyr" "caret" "lattice" "broom" "ggplot2" "stats"
## [7] "graphics" "grDevices" "utils" "datasets" "methods" "base"
##
## [[5]]
## [1] "corrplot" "dplyr" "caret" "lattice" "broom" "ggplot2"
## [7] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [13] "base"
##
## [[6]]
## [1] "tidyr" "corrplot" "dplyr" "caret" "lattice" "broom"
## [7] "ggplot2" "stats" "graphics" "grDevices" "utils" "datasets"
## [13] "methods" "base"
##
## [[7]]
## [1] "MASS" "tidyr" "corrplot" "dplyr" "caret" "lattice"
## [7] "broom" "ggplot2" "stats" "graphics" "grDevices" "utils"
## [13] "datasets" "methods" "base"
##
## [[8]]
## [1] "mgcv" "nlme" "MASS" "tidyr" "corrplot" "dplyr"
## [7] "caret" "lattice" "broom" "ggplot2" "stats" "graphics"
## [13] "grDevices" "utils" "datasets" "methods" "base"
##
## [[9]]
## [1] "mgcv" "nlme" "MASS" "tidyr" "corrplot" "dplyr"
## [7] "caret" "lattice" "broom" "ggplot2" "stats" "graphics"
## [13] "grDevices" "utils" "datasets" "methods" "base"
##
## [[10]]
## [1] "car" "carData" "mgcv" "nlme" "MASS" "tidyr"
## [7] "corrplot" "dplyr" "caret" "lattice" "broom" "ggplot2"
## [13] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [19] "base"# --- SEZIONE 1: Esplorazione dei dati ---
# Controllo struttura, sommario e valori mancanti
str(neonati)## 'data.frame': 2500 obs. of 10 variables:
## $ Annimadre : int 26 21 34 28 20 32 26 25 22 23 ...
## $ Ngravidanze: 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 ...
## $ Tipoparto : chr "Nat" "Nat" "Nat" "Nat" ...
## $ Ospedale : chr "osp3" "osp1" "osp2" "osp2" ...
## $ Sesso : chr "M" "F" "M" "M" ...summary(neonati)## Annimadre Ngravidanze Fumatrici Gestazione
## Min. : 0.00 Min. : 0.0000 Min. :0.0000 Min. :25.00
## 1st Qu.:25.00 1st Qu.: 0.0000 1st Qu.:0.0000 1st Qu.:38.00
## Median :28.00 Median : 1.0000 Median :0.0000 Median :39.00
## Mean :28.16 Mean : 0.9812 Mean :0.0416 Mean :38.98
## 3rd Qu.:32.00 3rd Qu.: 1.0000 3rd Qu.:0.0000 3rd Qu.:40.00
## Max. :46.00 Max. :12.0000 Max. :1.0000 Max. :43.00
## Peso Lunghezza Cranio Tipoparto
## Min. : 830 Min. :310.0 Min. :235 Length:2500
## 1st Qu.:2990 1st Qu.:480.0 1st Qu.:330 Class :character
## Median :3300 Median :500.0 Median :340 Mode :character
## Mean :3284 Mean :494.7 Mean :340
## 3rd Qu.:3620 3rd Qu.:510.0 3rd Qu.:350
## Max. :4930 Max. :565.0 Max. :390
## Ospedale Sesso
## Length:2500 Length:2500
## Class :character Class :character
## Mode :character Mode :character
##
##
## names(neonati)## [1] "Annimadre" "Ngravidanze" "Fumatrici" "Gestazione" "Peso"
## [6] "Lunghezza" "Cranio" "Tipoparto" "Ospedale" "Sesso"cat("Valori mancanti per colonna:")## Valori mancanti per colonna:print(colSums(is.na(neonati)))## Annimadre Ngravidanze Fumatrici Gestazione Peso Lunghezza
## 0 0 0 0 0 0
## Cranio Tipoparto Ospedale Sesso
## 0 0 0 0# Gestione dei dati mancanti
if (any(is.na(neonati))) {
cat("\nSono presenti valori mancanti. Rimuoviamo le righe con NA.\n")
neonati <- na.omit(neonati)
}# Conferma del numero di osservazioni
cat("Numero totale di osservazioni nel dataset:", nrow(neonati), "\n")## Numero totale di osservazioni nel dataset: 2500# Statistiche descrittive per variabili numeriche
numerical_vars <- c("Annimadre", "Ngravidanze", "Gestazione", "Peso", "Lunghezza", "Cranio")
cat("Statistiche descrittive per variabili numeriche:\n")## Statistiche descrittive per variabili numeriche:print(summary(neonati[, numerical_vars]))## Annimadre Ngravidanze Gestazione Peso
## Min. : 0.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.16 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# Identificazione degli outlier
cat("\nIdentificazione degli outlier per variabili numeriche:\n")##
## Identificazione degli outlier per variabili numeriche:for (var in numerical_vars) {
Q1 <- quantile(neonati[[var]], 0.25, na.rm = TRUE)
Q3 <- quantile(neonati[[var]], 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR
upper_bound <- Q3 + 1.5 * IQR
outliers <- sum(neonati[[var]] < lower_bound | neonati[[var]] > upper_bound, na.rm = TRUE)
cat(paste("Variabile:", var, "- Numero di outlier:", outliers, "\n"))
}## Variabile: Annimadre - Numero di outlier: 13
## Variabile: Ngravidanze - Numero di outlier: 246
## Variabile: Gestazione - Numero di outlier: 67
## Variabile: Peso - Numero di outlier: 69
## Variabile: Lunghezza - Numero di outlier: 59
## Variabile: Cranio - Numero di outlier: 48 # Frequenze per variabili categoriche
cat("\nFrequenze per variabili categoriche:\n")##
## Frequenze per variabili categoriche:cat("Fumatrici:\n")## Fumatrici:print(prop.table(table(neonati$Fumatrici)) * 100)##
## 0 1
## 95.84 4.16cat("\nTipoparto:\n")##
## Tipoparto:print(prop.table(table(neonati$Tipoparto)) * 100)##
## Ces Nat
## 29.12 70.88cat("\nOspedale:\n")##
## Ospedale:print(prop.table(table(neonati$Ospedale)) * 100)##
## osp1 osp2 osp3
## 32.64 33.96 33.40cat("\nSesso:\n")##
## Sesso:print(prop.table(table(neonati$Sesso)) * 100)##
## F M
## 50.24 49.76# Visualizzazioni preliminari
# Distribuzione Peso e Lunghezza
ggplot(neonati, aes(x = Peso)) +
geom_histogram(binwidth = 100, fill = "lightblue", color = "black") +
labs(title = "Distribuzione del Peso", x = "Peso (g)", y = "Frequenza") +
theme_minimal()
ggplot(neonati, aes(x = Lunghezza)) +
geom_histogram(binwidth = 1, fill = "lightgreen", color = "black") +
labs(title = "Distribuzione della Lunghezza", x = "Lunghezza (cm)", y = "Frequenza") +
theme_minimal()
# Boxplot Peso per Sesso
ggplot(neonati, aes(x = Sesso, y = Peso, fill = Sesso)) +
geom_boxplot() +
labs(title = "Boxplot del Peso per Sesso", x = "Sesso", y = "Peso (g)") +
theme_minimal()
# Distribuzione del Peso per Ospedale e Sesso
ggplot(neonati, aes(x = Ospedale, y = Peso, fill = Sesso)) +
geom_boxplot() +
labs(title = "Distribuzione del Peso per Ospedale e Sesso", x = "Ospedale", y = "Peso (g)") +
theme_minimal()
# Distribuzione della Gestazione per Ospedale
ggplot(neonati, aes(x = Ospedale, y = Gestazione, fill = Ospedale)) +
geom_boxplot() +
labs(title = "Distribuzione della Gestazione per Ospedale", x = "Ospedale", y = "Settimane di Gestazione") +
theme_minimal()
# Distribuzione del Peso in base a Fumatrici
ggplot(neonati, aes(x = Fumatrici, y = Peso, fill = Fumatrici)) +
geom_boxplot() +
labs(title = "Peso del Neonato in base a Fumatrici", x = "Fumatrici (0 = No, 1 = Sì)", y = "Peso (g)") +
theme_minimal()## Warning: Continuous x aesthetic
## ℹ did you forget `aes(group = ...)`?## Warning: The following aesthetics were dropped during statistical transformation: fill.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
# Matrice di correlazione
cor_matrix <- cor(neonati[, numerical_vars], use = "complete.obs", method = "pearson")
corrplot(cor_matrix, method = "color", addCoef.col = "black", tl.cex = 0.8, number.cex = 0.7, main = "Matrice di Correlazione")
# --- SEZIONE 2: Test delle ipotesi ---
# Ipotesi 1: Differenze nella proporzione di parti cesarei tra ospedali
cat("\nTest Chi-quadrato per proporzione di parti cesarei:\n")##
## Test Chi-quadrato per proporzione di parti cesarei:table_ospedale_parto <- table(neonati$Ospedale, neonati$Tipoparto)
test_chi <- chisq.test(table_ospedale_parto)
print(test_chi)##
## Pearson's Chi-squared test
##
## data: table_ospedale_parto
## X-squared = 1.0972, df = 2, p-value = 0.5778#Il test chi-quadrato non evidenzia una differenza significativa nei tassi di parto cesareo tra gli ospedali (𝑝=0.5778 p=0.5778). # Ipotesi 2: Confronto della media di Peso e Lunghezza con valori noti
cat("\nTest t per confronto con valori noti:\n")##
## Test t per confronto con valori noti:t_test_peso <- t.test(neonati$Peso, mu = 3200)
t_test_lung <- t.test(neonati$Lunghezza, mu = 50)
print(t_test_peso)##
## One Sample t-test
##
## data: neonati$Peso
## t = 8.0071, df = 2499, p-value = 1.782e-15
## alternative hypothesis: true mean is not equal to 3200
## 95 percent confidence interval:
## 3263.490 3304.672
## sample estimates:
## mean of x
## 3284.081print(t_test_lung)##
## One Sample t-test
##
## data: neonati$Lunghezza
## t = 844.82, df = 2499, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 50
## 95 percent confidence interval:
## 493.6598 495.7242
## sample estimates:
## mean of x
## 494.692#Il test 𝑡t per il Peso mostra una differenza significativa rispetto alla media attesa di 3200 g (𝑝<2.2𝑒−16
#p<2.2e−16). Si potrebbe esplorare se questa differenza è dovuta a fattori demografici (es. ospedale, età materna) o clinici (es. gravidanze multiple).# Ipotesi 3: Differenze nelle misure antropometriche tra i due sessi
cat("\nTest t per differenze tra i sessi:\n")##
## Test t per differenze tra i sessi:neonati$Sesso <- as.factor(neonati$Sesso)
t_test_sesso_peso <- t.test(Peso ~ Sesso, data = neonati, var.equal = TRUE)
t_test_sesso_lung <- t.test(Lunghezza ~ Sesso, data = neonati, var.equal = TRUE)
t_test_sesso_cranio <- t.test(Cranio ~ Sesso, data = neonati, var.equal = TRUE)
print(t_test_sesso_peso)##
## Two Sample t-test
##
## data: Peso by Sesso
## t = -12.102, df = 2498, 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.1173 -207.0493
## sample estimates:
## mean in group F mean in group M
## 3161.132 3408.215print(t_test_sesso_lung)##
## Two Sample t-test
##
## data: Lunghezza by Sesso
## t = -9.5758, df = 2498, 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.930768 -7.874975
## sample estimates:
## mean in group F mean in group M
## 489.7643 499.6672print(t_test_sesso_cranio)##
## Two Sample t-test
##
## data: Cranio by Sesso
## t = -7.408, df = 2498, p-value = 1.744e-13
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -6.090285 -3.540898
## sample estimates:
## mean in group F mean in group M
## 337.6330 342.4486#Le differenze significative tra i sessi per Peso ( 𝑝 < 2.2 𝑒 − 16 p<2.2e−16),Lunghezza e Cranio indicano che il sesso è una variabile importante per spiegare il Peso alla nascita.# --- SEZIONE 3: Modellizzazione ---
# Modello di regressione lineare multipla
modello <- lm(Peso ~ Annimadre + Ngravidanze + Fumatrici + Gestazione + Lunghezza + Cranio + Tipoparto + Ospedale + Sesso, data = neonati)
cat("\nRiassunto del modello di regressione:\n")##
## Riassunto del modello di regressione:print(summary(modello))##
## Call:
## lm(formula = Peso ~ Annimadre + Ngravidanze + Fumatrici + Gestazione +
## Lunghezza + Cranio + Tipoparto + Ospedale + Sesso, data = neonati)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1124.40 -181.66 -14.42 160.91 2611.89
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6738.4762 141.3087 -47.686 < 2e-16 ***
## Annimadre 0.8921 1.1323 0.788 0.4308
## Ngravidanze 11.2665 4.6608 2.417 0.0157 *
## Fumatrici -30.1631 27.5386 -1.095 0.2735
## Gestazione 32.5696 3.8187 8.529 < 2e-16 ***
## Lunghezza 10.2945 0.3007 34.236 < 2e-16 ***
## Cranio 10.4707 0.4260 24.578 < 2e-16 ***
## TipopartoNat 29.5254 12.0844 2.443 0.0146 *
## Ospedaleosp2 -11.2095 13.4379 -0.834 0.4043
## Ospedaleosp3 28.0958 13.4957 2.082 0.0375 *
## SessoM 77.5409 11.1776 6.937 5.08e-12 ***
## ---
## 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.2 on 10 and 2489 DF, p-value: < 2.2e-16#La variabile 𝐺 𝑒 𝑠 𝑡 𝑎 𝑧 𝑖 𝑜 𝑛 𝑒 Gestazione è altamente significativa ( 𝑝 < 2 𝑒 − 16 p<2e−16), supportando l'ipotesi che un aumento delle settimane di gestazione contribuisca al Peso alla nascita.# Diagnostica del modello
par(mfrow = c(2, 2))
plot(modello)
#I residui non soddisfano i presupposti di normalità ( 𝑝 < 2.2 𝑒 − 16 p<2.2e−16), suggerendo che potrebbero essere necessari miglioramenti del modello.# Analisi delle interazioni
cat("\nAnalisi delle interazioni nel modello:\n")##
## Analisi delle interazioni nel modello:cat("Test di Shapiro-Wilk per la normalità dei residui:\n")## Test di Shapiro-Wilk per la normalità dei residui:print(shapiro.test(resid(modello)))##
## Shapiro-Wilk normality test
##
## data: resid(modello)
## W = 0.97415, p-value < 2.2e-16cat("Test di Breusch-Pagan per l'omoscedasticità:\n")## Test di Breusch-Pagan per l'omoscedasticità:library(lmtest)## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericprint(bptest(modello))##
## studentized Breusch-Pagan test
##
## data: modello
## BP = 93.437, df = 10, p-value = 1.112e-15#L'omoscedasticità non è rispettata ( 𝑝 < 1.112 𝑒 − 15 p<1.112e−15), suggerendo una possibile trasformazione logaritmica o pesatura dei residui.
#cat("Durbin-Watson Test per l'indipendenza:\n")
print(dwtest(modello))##
## Durbin-Watson test
##
## data: modello
## DW = 1.9524, p-value = 0.117
## alternative hypothesis: true autocorrelation is greater than 0# Visualizzazione degli intervalli di confidenza
library(ggplot2)
coefficients_df <- as.data.frame(confint(modello))
coefficients_df$Coefficient <- rownames(coefficients_df)
coefficients_df$Estimate <- coef(modello)
colnames(coefficients_df) <- c("Lower", "Upper", "Coefficient", "Estimate")ggplot(coefficients_df, aes(x = Coefficient, y = Estimate)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = Lower, ymax = Upper), width = 0.2) +
labs(title = "Intervalli di Confidenza dei Coefficienti", x = "Coefficiente", y = "Stima") +
theme_minimal() +
coord_flip()
# --- SEZIONE 4: Selezione del modello ottimale ---
# Modello completo
full_model <- lm(Peso ~ Annimadre + Ngravidanze + Fumatrici + Gestazione + Lunghezza + Cranio + Tipoparto + Ospedale + Sesso, data = neonati)
# Modello nullo
null_model <- lm(Peso ~ 1, data = neonati)# Selezione stepwise con AIC
stepwise_aic_model <- stepAIC(null_model,
scope = list(lower = null_model, upper = full_model),
direction = "both",
trace = TRUE)## Start: AIC=31318.36
## Peso ~ 1
##
## Df Sum of Sq RSS AIC
## + Lunghezza 1 436531119 252357422 28810
## + Cranio 1 342202051 346686490 29604
## + Gestazione 1 241242027 447646515 30243
## + Sesso 1 38155459 650733082 31178
## <none> 688888542 31318
## + Ospedale 2 936237 687952305 31319
## + Annimadre 1 347826 688540716 31319
## + Fumatrici 1 247260 688641282 31320
## + Tipoparto 1 4250 688884292 31320
## + Ngravidanze 1 3992 688884550 31320
##
## Step: AIC=28809.78
## Peso ~ Lunghezza
##
## Df Sum of Sq RSS AIC
## + Cranio 1 54602868 197754555 28202
## + Gestazione 1 10962918 241394505 28701
## + Sesso 1 5227458 247129965 28759
## + Ngravidanze 1 1762634 250594788 28794
## + Ospedale 2 1191466 251165956 28802
## + Tipoparto 1 841991 251515431 28803
## + Annimadre 1 545046 251812376 28806
## <none> 252357422 28810
## + Fumatrici 1 3978 252353444 28812
## - Lunghezza 1 436531119 688888542 31318
##
## Step: AIC=28202.23
## Peso ~ Lunghezza + Cranio
##
## Df Sum of Sq RSS AIC
## + Gestazione 1 5301087 192453468 28136
## + Sesso 1 3904441 193850113 28154
## + Ospedale 2 910068 196844486 28195
## + Tipoparto 1 467558 197286996 28198
## + Ngravidanze 1 397001 197357554 28199
## <none> 197754555 28202
## + Annimadre 1 54703 197699851 28204
## + Fumatrici 1 9794 197744760 28204
## - Cranio 1 54602868 252357422 28810
## - Lunghezza 1 148931936 346686490 29604
##
## Step: AIC=28136.3
## Peso ~ Lunghezza + Cranio + Gestazione
##
## Df Sum of Sq RSS AIC
## + Sesso 1 3764780 188688687 28089
## + Ngravidanze 1 732630 191720838 28129
## + Ospedale 2 817200 191636268 28130
## + Tipoparto 1 439562 192013906 28133
## + Annimadre 1 299852 192153616 28134
## <none> 192453468 28136
## + Fumatrici 1 53464 192400004 28138
## - Gestazione 1 5301087 197754555 28202
## - Cranio 1 48941037 241394505 28701
## - Lunghezza 1 91893026 284346494 29110
##
## Step: AIC=28088.91
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso
##
## Df Sum of Sq RSS AIC
## + Ngravidanze 1 623141 188065546 28083
## + Ospedale 2 764059 187924629 28083
## + Tipoparto 1 435945 188252743 28085
## + Annimadre 1 256830 188431857 28088
## <none> 188688687 28089
## + Fumatrici 1 68994 188619694 28090
## - Sesso 1 3764780 192453468 28136
## - Gestazione 1 5161426 193850113 28154
## - Cranio 1 47793937 236482624 28651
## - Lunghezza 1 87113576 275802264 29036
##
## Step: AIC=28082.64
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso + Ngravidanze
##
## Df Sum of Sq RSS AIC
## + Ospedale 2 724866 187340680 28077
## + Tipoparto 1 463870 187601677 28078
## <none> 188065546 28083
## + Fumatrici 1 91892 187973654 28083
## + Annimadre 1 54816 188010731 28084
## - Ngravidanze 1 623141 188688687 28089
## - Sesso 1 3655292 191720838 28129
## - Gestazione 1 5464853 193530399 28152
## - Cranio 1 46108583 234174130 28629
## - Lunghezza 1 87632762 275698308 29037
##
## Step: AIC=28076.98
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso + Ngravidanze +
## Ospedale
##
## Df Sum of Sq RSS AIC
## + Tipoparto 1 440684 186899996 28073
## <none> 187340680 28077
## + Fumatrici 1 83359 187257321 28078
## + Annimadre 1 47713 187292968 28078
## - Ospedale 2 724866 188065546 28083
## - Ngravidanze 1 583948 187924629 28083
## - Sesso 1 3607981 190948661 28123
## - Gestazione 1 5365267 192705947 28146
## - Cranio 1 45972226 233312906 28624
## - Lunghezza 1 87951068 275291748 29037
##
## Step: AIC=28073.1
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso + Ngravidanze +
## Ospedale + Tipoparto
##
## Df Sum of Sq RSS AIC
## <none> 186899996 28073
## + Fumatrici 1 90897 186809099 28074
## + Annimadre 1 47456 186852540 28074
## - Tipoparto 1 440684 187340680 28077
## - Ospedale 2 701680 187601677 28078
## - Ngravidanze 1 610840 187510837 28079
## - Sesso 1 3602797 190502794 28119
## - Gestazione 1 5346781 192246777 28142
## - Cranio 1 45632149 232532146 28617
## - Lunghezza 1 88355030 275255027 29039# Selezione stepwise con AIC
stepwise_aic_model <- stepAIC(null_model,
scope = list(lower = null_model, upper = full_model),
direction = "both",
trace = TRUE)## Start: AIC=31318.36
## Peso ~ 1
##
## Df Sum of Sq RSS AIC
## + Lunghezza 1 436531119 252357422 28810
## + Cranio 1 342202051 346686490 29604
## + Gestazione 1 241242027 447646515 30243
## + Sesso 1 38155459 650733082 31178
## <none> 688888542 31318
## + Ospedale 2 936237 687952305 31319
## + Annimadre 1 347826 688540716 31319
## + Fumatrici 1 247260 688641282 31320
## + Tipoparto 1 4250 688884292 31320
## + Ngravidanze 1 3992 688884550 31320
##
## Step: AIC=28809.78
## Peso ~ Lunghezza
##
## Df Sum of Sq RSS AIC
## + Cranio 1 54602868 197754555 28202
## + Gestazione 1 10962918 241394505 28701
## + Sesso 1 5227458 247129965 28759
## + Ngravidanze 1 1762634 250594788 28794
## + Ospedale 2 1191466 251165956 28802
## + Tipoparto 1 841991 251515431 28803
## + Annimadre 1 545046 251812376 28806
## <none> 252357422 28810
## + Fumatrici 1 3978 252353444 28812
## - Lunghezza 1 436531119 688888542 31318
##
## Step: AIC=28202.23
## Peso ~ Lunghezza + Cranio
##
## Df Sum of Sq RSS AIC
## + Gestazione 1 5301087 192453468 28136
## + Sesso 1 3904441 193850113 28154
## + Ospedale 2 910068 196844486 28195
## + Tipoparto 1 467558 197286996 28198
## + Ngravidanze 1 397001 197357554 28199
## <none> 197754555 28202
## + Annimadre 1 54703 197699851 28204
## + Fumatrici 1 9794 197744760 28204
## - Cranio 1 54602868 252357422 28810
## - Lunghezza 1 148931936 346686490 29604
##
## Step: AIC=28136.3
## Peso ~ Lunghezza + Cranio + Gestazione
##
## Df Sum of Sq RSS AIC
## + Sesso 1 3764780 188688687 28089
## + Ngravidanze 1 732630 191720838 28129
## + Ospedale 2 817200 191636268 28130
## + Tipoparto 1 439562 192013906 28133
## + Annimadre 1 299852 192153616 28134
## <none> 192453468 28136
## + Fumatrici 1 53464 192400004 28138
## - Gestazione 1 5301087 197754555 28202
## - Cranio 1 48941037 241394505 28701
## - Lunghezza 1 91893026 284346494 29110
##
## Step: AIC=28088.91
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso
##
## Df Sum of Sq RSS AIC
## + Ngravidanze 1 623141 188065546 28083
## + Ospedale 2 764059 187924629 28083
## + Tipoparto 1 435945 188252743 28085
## + Annimadre 1 256830 188431857 28088
## <none> 188688687 28089
## + Fumatrici 1 68994 188619694 28090
## - Sesso 1 3764780 192453468 28136
## - Gestazione 1 5161426 193850113 28154
## - Cranio 1 47793937 236482624 28651
## - Lunghezza 1 87113576 275802264 29036
##
## Step: AIC=28082.64
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso + Ngravidanze
##
## Df Sum of Sq RSS AIC
## + Ospedale 2 724866 187340680 28077
## + Tipoparto 1 463870 187601677 28078
## <none> 188065546 28083
## + Fumatrici 1 91892 187973654 28083
## + Annimadre 1 54816 188010731 28084
## - Ngravidanze 1 623141 188688687 28089
## - Sesso 1 3655292 191720838 28129
## - Gestazione 1 5464853 193530399 28152
## - Cranio 1 46108583 234174130 28629
## - Lunghezza 1 87632762 275698308 29037
##
## Step: AIC=28076.98
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso + Ngravidanze +
## Ospedale
##
## Df Sum of Sq RSS AIC
## + Tipoparto 1 440684 186899996 28073
## <none> 187340680 28077
## + Fumatrici 1 83359 187257321 28078
## + Annimadre 1 47713 187292968 28078
## - Ospedale 2 724866 188065546 28083
## - Ngravidanze 1 583948 187924629 28083
## - Sesso 1 3607981 190948661 28123
## - Gestazione 1 5365267 192705947 28146
## - Cranio 1 45972226 233312906 28624
## - Lunghezza 1 87951068 275291748 29037
##
## Step: AIC=28073.1
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso + Ngravidanze +
## Ospedale + Tipoparto
##
## Df Sum of Sq RSS AIC
## <none> 186899996 28073
## + Fumatrici 1 90897 186809099 28074
## + Annimadre 1 47456 186852540 28074
## - Tipoparto 1 440684 187340680 28077
## - Ospedale 2 701680 187601677 28078
## - Ngravidanze 1 610840 187510837 28079
## - Sesso 1 3602797 190502794 28119
## - Gestazione 1 5346781 192246777 28142
## - Cranio 1 45632149 232532146 28617
## - Lunghezza 1 88355030 275255027 29039cat("Riassunto del modello ottimale (AIC):\n")## Riassunto del modello ottimale (AIC):print(summary(stepwise_aic_model))##
## Call:
## lm(formula = Peso ~ Lunghezza + Cranio + Gestazione + Sesso +
## Ngravidanze + Ospedale + Tipoparto, data = neonati)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1113.18 -181.16 -16.58 161.01 2620.19
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6707.4293 135.9438 -49.340 < 2e-16 ***
## Lunghezza 10.3086 0.3004 34.316 < 2e-16 ***
## Cranio 10.4922 0.4254 24.661 < 2e-16 ***
## Gestazione 31.9909 3.7896 8.442 < 2e-16 ***
## SessoM 77.4412 11.1756 6.930 5.36e-12 ***
## Ngravidanze 12.3619 4.3325 2.853 0.00436 **
## Ospedaleosp2 -11.0227 13.4363 -0.820 0.41209
## Ospedaleosp3 28.6408 13.4886 2.123 0.03382 *
## TipopartoNat 29.2803 12.0817 2.424 0.01544 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 273.9 on 2491 degrees of freedom
## Multiple R-squared: 0.7287, Adjusted R-squared: 0.7278
## F-statistic: 836.3 on 8 and 2491 DF, p-value: < 2.2e-16# Selezione stepwise con BIC
n <- nrow(neonati)
k_bic <- log(n)
stepwise_bic_model <- stepAIC(null_model,
scope = list(lower = null_model, upper = full_model),
direction = "both",
trace = TRUE,
k = k_bic)## Start: AIC=31324.18
## Peso ~ 1
##
## Df Sum of Sq RSS AIC
## + Lunghezza 1 436531119 252357422 28821
## + Cranio 1 342202051 346686490 29615
## + Gestazione 1 241242027 447646515 30254
## + Sesso 1 38155459 650733082 31190
## <none> 688888542 31324
## + Annimadre 1 347826 688540716 31331
## + Fumatrici 1 247260 688641282 31331
## + Tipoparto 1 4250 688884292 31332
## + Ngravidanze 1 3992 688884550 31332
## + Ospedale 2 936237 687952305 31336
##
## Step: AIC=28821.43
## Peso ~ Lunghezza
##
## Df Sum of Sq RSS AIC
## + Cranio 1 54602868 197754555 28220
## + Gestazione 1 10962918 241394505 28718
## + Sesso 1 5227458 247129965 28777
## + Ngravidanze 1 1762634 250594788 28812
## + Tipoparto 1 841991 251515431 28821
## <none> 252357422 28821
## + Annimadre 1 545046 251812376 28824
## + Ospedale 2 1191466 251165956 28825
## + Fumatrici 1 3978 252353444 28829
## - Lunghezza 1 436531119 688888542 31324
##
## Step: AIC=28219.7
## Peso ~ Lunghezza + Cranio
##
## Df Sum of Sq RSS AIC
## + Gestazione 1 5301087 192453468 28160
## + Sesso 1 3904441 193850113 28178
## <none> 197754555 28220
## + Tipoparto 1 467558 197286996 28222
## + Ngravidanze 1 397001 197357554 28222
## + Ospedale 2 910068 196844486 28224
## + Annimadre 1 54703 197699851 28227
## + Fumatrici 1 9794 197744760 28227
## - Cranio 1 54602868 252357422 28821
## - Lunghezza 1 148931936 346686490 29615
##
## Step: AIC=28159.59
## Peso ~ Lunghezza + Cranio + Gestazione
##
## Df Sum of Sq RSS AIC
## + Sesso 1 3764780 188688687 28118
## + Ngravidanze 1 732630 191720838 28158
## <none> 192453468 28160
## + Tipoparto 1 439562 192013906 28162
## + Annimadre 1 299852 192153616 28164
## + Ospedale 2 817200 191636268 28165
## + Fumatrici 1 53464 192400004 28167
## - Gestazione 1 5301087 197754555 28220
## - Cranio 1 48941037 241394505 28718
## - Lunghezza 1 91893026 284346494 29128
##
## Step: AIC=28118.03
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso
##
## Df Sum of Sq RSS AIC
## + Ngravidanze 1 623141 188065546 28118
## <none> 188688687 28118
## + Tipoparto 1 435945 188252743 28120
## + Annimadre 1 256830 188431857 28122
## + Ospedale 2 764059 187924629 28124
## + Fumatrici 1 68994 188619694 28125
## - Sesso 1 3764780 192453468 28160
## - Gestazione 1 5161426 193850113 28178
## - Cranio 1 47793937 236482624 28675
## - Lunghezza 1 87113576 275802264 29059
##
## Step: AIC=28117.58
## Peso ~ Lunghezza + Cranio + Gestazione + Sesso + Ngravidanze
##
## Df Sum of Sq RSS AIC
## <none> 188065546 28118
## - Ngravidanze 1 623141 188688687 28118
## + Tipoparto 1 463870 187601677 28119
## + Ospedale 2 724866 187340680 28124
## + Fumatrici 1 91892 187973654 28124
## + Annimadre 1 54816 188010731 28125
## - Sesso 1 3655292 191720838 28158
## - Gestazione 1 5464853 193530399 28181
## - Cranio 1 46108583 234174130 28658
## - Lunghezza 1 87632762 275698308 29066cat("Riassunto del modello ottimale (BIC):\n")## Riassunto del modello ottimale (BIC):print(summary(stepwise_bic_model))##
## Call:
## lm(formula = Peso ~ Lunghezza + Cranio + Gestazione + Sesso +
## Ngravidanze, data = neonati)
##
## 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 ***
## Lunghezza 10.2486 0.3006 34.090 < 2e-16 ***
## Cranio 10.5402 0.4262 24.728 < 2e-16 ***
## Gestazione 32.3321 3.7980 8.513 < 2e-16 ***
## SessoM 77.9927 11.2021 6.962 4.26e-12 ***
## Ngravidanze 12.4750 4.3396 2.875 0.00408 **
## ---
## 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# Confronto delle metriche di performance
cat("\nConfronto delle metriche:\n")##
## Confronto delle metriche:cat("AIC - Modello Completo:", AIC(full_model), "\n")## AIC - Modello Completo: 35171.95cat("AIC - Modello Ottimale (Stepwise AIC):", AIC(stepwise_aic_model), "\n")## AIC - Modello Ottimale (Stepwise AIC): 35169.79cat("BIC - Modello Completo:", BIC(full_model), "\n")## BIC - Modello Completo: 35241.84cat("BIC - Modello Ottimale (Stepwise BIC):", BIC(stepwise_bic_model), "\n")## BIC - Modello Ottimale (Stepwise BIC): 35220.1# --- SEZIONE 5: Visualizzazioni ---
# Grafico dell'impatto di Gestazione sul Peso previsto
ggplot(neonati, aes(x = Gestazione, y = Peso)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", formula = y ~ x, color = "blue", se = TRUE) +
labs(title = "Impatto delle Settimane di Gestazione sul Peso", x = "Settimane di Gestazione", y = "Peso (g)") +
theme_minimal()
# Grafico dell'interazione tra Fumatrici e Gestazione
ggplot(neonati, aes(x = Gestazione, y = Peso, color = as.factor(Fumatrici))) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", formula = y ~ x, se = FALSE) +
labs(title = "Impatto combinato di Gestazione e Fumo sul Peso", x = "Settimane di Gestazione", y = "Peso (g)", color = "Fumatrici") +
theme_minimal()
# Boxplot del Peso in base a Fumatrici e Sesso
ggplot(neonati, aes(x = Sesso, y = Peso, fill = as.factor(Fumatrici))) +
geom_boxplot() +
labs(title = "Peso per Sesso e Fumatrici", x = "Sesso", y = "Peso (g)", fill = "Fumatrici") +
theme_minimal()
# --- SEZIONE 6: Conclusioni ---
# Il progetto di previsione del peso neonatale è un'iniziativa fondamentale per Neonatal Health Solutions.
# Attraverso l'uso di dati clinici dettagliati e strumenti di analisi statistica avanzati, abbiamo dimostrato
# che è possibile costruire un modello accurato per stimare il peso neonatale.
# Le analisi hanno evidenziato:
# - L'importanza delle settimane di gestazione come fattore predittivo primario.
# - Un impatto rilevante delle misure antropometriche (lunghezza e cranio) sul peso del neonato.
# - Un'influenza statisticamente significativa, ma limitata, di altre variabili come il numero di gravidanze precedenti.
# Impatto pratico:
# 1. Miglioramento della cura prenatale: il modello consente di identificare neonati a rischio di basso peso alla nascita,
# permettendo interventi precoci.
# 2. Ottimizzazione delle risorse ospedaliere: le previsioni accurate possono supportare una migliore gestione delle unità di terapia intensiva neonatale (TIN).
# 3. Supporto alle politiche sanitarie: l'analisi dei dati può guidare lo sviluppo di strategie per ridurre i fattori di rischio come il fumo materno.
# Questo progetto rappresenta un punto di svolta per l'azienda, consentendo un miglioramento della pratica clinica e l'implementazione
# di politiche sanitarie più informate e proattive.