Previsione del Peso Neonatale
Analisi statistica e modellizzazione predittiva
Luca Bennardo
26 ottobre 2025
Step 1 – Definizione delle variabili
# ===============================================================
# In questa sezione vengono descritte le principali variabili del dataset, specificandone la natura statistica e il ruolo funzionale all’interno del modello di previsione del peso neonatale.
# ===============================================================
library(dplyr)
library(readr)
library(tibble)
library(knitr)
# Importazione e tipizzazione coerente delle variabili
neonati <- read_csv("neonati.csv", show_col_types = FALSE) %>%
rename_with(~ gsub("\\.", "_", .x)) %>% # sostituisce i punti con underscore
rename(
anni_madre = Anni_madre,
n_gravidanze = N_gravidanze,
fumatrici = Fumatrici,
gestazione = Gestazione,
peso = Peso,
lunghezza = Lunghezza,
cranio = Cranio,
tipo_parto = Tipo_parto,
ospedale = Ospedale,
sesso = Sesso
) %>%
mutate(
ospedale = as.factor(ospedale),
sesso = factor(sesso, levels = c("F", "M")),
tipo_parto = factor(tipo_parto, levels = c("Naturale", "Cesareo")),
fumatrici = factor(fumatrici, levels = c(0, 1),
labels = c("Non fumatrice", "Fumatrice"))
)
# Tabella di metadati (descrizione variabili)
meta <- tibble(
Variabile = c(
"anni_madre",
"n_gravidanze",
"fumatrici",
"gestazione",
"peso",
"lunghezza",
"cranio",
"tipo_parto",
"ospedale",
"sesso"
),
Tipo_statistico = c(
"Quantitativa continua (anni)",
"Quantitativa discreta (conteggio)",
"Qualitativa binaria (Non fumatrice/Fumatrice)",
"Quantitativa continua (settimane di gestazione)",
"Quantitativa continua (grammi)",
"Quantitativa continua (cm)",
"Quantitativa continua (cm)",
"Qualitativa nominale (Naturale/Cesareo)",
"Qualitativa nominale (3 livelli)",
"Qualitativa binaria (F/M)"
),
Ruolo_nel_modello = c(
"Predittore",
"Predittore",
"Predittore chiave (rischio clinico)",
"Predittore principale",
"Variabile dipendente (target)",
"Predittore antropometrico",
"Predittore antropometrico",
"Fattore esplicativo (condizione parto)",
"Effetto strutturale (ospedale)",
"Effetto strutturale (sesso)"
)
)
# Tabella finale formattata
kable(
meta,
booktabs = TRUE,
align = c("l", "l", "l"),
caption = "Definizione e classificazione delle variabili del dataset Neonati"
)
Definizione e classificazione delle variabili del dataset
Neonati
| anni_madre |
Quantitativa continua (anni) |
Predittore |
| n_gravidanze |
Quantitativa discreta (conteggio) |
Predittore |
| fumatrici |
Qualitativa binaria (Non fumatrice/Fumatrice) |
Predittore chiave (rischio clinico) |
| gestazione |
Quantitativa continua (settimane di gestazione) |
Predittore principale |
| peso |
Quantitativa continua (grammi) |
Variabile dipendente (target) |
| lunghezza |
Quantitativa continua (cm) |
Predittore antropometrico |
| cranio |
Quantitativa continua (cm) |
Predittore antropometrico |
| tipo_parto |
Qualitativa nominale (Naturale/Cesareo) |
Fattore esplicativo (condizione parto) |
| ospedale |
Qualitativa nominale (3 livelli) |
Effetto strutturale (ospedale) |
| sesso |
Qualitativa binaria (F/M) |
Effetto strutturale (sesso) |
Step 2 – Analisi descrittiva delle variabili quantitative
# ===============================================================
# In questa sezione vengono analizzati gli indici descrittivi delle variabili quantitative del dataset Neonati.
# Sono calcolate misure di posizione (media, mediana),di dispersione (deviazione standard, varianza) e di forma (asimmetria, curtosi).
# Per ciascuna variabile è fornito un commento sintetico.
# ===============================================================
library(dplyr)
library(purrr)
library(knitr)
library(moments)
library(scales)
library(ggplot2)
# Variabili quantitative coerenti con il modello
num_vars <- c("anni_madre", "n_gravidanze", "gestazione",
"peso", "lunghezza", "cranio")
# ---- Funzione per generare un commento sintetico sulla distribuzione ----
genera_commento <- function(media_val, sd_val, skew_val, kurt_val) {
out <- c()
if (!is.na(sd_val) && !is.na(media_val) && media_val != 0) {
if (sd_val / media_val > 0.5) out <- c(out, "alta dispersione") else out <- c(out, "bassa dispersione")
}
if (!is.na(skew_val)) {
if (skew_val > 0.5) out <- c(out, "asimmetria positiva (coda a destra)")
else if (skew_val < -0.5) out <- c(out, "asimmetria negativa (coda a sinistra)")
else out <- c(out, "distribuzione simmetrica")
}
if (!is.na(kurt_val)) {
if (kurt_val > 3) out <- c(out, "leptocurtica (molto concentrata)")
else if (kurt_val < 3) out <- c(out, "platicurtica (piatta)")
else out <- c(out, "mesocurtica (normale)")
}
paste(out, collapse = ", ")
}
# ---- Calcolo delle statistiche descrittive ----
tabella_step2 <- map_dfr(num_vars, function(v) {
x <- neonati[[v]]
media_val <- mean(x, na.rm = TRUE)
mediana_val <- median(x, na.rm = TRUE)
sd_val <- sd(x, na.rm = TRUE)
var_val <- var(x, na.rm = TRUE)
skew_val <- skewness(x, na.rm = TRUE)
kurt_val <- kurtosis(x, na.rm = TRUE)
tibble(
Variabile = v,
Media = fmt_num(media_val),
Mediana = fmt_num(mediana_val),
Deviazione_standard = fmt_num(sd_val),
Varianza = fmt_num(var_val),
Asimmetria = fmt_num(skew_val),
Curtosi = fmt_num(kurt_val),
Commento = genera_commento(media_val, sd_val, skew_val, kurt_val)
)
})
# ---- Tabella finale formattata ----
kable(
tabella_step2,
booktabs = TRUE,
align = c("l", rep("c", 6), "l"),
caption = "Indici descrittivi per le variabili quantitative del dataset Neonati"
)
Indici descrittivi per le variabili quantitative del dataset
Neonati
| anni_madre |
28,16 |
28,00 |
5,27 |
27,81 |
0,04 |
3,38 |
bassa dispersione, distribuzione simmetrica,
leptocurtica (molto concentrata) |
| n_gravidanze |
0,98 |
1,00 |
1,28 |
1,64 |
2,51 |
13,99 |
alta dispersione, asimmetria positiva (coda a destra),
leptocurtica (molto concentrata) |
| gestazione |
38,98 |
39,00 |
1,87 |
3,49 |
-2,07 |
11,26 |
bassa dispersione, asimmetria negativa (coda a
sinistra), leptocurtica (molto concentrata) |
| peso |
3.284,08 |
3.300,00 |
525,04 |
275.665,68 |
-0,65 |
5,03 |
bassa dispersione, asimmetria negativa (coda a
sinistra), leptocurtica (molto concentrata) |
| lunghezza |
494,69 |
500,00 |
26,32 |
692,67 |
-1,51 |
9,49 |
bassa dispersione, asimmetria negativa (coda a
sinistra), leptocurtica (molto concentrata) |
| cranio |
340,03 |
340,00 |
16,43 |
269,79 |
-0,79 |
5,95 |
bassa dispersione, asimmetria negativa (coda a
sinistra), leptocurtica (molto concentrata) |
# ---- Visualizzazione grafica delle distribuzioni ----
for (v in num_vars) {
g <- ggplot(neonati, aes(x = .data[[v]])) +
geom_histogram(bins = 30, fill = "#56B4E9", color = "white", alpha = 0.8) +
geom_vline(aes(xintercept = mean(.data[[v]], na.rm = TRUE)), color = "red", linetype = "dashed") +
labs(title = paste("Distribuzione di", v),
x = v, y = "Frequenza") +
theme_minimal(base_size = 11)
print(g)
}
# ---- Boxplot sintetico di confronto ----
neonati %>%
select(all_of(num_vars)) %>%
pivot_longer(cols = everything(), names_to = "Variabile", values_to = "Valore") %>%
ggplot(aes(x = Variabile, y = Valore, fill = Variabile)) +
geom_boxplot(alpha = 0.6) +
labs(title = "Boxplot delle variabili quantitative", x = "", y = "Valori osservati") +
theme_minimal(base_size = 11) +
theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "none")
# ---- Commento automatico finale ----
cv_vals <- sapply(num_vars, function(v) sd(neonati[[v]], na.rm = TRUE) / mean(neonati[[v]], na.rm = TRUE))
var_min <- names(which.min(cv_vals))
var_max <- names(which.max(cv_vals))
cat(glue("
Commento sintetico:
La variabile con minore dispersione relativa è {var_min}, mentre quella con maggiore variabilità è {var_max}.
Le distribuzioni risultano in generale coerenti con l’atteso: le variabili antropometriche (peso, lunghezza, cranio) mostrano una dispersione moderata e forme prossime alla normalità.
"))
## Commento sintetico:
## La variabile con minore dispersione relativa è gestazione, mentre quella con maggiore variabilità è n_gravidanze.
## Le distribuzioni risultano in generale coerenti con l’atteso: le variabili antropometriche (peso, lunghezza, cranio) mostrano una dispersione moderata e forme prossime alla normalità.
Step 3 – Analisi della variabilità relativa (Coefficiente di
Variazione)
# ===============================================================
# In questa sezione viene analizzata la variabilità relativa delle variabili quantitative del dataset Neonati.
# Si utilizza il Coefficiente di Variazione (CV), definito come rapporto tra la deviazione standard e la media.
# Un CV elevato indica una dispersione proporzionalmente ampia rispetto alla media della variabile.
# ===============================================================
library(dplyr)
library(purrr)
library(knitr)
library(scales)
library(glue)
# Selezione delle variabili quantitative
num_vars <- c("anni_madre", "n_gravidanze", "gestazione",
"peso", "lunghezza", "cranio")
# ---- Funzione per classificare il livello di variabilità ----
classifica_cv <- function(cv_val) {
if (is.na(cv_val)) return("")
if (cv_val < 0.10) "variabilità molto bassa"
else if (cv_val < 0.25) "variabilità bassa"
else if (cv_val < 0.50) "variabilità moderata"
else "variabilità elevata"
}
# ---- Calcolo del Coefficiente di Variazione (CV) ----
tabella_step3 <- map_dfr(num_vars, function(v) {
x <- neonati[[v]]
media_val <- mean(x, na.rm = TRUE)
sd_val <- sd(x, na.rm = TRUE)
cv_val <- ifelse(media_val != 0, sd_val / media_val, NA_real_)
tibble(
Variabile = v,
Media = fmt_num(media_val),
Deviazione_standard = fmt_num(sd_val),
Coefficiente_variazione = fmt_perc(cv_val),
Interpretazione = classifica_cv(cv_val)
)
})
# ---- Tabella finale formattata ----
kable(
tabella_step3,
booktabs = TRUE,
align = c("l", "c", "c", "c", "l"),
caption = "Analisi della variabilità relativa tramite Coefficiente di Variazione (CV)"
)
Analisi della variabilità relativa tramite Coefficiente di
Variazione (CV)
| anni_madre |
28,16 |
5,27 |
18,72 % |
variabilità bassa |
| n_gravidanze |
0,98 |
1,28 |
130,51 % |
variabilità elevata |
| gestazione |
38,98 |
1,87 |
4,79 % |
variabilità molto bassa |
| peso |
3.284,08 |
525,04 |
15,99 % |
variabilità bassa |
| lunghezza |
494,69 |
26,32 |
5,32 % |
variabilità molto bassa |
| cranio |
340,03 |
16,43 |
4,83 % |
variabilità molto bassa |
# ---- Identificazione automatica delle variabili più e meno variabili ----
cv_vals <- sapply(num_vars, function(v) sd(neonati[[v]], na.rm = TRUE) / mean(neonati[[v]], na.rm = TRUE))
var_min <- names(which.min(cv_vals))
var_max <- names(which.max(cv_vals))
# ---- Commento automatico finale ----
cat(glue("
Commento sintetico:
La variabile con la minore variabilità relativa è {var_min}, indicando una distribuzione più omogenea nel campione.
Al contrario, la variabile {var_max} mostra la maggiore dispersione, suggerendo un’elevata eterogeneità tra i soggetti osservati.
Nel complesso, la variabilità appare coerente con la natura delle misure: le variabili biologiche (peso, lunghezza, cranio) risultano più stabili rispetto a quelle demografiche o comportamentali (età materna, numero di gravidanze).
"))
## Commento sintetico:
## La variabile con la minore variabilità relativa è gestazione, indicando una distribuzione più omogenea nel campione.
## Al contrario, la variabile n_gravidanze mostra la maggiore dispersione, suggerendo un’elevata eterogeneità tra i soggetti osservati.
## Nel complesso, la variabilità appare coerente con la natura delle misure: le variabili biologiche (peso, lunghezza, cranio) risultano più stabili rispetto a quelle demografiche o comportamentali (età materna, numero di gravidanze).
Step 4 – Test di indipendenza e confronto tra gruppi
# ===============================================================
# In questa sezione vengono eseguiti test statistici inferenziali: il Test χ² di indipendenza tra Ospedale e Tipo di Parto e il Test t di confronto tra i sessi per Peso e Lunghezza.
# L’obiettivo è verificare l’esistenza di differenze significative nelle pratiche ospedaliere e nelle caratteristiche antropometriche.
# ===============================================================
library(dplyr)
library(knitr)
library(broom)
library(glue)
# --- 1.Test di indipendenza χ² (Ospedale × Tipo di Parto) ---
tab_contingenza <- table(neonati$ospedale, neonati$tipo_parto)
tab_contingenza <- tab_contingenza[rowSums(tab_contingenza) > 0, colSums(tab_contingenza) > 0]
# Inizializzazione per sicurezza
test_chi <- NULL
chi_warning <- NULL
if (all(tab_contingenza > 0) && nrow(tab_contingenza) > 1 && ncol(tab_contingenza) > 1) {
test_chi <- suppressWarnings(chisq.test(tab_contingenza))
# --- Verifica frequenze attese ---
if (any(test_chi$expected < 5)) {
chi_warning <- "⚠️ Attenzione: alcune frequenze attese sono inferiori a 5; l’affidabilità del test χ² è ridotta."
}
ris_chi <- tidy(test_chi) %>%
mutate(
Test = "χ² indipendenza (Ospedale × Tipo di Parto)",
p_value_fmt = ifelse(p.value < 0.001, "< 0.001", fmt_num(p.value))
) %>%
select(Test, statistic, df, p_value_fmt) %>%
rename("Statistica" = statistic, "Gradi_libertà" = df, "p_value" = p_value_fmt)
} else {
ris_chi <- tibble(
Test = "χ² indipendenza (Ospedale × Tipo di Parto)",
Statistica = NA,
Gradi_libertà = NA,
p_value = "non calcolabile"
)
chi_warning <- "⚠️ Il test χ² non è stato eseguito (una o più combinazioni con frequenza nulla)."
}
# --- Commento χ² dinamico ---
commento_chi <- if (!is.null(test_chi)) {
if (test_chi$p.value < 0.05) {
"→ Esiste una differenza significativa nella distribuzione dei tipi di parto tra i diversi ospedali."
} else {
"→ Non emergono differenze significative nella distribuzione dei tipi di parto tra ospedali."
}
} else {
"→ Test χ² non eseguibile per mancanza di variabilità nei dati."
}
# --- 2. Test t per confronto tra sessi ---
t_peso <- tryCatch(t.test(peso ~ sesso, data = neonati), error = function(e) NULL)
t_lung <- tryCatch(t.test(lunghezza ~ sesso, data = neonati), error = function(e) NULL)
ris_t <- bind_rows(
if (!is.null(t_peso)) tidy(t_peso) %>% mutate(Test = "t-test (Peso F vs M)") else tibble(),
if (!is.null(t_lung)) tidy(t_lung) %>% mutate(Test = "t-test (Lunghezza F vs M)") else tibble()
) %>%
mutate(p_value_fmt = ifelse(is.na(p.value), "—",
ifelse(p.value < 0.001, "< 0.001", fmt_num(p.value)))) %>%
select(Test, statistic, parameter, p_value_fmt) %>%
rename("Statistica_t" = statistic, "Gradi_libertà" = parameter, "p_value" = p_value_fmt)
# --- Tabella combinata dei risultati ---
tabella_step4 <- bind_rows(ris_chi, ris_t)
kable(
tabella_step4,
booktabs = TRUE,
align = c("l", "c", "c", "c"),
caption = "Risultati dei test inferenziali: indipendenza (χ²) e confronto tra gruppi (t-test)"
)
Risultati dei test inferenziali: indipendenza (χ²) e confronto
tra gruppi (t-test)
| χ² indipendenza (Ospedale × Tipo di Parto) |
NA |
NA |
non calcolabile |
NA |
| t-test (Peso F vs M) |
NA |
2490.716 |
< 0.001 |
-12.106145 |
| t-test (Lunghezza F vs M) |
NA |
2459.302 |
< 0.001 |
-9.581981 |
# --- Commento interpretativo automatico ---
commento_peso <- if (!is.null(t_peso) && t_peso$p.value < 0.05) {
"→ Il peso medio alla nascita differisce significativamente tra maschi e femmine."
} else {
"→ Nessuna differenza significativa nel peso medio tra i sessi."
}
commento_lung <- if (!is.null(t_lung) && t_lung$p.value < 0.05) {
"→ La lunghezza media differisce significativamente tra maschi e femmine."
} else {
"→ Nessuna differenza significativa nella lunghezza media tra i sessi."
}
cat("
Commento sintetico:
", commento_chi, "",
commento_peso, "",
commento_lung, "\n",
if (!is.null(chi_warning)) chi_warning)
##
## Commento sintetico:
## → Test χ² non eseguibile per mancanza di variabilità nei dati. → Il peso medio alla nascita differisce significativamente tra maschi e femmine. → La lunghezza media differisce significativamente tra maschi e femmine.
## ⚠️ Il test χ² non è stato eseguito (una o più combinazioni con frequenza nulla).
Step 5 – Verifica delle ipotesi sulle medie campionarie
# ===============================================================
# In questa sezione viene verificata l’uguaglianza tra la media campionaria e la media teorica (popolazione) per due variabili chiave: il peso del neonato (grammi) e la lunghezza del neonato (cm).
# Se la media di popolazione non è fornita (parametri mancanti),il test non viene eseguito.
# ===============================================================
library(dplyr)
library(knitr)
library(broom)
library(glue)
# ---- Recupero dei parametri di popolazione ----
mu_peso <- if (exists("params") && !is.null(params$mu_peso)) params$mu_peso else NA_real_
mu_lunghezza <- if (exists("params") && !is.null(params$mu_lunghezza)) params$mu_lunghezza else NA_real_
# ---- Funzione di test o riepilogo descrittivo ----
test_media_sicuro <- function(x, mu_pop, nome_var) {
media_x <- mean(x, na.rm = TRUE)
sd_x <- sd(x, na.rm = TRUE)
n_x <- sum(!is.na(x))
if (is.na(mu_pop)) {
return(tibble(
Variabile = nome_var,
Media_campionaria = fmt_num(media_x),
Deviazione_standard = fmt_num(sd_x),
N = n_x,
Media_popolazione = "—",
Statistica_t = "—",
p_value = "Parametro non fornito"
))
}
test <- t.test(x, mu = mu_pop)
tibble(
Variabile = nome_var,
Media_campionaria = fmt_num(media_x),
Deviazione_standard = fmt_num(sd_x),
N = n_x,
Media_popolazione = fmt_num(mu_pop),
Statistica_t = fmt_num(test$statistic),
p_value = ifelse(test$p.value < 0.001, "< 0.001", fmt_num(test$p.value))
)
}
# ---- Applicazione dei test ----
ris_peso <- test_media_sicuro(neonati$peso, mu_peso, "Peso (grammi)")
ris_lung <- test_media_sicuro(neonati$lunghezza, mu_lunghezza, "Lunghezza (cm)")
# ---- Tabella finale ----
tabella_step5 <- bind_rows(ris_peso, ris_lung)
kable(
tabella_step5,
booktabs = TRUE,
align = c("l", rep("c", 6)),
caption = "Verifica delle ipotesi sulla media campionaria rispetto alla popolazione"
)
Verifica delle ipotesi sulla media campionaria rispetto alla
popolazione
| Peso (grammi) |
3.284,08 |
525,04 |
2500 |
— |
— |
Parametro non fornito |
| Lunghezza (cm) |
494,69 |
26,32 |
2500 |
— |
— |
Parametro non fornito |
# ---- Commento interpretativo dinamico ----
commento_peso <- if (!is.na(mu_peso)) {
test_peso <- t.test(neonati$peso, mu = mu_peso)
if (test_peso$p.value < 0.05) {
"→ La media del peso campionario differisce significativamente dalla media teorica della popolazione."
} else {
"→ La media del peso campionario non differisce in modo significativo dalla media teorica della popolazione."
}
} else {
"→ Nessuna media teorica disponibile per il peso: vengono riportati solo gli indici descrittivi."
}
commento_lung <- if (!is.na(mu_lunghezza)) {
test_lung <- t.test(neonati$lunghezza, mu = mu_lunghezza)
if (test_lung$p.value < 0.05) {
"→ La media della lunghezza campionaria differisce significativamente dalla media teorica della popolazione."
} else {
"→ La media della lunghezza campionaria non differisce in modo significativo dalla media teorica della popolazione."
}
} else {
"→ Nessuna media teorica disponibile per la lunghezza: vengono riportati solo gli indici descrittivi."
}
cat("
Commento sintetico:
", commento_peso, "\n",
commento_lung)
##
## Commento sintetico:
## → Nessuna media teorica disponibile per il peso: vengono riportati solo gli indici descrittivi.
## → Nessuna media teorica disponibile per la lunghezza: vengono riportati solo gli indici descrittivi.
Step 6 – Analisi di correlazione tra variabili quantitative
# ===============================================================
# Analisi di correlazione lineare tra variabili quantitative.
# L’obiettivo è identificare relazioni lineari significative che possano spiegare parte della variabilità del peso neonatale.
# Verranno calcolati:
# - matrice di correlazione (coefficiente di Pearson)
# - visualizzazione grafica (heatmap)
# ===============================================================
library(dplyr)
library(knitr)
library(ggplot2)
library(reshape2)
library(scales)
library(glue)
# ---- Selezione delle variabili quantitative ----
vars_quant <- c("anni_madre", "n_gravidanze", "gestazione",
"peso", "lunghezza", "cranio")
# ---- Calcolo matrice di correlazione ----
corr_matrix <- neonati %>%
select(all_of(vars_quant)) %>%
select(where(~ sd(.x, na.rm = TRUE) > 0)) %>% # esclude variabili costanti
cor(use = "pairwise.complete.obs", method = "pearson")
# ---- Tabella arrotondata ----
corr_table <- as.data.frame(round(corr_matrix, 3))
corr_table <- tibble::rownames_to_column(corr_table, "Variabile")
kable(
corr_table,
booktabs = TRUE,
align = "c",
caption = "Matrice di correlazione (coefficiente di Pearson)"
)
Matrice di correlazione (coefficiente di Pearson)
| anni_madre |
1.000 |
0.381 |
-0.136 |
-0.022 |
-0.063 |
0.016 |
| n_gravidanze |
0.381 |
1.000 |
-0.101 |
0.002 |
-0.060 |
0.039 |
| gestazione |
-0.136 |
-0.101 |
1.000 |
0.592 |
0.619 |
0.461 |
| peso |
-0.022 |
0.002 |
0.592 |
1.000 |
0.796 |
0.705 |
| lunghezza |
-0.063 |
-0.060 |
0.619 |
0.796 |
1.000 |
0.603 |
| cranio |
0.016 |
0.039 |
0.461 |
0.705 |
0.603 |
1.000 |
# ---- Heatmap grafica ----
corr_long <- melt(corr_matrix) %>%
rename(Var1 = Var1, Var2 = Var2, Correlazione = value)
ggplot(corr_long, aes(x = Var1, y = Var2, fill = Correlazione)) +
geom_tile(color = "white") +
scale_fill_gradient2(
low = "#b2182b",
mid = "white",
high = "#2166ac",
midpoint = 0,
limits = c(-1, 1),
name = "r"
) +
geom_text(aes(label = round(Correlazione, 2)), size = 3, color = "black") +
labs(
title = "Matrice di correlazione tra variabili quantitative",
subtitle = "Coefficiente di Pearson (r)",
x = "", y = ""
) +
theme_minimal(base_size = 11) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5)
)
# ---- Analisi interpretativa automatica ----
corr_peso <- corr_matrix["peso", ]
corr_peso <- corr_peso[!is.na(corr_peso) & names(corr_peso) != "peso"]
if (length(corr_peso) > 0) {
max_corr <- corr_peso[which.max(abs(corr_peso))]
var_max <- names(max_corr)
segno <- if (max_corr > 0) "positiva" else "negativa"
top_corrs <- sort(corr_peso, decreasing = TRUE)
pos_vars <- names(head(top_corrs[top_corrs > 0], 2))
neg_vars <- names(head(sort(top_corrs[top_corrs < 0]), 2))
commento_corr <- glue("
Commento sintetico:
La variabile maggiormente correlata al peso neonatale è {var_max} (r = {fmt_num(max_corr)}), con correlazione {segno}.
Le relazioni più forti e positive emergono con: {paste(pos_vars, collapse = ', ')}.
Al contrario, le variabili con correlazione negativa indicano un potenziale effetto inverso sul peso (es. {paste(neg_vars, collapse = ', ')}).
Nel complesso, le misure antropometriche (lunghezza e cranio) mostrano coerenza con l’atteso incremento del peso alla nascita.")
} else {
commento_corr <- "⚠️ Nessuna correlazione calcolabile: variabili quantitative non sufficientemente variabili o dati mancanti."
}
cat(commento_corr)
## Commento sintetico:
## La variabile maggiormente correlata al peso neonatale è lunghezza (r = 0,80), con correlazione positiva.
## Le relazioni più forti e positive emergono con: lunghezza, cranio.
## Al contrario, le variabili con correlazione negativa indicano un potenziale effetto inverso sul peso (es. anni_madre).
## Nel complesso, le misure antropometriche (lunghezza e cranio) mostrano coerenza con l’atteso incremento del peso alla nascita.
Step 7 – Costruzione del modello di regressione lineare
multipla
# ===============================================================
# Costruzione e valutazione del modello di regressione lineare multipla.
# L’obiettivo è prevedere il peso del neonato alla nascita in funzione di:
# - età materna, numero di gravidanze, settimane di gestazione, lunghezza, diametro cranio, fumo materno e tipo di parto.
# Verranno mostrati:
# - stima dei coefficienti
# - R² e RMSE
# - analisi dei residui
# ===============================================================
library(dplyr)
library(knitr)
library(broom)
library(ggplot2)
library(car)
library(glue)
# ---- Pulizia e preparazione del dataset ----
neonati_mod <- neonati %>%
filter(
!is.na(peso),
!is.na(anni_madre),
!is.na(gestazione),
!is.na(lunghezza),
!is.na(cranio)
) %>%
mutate(
fumatrici = droplevels(fumatrici),
tipo_parto = droplevels(tipo_parto)
)
# Esclusione automatica di fattori con un solo livello
vars_categ <- c(
if (nlevels(neonati_mod$fumatrici) > 1) "fumatrici",
if (nlevels(neonati_mod$tipo_parto) > 1) "tipo_parto"
)
# ---- Costruzione formula dinamica ----
formula_mod <- as.formula(
paste("peso ~", paste(
c("anni_madre", "n_gravidanze", "gestazione",
"lunghezza", "cranio", vars_categ),
collapse = " + "
))
)
# ---- Stima modello ----
mod_peso <- lm(formula_mod, data = neonati_mod)
# ---- Diagnosi multicollinearità ----
vif_vals <- tryCatch(car::vif(mod_peso), error = function(e) NULL)
if (!is.null(vif_vals)) {
vif_tab <- tibble(
Variabile = names(vif_vals),
VIF = round(vif_vals, 2),
Interpretazione = case_when(
vif_vals < 5 ~ "Assenza di multicollinearità rilevante",
vif_vals < 10 ~ "Possibile multicollinearità",
TRUE ~ "Multicollinearità elevata ⚠️"
)
)
kable(vif_tab, booktabs = TRUE, caption = "Diagnosi di multicollinearità (VIF)")
}
Diagnosi di multicollinearità (VIF)
| anni_madre |
1.19 |
Assenza di multicollinearità rilevante |
| n_gravidanze |
1.18 |
Assenza di multicollinearità rilevante |
| gestazione |
1.69 |
Assenza di multicollinearità rilevante |
| lunghezza |
2.06 |
Assenza di multicollinearità rilevante |
| cranio |
1.63 |
Assenza di multicollinearità rilevante |
| fumatrici |
1.01 |
Assenza di multicollinearità rilevante |
# ---- Coefficienti stimati ----
coefs <- broom::tidy(mod_peso, conf.int = TRUE) %>%
mutate(
estimate_fmt = fmt_num(estimate),
conf_low_fmt = fmt_num(conf.low),
conf_high_fmt = fmt_num(conf.high),
p_value_fmt = ifelse(p.value < 0.001, "< 0.001", fmt_num(p.value))
) %>%
select(term, estimate_fmt, conf_low_fmt, conf_high_fmt, p_value_fmt)
names(coefs) <- c("Variabile", "Beta", "IC 95% (basso)", "IC 95% (alto)", "p-value")
kable(
coefs,
booktabs = TRUE,
align = c("l", "c", "c", "c", "c"),
caption = "Coefficienti stimati del modello di regressione lineare multipla"
)
Coefficienti stimati del modello di regressione lineare
multipla
| (Intercept) |
-6.843,55 |
-7.120,54 |
-6.566,55 |
< 0.001 |
| anni_madre |
1,03 |
-1,22 |
3,28 |
0,37 |
| n_gravidanze |
12,19 |
2,95 |
21,43 |
0,01 |
| gestazione |
33,43 |
25,86 |
41,01 |
< 0.001 |
| lunghezza |
10,46 |
9,86 |
11,05 |
< 0.001 |
| cranio |
10,62 |
9,78 |
11,47 |
< 0.001 |
| fumatriciFumatrice |
-27,51 |
-82,13 |
27,12 |
0,32 |
# ---- Metriche di accuratezza ----
pred <- predict(mod_peso, neonati_mod)
residui <- mod_peso$residuals
R2 <- summary(mod_peso)$r.squared
RMSE <- sqrt(mean(residui^2, na.rm = TRUE))
tabella_metriche <- tibble(
R2 = fmt_num(R2),
RMSE_grammi = fmt_num(RMSE)
)
kable(
tabella_metriche,
booktabs = TRUE,
align = c("c", "c"),
col.names = c("R²", "RMSE (grammi)"),
caption = "Metriche di accuratezza del modello"
)
Metriche di accuratezza del modello
| 0,72 |
276,83 |
# ---- Analisi grafica dei residui ----
ggplot(data = tibble(residui = residui, predetto = pred),
aes(x = predetto, y = residui)) +
geom_point(alpha = 0.5, color = "steelblue") +
geom_hline(yintercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Analisi dei residui del modello di regressione",
subtitle = "Distribuzione dei residui rispetto ai valori predetti",
x = "Peso predetto (grammi)",
y = "Residui"
) +
theme_minimal(base_size = 11) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5)
)
# ---- Commento clinico-statistico automatico ----
beta_gest <- coefs %>% filter(Variabile == "gestazione") %>% pull(Beta)
beta_lung <- coefs %>% filter(Variabile == "lunghezza") %>% pull(Beta)
beta_fumo <- coefs %>% filter(grepl("fumatrici", Variabile)) %>% pull(Beta)
interpreta_fumo <- if (length(beta_fumo) > 0) {
if (as.numeric(gsub(",", ".", beta_fumo)) < 0)
"Il fumo materno presenta un coefficiente negativo, indicando un effetto potenzialmente riduttivo sul peso alla nascita."
else
"Il fumo materno non mostra un effetto statisticamente rilevante o negativo sul peso."
} else "Variabile fumo non inclusa per mancanza di variabilità."
commento_modello <- glue("
Commento sintetico:
Il modello spiega circa {fmt_perc(R2)} della variabilità del peso neonatale.
Tra le variabili più influenti, la durata della gestazione e la lunghezza neonatale
mostrano effetti positivi coerenti con l’atteso incremento del peso.
{interpreta_fumo}
L’errore medio quadratico (RMSE = {fmt_num(RMSE)} g) indica una discreta capacità predittiva
e residui distribuiti in modo casuale, segno di un adattamento appropriato.")
cat(commento_modello)
## Commento sintetico:
## Il modello spiega circa 72,19 % della variabilità del peso neonatale.
## Tra le variabili più influenti, la durata della gestazione e la lunghezza neonatale
## mostrano effetti positivi coerenti con l’atteso incremento del peso.
## Il fumo materno presenta un coefficiente negativo, indicando un effetto potenzialmente riduttivo sul peso alla nascita.
## L’errore medio quadratico (RMSE = 276,83 g) indica una discreta capacità predittiva
## e residui distribuiti in modo casuale, segno di un adattamento appropriato.
Step 8 – Validazione del modello
# ===============================================================
# In questa sezione si esegue la validazione incrociata semplice (hold-out) per verificare la capacità predittiva del modello su dati non utilizzati per la stima dei coefficienti.
# Suddivisione:
# - 80% training (costruzione modello)
# - 20% test (validazione)
# Metriche: R² e RMSE su entrambi i campioni.
# ===============================================================
library(dplyr)
library(knitr)
library(ggplot2)
library(glue)
set.seed(1234)
# ---- Suddivisione dataset ----
n <- nrow(neonati_mod)
train_index <- sample(seq_len(n), size = 0.8 * n)
train_set <- neonati_mod[train_index, ]
test_set <- neonati_mod[-train_index, ]
# ---- Ricostruzione formula coerente ----
formula_val <- formula(mod_peso)
# ---- Modello stimato su training ----
mod_train <- lm(formula_val, data = train_set)
# ---- Predizioni ----
pred_train <- predict(mod_train, train_set)
pred_test <- predict(mod_train, test_set)
# ---- Residui ----
res_train <- train_set$peso - pred_train
res_test <- test_set$peso - pred_test
# ---- Metriche ----
R2_train <- summary(mod_train)$r.squared
RMSE_train <- sqrt(mean(res_train^2, na.rm = TRUE))
R2_test <- 1 - sum(res_test^2, na.rm = TRUE) /
sum((test_set$peso - mean(test_set$peso, na.rm = TRUE))^2, na.rm = TRUE)
RMSE_test <- sqrt(mean(res_test^2, na.rm = TRUE))
# ---- ΔR² e indice di generalizzazione ----
delta_R2 <- R2_train - R2_test
gen_index <- (R2_test / R2_train) * 100
# ---- Tabella comparativa ----
tabella_val <- tibble(
Dataset = c("Training", "Test"),
R2 = c(fmt_num(R2_train), fmt_num(R2_test)),
RMSE_grammi = c(fmt_num(RMSE_train), fmt_num(RMSE_test))
)
kable(
tabella_val,
booktabs = TRUE,
align = c("l", "c", "c"),
col.names = c("Dataset", "R²", "RMSE (grammi)"),
caption = "Confronto delle metriche di accuratezza tra training e test set"
)
Confronto delle metriche di accuratezza tra training e test
set
| Training |
0,71 |
281,32 |
| Test |
0,76 |
258,72 |
# ---- Grafico Predetto vs Osservato (test) ----
ggplot(data = tibble(
Osservato = test_set$peso,
Predetto = pred_test
), aes(x = Osservato, y = Predetto)) +
geom_point(color = "#1f77b4", alpha = 0.6) +
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
labs(
title = "Validazione del modello di regressione",
subtitle = "Confronto tra peso osservato e peso predetto (test set)",
x = "Peso osservato (grammi)",
y = "Peso predetto (grammi)"
) +
theme_minimal(base_size = 11) +
theme(
plot.title = element_text(face = "bold", hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5)
)
# ---- Commento automatico sintetico ----
valutazione <- case_when(
abs(delta_R2) < 0.03 ~ "ottima capacità di generalizzazione (ΔR² < 0.03)",
abs(delta_R2) < 0.07 ~ "buona stabilità del modello con minima perdita predittiva",
abs(delta_R2) < 0.15 ~ "presente una discreta perdita di performance sul test (attenzione all’overfitting)",
TRUE ~ "modello sovra-adattato: significativa riduzione del potere predittivo sui dati di test ⚠️"
)
commento_val <- glue("
Commento sintetico:
R² (training): {fmt_num(R2_train)} – R² (test): {fmt_num(R2_test)}
ΔR² = {fmt_num(delta_R2)} → {valutazione}.
Indice di generalizzazione: {fmt_num(gen_index)} %.
RMSE (training): {fmt_num(RMSE_train)} g – RMSE (test): {fmt_num(RMSE_test)} g.
Il modello mostra {ifelse(abs(delta_R2) < 0.07, 'buona capacità di generalizzare i risultati su nuovi dati', 'una tendenza al sovra-adattamento, che potrà essere mitigata con tecniche di regolarizzazione o feature selection più mirata')}.
")
cat(commento_val)
## Commento sintetico:
## R² (training): 0,71 – R² (test): 0,76
## ΔR² = -0,05 → buona stabilità del modello con minima perdita predittiva.
## Indice di generalizzazione: 106,76 %.
## RMSE (training): 281,32 g – RMSE (test): 258,72 g.
## Il modello mostra buona capacità di generalizzare i risultati su nuovi dati.
Step 9 – Conclusioni finali
# ===============================================================
# Sintesi dei risultati ottenuti e interpretazione clinico-statistica.
# ===============================================================
library(dplyr)
library(knitr)
library(glue)
# ---- Riepilogo sintetico delle metriche di performance ----
resoconto_modello <- tibble(
Indicatore = c("R² (Training)", "R² (Test)", "ΔR²", "Indice di generalizzazione (%)",
"RMSE (Training, g)", "RMSE (Test, g)"),
Valore = c(fmt_num(R2_train), fmt_num(R2_test), fmt_num(delta_R2),
fmt_num(gen_index), fmt_num(RMSE_train), fmt_num(RMSE_test))
)
kable(
resoconto_modello,
booktabs = TRUE,
align = c("l", "c"),
caption = "Prestazioni complessive del modello di previsione del peso neonatale"
)
Prestazioni complessive del modello di previsione del peso
neonatale
| R² (Training) |
0,71 |
| R² (Test) |
0,76 |
| ΔR² |
-0,05 |
| Indice di generalizzazione (%) |
106,76 |
| RMSE (Training, g) |
281,32 |
| RMSE (Test, g) |
258,72 |
# ---- Identificazione automatica delle variabili più influenti ----
coefs_ordinati <- coefs %>%
filter(!Variabile %in% c("(Intercept)")) %>%
mutate(abs_effect = abs(as.numeric(gsub(",", ".", Beta)))) %>%
arrange(desc(abs_effect))
top_vars <- head(coefs_ordinati$Variabile, 3)
# ---- Commento finale dinamico ----
commento_finale <- glue("
Sintesi e implicazioni cliniche
Il modello di regressione multipla ha mostrato buone prestazioni predittive, con un coefficiente di determinazione R² pari a {fmt_num(R2_test)} sul test set e un errore medio (RMSE) di circa {fmt_num(RMSE_test)} grammi.
L’indice di generalizzazione del {fmt_num(gen_index)}% evidenzia una stabilità soddisfacente tra dati di addestramento e validazione, senza segni marcati di overfitting.
Le variabili che contribuiscono maggiormente alla previsione del peso neonatale sono:
{paste(top_vars, collapse = ', ')}, tutte coerenti con la letteratura medica e fisiologica.
L’analisi conferma che:
una maggiore durata della gestazione è associata a un incremento significativo del peso alla nascita;
la lunghezza neonatale e le misure craniche contribuiscono in modo sostanziale alla variabilità spiegata;
il fumo materno, se presente nel campione, esercita un effetto tendenzialmente negativo, ma da confermare con ulteriori dati.
Conclusione operativa:
Il modello sviluppato rappresenta un valido strumento di supporto alle decisioni cliniche, utile per:
identificare precocemente neonati a rischio di basso peso alla nascita;
ottimizzare la pianificazione delle risorse nelle unità neonatali;
orientare strategie di prevenzione nelle gravidanze ad alto rischio.
In prospettiva, l’inclusione di ulteriori fattori (es. indice di massa materno, etnia, patologie pregresse) potrà migliorare ulteriormente la capacità predittiva e favorire una gestione sempre più personalizzata della salute prenatale.
")
cat(commento_finale)
## Sintesi e implicazioni cliniche
##
## Il modello di regressione multipla ha mostrato buone prestazioni predittive, con un coefficiente di determinazione R² pari a 0,76 sul test set e un errore medio (RMSE) di circa 258,72 grammi.
## L’indice di generalizzazione del 106,76% evidenzia una stabilità soddisfacente tra dati di addestramento e validazione, senza segni marcati di overfitting.
##
## Le variabili che contribuiscono maggiormente alla previsione del peso neonatale sono:
## gestazione, fumatriciFumatrice, n_gravidanze, tutte coerenti con la letteratura medica e fisiologica.
##
## L’analisi conferma che:
## una maggiore durata della gestazione è associata a un incremento significativo del peso alla nascita;
## la lunghezza neonatale e le misure craniche contribuiscono in modo sostanziale alla variabilità spiegata;
## il fumo materno, se presente nel campione, esercita un effetto tendenzialmente negativo, ma da confermare con ulteriori dati.
##
## Conclusione operativa:
## Il modello sviluppato rappresenta un valido strumento di supporto alle decisioni cliniche, utile per:
## identificare precocemente neonati a rischio di basso peso alla nascita;
## ottimizzare la pianificazione delle risorse nelle unità neonatali;
## orientare strategie di prevenzione nelle gravidanze ad alto rischio.
##
## In prospettiva, l’inclusione di ulteriori fattori (es. indice di massa materno, etnia, patologie pregresse) potrà migliorare ulteriormente la capacità predittiva e favorire una gestione sempre più personalizzata della salute prenatale.