Analisi del dataset

head(dati)
##   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
str(dati)
## '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" ...

Trasformazione delle variabili categoriche

dati$Fumatrici <- factor(
  dati$Fumatrici,
  levels = c(0, 1),
  labels = c("No", "Si")
)
dati$Tipo.parto <- factor(dati$Tipo.parto)
dati$Ospedale   <- factor(dati$Ospedale)
dati$Sesso      <- factor(dati$Sesso)

Distribuzione del peso neonatale

ggplot(dati, aes(x = Peso)) +
  geom_histogram(bins = 30, fill = "steelblue", color = "black") +
  labs(
    title = "Distribuzione del peso neonatale",
    x = "Peso alla nascita (grammi)",
    y = "Frequenza"
  )

Analisi sui parti cesari

tab_parto_osp <- table(dati$Tipo.parto, dati$Ospedale)
kable(
  tab_parto_osp,
  caption = "Distribuzione dei tipi di parto per ospedale"
)
Distribuzione dei tipi di parto per ospedale
osp1 osp2 osp3
Ces 242 254 232
Nat 574 595 603 
tab_parto_percentuali <- prop.table(tab_parto_osp, margin = 2) * 100
kable(
  round(tab_parto_percentuali, 2),
  caption = "Percentuale di parti per ospedale (%)"
)
Percentuale di parti per ospedale (%)
osp1 osp2 osp3
Ces 29.66 29.92 27.78
Nat 70.34 70.08 72.22 
chisq.test(tab_parto_osp)$expected
##      
##           osp1     osp2    osp3
##   Ces 237.6192 247.2288 243.152
##   Nat 578.3808 601.7712 591.848
test_cesari <- chisq.test(tab_parto_osp)
test_cesari
## 
##  Pearson's Chi-squared test
## 
## data:  tab_parto_osp
## X-squared = 1.0972, df = 2, p-value = 0.5778

Le tabelle mostrano fin da subito che i numeri dei cesari rispetto ai naturali sono molto omogenei fra loro e anche con i valori del test effetuato non possiamo dire che esistano differenze significative nella frequenza dei parti cesarei tra i tre ospedali (p-value molto maggiore di 0)

Analisi sul sesso dei neonati

table(dati$Sesso)
## 
##    F    M 
## 1256 1244
tab_sesso <- dati %>%
  group_by(Sesso) %>%
  summarise(
    N = n(),
    Peso_medio = mean(Peso),
    Peso_sd = sd(Peso),
    Lunghezza_media = mean(Lunghezza),
    Lunghezza_sd = sd(Lunghezza)
  )

kable(
  tab_sesso,
  digits = 2,
  caption = "Statistiche descrittive per sesso"
)
Statistiche descrittive per sesso
Sesso N Peso_medio Peso_sd Lunghezza_media Lunghezza_sd
F 1256 3161.13 526.31 489.76 27.53
M 1244 3408.22 493.80 499.67 24.04 
ggplot(dati, aes(x = Sesso, y = Peso, fill = Sesso)) +
  geom_boxplot() +
  labs(
    title = "Distribuzione del peso neonatale per sesso",
    x = "Sesso",
    y = "Peso alla nascita (grammi)"
  ) +
  theme(legend.position = "none")

t_test_peso <- t.test(Peso ~ Sesso, data = dati) 
t_test_peso 
## 
##  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
t_test_lunghezza <- t.test(Lunghezza ~ Sesso, data = dati) 
t_test_lunghezza
## 
##  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

Il dataset risulta molto bilancato, con quasi lo stesso numero di bambini maschi e femmine. Il peso medio e la lunghezza dei bambini maschi risulta subito visibilmente più alto, con una differenza di peso 247 grammi e di 10 mm di lunghezza. Con i risultati del t-test si può dire che ci sono differenze statisticamente significative tra neonati maschi e femmine sia per il peso che per la lunghezza alla nascita(p-value praticamente 0)

Valori del dataset rispetto a quelli comuni

t_test_peso_pop <- t.test(dati$Peso, mu = 3300) 
t_test_peso_pop 
## 
##  One Sample t-test
## 
## data:  dati$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
t_test_lunghezza_pop <- t.test(dati$Lunghezza, mu = 500) 
t_test_lunghezza_pop
## 
##  One Sample t-test
## 
## data:  dati$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
tab_ttest_pop <- data.frame(
  Variabile = c("Peso", "Lunghezza"),
  Media_campione = c(mean(dati$Peso), mean(dati$Lunghezza)),
  Media_popolazione = c(3300, 500),
  p_value = c(
    t_test_peso_pop$p.value,
    t_test_lunghezza_pop$p.value
  )
)

