24 votos

¿Es éste un método adecuado para comprobar los efectos estacionales en los datos de recuento de suicidios?

Tengo 17 años (1995 a 2011) de datos de certificados de defunción relacionados con muertes por suicidio para un estado de EE.UU. Hay mucha mitología por ahí sobre los suicidios y los meses/temporadas, mucha de ella contradictoria, y de la literatura que he revisado, no tengo una idea clara de los métodos utilizados o la confianza en los resultados.

Así que me he propuesto ver si puedo determinar si es más o menos probable que se produzcan suicidios en un mes determinado dentro de mi conjunto de datos. Todos mis análisis se realizan en R.

El número total de suicidios en los datos es de 13.909.

Si nos fijamos en el año con menos suicidios, éstos se producen en 309/365 días (85%). Si nos fijamos en el año con más suicidios, se producen en 339/365 días (93%).

Así que hay un buen número de días al año sin suicidios. Sin embargo, cuando se suman los 17 años, hay suicidios todos los días del año, incluido el 29 de febrero (aunque sólo 5 cuando la media es de 38).

enter image description here

La simple suma del número de suicidios en cada día del año no indica una estacionalidad clara (a mi entender).

Agregados a nivel mensual, la media de suicidios por mes oscila entre:

(m=65, sd=7,4, a m=72, sd=11,1)

Mi primera aproximación consistió en agregar el conjunto de datos por meses para todos los años y hacer una prueba de ji-cuadrado tras calcular las probabilidades esperadas para la hipótesis nula, que no había varianza sistemática en los recuentos de suicidios por mes. Calculé las probabilidades para cada mes teniendo en cuenta el número de días (y ajustando febrero para los años bisiestos).

Los resultados del chi-cuadrado no indicaron ninguna variación significativa en función del mes:

# So does the sample match  expected values?
chisq.test(monthDat$suicideCounts, p=monthlyProb)
# Yes, X-squared = 12.7048, df = 11, p-value = 0.3131

La imagen siguiente indica los recuentos totales por mes. Las líneas rojas horizontales se sitúan en los valores previstos para febrero, los meses de 30 días y los meses de 31 días, respectivamente. De acuerdo con la prueba chi-cuadrado, ningún mes queda fuera del intervalo de confianza del 95% para los recuentos previstos. enter image description here

Pensaba que había terminado hasta que empecé a investigar datos de series temporales. Como imagino que hace mucha gente, empecé con el método de descomposición estacional no paramétrica utilizando el stl del paquete stats.

Para crear los datos de las series temporales, empecé con los datos mensuales agregados:

suicideByMonthTs <- ts(suicideByMonth$monthlySuicideCount, start=c(1995, 1), end=c(2011, 12), frequency=12) 

# Plot the monthly suicide count, note the trend, but seasonality?
plot(suicideByMonthTs, xlab="Year",
  ylab="Annual  monthly  suicides")

enter image description here

     Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
1995  62  47  55  74  71  70  67  69  61  76  68  68
1996  64  69  68  53  72  73  62  63  64  72  55  61
1997  71  61  64  63  60  64  67  50  48  49  59  72
1998  67  54  72  69  78  45  59  53  48  65  64  44
1999  69  64  65  58  73  83  70  73  58  75  71  58
2000  60  54  67  59  54  69  62  60  58  61  68  56
2001  67  60  54  57  51  61  67  63  55  70  54  55
2002  65  68  65  72  79  72  64  70  59  66  63  66
2003  69  50  59  67  73  77  64  66  71  68  59  69
2004  68  61  66  62  69  84  73  62  71  64  59  70
2005  67  53  76  65  77  68  65  60  68  71  60  79
2006  65  54  65  68  69  68  81  64  69  71  67  67
2007  77  63  61  78  73  69  92  68  72  61  65  77
2008  67  73  81  73  66  63  96  71  75  74  81  63
2009  80  68  76  65  82  69  74  88  80  86  78  76
2010  80  77  82  80  77  70  81  89  91  82  71  73
2011  93  64  87  75 101  89  87  78 106  84  64  71

