Analisis de frecuencias

library(vcd)
## Loading required package: grid
library(gmodels)
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✔ ggplot2 3.3.6     ✔ purrr   0.3.4
## ✔ tibble  3.1.7     ✔ dplyr   1.0.9
## ✔ tidyr   1.2.0     ✔ stringr 1.4.0
## ✔ readr   2.1.2     ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

Tablas de frecuencia y contingencia

Para generar tablas de frecuencia, R tiene varias herramientas, en particular podemos trabajar con table, xtab, prop.table y margin.tables. Iniciaremos con ejemplos de tablas de variables categóricas. Usaremos los datos de R en la librería vcd.

Tablas de una via

La forma más directa para generar una tabla de variables en R es con el comando table() usaremos los datos en Arthritis. Sabemos que tiene las variables: Treatment. Sex, and Improved, todas variables categóricas.

head(Arthritis)
##   ID Treatment  Sex Age Improved
## 1 57   Treated Male  27     Some
## 2 46   Treated Male  29     None
## 3 77   Treated Male  30     None
## 4 17   Treated Male  32   Marked
## 5 36   Treated Male  46   Marked
## 6 23   Treated Male  58   Marked
mytable <- with(Arthritis, table(Improved))
mytable
## Improved
##   None   Some Marked 
##     42     14     28
# for percentage table
prop.table(mytable)*100
## Improved
##     None     Some   Marked 
## 50.00000 16.66667 33.33333

Tablas de dos-vias

Como ejemplo: datos del estado de California en el uso del cinturón de seguridad en el auto, se compara el uso del cinturón de seguridad en el auto comparando si el hecho del que los padres de menores usen el cinturón de seguridad esto resulte en que los menores también usen el cinturón de seguridad.

Se genera una tabla de contingencia:

Buckle_child <- read_csv("~/Dropbox/GitHub/ProbEstad/DataSets/ch12_all/CaliforniaBuckleChild.csv", show_col_types = FALSE)
# to build a two-way table
BuckleChild <- xtabs(~ Parent + Child, data=Buckle_child)
head(BuckleChild)
##             Child
## Parent       buckled un-buckled
##   buckled         56          8
##   un-buckled       2         16

La repuesta parece obvia, pero se puede usar la \(\chi^2\) para demostrar la correlación. Estas tablas de contingencia se pueden tabular otras propiedades de los datos, podemos estimar las distribuciones marginales. Resultados de proporción prop.table() y de de frecuencia.

addmargins(BuckleChild)
##             Child
## Parent       buckled un-buckled Sum
##   buckled         56          8  64
##   un-buckled       2         16  18
##   Sum             58         24  82
# porportions with respect to the first variable Parent
prop.table(BuckleChild, 1)
##             Child
## Parent         buckled un-buckled
##   buckled    0.8750000  0.1250000
##   un-buckled 0.1111111  0.8888889
addmargins(prop.table(BuckleChild))
##             Child
## Parent          buckled un-buckled        Sum
##   buckled    0.68292683 0.09756098 0.78048780
##   un-buckled 0.02439024 0.19512195 0.21951220
##   Sum        0.70731707 0.29268293 1.00000000

Para calcular la probabilidad parcial de la distribución de infantes con el cinturon de seguridad abrochado de la tabla con los marginales podemos estimar los siguientes parciales:
\(n_r\) número de renglones (el número de niveles \(r\))
\(n_c\) número de columnas (número de niveles \(c\))
\(Y_{ij}\) variable aleatoria de acuerdo a la frecuencia de celda \(i,j\)
\(p_{ij}\) la probabilidad de la celda \(i,j\)
Las probabilidades marginales son: \(P_i^r\), \(P_j^c\), son la probabilidad marginal igual a la suma de las probabilidades por renglǿn \(p_i^r = p_{i1} + p_{i2} + \dots + p_{in_r}\).
La hipótesis nula es que la variable columna es independiente de la variable renglón, es decir: \(H_0: p_{ij} = p_i^r p_j^c\).
La hipótesis nula se expresa como \(H_0: \verb+las variables son independientes+\) y la hipótesis alternativa es \(H_A: \verb+las variables no son independientes+\).
Por ejemplo de la tabla addmargins(BuckleChild) se obtienen valores estimados de probabilidad \(\hat p\).

Prueba de Independencia

Para la prueba de independencia en variables categóricas se pueden hacer varias estimaciones usando tablas de contingencia y para estimar la independencia entre variables se puede usar la prueba \(\chi^2\), esta prueba está basada en la distribución de \(\chi^2\) definida por:

\[ \chi^2 = \sum_{i=1}^{k} \frac{(\verb+OBSERVADO - ESPERADO+)^2}{\verb+ESPERADO+} \]

La distribución \(\chi^2\) como prueba de independencia. Si usamos la cantidad esperada por celda como \(n\hat{p}_{ij}\) se puede escribir como \(R_iC_j/n\) con \(R_i\) la suma del renglón (i), y \(C_j\) la suma de la columna (j) y se puede escribir la estadística \(\chi^2\) como:
\[ \chi^2 = \sum_{i=1}^{n_r} \sum_{j=1}^{n_c} \frac{(Y_{ij} - n\hat{p}_{ij})^2}{n \hat{p}_{ij}} \] con \(\chi^2\) con \((n_r - 1)(n_c - 1)\) grados de libertad. Esta estadística estima la componente para la celda. Para R la independencia de la variable renglón contra la variable columna una tabla ya “formada” se puede usar la prueba chisq.test() también la función fisher.test().

chisq.test(BuckleChild)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  BuckleChild
## X-squared = 35.995, df = 1, p-value = 1.978e-09
fisher.test(BuckleChild)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  BuckleChild
## p-value = 2.112e-09
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##    9.60524 538.85662
## sample estimates:
## odds ratio 
##   51.34668
# From SAS and SPSS the gmodels library have a CrossTable that does all in one step
CrossTable(BuckleChild, chisq = TRUE, fisher = TRUE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  82 
## 
##  
##              | Child 
##       Parent |    buckled | un-buckled |  Row Total | 
## -------------|------------|------------|------------|
##      buckled |         56 |          8 |         64 | 
##              |      2.544 |      6.148 |            | 
##              |      0.875 |      0.125 |      0.780 | 
##              |      0.966 |      0.333 |            | 
##              |      0.683 |      0.098 |            | 
## -------------|------------|------------|------------|
##   un-buckled |          2 |         16 |         18 | 
##              |      9.046 |     21.861 |            | 
##              |      0.111 |      0.889 |      0.220 | 
##              |      0.034 |      0.667 |            | 
##              |      0.024 |      0.195 |            | 
## -------------|------------|------------|------------|
## Column Total |         58 |         24 |         82 | 
##              |      0.707 |      0.293 |            | 
## -------------|------------|------------|------------|
## 
##  
## Statistics for All Table Factors
## 
## 
## Pearson's Chi-squared test 
## ------------------------------------------------------------
## Chi^2 =  39.5993     d.f. =  1     p =  3.117954e-10 
## 
## Pearson's Chi-squared test with Yates' continuity correction 
## ------------------------------------------------------------
## Chi^2 =  35.99532     d.f. =  1     p =  1.977918e-09 
## 
##  
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Sample estimate odds ratio:  51.34668 
## 
## Alternative hypothesis: true odds ratio is not equal to 1
## p =  2.112173e-09 
## 95% confidence interval:  9.60524 538.8566 
## 
## Alternative hypothesis: true odds ratio is less than 1
## p =  1 
## 95% confidence interval:  0 365.59 
## 
## Alternative hypothesis: true odds ratio is greater than 1
## p =  2.112173e-09 
## 95% confidence interval:  11.71007 Inf 
## 
## 
##

Si se tiene suficiente evidencia para desechar la hipótesis nula de independencia entre las variables, entonces la atención se turna en estimar una medida de asociación entre dichas variables. La función assocstats() de la librería vcd se puede usar para estimar los parámetros \(\phi\), de contingencia y de Cramer. En general a mayor valor de estos índices se tiene una mayor asociación.

# Association tests parameters
assocstats(BuckleChild)
##                     X^2 df   P(> X^2)
## Likelihood Ratio 38.359  1 5.8843e-10
## Pearson          39.599  1 3.1180e-10
## 
## Phi-Coefficient   : 0.695 
## Contingency Coeff.: 0.571 
## Cramer's V        : 0.695

Ejemplo ácido fólico durante el embarazo

“In 1992, the U.S. Public Health Service and the Centers for Disease Control and Prevention recommended that all women of childbearing age consume \(400 \mu g\) of folic acid daily to reduce the risk of having a pregnancy that is affected by a neural tube defect such as spina bifida or anencephaly. In a study by Stepanuk et al., 693 pregnant women called a teratology information service about their use of folic acid supplementation. The researchers wished to determine if preconceptional use of folic acid and race are independent. The data appear in EXA_C12_S04_01.csv”

FolicAcid <- read_csv("~/Dropbox/GitHub/ProbEstad/DataSets/ch12_all/EXA_C12_S04_01.csv", show_col_types = FALSE)

# to build a two-way table, race vs folic acid
FA_table <- xtabs(~ Race + FolicAcid, data = FolicAcid)
FA_tabSimp <- table(FolicAcid$Race, FolicAcid$FolicAcid)
head(FA_table)
##        FolicAcid
## Race     No Yes
##   Black  41  15
##   Other  14   7
##   White 299 260
head(FA_tabSimp)
##        
##          No Yes
##   Black  41  15
##   Other  14   7
##   White 299 260
# to estimate the marginal values of the table
addmargins(FA_table)
##        FolicAcid
## Race     No Yes Sum
##   Black  41  15  56
##   Other  14   7  21
##   White 299 260 559
##   Sum   354 282 636
# porportions with respect to the first variable Race
prop.table(FA_table, 1)
##        FolicAcid
## Race           No       Yes
##   Black 0.7321429 0.2678571
##   Other 0.6666667 0.3333333
##   White 0.5348837 0.4651163
addmargins(prop.table(FA_table))
##        FolicAcid
## Race            No        Yes        Sum
##   Black 0.06446541 0.02358491 0.08805031
##   Other 0.02201258 0.01100629 0.03301887
##   White 0.47012579 0.40880503 0.87893082
##   Sum   0.55660377 0.44339623 1.00000000
addmargins(prop.table(FA_tabSimp))
##        
##                 No        Yes        Sum
##   Black 0.06446541 0.02358491 0.08805031
##   Other 0.02201258 0.01100629 0.03301887
##   White 0.47012579 0.40880503 0.87893082
##   Sum   0.55660377 0.44339623 1.00000000
# Independence tests
chisq.test(FA_table)
## 
##  Pearson's Chi-squared test
## 
## data:  FA_table
## X-squared = 9.0913, df = 2, p-value = 0.01061
fisher.test(FA_table)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  FA_table
## p-value = 0.009282
## alternative hypothesis: two.sided
# To estimate the SAS type contingency table estimations
CrossTable(FA_table, prop.t = TRUE, prop.chisq = TRUE, 
           chisq = TRUE, fisher = TRUE, format = c("SAS"))
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  636 
## 
##  
##              | FolicAcid 
##         Race |        No |       Yes | Row Total | 
## -------------|-----------|-----------|-----------|
##        Black |        41 |        15 |        56 | 
##              |     3.100 |     3.892 |           | 
##              |     0.732 |     0.268 |     0.088 | 
##              |     0.116 |     0.053 |           | 
##              |     0.064 |     0.024 |           | 
## -------------|-----------|-----------|-----------|
##        Other |        14 |         7 |        21 | 
##              |     0.457 |     0.574 |           | 
##              |     0.667 |     0.333 |     0.033 | 
##              |     0.040 |     0.025 |           | 
##              |     0.022 |     0.011 |           | 
## -------------|-----------|-----------|-----------|
##        White |       299 |       260 |       559 | 
##              |     0.474 |     0.595 |           | 
##              |     0.535 |     0.465 |     0.879 | 
##              |     0.845 |     0.922 |           | 
##              |     0.470 |     0.409 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |       354 |       282 |       636 | 
##              |     0.557 |     0.443 |           | 
## -------------|-----------|-----------|-----------|
## 
##  
## Statistics for All Table Factors
## 
## 
## Pearson's Chi-squared test 
## ------------------------------------------------------------
## Chi^2 =  9.091262     d.f. =  2     p =  0.01061347 
## 
## 
##  
## Fisher's Exact Test for Count Data
## ------------------------------------------------------------
## Alternative hypothesis: two.sided
## p =  0.009281515 
## 
## 
assocstats(FA_table)
##                     X^2 df  P(> X^2)
## Likelihood Ratio 9.4808  2 0.0087352
## Pearson          9.0913  2 0.0106135
## 
## Phi-Coefficient   : NA 
## Contingency Coeff.: 0.119 
## Cramer's V        : 0.12

Dados los valores de p, resultado de la pruebas de independencia (y de la tabla CrossTable) podemos rechazar la hipótesis nula \(H_0\), y por lo tanto podemos concluir que hay una relación entre la raza y el uso durante el embarazo de ácido fólico. Aunque el efecto no es grande, como resultado de los valores bajos de los coeficientes de contingencia y Cramer V.