kable(
  tab_ttest_pop,
  digits = 4,
  caption = "Confronto tra campione e valori medi di riferimento"
)
Confronto tra campione e valori medi di riferimento
Variabile Media_campione Media_popolazione p_value
Peso 3284.081 3300 0.1296
Lunghezza 494.692 500 0.0000

Effettuando dei t-test con dei valori statistici medi emerge che i valori del peso sono omogenei con quelli del resto della popolazione, ma la lunghezza risulta avere delle differenze numeriche notabili. Probabilmente andrebbero studiate in maniera più approfondita altre caratteristiche, come la geografia degli opsedali, poichè sarebbe più opportuno comparare i loro valori con altri più più affini rispetto ad una media statistica generale.

Modello di regressione

modello_completo <- lm(
  Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione +
    Lunghezza + Cranio + Tipo.parto + Ospedale + Sesso,
  data = dati
)

Il modello di regressione lineare multipla (R² di circa 73%) mostra come le features che più hanno effetto sul peso di un bambino alla nascita sono la durata della gestazione, il sesso e le misure della lunghezza e dal diametro craniale. Il sesso maschile e un aumento dei valori delle misure sopracitate si associa un incremento significativo di peso alla nascita.

Criterio AIC

modello_aic <- step(
  modello_completo,
  direction = "backward",
  trace = TRUE
)
## Start:  AIC=28075.26
## Peso ~ Anni.madre + N.gravidanze + Fumatrici + Gestazione + Lunghezza + 
##     Cranio + Tipo.parto + Ospedale + Sesso
## 
##                Df Sum of Sq       RSS   AIC
## - Anni.madre    1     46578 186809099 28074
## - Fumatrici     1     90019 186852540 28075
## <none>                      186762521 28075
## - N.gravidanze  1    438452 187200974 28079
## - Tipo.parto    1    447929 187210450 28079
## - Ospedale      2    685979 187448501 28080
## - Sesso         1   3611021 190373542 28121
## - Gestazione    1   5458403 192220925 28145
## - Cranio        1  45326172 232088693 28617
## - Lunghezza     1  87951062 274713583 29038
## 
## Step:  AIC=28073.88
## Peso ~ N.gravidanze + Fumatrici + Gestazione + Lunghezza + Cranio + 
##     Tipo.parto + Ospedale + Sesso
## 
##                Df Sum of Sq       RSS   AIC
## - Fumatrici     1     90897 186899996 28073
## <none>                      186809099 28074
## - Tipo.parto    1    448222 187257321 28078
## - Ospedale      2    692738 187501837 28079
## - N.gravidanze  1    633756 187442855 28080
## - Sesso         1   3618736 190427835 28120
## - Gestazione    1   5412879 192221978 28143
## - Cranio        1  45588236 232397335 28618
## - Lunghezza     1  87950050 274759149 29036
## 
## Step:  AIC=28073.1
## Peso ~ N.gravidanze + Gestazione + Lunghezza + Cranio + Tipo.parto + 
##     Ospedale + Sesso
## 
##                Df Sum of Sq       RSS   AIC
## <none>                      186899996 28073
## - Tipo.parto    1    440684 187340680 28077
## - Ospedale      2    701680 187601677 28079
## - N.gravidanze  1    610840 187510837 28079
## - Sesso         1   3602797 190502794 28119
## - Gestazione    1   5346781 192246777 28142
## - Cranio        1  45632149 232532146 28617
## - Lunghezza     1  88355030 275255027 29039
coef_modello <- summary(modello_aic)$coefficients

kable(
  coef_modello,
  digits = 3,
  caption = "Coefficienti del modello di regressione selezionato (AIC)"
)
Coefficienti del modello di regressione selezionato (AIC)
Estimate Std. Error t value Pr(>|t|)
(Intercept) -6707.429 135.944 -49.340 0.000
N.gravidanze 12.362 4.333 2.853 0.004
Gestazione 31.991 3.790 8.442 0.000
Lunghezza 10.309 0.300 34.316 0.000
Cranio 10.492 0.425 24.661 0.000
Tipo.partoNat 29.280 12.082 2.424 0.015
Ospedaleosp2 -11.023 13.436 -0.820 0.412
Ospedaleosp3 28.641 13.489 2.123 0.034
SessoM 77.441 11.176 6.930 0.000 
AIC(modello_completo, modello_aic)
##                  df      AIC
## modello_completo 12 35171.95
## modello_aic      10 35169.79