Y luego realizó la stl() descomposición

# Seasonal decomposition
suicideByMonthFit <- stl(suicideByMonthTs, s.window="periodic")
plot(suicideByMonthFit)

enter image description here

En este punto me preocupé porque me parece que hay tanto un componente estacional como una tendencia. Después de mucho buscar en Internet, decidí seguir las instrucciones de Rob Hyndman y George Athanasopouls que figuran en su texto en línea "Forecasting: principles and practice", concretamente aplicar un modelo ARIMA estacional.

Utilicé adf.test() y kpss.test() para evaluar estacionariedad y obtuve resultados contradictorios. Ambos rechazaron la hipótesis nula (señalando que ponen a prueba la hipótesis contraria).

adfResults <- adf.test(suicideByMonthTs, alternative = "stationary") # The p < .05 value 
adfResults

    Augmented Dickey-Fuller Test

data:  suicideByMonthTs
Dickey-Fuller = -4.5033, Lag order = 5, p-value = 0.01
alternative hypothesis: stationary

kpssResults <- kpss.test(suicideByMonthTs)
kpssResults

    KPSS Test for Level Stationarity

data:  suicideByMonthTs
KPSS Level = 2.9954, Truncation lag parameter = 3, p-value = 0.01

A continuación, utilicé el algoritmo del libro para ver si podía determinar la cantidad de diferenciación que había que hacer tanto para la tendencia como para la estación. Terminé con nd = 1, ns = 0.

Luego corrí auto.arima que eligió un modelo con un componente tendencial y otro estacional, junto con una constante de tipo "deriva".

# Extract the best model, it takes time as I've turned off the shortcuts (results differ with it on)
bestFit <- auto.arima(suicideByMonthTs, stepwise=FALSE, approximation=FALSE)
plot(theForecast <- forecast(bestFit, h=12))
theForecast

enter image description here

> summary(bestFit)
Series: suicideByMonthFromMonthTs 
ARIMA(0,1,1)(1,0,1)[12] with drift         

Coefficients:
          ma1    sar1     sma1   drift
      -0.9299  0.8930  -0.7728  0.0921
s.e.   0.0278  0.1123   0.1621  0.0700

sigma^2 estimated as 64.95:  log likelihood=-709.55
AIC=1429.1   AICc=1429.4   BIC=1445.67

Training set error measures:
                    ME    RMSE     MAE       MPE     MAPE     MASE       ACF1
Training set 0.2753657 8.01942 6.32144 -1.045278 9.512259 0.707026 0.03813434

Por último, he mirado los residuos del ajuste y, si lo he entendido bien, como todos los valores están dentro de los límites del umbral, se comportan como ruido blanco y, por tanto, el modelo es bastante razonable. He ejecutado un prueba de portmanteau como se describe en el texto, que tenía un valor p muy por encima de 0,05, pero no estoy seguro de tener los parámetros correctos.

Acf(residuals(bestFit))

enter image description here

Box.test(residuals(bestFit), lag=12, fitdf=4, type="Ljung")

    Box-Ljung test

data:  residuals(bestFit)
X-squared = 7.5201, df = 8, p-value = 0.4817

Después de volver a leer el capítulo sobre el modelado arima, ahora me doy cuenta de que auto.arima optó por modelar la tendencia y la temporada. Y también me estoy dando cuenta de que la previsión no es específicamente el análisis que probablemente debería estar haciendo. Quiero saber si un mes concreto (o, más en general, una época del año) debería marcarse como mes de alto riesgo. Parece que las herramientas de la literatura de previsión son muy pertinentes, pero quizás no las mejores para mi pregunta. Agradeceré cualquier aportación.

Estoy publicando un enlace a un archivo csv que contiene los recuentos diarios. El archivo tiene este aspecto:

