library(dplyr)
library(ggplot2)
library(car)
library(lmtest)
library(MASS)
library(sandwich)
neonati <- read.csv("C:/Users/Timar/Desktop/neonati.csv", stringsAsFactors= T, sep=",")
summary(neonati)
## Anni.madre N.gravidanze 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 Tipo.parto Ospedale Sesso
## Min. : 830 Min. :310.0 Min. :235 Ces: 728 osp1:816 F:1256
## 1st Qu.:2990 1st Qu.:480.0 1st Qu.:330 Nat:1772 osp2:849 M:1244
## Median :3300 Median :500.0 Median :340 osp3:835
## Mean :3284 Mean :494.7 Mean :340
## 3rd Qu.:3620 3rd Qu.:510.0 3rd Qu.:350
## Max. :4930 Max. :565.0 Max. :390
Analisi descrittiva delle variabili:
L’età delle madri (variabile quantitativa continua) varia da 0 a 46 anni (probabilmente un errore per l’età minima). L’età media è 28.16 anni, con una mediana di 28 anni;
Numero di gravidanze, variabile quantitativa discreta, con un valore medio di 0.98 e una mediana di 1. Il numero massimo di gravidanze registrato è 12, la minima 0;
Fumatrici, variabile binaria, con il 4.16% delle madri che dichiara di fumare. Ciò suggerisce che il campione ha una prevalenza relativamente bassa di fumatrici;
Gestazione, varibile quantitativa discreta ha una media di 38.98 settimane, con una mediana di 39 settimane. L’intervallo va da 25 a 43 settimane, suggerendo la presenza di gravidanze premature (≤37 settimane) e prolungate (≥42 settimane);
Il peso (variabile quantitativa continua), la media alla nascita è di 3284 g, con una mediana di 3300 g. Il peso minimo registrato è 830 g, mentre il massimo è 4930 g;
La lunghezza (quantitativa continua), media alla nascita è 494.7 mm, con una mediana di 500 mm;
Il diametro medio del cranio (variabile quantitativa continua) è di 340 mm, con una mediana di 340 mm. Il valore massimo è 390 mm, mentre il minimo è 235 mm, suggerendo una certa variabilità tra i neonati;
Tipo di parto, variabile categorica con due livelli: naturale (Nat) e cesareo (Ces);
Ospedale, variabile categorica che identifica tre strutture diverse (osp1, osp2 e osp3);
Sesso variabile categorica binaria con due valori, Maschio (“M”) e Femmina (“F”).
Verifica della presenza di valori mancanti
if(sum(is.na(neonati)) > 0){
cat("Attenzione: sono presenti valori mancanti\n")
} else {
cat("Nessun valore mancante rilevato.\n")
}
## Nessun valore mancante rilevato.
Escludiamo casi non realistici (es. Anni.madre = 0)
neonati <- neonati %>% filter(Anni.madre > 12)
Convertiamo alcune variabili categoriche
neonati <- neonati %>%
mutate(
Fumo.materno = factor(Fumatrici, levels = c(0,1), labels = c("No", "Sì")),
Tipo.parto = factor(Tipo.parto),
Ospedale = factor(Ospedale),
Sesso = factor(Sesso)
)
tabella_parto <- table(neonati$Tipo.parto, neonati$Ospedale)
chisq_result <- chisq.test(tabella_parto)
print(chisq_result)
##
## Pearson's Chi-squared test
##
## data: tabella_parto
## X-squared = 1.083, df = 2, p-value = 0.5819
Il test del chi-quadrato (X² = 1.083, p-value = 0.5819) non ha evidenziato differenze significative nella proporzione di parti cesarei tra i tre ospedali. Questo suggerisce che le pratiche ostetriche relative al tipo di parto potrebbero essere uniformi tra le strutture.
t.test(neonati$Peso, mu = 3300)
##
## One Sample t-test
##
## data: neonati$Peso
## t = -1.505, df = 2497, p-value = 0.1324
## alternative hypothesis: true mean is not equal to 3300
## 95 percent confidence interval:
## 3263.577 3304.791
## sample estimates:
## mean of x
## 3284.184
t.test(neonati$Lunghezza, mu = 500)
##
## One Sample t-test
##
## data: neonati$Lunghezza
## t = -10.069, df = 2497, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 500
## 95 percent confidence interval:
## 493.6628 495.7287
## sample estimates:
## mean of x
## 494.6958
Il peso medio alla nascita (3284 g) non differisce significativamente dal valore atteso di 3300 g (t = -1.505, p-value = 0.1324). Al contrario, la lunghezza media (494.70 mm) è inferiore a 500 mm (t = -10.069, p-value < 0.001).
t.test(Peso ~ Sesso, data = neonati)
##
## Welch Two Sample t-test
##
## data: Peso by Sesso
## t = -12.115, df = 2488.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.4841 -207.3844
## sample estimates:
## mean in group F mean in group M
## 3161.061 3408.496
t.test(Lunghezza ~ Sesso, data = neonati)
##
## Welch Two Sample t-test
##
## data: Lunghezza by Sesso
## t = -9.5823, df = 2457.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.939001 -7.882672
## sample estimates:
## mean in group F mean in group M
## 489.7641 499.6750
t.test(Cranio ~ Sesso, data = neonati)
##
## Welch Two Sample t-test
##
## data: Cranio by Sesso
## t = -7.4366, df = 2489.4, p-value = 1.414e-13
## alternative hypothesis: true difference in means between group F and group M is not equal to 0
## 95 percent confidence interval:
## -6.110504 -3.560417
## sample estimates:
## mean in group F mean in group M
## 337.6231 342.4586
I neonati maschi presentano misure antropometriche significativamente maggiori rispetto alle femmine: peso (3408 g vs 3161 g, p < 0.001), lunghezza (499.7 mm vs 489.8 mm, p < 0.001) e diametro craniale (342.5 mm vs 337.6 mm, p < 0.001).
Matrice di correlazione con scatterplot nella parte superiore e valori di correlazione nella parte inferiore.
panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...) {
usr <- par("usr"); on.exit(par(usr))
par(usr = c(0, 1, 0, 1))
r <- cor(x, y, use = "complete.obs")
txt <- format(c(r, 1), digits = digits)[1]
txt <- paste0(prefix, txt)
if (missing(cex.cor)) cex.cor <- 0.8 / strwidth(txt)
text(0.5, 0.5, txt, cex = 1.5)
}
pairs(neonati, upper.panel = panel.smooth, lower.panel = panel.cor)
La matrice di correlazione mostra che la durata della gravidanza (Gestazione) ha una forte correlazione positiva con il peso del neonato, confermando che i neonati nati dopo una gestazione più lunga tendono a pesare di più.
Anche la lunghezza e il diametro del cranio mostrano una correlazione positiva moderata con il peso, suggerendo che queste variabili potrebbero essere utili nel modello predittivo.
Al contrario, il fumo materno mostra una debole correlazione negativa con il peso del neonato, indicando che il fumo potrebbe avere un impatto limitato sul peso alla nascita in questo campione.
mod_1 <- lm(Peso ~ Gestazione + Lunghezza + Cranio + Fumo.materno, data = neonati)
summary(mod_1)
##
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio + Fumo.materno,
## data = neonati)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1106.12 -184.29 -13.02 167.10 2620.16
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6778.3648 135.7173 -49.945 <2e-16 ***
## Gestazione 31.9396 3.8313 8.337 <2e-16 ***
## Lunghezza 10.4097 0.3025 34.412 <2e-16 ***
## Cranio 10.7900 0.4285 25.181 <2e-16 ***
## Fumo.maternoSì -23.3289 27.8768 -0.837 0.403
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 277.8 on 2493 degrees of freedom
## Multiple R-squared: 0.7207, Adjusted R-squared: 0.7203
## F-statistic: 1608 on 4 and 2493 DF, p-value: < 2.2e-16
Coefficienti:
(Intercept): -6778.36, rappresenta il peso teorico del neonato quando tutte le variabili indipendenti sono pari a zero. Tuttavia, questo valore non ha un significato pratico nel contesto del problema, poiché non è possibile avere una gravidanza di 0 settimane o una lunghezza/diametro craniale pari a zero;
Gestazione: 31.94, per ogni settimana aggiuntiva di gestazione il peso del neonato aumenta in media di 31.94 grammi. Questo risultato è altamente significativo (p-value < 2e-16), confermando che la durata della gravidanza è un fattore cruciale per il peso alla nascita;
Lunghezza: 10.41, indicando che per ogni millimetro aggiuntivo di lunghezza del neonato il peso aumenta in media di 10.41 grammi. Anche questo coefficiente è altamente significativo (p-value < 2e-16).
Cranio: 10.79, suggerendo che per ogni millimetro aggiuntivo di diametro craniale, il peso aumenta in media di 10.79 grammi. Anche questo risultato è altamente significativo (p-value < 2e-16).
Fumo Materno: -23.33, il che significa che i neonati di madri fumatrici pesano in media 23.33 grammi in meno rispetto a quelli di madri non fumatrici. Comunque, questo risultato non è statisticamente significativo (p-value = 0.403). Dato che il fumo materno non è significativo, potremmo rimuoverlo dal modello per semplificarlo:
mod_2 <- lm(Peso ~ Gestazione + Lunghezza + Cranio, data = neonati)
summary(mod_2)
##
## Call:
## lm(formula = Peso ~ Gestazione + Lunghezza + Cranio, data = neonati)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1105.68 -183.52 -12.69 166.41 2622.95
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -6778.1583 135.7089 -49.946 <2e-16 ***
## Gestazione 31.7554 3.8247 8.303 <2e-16 ***
## Lunghezza 10.4210 0.3022 34.486 <2e-16 ***
## Cranio 10.7911 0.4285 25.186 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 277.8 on 2494 degrees of freedom
## Multiple R-squared: 0.7207, Adjusted R-squared: 0.7203
## F-statistic: 2145 on 3 and 2494 DF, p-value: < 2.2e-16
La rimozione della variabile Fumo Materno non ha avuto un impatto significativo sulla capacità predittiva del modello:
Proviamo a testare se l’effetto di una variabile dipende da un’altra, ad esempio, includiamo un’interazione tra Gestazione e Lunghezza
mod_3 <- lm(Peso ~ Gestazione * Lunghezza + Cranio, data = neonati)
summary(mod_3)
##
## Call:
## lm(formula = Peso ~ Gestazione * Lunghezza + Cranio, data = neonati)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1137.31 -180.01 -7.48 164.76 2637.67
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.559e+03 9.269e+02 -1.682 0.0928 .
## Gestazione -1.086e+02 2.494e+01 -4.352 1.4e-05 ***
## Lunghezza -1.069e+00 2.041e+00 -0.524 0.6006
## Cranio 1.103e+01 4.279e-01 25.783 < 2e-16 ***
## Gestazione:Lunghezza 3.030e-01 5.323e-02 5.692 1.4e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 276 on 2493 degrees of freedom
## Multiple R-squared: 0.7242, Adjusted R-squared: 0.7238
## F-statistic: 1637 on 4 and 2493 DF, p-value: < 2.2e-16
Il modello mod_3 rappresenta un miglioramento rispetto a mod_2 in termini di capacità esplicativa (0.7242 vs 0.7207) e precisione (errore standard dei residui più basso, 276 vs 277.8 g).
Proviamo ad aggiungere un termine quadratico per la gestazione (I(Gestazione^2)), oltre alle variabili Lunghezza e Cranio, in modo da trovare eventuali relazioni non lineari tra la durata della gestazione e il peso del neonato.
mod_4 <- lm(Peso ~ Gestazione + I(Gestazione^2) + Lunghezza + Cranio, data = neonati)
summary(mod_4)
##
## Call:
## lm(formula = Peso ~ Gestazione + I(Gestazione^2) + Lunghezza +
## Cranio, data = neonati)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1171.12 -182.89 -13.29 166.24 2651.38
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4239.1777 906.2352 -4.678 3.05e-06 ***
## Gestazione -109.7575 50.0879 -2.191 0.02852 *
## I(Gestazione^2) 1.8889 0.6666 2.834 0.00464 **
## Lunghezza 10.5435 0.3048 34.587 < 2e-16 ***
## Cranio 10.9086 0.4299 25.377 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 277.4 on 2493 degrees of freedom
## Multiple R-squared: 0.7216, Adjusted R-squared: 0.7211
## F-statistic: 1615 on 4 and 2493 DF, p-value: < 2.2e-16
Il coefficiente del termine quadratico (1.8889) è positivo, il che suggerisce che l’effetto della gestazione sul peso non è costante, ma aumenta con l’aumentare della durata della gestazione. In altre parole, il peso del neonato aumenta più rapidamente nelle ultime settimane di gestazione. In mod_4, sia il termine lineare (Gestazione) che quello quadratico (I(Gestazione^2)) sono significativi (p-value < 0.05). Questo suggerisce che la relazione tra gestazione e peso non è lineare.
Il modello mod_4 rappresenta un miglioramento rispetto a mod_2, tuttavia, mod_3 rimane, al momento il modello con la migliore capacità esplicativa (R² più alto) e la maggiore precisione (errore standard dei residui più basso).
Dato che mod_3 e mod_4 hanno entrambi mostrato miglioramenti possiamo provare con un modello combinato:
mod_5 <- lm(Peso ~ Gestazione * Lunghezza + I(Gestazione^2) + Cranio, data = neonati)
summary(mod_5)
##
## Call:
## lm(formula = Peso ~ Gestazione * Lunghezza + I(Gestazione^2) +
## Cranio, data = neonati)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1085.42 -180.50 -6.42 165.19 2560.77
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2369.1939 939.0117 -2.523 0.01170 *
## Gestazione 170.2429 64.4194 2.643 0.00828 **
## Lunghezza -19.3221 4.3901 -4.401 1.12e-05 ***
## I(Gestazione^2) -6.6271 1.4128 -4.691 2.87e-06 ***
## Cranio 10.9950 0.4262 25.799 < 2e-16 ***
## Gestazione:Lunghezza 0.7730 0.1134 6.819 1.15e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 274.9 on 2492 degrees of freedom
## Multiple R-squared: 0.7267, Adjusted R-squared: 0.7261
## F-statistic: 1325 on 5 and 2492 DF, p-value: < 2.2e-16
Il modello mod_5 rappresenta il miglior modello, con la più alta capacità esplicativa (R² = 0.7267) e la maggiore precisione (errore standard dei residui = 274.9 g).
Confrontiamo i modelli usando il criterio di informazione di Akaike (AIC) e BIC (Bayesian Information Criterion):
AIC(mod_1, mod_2, mod_3, mod_4, mod_5)
## df AIC
## mod_1 6 35207.73
## mod_2 5 35206.43
## mod_3 6 35176.18
## mod_4 6 35200.40
## mod_5 7 35156.22
BIC(mod_1, mod_2, mod_3, mod_4, mod_5)
## df BIC
## mod_1 6 35242.67
## mod_2 5 35235.55
## mod_3 6 35211.12
## mod_4 6 35235.34
## mod_5 7 35196.98
anova(mod_1, mod_2, mod_3, mod_4, mod_5)
## Analysis of Variance Table
##
## Model 1: Peso ~ Gestazione + Lunghezza + Cranio + Fumo.materno
## Model 2: Peso ~ Gestazione + Lunghezza + Cranio
## Model 3: Peso ~ Gestazione * Lunghezza + Cranio
## Model 4: Peso ~ Gestazione + I(Gestazione^2) + Lunghezza + Cranio
## Model 5: Peso ~ Gestazione * Lunghezza + I(Gestazione^2) + Cranio
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 2493 192370245
## 2 2494 192424285 -1 -54040 0.7152 0.3978
## 3 2493 189955566 1 2468719 32.6727 1.221e-08 ***
## 4 2493 191806553 0 -1850987
## 5 2492 188293070 1 3513484 46.4999 1.146e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Il modello mod_5 ha il valore AIC e BIC più basso (35156.22 - 35196.98), quindi è il modello ottimale. Inoltre, il modello mos_5 ha il RSS più basso (188293070), il che indica un migliore adattamento ai dati.
Grafico dei residui per verificare l’assunzione di normalità:
par(mfrow=c(2,2))
plot(mod_5)
Residuals vs Fitted: mostra la distribuzione dei residui rispetto ai valori predetti, qui si nota una leggera curva che potrebbe indicare una non linearità residua.
Q-Q Plot dei residui: verifica se i residui seguono una distribuzione normale, qui vediamo code lunghe, quindi i residui potrebbero avere una distribuzione non perfettamente normale.
Scale-Location: verifica l’omoschedasticità, sembra abbastanza stabile, ma con una leggera varianza crescente.
Residuals vs Leverage: identifica punti influenti nel modello, alcuni punti fuori dai limiti (es. 1549) potrebbero essere outlier influenti.
Test di normalità dei residui e di Breusch-Pagan per l’omoschedasticità:
shapiro.test(resid(mod_5))
##
## Shapiro-Wilk normality test
##
## data: resid(mod_5)
## W = 0.97623, p-value < 2.2e-16
bptest(mod_5)
##
## studentized Breusch-Pagan test
##
## data: mod_5
## BP = 85.867, df = 5, p-value < 2.2e-16
Test di Shapiro-Wilk: un p-value così basso indica che i residui non seguono una distribuzione normale (questo è confermato dal Q-Q plot dell’immagine precedente).
Test di Breusch-Pagan: i residui non hanno varianza costante (il grafico Scale-Location mostrava già una leggera varianza crescente).
Iniziamo con il rimuovere gli outlier:
resid_stud <- rstudent(mod_5)
outliers <- which(abs(resid_stud) > 3)
neonati_clean <- neonati[-outliers, ]
mod_5_clean <- lm(Peso ~ Gestazione * Lunghezza + I(Gestazione^2) + Cranio, data = neonati_clean)
shapiro.test(resid(mod_5_clean))
##
## Shapiro-Wilk normality test
##
## data: resid(mod_5_clean)
## W = 0.99723, p-value = 0.0001933
bptest(mod_5_clean)
##
## studentized Breusch-Pagan test
##
## data: mod_5_clean
## BP = 18.298, df = 5, p-value = 0.002596
Il test di Shapiro-Wilk ha un p-value = 0.0001933, il che significa che i residui non seguono una distribuzione normale. Però, il valore di W = 0.99723 è molto vicino a 1, il che suggerisce che i residui sono quasi normali. Il test di Breusch-Pagan ha un p-value = 0.002596, il che indica che c’è eteroschedasticità.
Box-Cox:
bc <- boxcox(Peso ~ Gestazione * Lunghezza + I(Gestazione^2) + Cranio, data = neonati_clean)
lambda <- bc$x[which.max(bc$y)]
neonati_clean$Peso_bc <- (neonati_clean$Peso^lambda - 1) / lambda
mod_5_bc <- lm(Peso_bc ~ Gestazione * Lunghezza + I(Gestazione^2) + Cranio, data = neonati_clean)
shapiro.test(resid(mod_5_bc))
##
## Shapiro-Wilk normality test
##
## data: resid(mod_5_bc)
## W = 0.99893, p-value = 0.1332
bptest(mod_5_bc)
##
## studentized Breusch-Pagan test
##
## data: mod_5_bc
## BP = 9.0301, df = 5, p-value = 0.1079
r_squared <- summary(mod_5_bc)$r.squared
r_squared
## [1] 0.7803033
rmse <- sqrt(mean(resid(mod_5_bc)^2))
rmse
## [1] 6.417524
I residui del modello mod_5_bc seguono una distribuzione normale e la varianza è costante.
Grafico di Log-Likelihood: La trasformazione di Box-Cox ha migliorato l’adattamento del modello, con un massimo di log-verosimiglianza intorno a λ=0.
R² (Coefficiente di Determinazione): 0.78, il modello è in grado di catturare una grande proporzione della variabilità nei dati.
RMSE (Root Mean Squared Error): 6.42, il modello fa previsioni molto precise.
Creazione di un nuovo dato per la previsione:
new_data <- data.frame(
Gestazione = 39,
Lunghezza = 500,
Cranio = 340,
Fumo.materno = "No",
Tipo.parto = "Nat",
Ospedale = "osp1",
Sesso = "F"
)
predicted_weight <- predict(mod_5_bc, newdata = new_data)
if (lambda == 0) {
predicted_weight <- exp(predicted_weight)
} else {
predicted_weight <- (lambda * predicted_weight + 1)^(1 / lambda)
}
predicted_weight
## 1
## 3324.954
Il risultato della previsione è 3324.954 grammi, che è un valore realistico per il peso di un neonato
Scatter plot con regressione: Peso vs settimane di gestazione:
ggplot(neonati, aes(x = Gestazione, y = Peso, color = Fumo.materno)) +
geom_jitter(width = 0.2, height = 0, alpha = 0.5) +
geom_smooth(method = "lm", se = TRUE) +
scale_color_manual(values = c("No" = "blue", "Sì" = "red")) +
labs(title = "Peso neonatale rispetto alle settimane di gestazione",
subtitle = "Confronto tra madri fumatrici e non fumatrici",
x = "Settimane di Gestazione", y = "Peso (g)") +
theme_minimal()
I punti rappresentano i singoli neonati, con il colore che distingue tra madri fumatrici (rossi) e non fumatrici (blu).
La distribuzione dei punti mostra una tendenza generale, all’aumentare delle settimane di gestazione il peso del neonato tende ad aumentare.
Le linee di tendenza mostrano l’andamento medio del peso in base alle settimane di gestazione per ciascun gruppo (fumatrici e non fumatrici).
La linea blu (non fumatrici) è generalmente più alta della linea rossa (fumatrici), indicando che i neonati di madri non fumatrici tendono a pesare di più rispetto a quelli di madri fumatrici, a parità di settimane di gestazione.
Le aree ombreggiate attorno alle linee di tendenza rappresentano l’intervallo di confidenza. Più l’area è ampia, maggiore è l’incertezza nella stima della relazione.
Relazione tra Peso, Lunghezza e Gestazione:
library(plotly)
plot_ly(data = neonati, x = ~Gestazione, y = ~Lunghezza, z = ~Peso, color = ~Fumo.materno,
colors = c("No" = "blue", "Sì" = "red"),
type = "scatter3d", mode = "markers",
marker = list(size = 3, opacity = 0.7)) %>%
layout(scene = list(
xaxis = list(title = "Settimane di gestazione"),
yaxis = list(title = "Lunghezza (mm)"),
zaxis = list(title = "Peso (g)")
),
title = "Relazione tra Gestazione, Lunghezza e Peso Neonatale",
margin = list(l = 0, r = 0, b = 0, t = 40)
)
l grafico mostra una relazione tra la lunghezza del neonato, le settimane di gestazione e il peso del neonato. Anche in questo grafico i punti rappresentano i singoli neonati, con il colore che distingue tra madri fumatrici (rossi) e non fumatrici (blu). Con l’aumentare delle settimane di gestazione aumentano peso e lunghezza.
Relazione tra Peso Osservato e Predetto dal Modello:
neonati$Peso_predetto <- predict(mod_5, newdata = neonati)
ggplot(neonati, aes(x = Peso, y = Peso_predetto, color = Gestazione)) +
geom_point(alpha = 0.6) +
geom_abline(slope = 1, intercept = 0, color = "red", linetype = "dashed") +
labs(title = "Confronto tra Peso Osservato e Peso Predetto",
subtitle = "Modello di regressione migliorato",
x = "Peso Osservato (g)", y = "Peso Predetto (g)") +
theme_minimal()
Se i punti sono vicini alla linea rossa, il modello predice bene il peso. Punti lontani indicano errori di previsione. La distribuzione dei punti lungo la linea suggerisce che il modello è abbastanza accurato, ma potrebbe esserci qualche discrepanza per pesi molto alti o molto bassi. Il colore dei punti mostra che i neonati con una gestazione più avanzata (ad esempio, 40 settimane) tendono a pesare di più, sia osservato che predetto.