Con l’utilizzo del criterio AIC sono state eliminate le variabili età madre e fumatici, poichè ininfluenti sul modello di predizione. Anche con questi criteri il modello si mantiene con un R² al 73%. Le ipotesi che quindi queste statistiche siano significative nel futuro peso del nascituro sembrerebbero false, ma ovviamente non possono essere esclusi per altre possibili complicanze e/o problemi.

Analisi dei residui

par(mfrow = c(2, 2))
plot(modello_aic)

par(mfrow = c(1, 1))

I grafici dei residui sul modello con AIC risultano abbastanza conformi, senza mostrare particolari valori da compromettere il modello.

Predizioni

nuovo_neonato <- data.frame(
  N.gravidanze = 3,
  Gestazione   = 39,
  Lunghezza    = 500,
  Cranio       = 340,
  Tipo.parto   = factor("Nat", levels = levels(dati$Tipo.parto)),
  Ospedale     = factor("osp1", levels = levels(dati$Ospedale)),
  Sesso        = factor("F", levels = levels(dati$Sesso))
)
pred_peso <- predict(
  modello_aic,
  newdata = nuovo_neonato
)
pred_peso
##        1 
## 3328.245
pred_conf <- predict(
  modello_aic,
  newdata = nuovo_neonato,
  interval = "confidence"
)

kable(
  as.data.frame(pred_conf),
  digits = 1,
  caption = "Predizione del peso neonatale con intervallo di confidenza 95%"
)
Predizione del peso neonatale con intervallo di confidenza 95%
fit lwr upr
3328.2 3298.9 3357.6

Utilizzando i dati forniti per un caso esempio il peso predetto risulta essere 3328gr, probabilisticamente tra i 3298gr e i 3357gr,

Grafico di previsione

gest_seq <- seq(35, 42, by = 0.1)

dati_pred <- data.frame(
  N.gravidanze = 1,
  Gestazione   = gest_seq,
  Lunghezza    = 500,
  Cranio       = 340,
  Tipo.parto   = factor("Nat", levels = levels(dati$Tipo.parto)),
  Ospedale     = factor("osp1", levels = levels(dati$Ospedale)),
  Sesso        = factor("F", levels = levels(dati$Sesso))
)

pred <- predict(
  modello_aic,
  newdata = dati_pred,
  interval = "confidence"
)

dati_pred$fit <- pred[, "fit"]
dati_pred$lwr <- pred[, "lwr"]
dati_pred$upr <- pred[, "upr"]

ggplot(dati_pred, aes(x = Gestazione, y = fit)) +
  geom_line(color = "steelblue", linewidth = 1) +
  geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.2, fill = "steelblue") +
  labs(
    title = "Peso neonatale previsto in funzione delle settimane di gestazione",
    subtitle = "Predizione dal modello di regressione con IC 95%",
    x = "Settimane di gestazione",
    y = "Peso alla nascita previsto (grammi)"
  ) +
  theme_minimal()

Conclusione

La ricerca sviluppata su questi dati permette di capire come le variabili che più ci permettono di prevedere il peso di un neonato sono date prevalentemente da ragioni fisiche del nascituro. Più il neonato sarà “grande fisicamente” e più di conseguenza peserà. Allo stesso tempo, anche il fattore gestazione risulta fondamentale perchè strettamente collegato ai valori fisici, più un bambino “cresce” con il passare del tempo e più, anche in questo caso, peserà. Le altre variabili risultano quindi meno “importanti”. Potrebbero anche essere collegate alla durata della gestazione o alle caratteristiche fisiche, ma comparate a questi ultimi risultano ininfluenti(esempio: anzianità e fumo potrebbero essere collegate ad un periodo di gestazione più breve e quindi ad un neonato meno sviluppato fisicamente. Il peso però risulterebbe influenzato più da queste ultime caratteristiche che da quelle iniziali della madre) . Aggiungerei ancora che il fattore fumo potrebbe essere studiato più nel dettaglio. Nello studio fatto emerge come un fattore non strettamente collegato al peso, ma non viene identificato se il fumo risulta “assunto” in gestazione, se il fumo risulta occasionale o intenso. Tutte variabili che potrebbero però essere importanti ai fini della ricerca. In conclusione, il modello generato mostra una buona capacità predittiva del peso neonatale in funzione delle principali caratteristiche cliniche e antropometriche.

I dati utilizzati come “comuni” per la verifica dei pesi medi comuni sono stati raccolti da ricerche nel web (Fonti: https://www.ospedalebambinogesu.it/da-0-a-30-giorni-come-si-presenta-e-come-cresce-80012/, https://www.my-personaltrainer.it/salute/lunghezza-neonato.html)