head(suicideByDay)

        date year month day_of_month t count
1 1995-01-01 1995    01           01 1     2
2 1995-01-03 1995    01           03 2     1
3 1995-01-04 1995    01           04 3     3
4 1995-01-05 1995    01           05 4     2
5 1995-01-06 1995    01           06 5     3
6 1995-01-07 1995    01           07 6     2

datos_suicidio_diarios.csv

El recuento es el número de suicidios ocurridos ese día. "t" es una secuencia numérica de 1 al número total de días de la tabla (5533).

He tomado nota de los comentarios de abajo y he pensado en dos cosas relacionadas con el suicidio de modelos y las estaciones. En primer lugar, con respecto a mi pregunta, los meses son simplemente aproximaciones para marcar el cambio de estación, no estoy interesado en si un mes en particular es o no diferente de los demás (por supuesto, es una pregunta interesante, pero no es lo que me propuse investigar). Por lo tanto, creo que tiene sentido igualar los meses utilizando simplemente los 28 primeros días de todos los meses. Al hacer esto, se obtiene un ajuste ligeramente peor, lo que interpreto como una prueba más de la falta de estacionalidad. En la salida de abajo, el primer ajuste es una reproducción de una respuesta de abajo utilizando los meses con su verdadero número de días, seguido de un conjunto de datos suicideByShortMonth en el que los recuentos de suicidios se calcularon a partir de los 28 primeros días de todos los meses. Me interesa saber qué opina la gente sobre si este ajuste es una buena idea, no es necesario o es perjudicial.

> summary(seasonFit)

Call:
glm(formula = count ~ t + days_in_month + cos(2 * pi * t/12) + 
    sin(2 * pi * t/12), family = "poisson", data = suicideByMonth)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.4782  -0.7095  -0.0544   0.6471   3.2236  

Coefficients:
                     Estimate Std. Error z value Pr(>|z|)    
(Intercept)         2.8662459  0.3382020   8.475  < 2e-16 ***
t                   0.0013711  0.0001444   9.493  < 2e-16 ***
days_in_month       0.0397990  0.0110877   3.589 0.000331 ***
cos(2 * pi * t/12) -0.0299170  0.0120295  -2.487 0.012884 *  
sin(2 * pi * t/12)  0.0026999  0.0123930   0.218 0.827541    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for poisson family taken to be 1)

    Null deviance: 302.67  on 203  degrees of freedom
Residual deviance: 190.37  on 199  degrees of freedom
AIC: 1434.9

Number of Fisher Scoring iterations: 4

> summary(shortSeasonFit)

Call:
glm(formula = shortMonthCount ~ t + cos(2 * pi * t/12) + sin(2 * 
    pi * t/12), family = "poisson", data = suicideByShortMonth)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-3.2414  -0.7588  -0.0710   0.7170   3.3074  

Coefficients:
                     Estimate Std. Error z value Pr(>|z|)    
(Intercept)         4.0022084  0.0182211 219.647   <2e-16 ***
t                   0.0013738  0.0001501   9.153   <2e-16 ***
cos(2 * pi * t/12) -0.0281767  0.0124693  -2.260   0.0238 *  
sin(2 * pi * t/12)  0.0143912  0.0124712   1.154   0.2485    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for poisson family taken to be 1)

    Null deviance: 295.41  on 203  degrees of freedom
Residual deviance: 205.30  on 200  degrees of freedom
AIC: 1432

Number of Fisher Scoring iterations: 4

La segunda cosa que he investigado más es la cuestión de utilizar el mes como sustituto de la temporada. Quizá un mejor indicador de la temporada sea el número de horas de luz que recibe una zona. Estos datos proceden de un estado septentrional que tiene una variación sustancial de la luz diurna. A continuación se muestra un gráfico de la luz del día a partir del año 2002.

enter image description here

Cuando utilizo estos datos en lugar del mes del año, el efecto sigue siendo significativo, pero el efecto es muy, muy pequeño. La desviación residual es mucho mayor que en los modelos anteriores. Si las horas de luz son un modelo mejor para las estaciones, y el ajuste no es tan bueno, ¿es esto una prueba más de que el efecto estacional es muy pequeño?

> summary(daylightFit)

Call:
glm(formula = aggregatedDailyCount ~ t + daylightMinutes, family = "poisson", 
    data = aggregatedDailyNoLeap)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-3.0003  -0.6684  -0.0407   0.5930   3.8269  

Coefficients:
                  Estimate Std. Error z value Pr(>|z|)    
(Intercept)      3.545e+00  4.759e-02  74.493   <2e-16 ***
t               -5.230e-05  8.216e-05  -0.637   0.5244    
daylightMinutes  1.418e-04  5.720e-05   2.479   0.0132 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for poisson family taken to be 1)

    Null deviance: 380.22  on 364  degrees of freedom
Residual deviance: 373.01  on 362  degrees of freedom
AIC: 2375

Number of Fisher Scoring iterations: 4

Pongo las horas de luz por si alguien quiere jugar con esto. Ojo, este no es un año bisiesto, así que si quieres poner los minutos de los años bisiestos, extrapola o recupera los datos.

estado.luz.diurna.2002.csv

[ Editar para añadir la trama de la respuesta eliminada (espero que a rnso no le importe que mueva la trama de la respuesta eliminada aquí arriba a la pregunta. svannoy, si no quieres que esto se añada después de todo, puedes revertirlo)].

enter image description here

13voto

user8076 Puntos 16

¿Y una regresión de Poisson?

He creado un marco de datos que contiene sus datos, además de un índice t para el tiempo (en meses) y una variable monthdays para el número de días de cada mes.

T <- read.table("suicide.txt", header=TRUE)
U <- data.frame( year = as.numeric(rep(rownames(T),each=12)), 
         month = rep(colnames(T),nrow(T)), 
         t = seq(0, length = nrow(T)*ncol(T)), 
         suicides = as.vector(t(T)))
U$monthdays <- c(31,28,31,30,31,30,31,31,30,31,30,31)
U$monthdays[ !(U$year %% 4) & U$month == "Feb" ] <- 29

Así que parece esto:

> head(U,14)
   year month  t suicides monthdays
1  1995   Jan  0       62        31
2  1995   Feb  1       47        28
3  1995   Mar  2       55        31
4  1995   Apr  3       74        30
5  1995   May  4       71        31
6  1995   Jun  5       70        30
7  1995   Jul  6       67        31
8  1995   Aug  7       69        31
9  1995   Sep  8       61        30
10 1995   Oct  9       76        31
11 1995   Nov 10       68        30
12 1995   Dec 11       68        31
13 1996   Jan 12       64        31
14 1996   Feb 13       69        29

Ahora comparemos un modelo con un efecto temporal y un efecto de número de días con un modelo en el que añadimos un efecto de mes:

> a0 <- glm( suicides ~ t + monthdays, family="poisson", data = U )
> a1 <- glm( suicides ~ t + monthdays + month, family="poisson", data = U )

He aquí el resumen del modelo "pequeño":

> summary(a0)

Call:
glm(formula = suicides ~ t + monthdays, family = "poisson", data = U)

Deviance Residuals:
    Min       1Q   Median       3Q      Max
-2.7163  -0.6865  -0.1161   0.6363   3.2104

Coefficients:
             Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.8060135  0.3259116   8.610  < 2e-16 ***
t           0.0013650  0.0001443   9.461  < 2e-16 ***
monthdays   0.0418509  0.0106874   3.916 9.01e-05 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for poisson family taken to be 1)

    Null deviance: 302.67  on 203  degrees of freedom
Residual deviance: 196.64  on 201  degrees of freedom
AIC: 1437.2

Number of Fisher Scoring iterations: 4

Puede verse que las dos variables tienen efectos marginales ampliamente significativos. Ahora mire el modelo más amplio:

> summary(a1)

Call:
glm(formula = suicides ~ t + monthdays + month, family = "poisson",
    data = U)

Deviance Residuals:
     Min        1Q    Median        3Q       Max
-2.56164  -0.72363  -0.05581   0.58897   3.09423

Coefficients:
              Estimate Std. Error z value Pr(>|z|)
(Intercept)  1.4559200  2.1586699   0.674    0.500
t            0.0013810  0.0001446   9.550   <2e-16 ***
monthdays    0.0869293  0.0719304   1.209    0.227
monthAug    -0.0845759  0.0832327  -1.016    0.310
monthDec    -0.1094669  0.0833577  -1.313    0.189
monthFeb     0.0657800  0.1331944   0.494    0.621
monthJan    -0.0372652  0.0830087  -0.449    0.653
monthJul    -0.0125179  0.0828694  -0.151    0.880
monthJun     0.0452746  0.0414287   1.093    0.274
monthMar    -0.0638177  0.0831378  -0.768    0.443
monthMay    -0.0146418  0.0828840  -0.177    0.860
monthNov    -0.0381897  0.0422365  -0.904    0.366
monthOct    -0.0463416  0.0830329  -0.558    0.577
monthSep     0.0070567  0.0417829   0.169    0.866
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for poisson family taken to be 1)

    Null deviance: 302.67  on 203  degrees of freedom
Residual deviance: 182.72  on 190  degrees of freedom
AIC: 1445.3

Number of Fisher Scoring iterations: 4

Bueno, por supuesto el monthdays el efecto desaparece; ¡¡sólo puede estimarse gracias a los años bisiestos!! Mantenerlo en el modelo (y tener en cuenta los años bisiestos) permite utilizar las desviaciones residuales para comparar los dos modelos.

> anova(a0, a1, test="Chisq")
Analysis of Deviance Table

Model 1: suicides ~ t + monthdays
Model 2: suicides ~ t + monthdays + month
  Resid. Df Resid. Dev Df Deviance Pr(>Chi)
1       201     196.65
2       190     182.72 11   13.928    0.237

Entonces, ¿no hay efecto mes (significativo)? Pero, ¿y un efecto estacional? Podemos intentar captar la estacionalidad utilizando dos variables $\cos\left( {2\pi t \over 12}\right)$ y $\sin\left( {2\pi t \over 12}\right)$ :

> a2 <- glm( suicides ~ t + monthdays + cos(2*pi*t/12) + sin(2*pi*t/12),
             family="poisson", data = U )
> summary(a2)

Call:
glm(formula = suicides ~ t + monthdays + cos(2 * pi * t/12) +
    sin(2 * pi * t/12), family = "poisson", data = U)

Deviance Residuals:
    Min       1Q   Median       3Q      Max
-2.4782  -0.7095  -0.0544   0.6471   3.2236

Coefficients:
                     Estimate Std. Error z value Pr(>|z|)
(Intercept)         2.8676170  0.3381954   8.479  < 2e-16 ***
t                   0.0013711  0.0001444   9.493  < 2e-16 ***
monthdays           0.0397990  0.0110877   3.589 0.000331 ***
cos(2 * pi * t/12) -0.0245589  0.0122658  -2.002 0.045261 *
sin(2 * pi * t/12)  0.0172967  0.0121591   1.423 0.154874
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for poisson family taken to be 1)

    Null deviance: 302.67  on 203  degrees of freedom
Residual deviance: 190.37  on 199  degrees of freedom
AIC: 1434.9

Number of Fisher Scoring iterations: 4

Ahora compárelo con el modelo nulo:

> anova(a0, a2, test="Chisq")
Analysis of Deviance Table

Model 1: suicides ~ t + monthdays
Model 2: suicides ~ t + monthdays + cos(2 * pi * t/12) + sin(2 * pi *
    t/12)
  Resid. Df Resid. Dev Df Deviance Pr(>Chi)
1       201     196.65                   
2       199     190.38  2   6.2698   0.0435 *
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Por lo tanto, se puede decir con seguridad que esto sugiere un efecto estacional...

8voto

einverne Puntos 126

Una prueba chi-cuadrado es una buena aproximación como visión preliminar a su pregunta.

En stl puede resultar engañosa como herramienta para comprobar la presencia de estacionalidad. Este procedimiento consigue devolver un patrón estacional estable incluso si un ruido blanco (señal aleatoria sin estructura). Pruébelo, por ejemplo:

plot(stl(ts(rnorm(144), frequency=12), s.window="periodic"))

Fijarse en los órdenes elegidos por un procedimiento automático de selección de modelos ARIMA también es un poco arriesgado, ya que un modelo ARIMA estacional no siempre implica estacionalidad (para más detalles, véase este debate ). En este caso, el modelo elegido genera ciclos estacionales y el comentario de @RichardHardy es razonable, sin embargo, se requiere una mayor profundización para concluir que los suicidios están impulsados por un patrón estacional.

A continuación, resumo algunos resultados basados en el análisis de la serie mensual que has publicado. Se trata del componente estacional estimado a partir del modelo básico de series temporales estructurales:

require(stsm)
m <- stsm.model(model = "llm+seas", y = x)
fit <- stsmFit(m, stsm.method = "maxlik.td.scoring")
plot(tsSmooth(fit)$states[,2], ylab = "")
mtext(text = "seasonal component", side = 3, adj = 0, font = 2)

estimated seasonal component

Se extrajo un componente similar utilizando el programa TRAMO-SEATS con las opciones por defecto. Podemos ver que el patrón estacional estimado no es estable a través del tiempo y, por lo tanto, no apoya la hipótesis de un patrón recurrente en el número de suicidios a través de los meses durante el período de la muestra. Ejecutando el software X-13ARIMA-SEATS con las opciones por defecto, la prueba combinada de estacionalidad concluye que no existe estacionalidad identificable.

Editar (véase esta respuesta y mi comentario más abajo para una definición de estacionalidad identificable ).

Dada la naturaleza de sus datos, valdría la pena complementar este análisis basado en métodos de series temporales con un modelo para datos de recuento (por ejemplo, el modelo de Poisson) y comprobar la significación de la estacionalidad en ese modelo. Añadir la etiqueta datos de recuento a su pregunta puede dar lugar a más opiniones y posibles respuestas en esta dirección.

1voto

rnso Puntos 2424

Para una primera estimación visual, puede utilizarse el siguiente gráfico. Si se trazan los datos mensuales con la curva de loess y su intervalo de confianza del 95%, parece que hay un aumento a mediados de año que alcanza su punto máximo en junio. Otros factores pueden hacer que los datos tengan una distribución amplia, por lo que la tendencia estacional puede quedar enmascarada en este gráfico de loess de datos brutos. Los puntos de datos se han desplazado.

enter image description here

Edición: El siguiente gráfico muestra la curva de Loess y el intervalo de confianza para el cambio en el número de casos con respecto al número del mes anterior:

enter image description here

Esto también demuestra que durante los meses del primer semestre del año, el número de casos sigue aumentando, mientras que desciende en el segundo semestre. Esto también sugiere un pico a mediados de año. Sin embargo, los intervalos de confianza son amplios y pasan por 0, es decir, sin cambios, a lo largo del año, lo que indica una falta de significación estadística.

La diferencia de las cifras de un mes puede compararse con la media de los valores de los 3 meses anteriores:

enter image description here

Esto muestra un claro aumento de las cifras en mayo y un descenso en octubre.

i-Ciencias.com

I-Ciencias es una comunidad de estudiantes y amantes de la ciencia en la que puedes resolver tus problemas y dudas.
Puedes consultar las preguntas de otros usuarios, hacer tus propias preguntas o resolver las de los demás.

Powered by:

X