Análise de Dados Categóricos

Capítulo 6- Tópicos adicionais

• 6.1 Respostas binárias e erro de teste
• 6.1.1 Estimando a probabilidade de sucesso
• 6.1.2 Modelos de regressão binária
• 6.1.3 Outros métodos
• 6.2 Inferência exata
• 6.2.1 Teste exato de Fisher para independência
• 6.2.2 Teste de permutação para independência
• 6.2.3 Regressão logística exata
• 6.2.4 Procedimentos adicionais de inferência exata
• 6.3 Dados categóricos em delineamentos amostrais complexos
• 6.3.1 O paradigma da amostragem em pesquisas
• 6.3.2 Visão geral das abordagens de análise
• 6.3.3 Contagens de células ponderadas
• 6.3.4 Inferência sobre proporções populacionais
• 6.3.5 Tabelas de contingência e modelos log-lineares
• 6.3.6 Regressão logística
• 6.4 Dados do tipo “selecione todas as opções aplicáveis”
• 6.4.1 Tabela de resposta aos iten
• 6.4.2 Teste de independência marginal
• 6.4.3 Modelagem de regressão
• 6.5 Modelos mistos para dados correlacionados
• 6.5.1 Efeitos aleatórios
• 6.5.2 Modelos de efeitos mistos
• 6.5.3 Ajuste do modelo
• 6.5.4 Inferência
• 6.5.5 Modelagem marginal utilizando equações de estimação generalizadas
• 6.6 Métodos bayesianos para dados categóricos
• 6.6.1 Estimação da probabilidade de sucesso
• 6.6.2 Modelos de regressão
• 6.7 Exercícios
• 6.8 Referências

6.1 Respostas binárias e erro de teste

Os processos de medição são frequentemente imperfeitos. Os instrumentos podem estar calibrados incorretamente, por exemplo, balanças de banheiro, as condições locais podem não ser todas idênticas, por exemplo, temperaturas em uma região ou um alvo pode ser difícil de medir, por exemplo, pessoas sem-teto em um censo.

Até mesmo respostas binárias às vezes são medidas com erro: um “sucesso” pode, na verdade, ser uma “falha” mal medida e vice-versa. Por exemplo, um árbitro pode declarar erroneamente um chute a gol válido quando não foi, e vice-versa.

Nesta seção, focamos nas respostas binárias resultantes de testes diagnósticos para doenças infecciosas. Por exemplo, testes para infecções como HIV, vírus do Nilo Ocidental e clamídia geralmente não são 100% precisos. Os motivos para erros nos testes podem incluir

1. níveis da bactéria, vírus ou outro microrganismo causador abaixo dos níveis detectáveis (frequentemente o caso de novas infecções),

2. inibidores dentro de uma amostra que impedem a detecção de um resultado positivo e

3. erro de laboratório.

Felizmente, os testes diagnósticos geralmente apresentam altos níveis de precisão, como vimos no Exercício 6 do Capítulo 1 para o Ensaio Aptima Combo 2.

No entanto, a possibilidade de erro de teste ainda precisa ser levada em consideração em uma análise estatística para permitir inferências corretas. O objetivo desta seção é discutir técnicas básicas para levar em conta o erro de teste que podem ser usadas em situações examinadas nos Capítulos 1 e 2.

6.1.1 Estimando a probabilidade de sucesso

Defina \(Y\) como uma variável aleatória de Bernoulli que representa o resultado medido de um teste diagnóstico: positivo (1) ou negativo (0). Quando \(Y\) é medido com a possibilidade de erro de teste, é necessário definir outra variável aleatória de Bernoulli, \(\widetilde{Y}\), que representa o estado verdadeiro: positivo (1) ou negativo (0).

Isso leva às seguintes medidas de acurácia:

1. Sensibilidade: \(S_e = P(Y = 1 \, |\, \widetilde{Y} = 1)\)

2. Especificidade: \(S_p = P (Y = 0 \, | \, \widetilde{Y} = 0)\)

Assim, a sensibilidade é a probabilidade de um resultado medido ser positivo, dado que ele é verdadeiramente positivo, e a especificidade é a probabilidade de um resultado medido ser negativo, dado que ele é verdadeiramente negativo. Idealmente, gostaríamos que essas probabilidades condicionais fossem iguais a 1, o que significaria um teste diagnóstico perfeito. Infelizmente, muitas vezes esse não é o caso.

Portanto, a taxa de erro do teste é \(1-S_e = P(Y = 0 \, | \, \widetilde{Y}= 1)\) para indivíduos verdadeiramente positivos e \(1-S_p = P(Y = 1 \, | \, \widetilde{Y} = 0)\) para indivíduos verdadeiramente negativos.

Na avaliação de um teste diagnóstico, os valores de sensibilidade (\(S_e\)) e especificidade (\(S_p\)) são geralmente determinados pela realização de testes em amostras com resultados conhecidos como verdadeiros positivos e verdadeiros negativos. Por exemplo, ensaios para doenças infecciosas frequentemente passam por ensaios clínicos dessa forma, e os resultados obtidos são apresentados na bula do produto. De fato, os dados utilizados no Exercício 6 do Capítulo 1 foram extraídos da bula do produto da Gen-Probe. Curiosamente, as estimativas de sensibilidade e especificidade provenientes desses ensaios são tipicamente consideradas como os valores verdadeiros, sem levar em conta a variabilidade que inevitavelmente ocorre.

Adotaremos a mesma abordagem aqui, mas abordaremos métodos de análise alternativos na Seção 6.1.3. Existe uma relação simples entre \(Y\) e \(\widetilde{Y}\) que pode ser expressa em termos de probabilidades. Utilizando a definição de probabilidades marginais e condicionais, a probabilidade de uma resposta positiva no teste é \[ \begin{array}{rcl} P(Y=1) & = & P(Y=1 \; \mbox{ e } \; \widetilde{Y}=1) + P(Y=1 \; \mbox{ e } \; \widetilde{Y}=0) \\[0.8em] & = & P(Y=1 \, | \, \widetilde{Y}=1)P(\widetilde{Y}=1)+ P(Y=1 \, | \, \widetilde{Y}=0)P(\widetilde{Y}=0)\\[0.8em] & = & S_e P(\widetilde{Y}=1)+(1-S_p)P(\widetilde{Y}=0)\cdot \end{array} \]

Fazendo \(P(Y = 1) = \pi\) e \(P(\widetilde{Y} = 1) = \widetilde{\pi}\) e resolvendo para \(\widetilde{\pi}\) na expressão acima, podemos escrever de forma compacta a verdadeira probabilidade de positividade como: \[ \tag{6.1} \widetilde{\pi}=\dfrac{\pi+S_p-1}{S_e+S_p-1}\cdot \]

Para estimar \(\widetilde{\pi}\), suponha que uma amostra de \(n\) indivíduos seja testada para uma determinada doença, gerando respostas \(y_1,\cdots,y_n\). Por exemplo, \(y_1,\cdots,y_n\) podem representar os resultados positivos e negativos observados em testes de HIV de doações de sangue enviadas a um banco de sangue.

As respostas observadas podem ser modeladas utilizando uma distribuição de Bernoulli com probabilidade \(\pi\). A partir desse modelo, a estimativa de máxima verossimilhança de \(\widetilde{\pi}\) — denotada por \(\widehat{\widetilde{\pi}}\) — pode ser obtida pelos métodos usuais.

A função de verossimilhança é \[ \tag{6.2} \begin{array}{rcl} L(\widetilde{\pi}\, | \, y_1,\cdots,y_n) & = & \pi^\omega (1-\pi)^{n-\omega}\\[0.8em] & = & \Big(S_e \widetilde{\pi}+(1-S_p)(1-\widetilde{\pi}) \Big)^\omega \Big(1-S_e\widetilde{\pi}-(1-S_p)(1-\widetilde{\pi}) \Big)^{n-\omega} \end{array} \] onde \(\omega=\sum_{i=1}^n y_i\) é o número observado de respostas positivas ao teste em uma amostra de tamanho \(n\).

Maximizar a Equação (6.2) resulta na estimativa de máxima verossimilhança (EMV) de \(\widetilde{\pi}\) \[ \tag{6.3} \widehat{\widetilde{\pi}}=\dfrac{\widehat{\pi}+S_p-1}{S_e+S_p-1}, \] onde \(\widehat{\pi}=\omega/n\) (ver o Exercício 3).

Alternativamente, pode-se utilizar a propriedade de invariância dos estimadores de máxima verossimilhança e simplesmente substituir \(\widehat{\pi}\) por \(\pi\) na Equação (6.1). Observe que, quando não há erro de teste (\(S_e = S_p = 1\)), tem-se \(\widehat{\widetilde{\pi}}=\widehat{\pi}\) como seria de esperar.

Há um problema inconveniente com a Equação (6.3). Normalmente, \(S_p\) será um número elevado, próximo de 1. No entanto, algumas doenças apresentam taxas de infecção tão baixas — e, consequentemente, valores tão pequenos de \(\widehat{\pi}\) — que o valor de \(S_p\) pode não ser suficiente para impedir que o numerador resulte em um valor negativo.

Como o denominador é positivo em todas as aplicações realistas, isso resulta em um valor que não faz sentido para uma probabilidade. Uma solução simples — embora não necessariamente ideal para lidar com um valor negativo de \(\widehat{\widetilde{\pi}}\) — consiste em definir a estimativa de \(\widetilde{\pi}\) como 0 caso a estimativa de máxima verossimilhança (MLE) seja negativa. Por outro lado, pode haver uma questão mais ampla a ser considerada quando a MLE é negativa: talvez o teste diagnóstico simplesmente não seja preciso o suficiente para fornecer uma estimativa significativa de \(\widetilde{\pi}\).

A variância estimada de \(\widehat{\widetilde{\pi}}\) também pode ser encontrada de maneira semelhante à da Seção 1.1.2. O Exercício 3 mostra que a variância é \[ \widehat{\mbox{Var}}(\widehat{\widetilde{\pi}})=\dfrac{\widehat{\pi}(1-\widehat{\pi})}{n(S_e+S_p-1)^2}\cdot \]

Essa variância é a mesma apresentada na Equação (1.3) para o caso de ausência de erro de teste, exceto pelo termo \((S_e + S_p − 1)^2\) no denominador. Assim, como \(1 < S_e + S_p < 2\) em todas as aplicações realistas, a presença de erro de teste reduz essencialmente o tamanho efetivo da amostra de \(n\) para \(n(S_e + S_p − 1)^2\).

O resultado final é uma maior variabilidade do estimador quando há erro de teste. Esse resultado é intuitivo, pois a variabilidade é uma medida de incerteza. Se existe incerteza quanto a uma resposta verdadeira, isso deve se refletir em uma variância maior!

O intervalo de confiança de Wald de \((1-\alpha)100\%\) para \(\widetilde{\pi}\) é \[ \widehat{\widetilde{\pi}}-Z_{1-\alpha/2}\sqrt{\dfrac{\widehat{\pi}(1-\widehat{\pi})}{n(S_e+S_p-1)^2}} < \widetilde{\pi} < \widehat{\widetilde{\pi}}+Z_{1-\alpha/2}\sqrt{\dfrac{\widehat{\pi}(1-\widehat{\pi})}{n(S_e+S_p-1)^2}}\cdot \]

O desempenho do intervalo é semelhante ao do intervalo de Wald para \(\pi\). O Exercício 2 explora esse comportamento mais a fundo. Um intervalo de razão de verossimilhança para \(\widetilde{\pi}\) é apresentado no Exercício 5 como uma alternativa ao intervalo de Wald.

Exemplo 6.1: Prevalência de hepatite C entre doadores de sangue

A Seção 1.1.2 apresenta um exemplo no qual 42 de 1.875 doadores de sangue testaram positivo para hepatite C na cidade de Xuzhou, China. Embora não sejam fornecidos valores de sensibilidade (\(S_e\)) e especificidade (\(S_p\)) no artigo correspondente de Liu et al. (1997), é comum que testes diagnósticos não apresentem precisão perfeita em contextos semelhantes.

Por exemplo, Wilkins et al. (2010) indicam valores de \(S_e = 0.96\) e \(S_p = 0.99\) para ensaios de reação em cadeia da polimerase (PCR) de RNA. Esses autores também apresentam valores mais altos e mais baixos de \(S_e\) e \(S_p\) para outros tipos de testes diagnósticos de hepatite C.

A proporção de indivíduos com resultado positivo para hepatite C foi \[ \widehat{\pi} = 42/1875 = 0.0224\cdot \] Assumindo os mesmos níveis de acurácia do ensaio de PCR, a estimativa de máxima verossimilhança (MLE) para a prevalência geral passa a ser \[ \widehat{\widetilde{\pi}}=\dfrac{0.0224+0.99-1}{0.96+0.99-1}=0.0131\cdot \]

A variância estimada de \(\widehat{\pi}\) é \[ 0.0224\times (1-0.0224)/1875 = 0.00001168, \] e a variância estimada de \(\widehat{\widetilde{\pi}}\) é \[ 0.0224\times (1-0.0224)/\big(1875\times (0.96+0.99-1)^2\big) = 0.00001294\cdot \]

Quando o erro do teste é incluído na análise, observa-se que a prevalência estimada diminui, enquanto a variância estimada aumenta. Os intervalos de Wald de 95% para \(\widehat{\pi}\) e \(\widetilde{\pi}\) são \(0.01570 < \widehat{\pi} < 0.02910\) e \(0.006002 <\widetilde{\pi} < 0.02010\), respectivamente.

Para examinar mais a fundo os efeitos do erro de teste, cálculos adicionais são apresentados na Tabela 6.1 para valores de \(S_e\) e \(S_p\) fornecidos por Wilkins et al. (2010) referentes a outros testes diagnósticos.

As linhas da tabela estão ordenadas de acordo com a incerteza global na acurácia do teste. Observa-se que, à medida que a incerteza global aumenta, a variância estimada também aumenta. Além disso, ocorrem estimativas sem sentido para \(\widetilde{\pi}\) com valores menores de \(S_p\) — incluindo um valor de -0.301 na última linha, que utiliza os valores de \(S_e\) e \(S_p\) de um ensaio de imunoblot recombinante.

Ressaltamos que essa comparação de estimativas pode ser, de certa forma, inadequada, uma vez que diferentes ensaios produzirão estimativas distintas de \(\pi\). Em particular, não se esperaria, na prática, uma estimativa tão extrema quanto -0.301, pois uma \(S_p\) baixa resulta em um número maior de indivíduos com resultados falso-positivos, o que, por sua vez, eleva o valor de \(\widehat{\pi}\). Ainda assim, essas comparações servem para demonstrar que uma maior incerteza conduz a uma maior variabilidade e, possivelmente, até mesmo a estimativas sem sentido.

# PURPOSE: Estimate prevalence under testing error                        #

library(ggplot2)

# 1. Parâmetros globais
w <- 42
n <- 1875
alpha <- 0.05

# 2. Nova função que retorna um data.frame estruturado
calc_prevalence <- function(teste, w, n, Se, Sp, alpha = 0.05) {
  pi.hat <- w / n
  pi.tilde.hat <- (pi.hat + Sp - 1) / (Se + Sp - 1)
  var.pi.tilde.hat <- pi.hat * (1 - pi.hat) / (n * (Se + Sp - 1)^2)
  
  # Margem de erro (Wald)
  me <- qnorm(1 - alpha / 2) * sqrt(var.pi.tilde.hat)
  ic_inf <- pi.tilde.hat - me
  ic_sup <- pi.tilde.hat + me
  
  # Forçar limites lógicos entre 0 e 1, se necessário
  ic_inf <- max(0, ic_inf)
  ic_sup <- min(1, ic_sup)
  
  data.frame(
    Teste = teste,
    Se = Se,
    Sp = Sp,
    Prevalencia = pi.tilde.hat,
    IC_Inf = ic_inf,
    IC_Sup = ic_sup
  )
}

# 3. Construção do Banco de Dados com os cenários do script original
dados_testes <- rbind(
  calc_prevalence("Recombinant Immunoblot", w, n, Se = 0.79, Sp = 0.80),
  calc_prevalence("Saliva-based anti-HCV",  w, n, Se = 0.87, Sp = 0.99),
  calc_prevalence("anti-HCV (ELISA) v1",     w, n, Se = 0.94, Sp = 0.97),
  calc_prevalence("anti-HCV (ELISA) v2",     w, n, Se = 1.00, Sp = 0.98),
  calc_prevalence("PCR (Original)",          w, n, Se = 0.96, Sp = 0.99)
)

# 4. Geração do Gráfico de Intervalos de Confiança (Forest Plot)
ggplot(dados_testes, aes(x = reorder(Teste, Prevalencia), y = Prevalencia)) +
  # Adiciona as barras de erro (Intervalo de Confiança)
  geom_errorbar(aes(ymin = IC_Inf, ymax = IC_Sup), width = 0.2, color = "#2c3e50", size = 0.8) +
  # Adiciona o ponto da estimativa central
  geom_point(color = "#e74c3c", size = 3.5) +
  # Inverte os eixos para facilitar a leitura dos nomes dos testes
  coord_flip() +
  # Customização estética e rótulos
  theme_minimal(base_size = 12) +
  labs(
    title = "Estimativa de Prevalência Corrigida por Erro de Teste",
    subtitle = paste("Baseado em w =", w, "positivos de n =", n, "indivíduos (Wald 95%)"),
    x = "Método de Testagem / Diagnóstico",
    y = "Prevalência Estimada (pi tilde)",
    caption = "Dados originais: Script Chris Bilder (2013)"
  ) +
  theme(
    plot.title = element_text(face = "bold", size = 14),
    panel.grid.minor = element_blank(),
    axis.title.x = element_text(margin = margin(t = 10))
  )

# Visualizar a tabela formatada no console
print(dados_testes)

##                    Teste   Se   Sp  Prevalencia
## 1 Recombinant Immunoblot 0.79 0.80 -0.301016949
## 2  Saliva-based anti-HCV 0.87 0.99  0.014418605
## 3    anti-HCV (ELISA) v1 0.94 0.97 -0.008351648
## 4    anti-HCV (ELISA) v2 1.00 0.98  0.002448980
## 5         PCR (Original) 0.96 0.99  0.013052632
##        IC_Inf        IC_Sup
## 1 0.000000000 -0.2896642260
## 2 0.006630109  0.0222071008
## 3 0.000000000 -0.0009910916
## 4 0.000000000  0.0092837823
## 5 0.006001993  0.0201032702

Tabela 6.1: Estimativas de prevalência para vários valores de \(S_e\) e \(S_p\).

6.1.2 Modelos de regressão binária

A presença de erro de teste pode ser incorporada à estimação de um modelo de regressão logística (ou outros modelos de regressão binária) de maneira semelhante à demonstrada na Seção 6.1.1.

A abordagem geral consiste em modelar a probabilidade verdadeira com base nas respostas \(y_1,\cdots,y_n\), que incluem possíveis erros de teste. Em seguida, aplica-se a Equação (6.2) para transitar entre as duas probabilidades distintas.

O modelo de regressão logística agora tem a forma \[ \text{logit}(\widetilde{\pi}_i)=\beta_0+\beta_1 x_{i1}+\cdots+\beta_p x_{ip}, \] onde \(\widetilde{\pi}_i\) é a verdadeira probabilidade de sucesso para a observação \(i = 1,\cdots, n\).

O modelo utiliza uma função de verossimilhança em um formato semelhante ao apresentado na Seção 2.2.1: \[ \begin{array}{rcl} L(\pmb{\beta} \, | \,\pmb{y}) & = & \displaystyle \prod_{i=1}^n \pi_i^{y_i} (1-\pi_i)^{1-y_i} \\[0.8em] & = & \displaystyle \prod_{i=1}^n \big(S_e\widetilde{\pi}_i +(1-S_p)(1-\widetilde{\pi}) \big)^{y_i} \Big(1-\big(S_e\widetilde{\pi}_i-(1-S_p)(1-\widetilde{\pi}_i)\big) \Big)^{1-y_i}, \end{array} \] onde \(\pi_i\) é a probabilidade de sucesso para a observação \(y_i\), \(\pmb{\beta} = (\beta_0,\cdots,\beta_p)\) e \(\pmb{y} = (y_1,\cdots,y_n)\).

Novamente, procedimentos numéricos iterativos precisam ser usados para estimar os parâmetros de regressão. A matriz de covariância estimada pode ser encontrada invertendo-se o negativo da matriz Hessiana. A variância de qualquer estimador de máxima verossimilhança (MLE) está relacionada à curvatura da função de log-verossimilhança nas imediações do MLE.

Se a log-verossimilhança for muito plana próximo ao máximo, há grande incerteza nos dados quanto à localização do parâmetro, ou seja, muitos valores diferentes do vetor de parâmetros \(\theta\) resultam em valores de verossimilhança igualmente elevados. Por outro lado, se a log-verossimilhança apresentar um pico acentuado, os dados indicam pouca dúvida sobre a região em que o parâmetro deve estar situado.

Formalmente, a variância da estimativa de máxima verossimilhança (MLE) se reduz, em amostras grandes, a uma quantidade que é estimada diretamente a partir da segunda derivada da função de verossimilhança em seu pico: \[ \dfrac{\partial^2}{\partial \pmb{\theta}^2} \log\big( L(\pmb{\theta} \, | \, \pmb{y})\big), \] que é conhecida como matriz Hessiana.

A partir da Hessiana, calcula-se a variância assintótica estimada, que chamaremos simplesmente de “variância estimada”, como \[ \tag{6.4} \widehat{\mbox{Var}}(\widehat{\pmb{\theta}})=-\left. \mbox{E}\left( \dfrac{\partial^2}{\partial \pmb{\theta}^2} \log\big( L(\pmb{\theta} \, | \, \pmb{Y})\big) \right)^{-1} \right|_{\pmb{\theta}=\widehat{\pmb{\theta}}}\cdot \]

A variância estimada pode, em vez disso, ser aproximada por \[ \tag{6.5} \widehat{\mbox{Var}}(\widehat{\pmb{\theta}}) \approx -\left. \left( \dfrac{\partial^2}{\partial \pmb{\theta}^2} \log\big( L(\pmb{\theta} \, | \, \pmb{y})\big) \right)^{-1} \right|_{\pmb{\theta}=\widehat{\pmb{\theta}}}\cdot \] o que é frequentemente mais fácil de calcular. A Equação (6.5) é assintoticamente equivalente à Equação (6.4), o que significa que essas variâncias estimadas serão essencialmente as mesmas em amostras muito grandes.

Outras variantes assintoticamente equivalentes dessas fórmulas também são utilizadas às vezes. O desvio padrão estimado da estatística, isto é, o erro padrão é calculado extraindo-se a raiz quadrada de \(\widehat{\mbox{Var}}(\widehat{\pmb{\theta}})\).

Qundo \(p>1\), \[ \widehat{\mbox{Var}}(\widehat{\pmb{\theta}})=\begin{pmatrix} \widehat{\mbox{Var}}(\widehat{\theta}_1) & \widehat{\mbox{Cov}}(\widehat{\theta}_1,\widehat{\theta}_2) & \cdots & \widehat{\mbox{Cov}}(\widehat{\theta}_1,\widehat{\theta}_p) \\ \widehat{\mbox{Cov}}(\widehat{\theta}_1,\widehat{\theta}_2) & \widehat{\mbox{Var}}(\widehat{\theta}_2) & \cdots & \widehat{\mbox{Cov}}(\widehat{\theta}_2,\widehat{\theta}_p) \\ \vdots & \vdots & \ddots & \vdots \\ \widehat{\mbox{Cov}}(\widehat{\theta}_1,\widehat{\theta}_p) & \widehat{\mbox{Cov}}(\widehat{\theta}_2,\widehat{\theta}_p) & \cdots & \widehat{\mbox{Var}}(\widehat{\theta}_p) \end{pmatrix}\cdot \]

Essa é conhecida como matriz de variância-covariância estimada, às vezes abreviada como matriz de covariância ou matriz de variância. Os elementos da diagonal da matriz, onde os números da linha e da coluna são iguais, são as variâncias estimadas dos MLEs.

Os elementos fora da diagonal são as covariâncias entre pares de MLEs. Essas covariâncias estimadas medem a dependência entre os MLEs e podem ser úteis para encontrar as variâncias de funções dos MLEs (ver Apêndice A). Porque \(\widehat{\mbox{Cov}}(\widehat{\theta}_i,\widehat{\theta}_j)=\widehat{\mbox{Cov}}(\widehat{\theta}_j,\widehat{\theta}_i)\), a matriz é simétrica, de modo que o elemento na linha \(i\), coluna \(j\) é igual ao elemento na linha \(j\), coluna \(i\), para qualquer \(i\neq j\).

Exemplo 6.2:

O objetivo deste exemplo é encontrar a variância de \(\widehat{\mu}\) na função de probabilidade Poisson. A Figura 6.1 mostra a curvatura da função de log-verossimilhança para duas amostras diferentes, onde a amostra 1 tem \[ y = (3, 5, 6, 6, 7, 10, 13, 15, 18, 22) \] e a amostra 2 tem \[ y = (9, 12)\cdot \]

Para ambas as amostras, \(\widehat{\mu} = 10.5\). Podemos ver que a função de log-verossimilhança da amostra 2 é relativamente plana devido ao seu pequeno tamanho de amostra, enquanto a função de log-verossimilhança da amostra 1 tem muito mais curvatura devido ao seu maior tamanho de amostra.

Como a variância de \(\widehat{\mu}\) é baseada nessa curvatura, esperaríamos que a variância da amostra 1 fosse muito menor que a variância da amostra 2. Formalmente, calculamos a variância como \[ \widehat{\mbox{Var}}(\widehat{{\mu}}) = -\left. \left( \dfrac{\partial^2}{\partial {\mu}^2} \log\big( L({\mu} \, | \, \pmb{y})\big) \right)^{-1} \right|_{{\mu}=\widehat{{\mu}}} = \dfrac{\widehat{\mu}^2}{\displaystyle \sum_{i=1}^n y_i} = \dfrac{\widehat{\mu}}{n}\cdot \]

#########################
# Amostra #1

  y1<-c(3,5,6,6,7,10,13,15,18,22) 
  n1<-length(y1)  # Sample size
  mle1 <- sum(y1)/n1
  mle1

## [1] 10.5

  maxlik1 <- -n1*mle1 + log(mle1)*sum(y1) - sum(lfactorial(y1))  # log(L) = -n*mu +log(mu)*sum(y_i) - sum(log(y_i !)) evaluated at MLE (mu^)
  maxlik1  # Maximum possible value of log likelihood

## [1] -36.79099

  # curve(expr=-n1*x + log(x)*sumy1 - sumlfac1, from=3, to=25, xlab=expression(mu),ylab="Log Likelihood")
  
  mle1^2/sum(y1)  # Var^(mu^)

## [1] 1.05

#########################
# Amostra #2

  y2 <- c(9,12)
  n2<-length(y2)
  
  # Example of evaluating log(L)
  mu <- c(1:25)
  loglik2 <- -n2*mu + log(mu)*sum(y2) - sum(lfactorial(y2)) # log(L) = -n*mu +log(mu)*sum(y_i) - sum(log(y_i !)) 
  data.frame(mu,loglik2)

##    mu    loglik2
## 1   1 -34.789042
## 2   2 -22.232951
## 3   3 -15.718184
## 4   4 -11.676860
## 5   5  -8.990846
## 6   6  -7.162093
## 7   7  -5.924929
## 8   8  -5.120770
## 9   9  -4.647326
## 10 10  -4.434755
## 11 11  -4.433241
## 12 12  -4.606002
## 13 13  -4.925105
## 14 14  -5.368838
## 15 15  -5.919988
## 16 16  -6.564679
## 17 17  -7.291562
## 18 18  -8.091235
## 19 19  -8.955823
## 20 20  -9.878664
## 21 21 -10.854071
## 22 22 -11.877150
## 23 23 -12.943663
## 24 24 -14.049912
## 25 25 -15.192650

  mle2 <- sum(y2)/n2
  mle2

## [1] 10.5

  maxlik2 <- -n2*mle2 + log(mle2)*sum(y2) - sum(lfactorial(y2)) 
  maxlik2  # Maximum possible value of log likelihood

## [1] -4.410162

  mle2^2/sum(y2)  # Var^(mu^)

## [1] 5.25

#########################
# Plot 

# Instale se não tiver: install.packages("ggplot2")
library(ggplot2)

# Criando um data frame com os valores das funções para o ggplot
x_seq <- seq(3, 25, length.out = 200)
f1 <- -n1*x_seq + log(x_seq)*sum(y1) - sum(lfactorial(y1)) - maxlik1
f2 <- -n2*x_seq + log(x_seq)*sum(y2) - sum(lfactorial(y2)) - maxlik2

df_plot <- data.frame(
  mu = rep(x_seq, 2),
  loglik = c(f1, f2),
  Amostra = rep(c(paste0("Amostra 1 (n=", n1, ")"), paste0("Amostra 2 (n=", n2, ")")), each = 200)
)

# Construindo o gráfico
ggplot(df_plot, aes(x = mu, y = loglik, color = Amostra, linetype = Amostra)) +
  geom_line(size = 1.2) +
  # Linha vertical do MLE
  geom_vline(xintercept = mle1, linetype = "dotted", color = "gray40", size = 0.8) +
  # Ponto no valor máximo
  annotate("point", x = mle1, y = 0, color = "red", size = 3) +
  annotate("text", x = mle1 + 1.8, y = 2, label = paste("MLE =", mle1), color = "gray30", fontface = "italic") +
  # Estilização de cores modernas
  scale_color_manual(values = c("#1f77b4", "#ff7f0e")) +
  scale_linetype_manual(values = c("solid", "dashed")) +
  # Limites e Rótulos
  ylim(-50, 5) +
  labs(
    title = "Log-Verossimilhança Relativa para Amostras de Poisson",
    subtitle = "Amostra 2 (menor) apresenta maior incerteza (curva mais aberta)",
    x = expression(paste("Parâmetro ", mu)),
    y = expression(log[L](mu) - log[L](hat(mu)))
  ) +
  # Tema minimalista e limpo
  theme_minimal(base_size = 12) +
  theme(
    legend.position = c(0.85, 0.2),
    legend.title = element_blank(),
    panel.grid.minor = element_blank(),
    plot.title = element_text(face = "bold")
  )

Figura 6.1: Log-verossimilhanças de Poisson para amostras de tamanho \(n = 10\) (amostra 1) e \(n = 2\) (amostra 2) com estimador de máxima verossimilhança (EMV) comum \(\widehat{\mu}= 10.5\). Observe que as duas curvas foram deslocadas verticalmente de modo que os valores de log-verossimilhança sejam iguais a 0 no EMV.

Para a amostra 1, \[ \widehat{\mbox{Var}}(\widehat{{\mu}}) = 10.5/10 = 1.05, \] enquanto para a amostra 2, \[ \widehat{\mbox{Var}}(\widehat{{\mu}})= 10.5/2 = 5.25\cdot \] Como esperado, a variância de \(\widehat{\mu}\) é maior para a amostra 2 do que para a amostra 1.

Exemplo 6.3: Rastreamento pré-natal de doenças infecciosas.

Verstraeten et al. (1998) realizaram uma triagem de HIV em uma amostra de gestantes no Quênia com o objetivo de avaliar um novo método de triagem. Embora não abordado neste artigo, trabalhos posteriores de Vansteelandt et al. (2000) e outros analisaram esses dados no contexto de modelos de regressão binária. Uma parte do conjunto de dados original está disponível no conjunto de dados correspondente a este exemplo.

A variável resposta, hiv, assume o valor 0 para teste negativo e 1 para teste positivo. As variáveis explicativas são:

1. parity (número de partos anteriores da mulher),

2. age (idade em anos),

3. marital.status (1 = solteira, 2 = casada em regime polígamo, 3 = casada em regime monogâmico, 4 = divorciada) e

4. education (1 = nenhuma, 2 = ensino fundamental, 3 = ensino médio, 4 = ensino superior).

Aqui, concentramo-nos apenas na variável explicativa age, deixando a análise envolvendo as demais variáveis para o Exercício 4. Abaixo, apresentam-se os resultados do ajuste de um modelo de regressão logística aos dados, assumindo a ausência de erro de teste:

set1 <- read.csv( file = "https://estatistica.c3sl.ufpr.br/~lucambio/ADC/HIVKenya.csv")
head( set1 )

##   parity age marital.status education hiv
## 1      1  16              3         2   0
## 2      0  17              3         1   0
## 3      2  26              3         2   0
## 4      3  20              3         2   0
## 5      1  18              3         1   0
## 6      5  35              3         2   0

mod.fit <- glm ( formula = hiv ~ age , data = set1 , family = binomial ( link = logit ) )
round ( summary( mod.fit )$coefficients , 4)

##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  -1.8618     0.6917 -2.6917   0.0071
## age          -0.0273     0.0287 -0.9528   0.3407

O processo de testagem propriamente dito envolveu uma série de até três testes por indivíduo, a fim de reduzir a probabilidade de um diagnóstico incorreto. Infelizmente, os dados de cada teste individual não estão disponíveis; o conjunto de dados fornece apenas os diagnósticos finais. Para fins de ilustração, examinamos a seguir como estimar o modelo considerando \(S_e = 0.98\) e \(S_p = 0.98\).

Apresentamos duas formas de estimar o modelo utilizando o R. Primeiramente, seguimos um processo semelhante ao ilustrado na Seção 2.2.1, quando utilizamos uma função própria para avaliar a log-verossimilhança e, em seguida, a função optim() para maximizá-la. Abaixo, apresentamos o código e a saída correspondente:

Se <- 0.98  # non-perfect testing
Sp <- 0.98
# Se <- 1  # Use perfect testing to confirm that one obtains the same answer with all model fitting methods
# Sp <- 1


###########################################################################
# Estimate the model using glm() and no testing error

 mod.fit <- glm(formula = hiv ~ age, data = set1, family = binomial(link = logit))
 round(summary(mod.fit)$coefficients, 4)

##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  -1.8618     0.6917 -2.6917   0.0071
## age          -0.0273     0.0287 -0.9528   0.3407

 logLik(mod.fit)

## 'log Lik.' -177.2237 (df=2)

 X <- model.matrix(mod.fit)
 # library(package = car)
 # Anova(mod.fit)

###########################################################################
# Estimate the model using optim()

 logL <- function(beta, X, Y, Se, Sp) {
  # pi.tilde <- exp(X%*%beta)/(1+exp(X%*%beta))  # Same as plogis()
  pi.tilde <- plogis(X%*%beta)
  # Non-matrix algebra alternative for an intercept and one explanatory variable
  # pi.tilde <- exp(beta[1] + beta[2]*X[,2])/(1+exp(beta[1] + beta[2]*X[,2]))
  pi <- Se*pi.tilde + (1 - Sp)*(1 - pi.tilde)
  sum(Y*log(pi) + (1-Y)*log(1-pi))
 }

 mod.fit.opt <- optim(par = mod.fit$coefficients, fn = logL, hessian = TRUE,
  X = X, Y = set1$hiv, control = list(fnscale = -1), Se = Se, Sp = Sp, method = "BFGS")
 mod.fit.opt$par # beta.hats

## (Intercept)         age 
##  -2.0068169  -0.0334271

 mod.fit.opt$value # log(L)

## [1] -177.27

 mod.fit.opt$convergence # 0 means converged

## [1] 0

 cov.mat <- -solve(mod.fit.opt$hessian) # Estimated covariance matrix; multiply by -1 because of fnscale
 cov.mat

##             (Intercept)          age
## (Intercept)   0.7884776 -0.032263002
## age          -0.0322630  0.001388222

 sqrt(diag(cov.mat)) # SEs

## (Intercept)         age 
##  0.88796260  0.03725886

 z <- mod.fit.opt$par[2]/sqrt(diag(cov.mat))[2] # Wald statistic
 2*(1-pnorm(q = abs(z))) # p-value

##       age 
## 0.3696344

 # Compare to optim results
 summary(mod.fit)$coefficients

##               Estimate Std. Error    z value
## (Intercept) -1.8617993 0.69168074 -2.6917032
## age         -0.0273417 0.02869631 -0.9527949
##                Pr(>|z|)
## (Intercept) 0.007108818
## age         0.340693997

A função logL() avalia a função de log-verossimilhança utilizando álgebra matricial para calcular \(\widetilde{\pi}_i\) para \(i = 1,\cdots,n\). Essa representação via álgebra matricial permite que o código seja generalizado para mais de uma variável explicativa. Uma alternativa que não utiliza álgebra matricial, para o caso de uma única variável explicativa, é apresentada no programa correspondente. O modelo de regressão logística estimado é \[ \text{logit}(\widehat{\widetilde{\pi}})=-2.0068169-0.0334271\times \mbox{age} \cdot \]

Uma estimativa numérica da matriz Hessiana é produzida especificando hessian = TRUE em optim() e leva à matriz de covariância estimada para \(\widehat{\beta}_0\) e \(\widehat{\beta}_1\) conforme a Equação (6.5). Um teste de Wald de \(H_0 : \beta_1 = 0\) vs. \(H_a : \beta_1\neq 0\) tem um \(p\)-valor de 0.3696, o que indica pouca evidência de que um termo linear de idade seja necessário.

O modelo também pode ser estimado escrevendo uma nova função de ligação para o argumento family de glm(). Especificamente, a forma da função de ligação pode ser vista reescrevendo nosso modelo como \[ \text{logit}\left(\dfrac{\pi+S_p-1}{S_e+S_p-1} \right) = \beta_0+\beta_1\times \mbox{age}, \] onde a Equação (6.1) é utilizada para expressar o modelo em termos de \(\widehat{\pi}\).

Isolar \(\pi\) no lado esquerdo resulta na função de ligação inversa: \[ \pi=\dfrac{S_e \exp(\beta_0+\beta_1\times \mbox{age})-S_1+1}{1+\exp(\beta_0+\beta_1\times \mbox{age})}\cdot \]

Codificamos essas equações em nossa própria função, abaixo:

# Estimate the model using the m.logit() function and glm()

 # Used posting at https://stat.ethz.ch/pipermail/r-help/2006-April/103799.html and the work of
 #  Boan Zhang in Zhang, Bilder, and Tebbs (Statistics in Medicine, 2013) for motivation
 # mu = E(Y) = pi
 my.link <- function(Se, Sp) {
  linkfun <- function(mu) {
   pi.tilde <- (mu + Sp - 1)/(Se + Sp - 1)
   log(pi.tilde/(1-pi.tilde))
  }
  linkinv <- function(eta) {
   (exp(eta)*Se - Sp + 1)/(1 + exp(eta))
  }
  mu.eta <- function(eta) {
   exp(eta)*(Se + Sp - 1)/(1 + exp(eta))^2
  }
  save.it <- list(linkfun = linkfun, linkinv = linkinv, mu.eta = mu.eta)
  class(save.it) <- "link-glm"
  save.it
 }

 mod.fit2 <- glm(formula = hiv ~ age, data = set1, family = binomial(link = my.link(Se, Sp)))
 round(summary(mod.fit2)$coefficients, 4)

##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  -2.0097     0.9398 -2.1383   0.0325
## age          -0.0333     0.0397 -0.8396   0.4011

 vcov(mod.fit2)

##             (Intercept)          age
## (Intercept)  0.88329971 -0.036451992
## age         -0.03645199  0.001573203

A função mu.eta() dentro de my.link() fornece a derivada parcial de \(\pi\) em relação ao componente sistemático, \(\eta=\beta_0+\beta_1\times \mbox{age}\): \[ \dfrac{\partial\pi}{\partial\eta}=\dfrac{\exp(\eta)(S_e+S_p-1)}{\big(1+\exp(\eta) \big)^2}\cdot \]

A função glm() é então utilizada da mesma maneira que na regressão logística, exceto pelo valor do parâmetro de ligação (link) dentro de binomial(). As estimativas dos parâmetros de regressão são praticamente idênticas às obtidas com o uso de optim().

As pequenas diferenças entre as matrizes de covariância estimadas pelos dois métodos decorrem do fato de que glm() utiliza a Equação (6.4) em seu cálculo, enquanto optim() utiliza a Equação (6.5).

A raiz quadrada da variância estimada para \(\widehat{\beta}_1\) é 0.0287 na ausência de erro de teste e 0.0397 na presença de erro de teste. Esse aumento ocorre porque há maior incerteza na resposta quando o erro de teste está presente, o que se reflete nas variâncias das estimativas dos parâmetros de regressão. O Exercício 6 examina esse comportamento mais detalhadamente.

6.1.3 Outros métodos

Os métodos descritos na Seção 6.1.2 destinam-se a situações em que os valores de \(S_e\) e \(S_p\) são conhecidos, ou quando a variabilidade decorrente da estimativa de \(S_e\) e \(S_p\) é desconhecida ou não pode ser facilmente obtida. Quando os dados originais utilizados para estimar \(S_e\) e \(S_p\) estão disponíveis, eles podem ser empregados na construção de uma estimativa intervalar para \(\widetilde{\pi}\) de modo a levar em conta a variabilidade adicional.

Em outras situações, existem mais de duas categorias de resposta de interesse para um determinado problema, como vimos no Capítulo 3. Essas categorias de resposta adicionais levam, consequentemente, a mais tipos de classificação incorreta que precisam ser tratados. O Capítulo 2 do livro de Buonaccorsi (2010) aborda ambas as situações mencionadas, e remetemos o leitor a essa obra para uma discussão detalhada.

Küchenhoff et al. (2006) apresentam uma abordagem inovadora para levar em conta o erro de teste em contextos de resposta categórica e/ou variáveis explicativas. Seu método de “classificação incorreta, simulação e extrapolação” (MC-SIMEX) é implementado pelo pacote simex do R (Lederer and Küchenhoff 2006), e mostramos como utilizar esse pacote no Exercício 7.

Em situações nas quais apenas uma variável de resposta binária está sujeita a erro de teste, simulações realizadas por Küchenhoff et al. (2006) demonstram que a metodologia de máxima verossimilhança descrita nas Seções 6.1.1 e 6.1.2 fornece estimadores praticamente não viesados, ao passo que o método MC-SIMEX produz estimadores com algum viés. Portanto, os métodos de análise aqui apresentados seriam, em geral, preferíveis quando a sensibilidade (\(S_e\)) e a especificidade (\(S_p\)) são conhecidas.

A análise de dados medidos com erro — seja na variável de resposta ou nas variáveis explicativas — constitui uma área de pesquisa ampla e ativa. Obras como as de Buonaccorsi (2010), Carroll et al. (2010) e Gustafson (2004) oferecem abordagens detalhadas sobre o tema.

6.2 Inferência exata

A maioria dos procedimentos de inferência examinados até o momento baseia-se em uma afirmação semelhante à seguinte: À medida que o tamanho da amostra tende ao infinito, a distribuição da estatística aproxima-se de uma distribuição qui-quadrado (ou normal).

Infelizmente, o infinito é o único tamanho de amostra que nunca podemos obter. Existem muitas situações em que uma distribuição “nomeada” — como a normal ou a qui-quadrado — serve como uma boa aproximação para a distribuição real da estatística.

No entanto, há situações em que isso não ocorre, particularmente quando o tamanho da amostra é pequeno. O objetivo desta seção é desenvolver procedimentos de inferência que não dependam de aproximações para amostras grandes. Tais procedimentos são frequentemente chamados de “exatos”, no sentido de que utilizam a distribuição real da estatística de interesse, baseando-se em pressupostos mínimos sobre a estrutura dos dados.

Esses procedimentos de inferência exata também costumam oferecer meios de avaliar se uma aproximação da distribuição de uma estatística para amostras grandes é ou não adequada.

Métodos de inferência exata foram discutidos inicialmente na Seção 1.1.2, em relação ao intervalo de Clopper-Pearson para o parâmetro de probabilidade de sucesso em uma distribuição binomial. Mostramos que o intervalo sempre apresentava um nível de confiança real pelo menos igual ao nível declarado, podendo, contudo, ser bem superior a ele. Isso nos levou a classificar o intervalo como conservador.

Infelizmente, a maioria dos outros métodos de inferência exata também é conservadora. No contexto de testes de hipóteses, os testes exatos tendem a rejeitar a hipótese nula com menor frequência do que o nível declarado de erro do Tipo I quando a hipótese nula é verdadeira; a taxa de rejeição nunca será superior a esse nível. Esse comportamento persiste quando a hipótese nula é falsa, de modo que testes exatos podem apresentar menor poder estatístico do que outros testes. Ainda assim, um teste conservador é geralmente preferível a um teste liberal quando o controle da taxa de erro é importante — especialmente em situações com amostras pequenas, nas quais testes não exatos podem se tornar excessivamente liberais.

Não dispomos de espaço para abordar todos os procedimentos possíveis de inferência exata; por isso, começamos na Seção 6.2.1 com um dos procedimentos exatos mais utilizados: o teste exato de Fisher. Generalizamos as ideias de inferência exata na Seção 6.2.2, onde métodos de permutação nos permitem testar a independência. Na Seção 6.2.3, introduzimos a inferência exata no contexto da regressão logística. Por fim, concluímos com uma visão geral de outros procedimentos de inferência exata na Seção 6.2.4, destinada aos leitores que desejam aprofundar-se no assunto.

6.2.1 Teste exato de Fisher para independência

Começamos examinando um teste de independência em uma tabela de contingência \(2\times 2\), uma estrutura estudada anteriormente na Seção 1.2. Sejam dois grupos representados pelas linhas da tabela e as respostas “sucesso” e “falha” representadas pelas colunas. Lembre-se de que uma razão de chances (OR) com valor igual a 1 significa que as chances de sucesso para o grupo 1 são iguais às chances de sucesso para o grupo 2; isto é, as chances são independentes da designação do grupo.

Com base nesse resultado, escreveremos simplesmente \(H_0 : OR = 1\) vs. \(H_a : OR \neq 1\) como nossas hipóteses em um teste de independência entre as respostas das colunas e as respostas das linhas.

Distribuição hipergeométrica

A distribuição de probabilidade hipergeométrica desempenha um papel importante na construção de um teste exato de independência; por isso, apresentamos aqui uma breve revisão. Essa distribuição é tipicamente introduzida por meio de um exemplo como o seguinte:

Suponha que uma urna contenha \(a\) bolas vermelhas e \(b\) bolas azuis, com \(n = a + b\). Suponha que \(k \leq n\) bolas sejam retiradas aleatoriamente da urna, sem reposição. Seja \(M\) o número de bolas vermelhas retiradas.

\[ \begin{array}{ccccccccccc}\hline\hline & & & \mbox{Resposta} & & & & & \mbox{Urna} & & \\[0.4em] & & 1 & 2 & & & & & \mbox{Estraídas} & \mbox{Restantes} & \\[0.8em]\hline \mbox{Grupo} & 1 & \omega_1 & n_1-\omega_1 & n_1 & & \mbox{Cor} & \mbox{Vermelhas} & m & a-m & a \\[0.8em] & 2 & \omega_2 & n_2-\omega_2 & n_2 & & & \mbox{Azuis} & k-m & b-k+m & b \\[0.4em]\hline & & \omega_+ & n_+ - \omega_+ & n_+ & & & & k & n-k & n \\\hline\hline \end{array} \] Tabela 6.2: Duas representações de uma tabela \(2\times 2\). A representação à esquerda utiliza a notação da Seção 1.2.1, e a representação à direita utiliza a notação da distribuição hipergeométrica no contexto do exemplo da urna.

A variável aleatória \(M\) tem uma distribuição hipergeométrica. A função de probabilidade é \[ P(M=m)=\dfrac{\displaystyle \binom{a}{m}\binom{b}{k-m}}{\displaystyle \binom{n}{k}}, \] para \(m = 0,\cdots,k\), sujeito a \(m\leq a\) e \(k-m\leq b\). Note que \(a\), \(b\), \(n\) e \(k\) são todas quantidades fixas. A única variável no lado direito é \(m\).

A distribuição hipergeométrica pode ser utilizada para determinar a probabilidade de se observar uma determinada tabela \(2\times 2\) sob a condição de independência. A Tabela 6.2 apresenta uma tabela \(2\times 2\) sob duas perspectivas. O lado esquerdo mostra a notação para uma tabela \(2\times 2\) segundo o modelo binomial de independência, conforme apresentado na Seção 1.2.1.

O lado direito mostra a mesma tabela utilizando a notação da distribuição hipergeométrica. A principal diferença entre ambas é que, na distribuição hipergeométrica, todas as contagens marginais são fixas (ou seja, conhecidas) antes da realização de qualquer amostragem; já no modelo binomial, as margens das colunas — que representam o número total de sucessos e fracassos observados — são consideradas aleatórias. No entanto, sob certas premissas, os modelos para essas duas tabelas podem ser tornados equivalentes, como demonstraremos a seguir.

No modelo binomial independente, observamos duas variáveis aleatórias, \(W_1\) e \(W_2\). Utilizamos os valores observados \(\omega_1\) e \(\omega_2\) para comparar as respectivas probabilidades de sucesso, \(\pi_1\) e \(\pi_2\). O número total de sucessos, \(\omega_+\), não fornece informações sobre a possível diferença entre \(\pi_1\) e \(\pi_2\) e, portanto, não é relevante para a comparação. Assim, não há prejuízo em “condicionar a” \(w_+\), isto é, assumir que esse valor é conhecido, em vez de aleatório. De fato, existem vantagens matemáticas em adotar essa suposição.

Quando \(H_0: \pi_1 = \pi_2\) é verdadeira, pode-se demonstrar que condicionar a \(\omega_+\) no modelo binomial independente conduz ao modelo hipergeométrico. Consulte o Exercício 1 para obter detalhes dessa derivação.

Como todos os totais marginais são conhecidos no modelo hipergeométrico, uma vez observada a contagem de uma célula, as três contagens restantes são obtidas por subtração, determinando-se assim toda a tabela. Dessa forma, a distribuição hipergeométrica nos fornece a probabilidade de observar uma determinada tabela de contingência sob a hipótese de independência. Isso é útil para a construção de um teste de independência, pois oferece um método para calcular o \(p\)-valor exato do teste.

Se a probabilidade de ocorrer uma tabela tão extrema quanto a observada for baixa, isso coloca em dúvida a suposição de independência. O teste exato de Fisher, que discutiremos a seguir, baseia-se nessa ideia.

Teste exato de Fisher

Salsburg (2001) descreve um dos eventos mais frequentemente discutidos na história da estatística da seguinte forma. Certo dia, em Cambridge, Inglaterra, no final da década de 1920, algumas pessoas reuniram-se para o chá da tarde. Uma senhora do grupo afirmou ser capaz de distinguir se o leite ou o chá havia sido colocado primeiro na xícara. Sir Ronald Fisher, que contribuiu imensamente para os fundamentos iniciais da estatística, estava no grupo e propôs um experimento simples para testar a afirmação da senhora.

Ele sugeriu colocar primeiro o chá em quatro xícaras e, primeiro, o leite em outras quatro. A senhora não sabia em quais xícaras o leite ou o chá haviam sido colocados primeiro, mas sabia que havia quatro de cada tipo. Assim, esperava-se que ela escolhesse quatro xícaras com leite e quatro com chá, resultando em valores fixos tanto para os totais das linhas quanto para os das colunas em uma tabela de contingência \(2\times 2\) que resumisse suas escolhas. A Tabela 6.3 apresenta um resultado hipotético do experimento, no qual duas xícaras foram identificadas incorretamente.

\[ \begin{array}{c:c}\hline\hline & \mbox{A resposta da dama} \\ \begin{array}{cc} & \\ \hline \mbox{Verdadeiro} & \mbox{Leite} \\ & \mbox{Chá} \\\hline & & \\ \end{array} & \begin{array}{ccc} \mbox{Leite} & \mbox{Chá} & \\ \hline 3 & 1 & 4 \\ 1 & 3 & 4 \\\hline 4 & 4 & 8 \end{array} \\\hline\hline \end{array} \] Tabela 6.3: Resultado hipotético do experimento de Fisher.

Se a senhora não conseguisse realmente distinguir qual ingrediente foi adicionado primeiro à xícara, então suas escolhas de “leite” corresponderiam, na realidade, a quatro xícaras selecionadas ao acaso, e as probabilidades associadas a uma resposta de “leite” seriam as mesmas, independentemente de o leite ou o chá ter sido realmente adicionado primeiro, as probabilidades da linha 1 seriam iguais às da linha 2.

Essa estrutura de amostragem é a mesma do exemplo anterior de “bolas e urnas”, no qual o leite e o chá representam as duas cores das bolas. Portanto, podemos calcular as probabilidades de todas as tabelas \(2\times 2\) possíveis nesse cenário utilizando a distribuição hipergeométrica.

Essas probabilidades são apresentadas na Tabela 6.4, onde m representa a contagem na célula \((1,1)\) da tabela de contingência. Observa-se que, quanto mais próxima de 1 estiver a razão de chances estimada, maior será a probabilidade de uma determinada tabela de contingência ser observada por meio de uma seleção aleatória. O inverso ocorre à medida que a razão de chances estimada se afasta de 1.

\[ \begin{array}{cccccc}\hline M & & P(M=m) & & \widehat{OR} & X^2 \\[0.8em]\hline 0 & & 0.0143 & & 0 & 8 \\ 1 & & 0.2286 & & 1/9 & 2 \\ 2 & & 0.5143 & & 1 & 0 \\ 3 & & 0.2286 & & 9 & 2 \\ 4 & & 0.0143 & & >9 & 8 \\ \hline\hline \end{array} \] Tabela 6.4: Probabilidade dos resultados possíveis para o experimento de Fisher. Observe que a última razão de chances é \(4\times 4/(0\times 0)\), a qual é indefinida. Esse valor foi designado como \(> 9\).

Suponha que a senhora tenha respondido conforme mostrado na Tabela 6.3. A razão de chances (odds ratio) estimada é 9, indicando que a chance estimada de uma resposta “leite” é 9 vezes maior quando o leite é realmente colocado primeiro do que quando o chá é colocado primeiro. Assim, pode parecer que a senhora é capaz de detectar o que foi colocado primeiro na xícara.

As probabilidades apresentadas na Tabela 6.4 medem a probabilidade de essa ou outras escolhas ocorrerem caso ela não soubesse realmente a diferença. Podemos utilizar essas probabilidades no contexto de um teste de hipóteses padrão, no qual calculamos um \(p\)-valor (p-value) como a probabilidade de ocorrer um evento pelo menos tão extremo quanto aquele observado.

A probabilidade de acertar ao acaso três ou mais das xícaras com leite primeiro é \[ P(M\geq 3) = 0.2286 + 0.0143 = 0.,2429\cdot \] Essa probabilidade é relativamente alta; portanto, concluiríamos que a resposta da senhora não seria incomum para alguém que estivesse chutando ao acaso. Suponha, por outro lado, que ela tivesse identificado corretamente todas as quatro xícaras em que o leite foi colocado primeiro. Nesse caso, começaríamos a acreditar que se tratava de uma habilidade dela, pois a probabilidade de fazer isso ao acaso é de apenas \(P(M\geq 4) = 0.0143\).

Os cenários descritos no último parágrafo mostram como calcular um \(p\)-valor para o teste exato de Fisher para \(H_0: OR \leq 1\) versus \(H_a: OR > 1\). Uma hipótese alternativa unilateral faz mais sentido aqui do que uma bilateral, pois apenas \(OR > 1\) significa que a senhora consegue identificar corretamente o que foi despejado primeiro na xícara. Em geral, para um teste unilateral, o \(p\)-valor é calculado como a soma das probabilidades da tabela apenas na direção representada pela hipótese alternativa.

Para outras situações, um teste bilateral pode ser de interesse. O \(p\)-valor para um teste bilateral é calculado como a probabilidade de observar um valor \(M\) pelo menos tão extremo quanto o observado, isto é, observar uma tabela de contingência com probabilidade menor ou igual a \(P(M = m)\).

Para fins de demonstração, o \(p\)-valor de um teste bilateral é \[ 0.0143 + 0.2286 + 0.2286 + 0.0143 = 0.4858 \] se a Tabela 6.3 for observada. Um método alternativo, às vezes utilizado para calcular \(p\)-valores de testes bilaterais, consiste simplesmente em tomar o dobro do menor dos dois \(p\)-valores unilaterais. Para os dados da Tabela 6.3, calculamos \[ 2\min\{0.5, P(M\leq 3),P(M\geq 3\}=2\min\{0.5,0.9857,0.2429\} = 0.4858, \] onde 0.5 é incluído entre colchetes para garantir que o \(p\)-valor calculado não exceda 1. Os dois métodos de cálculo do \(p\)-valor apresentados são equivalentes quando a distribuição correspondente é simétrica.

Observamos anteriormente que os procedimentos de inferência exata são frequentemente conservadores ao rejeitar a hipótese nula. Esse também é o caso do teste exato de Fisher, devido à natureza altamente discreta da distribuição hipergeométrica. Raramente ocorre de haver uma configuração de probabilidades da tabela sob \(H_0\) que leve exatamente ao nível de significância α declarado. Para a versão unilateral do experimento da senhora que prova o chá, existe apenas uma probabilidade de 0.0143 de observar um \(p\)-valor abaixo de \(\alpha = 0,05\) sob a condição de independência; portanto, um teste nesse nível tem, na verdade, uma taxa de erro do Tipo I de 0.0143, não sendo possível realizar um teste com uma taxa de erro do Tipo I exatamente igual a 0.05.

Exemplo 6.4: Prova de chá

Salsburg (2001) indica que a senhora respondeu corretamente em relação a todas as 8 xícaras, resultando em um \(p\)-valor de 0.0143. Para reproduzir esses cálculos no R, podemos utilizar a função dhyper() para encontrar as probabilidades da distribuição hipergeométrica ou usar fisher.test() para calcular o \(p\)-valor.

# All possible probabilities 
M <- 0:4
# Syntax for dhyper(m, a, b, k)
data.frame(M, prob = round(dhyper(M, 4, 4, 4), 4))

##   M   prob
## 1 0 0.0143
## 2 1 0.2286
## 3 2 0.5143
## 4 3 0.2286
## 5 4 0.0143

c.table <- array(data = c(4, 0, 0, 4), dim = c(2,2), dimnames = list(Actual = c("Milk", "Tea"),
          Response = c("Milk", "Tea")))
c.table

##       Response
## Actual Milk Tea
##   Milk    4   0
##   Tea     0   4

fisher.test(x = c.table)

## 
##  Fisher's Exact Test for Count Data
## 
## data:  c.table
## p-value = 0.02857
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  1.339059      Inf
## sample estimates:
## odds ratio 
##        Inf

fisher.test(x = c.table, alternative = "greater")

## 
##  Fisher's Exact Test for Count Data
## 
## data:  c.table
## p-value = 0.01429
## alternative hypothesis: true odds ratio is greater than 1
## 95 percent confidence interval:
##  2.003768      Inf
## sample estimates:
## odds ratio 
##        Inf

###############################################################################
# Exact distribution for X^2

 X.sq <- c(chisq.test(x = matrix(data = c(0, 4, 4, 0), nrow = 2, ncol = 2), correct = FALSE)$statistic,
     chisq.test(x = matrix(data = c(1, 3, 3, 1), nrow = 2, ncol = 2), correct = FALSE)$statistic,
     chisq.test(x = matrix(data = c(2, 2, 2, 2), nrow = 2, ncol = 2), correct = FALSE)$statistic,
     chisq.test(x = matrix(data = c(3, 1, 1, 3), nrow = 2, ncol = 2), correct = FALSE)$statistic,
     chisq.test(x = matrix(data = c(4, 0, 0, 4), nrow = 2, ncol = 2), correct = FALSE)$statistic)
 pmf1 <- data.frame(X.sq, prob = round(dhyper(0:4, 4, 4, 4),4))
 pmf1

##   X.sq   prob
## 1    8 0.0143
## 2    2 0.2286
## 3    0 0.5143
## 4    2 0.2286
## 5    8 0.0143

 # Find PMF over unique values of X^2 (See Chapter 2's placekick example for another use of this function)
 pmf2 <- aggregate( prob ~ X.sq, data = pmf1, FUN = sum)
 cdf <- cumsum(pmf2$prob)
 pmf3 <- data.frame(pmf2, cdf)
 pmf3  # >1 in last element due to rounding error

##   X.sq   prob    cdf
## 1    0 0.5143 0.5143
## 2    2 0.4572 0.9715
## 3    8 0.0286 1.0001

# Plot of CDFs
plot(x = c(0,0,9,9), y = c(0,1,0,1), type = "n", ylab = "Cumulative probability", xlab = expression(X^2))
 abline(h = c(0,1), col = "black", lty = "dotted")
 curve(expr = pchisq(q = x, df = 1), xlim = c(0,9), col = "black", ylab = "Cumulative probability", xlab = expression(X^2), 
   add = TRUE, lwd = 2, n = 1000)
 curve(expr = pchisq(q = x, df = 1), xlim = c(9,12), col = "black", add = TRUE, lwd = 2)
 segments(x0 = -1, y0 = 0, x1 = 0, y1 = 0, lwd = 1, col = "black", lty = "dashed")
 segments(x0 = 0, y0 = 0, x1 = 0, y1 = 0.5143, lwd = 1, col = "black", lty = "dashed")
 segments(x0 = 0, y0 = 0.5143, x1 = 2, y1 = 0.5143, lwd = 1, col = "black", lty = "dashed")
 segments(x0 = 2, y0 = 0.5143, x1 = 2, y1 = 0.9714, lwd = 1, col = "black", lty = "dashed")
 segments(x0 = 2, y0 = 0.9714, x1 = 8, y1 = 0.9714, lwd = 1, col = "black", lty = "dashed")
 segments(x0 = 8, y0 = 0.9714, x1 = 8, y1 = 1, lwd = 1, col = "black", lty = "dashed")
 segments(x0 = 8, y0 = 1, x1 = 10, y1 = 1, lwd = 1, col = "black", lty = "dashed")
 legend(x = 6, y = 0.8, legend = c(expression(chi[1]^2),"Exact"), lty = c("solid","dashed"), lwd = c(2,1), col = c("black", "black"), bty = "n")
grid()

Figura 6.1: CDFs exata e qui-quadrado para o exemplo da senhora que prova o chá.

Utilizamos o valor alternative = "greater" para o argumento alternative na função fisher.test() para especificar a hipótese alternativa \(H_a: OR > 1\). O valor padrão para esse argumento é two.sided.

O \(p\)-valor obtido coincide com o valor que calculamos anteriormente utilizando a distribuição hipergeométrica. Observe que também é apresentada uma estimativa da razão de chances (odds ratio), acompanhada de um intervalo de confiança. Os limites desse intervalo de confiança são calculados com base em uma distribuição hipergeométrica não central que não pressupõe independência.

Distribuição hipergeométrica múltipla para tabelas \(I\times J\)

O teste exato de Fisher pode ser estendido para tabelas maiores que \(2\times 2\) utilizando a distribuição hipergeométrica múltipla. Nesse contexto, os totais de linha e coluna permanecem fixos, mas agora existem \((I-1)(J-1)\) variáveis aleatórias distintas. Ainda é possível calcular as probabilidades para cada tabela de contingência possível, resultando em um teste de independência da mesma forma que anteriormente.

A probabilidade de observar um conjunto específico de contagens de células, \(n_{ij}\), \(i = 1, \cdots, I\); \(j = 1, \cdots, J\), é \[ \dfrac{\displaystyle \left(\prod_{i=1}^I n_{i+}! \right)\left(\prod_{j=1}^J n_{+j}! \right)}{\displaystyle n! \left(\prod_{i=1}^I\prod_{j=1}^J n_{ij}! \right)}, \] onde utilizamos a notação da Seção 3.2 para descrever as contagens da tabela.

Como pode haver um número muito grande de tabelas de contingência, foram desenvolvidos algoritmos eficientes para realizar os cálculos. Um algoritmo relacionado é discutido na Seção 6.2.2.

Exemplo 6.5: Biscoitos enriquecidos com fibras

Um exemplo na Seção 3.2 analisou o teste de independência entre a fonte de fibra dos biscoitos e a gravidade da distensão abdominal nos indivíduos que os consumiram. Os testes qui-quadrado de Pearson e da razão de verossimilhança (LR) para independência resultaram em \(p\)-valores de 0.0496 e 0.0262, respectivamente.

Havia várias contagens esperadas nas células muito baixas; por isso, havia certa preocupação de que a aproximação qui-quadrado para grandes amostras, utilizada com as estatísticas de teste, pudesse não corresponder adequadamente às suas distribuições reais. A aplicação do teste exato de Fisher permite contornar essa preocupação.

# Read in data

 diet <- read.csv(file = "https://www.estatistica.c3sl.ufpr.br/~lucambio/ADC/Fiber.csv")

 fiber <- factor(x = diet$fiber, levels = c("none", "bran", "gum", "both"))
 bloat <- factor(x = diet$bloat, levels = c("none", "low", "medium", "high"))
 diet2 <- data.frame(fiber, bloat, count = diet$count)

 diet.table <- xtabs(formula = count ~ fiber + bloat, data = diet2)
 diet.table

##       bloat
## fiber  none low medium high
##   none    6   4      2    0
##   bran    7   4      1    0
##   gum     2   2      3    5
##   both    2   5      3    2

#####################################################################
# Fisher exact test

 fisher.test(x = diet.table)

## 
##  Fisher's Exact Test for Count Data
## 
## data:  diet.table
## p-value = 0.06636
## alternative hypothesis: two.sided

################################################
# Permuation test - just p-value

 set.seed(8912)
 chisq.test(x = diet.table, correct = FALSE, simulate.p.value = TRUE, B = 1000)

## 
##  Pearson's Chi-squared test with simulated
##  p-value (based on 1000 replicates)
## 
## data:  diet.table
## X-squared = 16.943, df = NA, p-value = 0.03896

 # C.I. for p-value
 set.seed(8912)
 save.p <- chisq.test(x = diet.table, correct = FALSE, simulate.p.value = TRUE, B = 1000)
 library(package = binom)
 binom.confint(x = round(save.p$p.value*1000,0), n = 1000, conf.level = 1-0.05, methods = "wilson")

##   method  x    n  mean      lower      upper
## 1 wilson 39 1000 0.039 0.02865896 0.05286931

 # Larger number of permutations
 set.seed(8912)
 save.p2 <- chisq.test(x = diet.table, correct = FALSE, simulate.p.value = TRUE, B = 100000)
 binom.confint(x = round(save.p2$p.value*100000,0), n = 100000, conf.level = 1-0.05, methods = "wilson")

##   method    x     n    mean      lower      upper
## 1 wilson 4552 1e+05 0.04552 0.04424545 0.04682946

##############################################################################
# Permutation test

  # Put the data into its raw form
  set1 <- as.data.frame(as.table(diet.table))
  tail(set1)  # Notice 2 obs. for fiber = both and bloat = high

##    fiber  bloat Freq
## 11   gum medium    3
## 12  both medium    3
## 13  none   high    0
## 14  bran   high    0
## 15   gum   high    5
## 16  both   high    2

  set2 <- set1[rep(1:nrow(set1), times = set1$Freq), -3]
  tail(set2)  # Notice 2 obs. for fiber = both and bloat = high

##      fiber bloat
## 15.1   gum  high
## 15.2   gum  high
## 15.3   gum  high
## 15.4   gum  high
## 16    both  high
## 16.1  both  high

  # Verify data is correct
  xtabs(formula = ~ set2[,1] + set2[,2])

##          set2[, 2]
## set2[, 1] none low medium high
##      none    6   4      2    0
##      bran    7   4      1    0
##      gum     2   2      3    5
##      both    2   5      3    2

  X.sq <- chisq.test(set2[,1], set2[,2], correct = FALSE)
  X.sq$statistic

## X-squared 
##  16.94267

  # Could specify the variables directly too in xtabs()
  xtabs(formula = ~ fiber + bloat, data = set2)

##       bloat
## fiber  none low medium high
##   none    6   4      2    0
##   bran    7   4      1    0
##   gum     2   2      3    5
##   both    2   5      3    2

 ###########################################################
 # Another way to put the data in a raw form using for loops
 
 # Put data into its raw form
 all.data <- matrix(data = NA, nrow = 0, ncol = 2)

 # Put data in "raw" form
 for (i in 1:nrow(diet.table)) {
   for (j in 1:ncol(diet.table)) {
    all.data <- rbind(all.data, matrix(data = c(i, j), nrow = diet.table[i,j], ncol = 2, byrow = T))
  }
 }
 # Note that warning messages will be generated since diet.table[i,j] = 0 sometimes

 # Verify data is correct
 head(all.data)  # First 6 rows

##      [,1] [,2]
## [1,]    1    1
## [2,]    1    1
## [3,]    1    1
## [4,]    1    1
## [5,]    1    1
## [6,]    1    1

 tail(all.data)  # Last 6 rows

##       [,1] [,2]
## [43,]    4    2
## [44,]    4    3
## [45,]    4    3
## [46,]    4    3
## [47,]    4    4
## [48,]    4    4

 xtabs(formula = ~ all.data[,1] + all.data[,2])

##              all.data[, 2]
## all.data[, 1] 1 2 3 4
##             1 6 4 2 0
##             2 7 4 1 0
##             3 2 2 3 5
##             4 2 5 3 2

 ###########################################################
 # Another way to put the data in a raw form using for loops
 #  and no warning messages

 all.data2 <- matrix(data = NA, nrow = sum(diet.table), ncol = 2)
 counter <- 1

 # Put data in "raw" form
 for (i in 1:nrow(diet.table)) {
   for (j in 1:ncol(diet.table)) {
    if (diet.table[i,j] != 0) {
     all.data2[counter:(counter+diet.table[i,j]-1),] <- matrix(data = c(i, j), nrow = diet.table[i,j], ncol = 2, byrow = T)
     counter <- counter + diet.table[i,j]
    }
  }
 }
 
 # Verify data is correct
 xtabs(formula = ~ all.data2[,1] + all.data2[,2])

##               all.data2[, 2]
## all.data2[, 1] 1 2 3 4
##              1 6 4 2 0
##              2 7 4 1 0
##              3 2 2 3 5
##              4 2 5 3 2

 X.sq <- chisq.test(all.data[,1], all.data[,2], correct = F)
 X.sq$statistic

## X-squared 
##  16.94267

 ######################################################################
 # Do one permutation to illustrate 
 
 set.seed(4088)
 set2.star <- data.frame(row = set2[,1], column = sample(set2[,2], replace = FALSE))
 xtabs(formula = ~ set2.star[,1] + set2.star[,2])

##               set2.star[, 2]
## set2.star[, 1] none low medium high
##           none    3   6      2    1
##           bran    6   4      1    1
##           gum     5   4      3    0
##           both    3   1      3    5

 X.sq.star <- chisq.test(set2.star[,1], set2.star[,2], correct = FALSE)
 X.sq.star$statistic

## X-squared 
##  14.63903

 ######################################################################
 #Repeat the permutation B times 
 
 B <- 1000
 X.sq.star.save <- matrix(data = NA, nrow = B, ncol = 1)

 set.seed(1938)
 # options(warn = -1)
 for(i in 1:B) {
  set2.star <- data.frame(row = set2[,1], column = sample(set2[,2], replace = FALSE))
  X.sq.star <- chisq.test(set2.star[,1], set2.star[,2], correct = FALSE)
  X.sq.star.save[i,1] <- X.sq.star$statistic
 }

 mean(X.sq.star.save >= X.sq$statistic)

## [1] 0.039

 # options(warn = 0)
 
 summarize <- function(result.set, statistic, df, B, color.line = "red") {

  par(mfrow = c(1,3), mar = c(5,4,4,0.5))

  # Histogram
  hist(x = result.set, main = "Histogram", freq = FALSE,
   xlab = expression(X^{"2*"}))
  # , ylim = c(0,0.11) - used for book plot
  curve(expr = dchisq(x = x, df = df), col = color.line, add = TRUE, lwd = 2)
  segments(x0 = statistic, y0 = -10, x1 = statistic, y1 = 10)
  
  # Compare CDFs
  plot.ecdf(x = result.set, verticals = TRUE, do.p = FALSE, main = "CDFs", lwd = 2, col = "black",
      xlab = expression(X^"2*"),
      ylab = "CDF")
  curve(expr = pchisq(q = x, df = df), col = color.line, add = TRUE, lwd = 2, lty = "dotted")
  legend(x = df, y = 0.4, legend = c(expression(Perm.), substitute(chi[df1]^2, list(df1 = df))), lwd = c(2,2),
   col = c("black", color.line), lty = c("solid", "dotted"), bty = "n")  # When expression() is removed, the substitute() part oddly does not work

  # QQ-Plot
  chi.quant <- qchisq(p = seq(from = 1/(B+1), to = 1-1/(B+1), by = 1/(B+1)), df = df)
  plot(x = sort(result.set), y = chi.quant, main = "QQ-plot",
     xlab = expression(X^{"2*"}), ylab = "Chi-square quantiles")
  abline(a = 0, b = 1)

  par(mfrow = c(1,1))

  # p-value
  mean(result.set >= statistic)
 }

 summarize(result.set = X.sq.star.save, statistic = X.sq$statistic, df = (nrow(diet.table)-1)*(ncol(diet.table)-1), B = B)

## [1] 0.039

 # dev.off()  # Create plot for book

 summarize(result.set = X.sq.star.save, statistic = X.sq$statistic,
   df = (nrow(diet.table)-1)*(ncol(diet.table)-1), B = B, color.line = "black")

## [1] 0.039

 # dev.off()  # Create plot for book

 qqplot <- data.frame(p = seq(from = 1/(B+1), to = 1-1/(B+1), by = 1/(B+1)),
  q = qchisq(p = seq(from = 1/(B+1), to = 1-1/(B+1), by = 1/(B+1)), df = 9),
  X.sq.star = sort(X.sq.star.save)) 
 head(qqplot)

##             p        q X.sq.star
## 1 0.000999001 1.151664  1.138375
## 2 0.001998002 1.369859  1.138375
## 3 0.002997003 1.519046  1.138375
## 4 0.003996004 1.636266  1.608964
## 5 0.004995005 1.734478  1.671709
## 6 0.005994006 1.819896  1.671709

 qqplot[495:505,]

##             p        q X.sq.star
## 495 0.4945055 8.287079  8.673763
## 496 0.4955045 8.297198  8.681232
## 497 0.4965035 8.307325  8.681232
## 498 0.4975025 8.317460  8.688702
## 499 0.4985015 8.327603  8.732026
## 500 0.4995005 8.337754  8.746965
## 501 0.5004995 8.347913  8.761905
## 502 0.5014985 8.358081  8.785808
## 503 0.5024975 8.368257  8.785808
## 504 0.5034965 8.378442  8.796265
## 505 0.5044955 8.388635  8.796265

##############################################################################
# Permutation test using boot()

 library(boot)  # Already present in a default installation of R (do not need to download it separately) 
           
 # Perform the test
 x.sq <- function(data, i) {
  perm.data <- data[i]
  chisq.test(all.data[,1], perm.data, correct = F)$statistic
 }


 set.seed(6488)
 perm.test <- boot(data = all.data[,2], statistic = x.sq, R = 1000, sim = "permutation")
 names(perm.test)

##  [1] "t0"        "t"         "R"         "data"     
##  [5] "seed"      "statistic" "sim"       "call"     
##  [9] "stype"     "strata"

 mean(perm.test$t >= perm.test$t0)

## [1] 0.041

O \(p\)-valor é 0.0664, o que, novamente, indica evidência moderada contra a independência. É interessante notar que esse \(p\)-valor é ligeiramente maior do que os \(p\)-valores dos testes qui-quadrado de Pearson e da razão de verossimilhança (LR).

Isso pode ser atribuído à natureza conservadora do teste exato de Fisher e/ou ao fato de a aproximação qui-quadrado não funcionar tão bem quanto gostaríamos. Realizaremos uma análise mais detalhada dessa aproximação na próxima seção.

6.2.2 Teste de permutação para independência

A distribuição de probabilidade real da estatística de teste qui-quadrado de Pearson, \(X^2\), não é exatamente \(\chi^2_{(I-1)(J-1)}\) em um teste de independência. Em vez disso, ela está estreitamente relacionada à distribuição hipergeométrica (ou hipergeométrica múltipla) quando os totais de linha e coluna de uma tabela de contingência são fixos.

A Tabela 6.4 apresenta cada valor possível de \(X^2\) que poderia ser observado no experimento da senhora que prova o chá. Ao somar as probabilidades referentes a valores repetidos de \(X^2\), obtemos a função de probabilidade (PMF) exata sob a condição de independência: \(P(X^2 = 0) = 0.5143\), \(P(X^2 = 2) = 0.4571\) e \(P(X^2 = 8) = 0.0286\).

A Figura 6.1 apresenta o gráfico da função de distribuição acumulada exata para \(X^2\), juntamente com uma aproximação pela FDA da distribuição \(\chi_1^2\). Embora a distribuição \(\chi_1^2\) passe aproximadamente pelo meio da função exata, observa-se que existem, de fato, diferenças entre ambas. Por exemplo, o \(p\)-valor para \(X^2 = 2\) é \(P(X^2\geq 2) = 0.4857\) utilizando a distribuição exata, enquanto a aproximação pela \(\chi_1^2\) resulta em 0.1572. Para \(X^2 = 8\), o \(p\)-valor exato é 0.0286, ao passo que o valor aproximado é 0.0047.

O uso da distribuição hipergeométrica é simples para tabelas de contingência \(2\times 2\); no entanto, quando o tamanho da amostra ou a dimensão da tabela é grande, o número de tabelas cujas probabilidades compõem o \(p\)-valor pode ser tão elevado que se torna muito difícil calcular o \(p\)-valor de forma exata. Em vez disso, podemos utilizar um procedimento geral conhecido como teste de permutação para estimar a distribuição exata de uma estatística de teste.

Um teste de permutação permuta (reordena) aleatoriamente os dados observados um grande número de vezes. Cada permutação é realizada de modo a permitir que a hipótese nula seja verdadeira e que as contagens marginais na tabela de contingência permaneçam inalteradas. Lembre-se de que, para testes de hipóteses em geral, assume-se que a hipótese nula é verdadeira e determina-se uma distribuição de probabilidade para a estatística de teste de interesse.

Para cada permutação, calcula-se a estatística de interesse. A função de probabilidade (FMP) estimada sob a hipótese nula é calculada a partir dessas estatísticas, simplesmente construindo-se uma tabela de frequências relativas ou um histograma. Os \(p\)-valores são, então, calculados diretamente a partir dessa FMP.

Para testar a independência utilizando o teste qui-quadrado (\(X^2\)), podemos primeiramente decompor a tabela de contingência em sua forma de dados brutos (ver Seção 1.2.1); isto é, criamos um conjunto de dados no qual cada linha representa uma observação e duas variáveis representam, respectivamente, a categoria da linha e a categoria da coluna de uma observação da tabela de contingência.

A Tabela 6.5 (à esquerda) apresenta esse formato para os dados da Tabela 6.3. Identificamos cada resposta de coluna na Tabela 6.5 pelo seu número de observação original, utilizando \(z_j\) (com \(j = 1, \dots, 8\)). Isso nos permite perceber que muitas permutações distintas das respostas de coluna podem resultar na mesma tabela de contingência.

\[ \begin{array}{cccccccc} \hline \mbox{Linha} & \mbox{coluna} & & \mbox{Linha} & \mbox{Coluna} & & \mbox{Linha} & \mbox{Coluna} \\[0.8em]\hline 1 & z_1 =1 & & 1 & z_2=1 & & 1 & z_1=1 \\[0.4em] 1 & z_2 =1 & & 1 & z_1=1 & & 1 & z_2=1 \\[0.4em] 1 & z_3 =1 & & 1 & z_3=1 & & 1 & z_7=2 \\[0.4em] 1 & z_4 =2 & & 1 & z_4=2 & & 1 & z_4=2 \\[0.4em] 2 & z_5 =1 & & 2 & z_5=1 & & 2 & z_5=1 \\[0.4em] 2 & z_6 =2 & & 2 & z_6=2 & & 2 & z_8=2 \\[0.4em] 2 & z_7 =2 & & 2 & z_7=2 & & 2 & z_3=1 \\[0.4em] 2 & z_8 =2 & & 2 & z_8=2 & & 2 & z_6=2 \\\hline \end{array} \] Tabela 6.5: Forma bruta dos dados da Tabela 6.3. A tabela à esquerda contém os dados originais. As tabelas central e à direita mostram possíveis permutações.

Por exemplo, os dados originais e a permutação central da Tabela 6.5 levam à mesma tabela de contingência, para a qual \(X^2 = 2\). A permutação à direita resulta na formação de uma tabela de contingência diferente, para a qual \(X^2 = 0\).

Sob a condição de independência entre as variáveis de linha e coluna e condicionando-se às contagens marginais observadas de linhas e colunas, qualquer permutação aleatória das observações das colunas tem a mesma probabilidade de ocorrer em conjunto com as observações das linhas dadas. Existem 8! = 40320 permutações possíveis diferentes dos dados originais da Tabela 6.5, sendo que cada uma delas tem uma probabilidade de 1/40320 de ocorrer sob a hipótese de independência.

Para esse cenário, pode-se demonstrar matematicamente que existem 20736 permutações que resultam em \(X^2 = 0\), 18432 permutações que resultam em \(X^2 = 2\) e 1152 permutações que resultam em \(X^2 = 8\). Utilizando essas permutações, podemos calcular a distribuição exata de \(X^2\) como \[ P(X^2 = 0) = 20736/40320 = 0.5143, \quad P(X^2 = 2) = 18432/40320 = 0.4571 \quad \mbox{e} \\[0.8em] P(X^2 = 8) = 1152/40320 = 0.0286\cdot \] Essas probabilidades são idênticas às fornecidas pela distribuição hipergeométrica.

Frequentemente, o número de permutações e o número de valores possíveis de \(X^2\) são tão grandes que se torna difícil calcular a PMF avaliando cada permutação possível.

Em vez disso, podemos estimar o \(p\)-valor de forma semelhante ao que foi feito na Seção 3.2.3 para a distribuição multinomial: selecionamos aleatoriamente um grande número de permutações (digamos, \(B\)), calculamos \(X^2\) para cada permutação e utilizamos a distribuição empírica desses valores calculados como uma estimativa da distribuição exata. Essa estimativa é frequentemente denominada distribuição de permutação da estatística \(X^2\). A utilização dessa distribuição para realizar um teste de hipóteses é chamada de teste de permutação.

Abaixo, apresenta-se um algoritmo para obter a estimativa de permutação do \(p\)-valor utilizando a simulação de Monte Carlo:

1. Permute aleatoriamente as observações das colunas, mantendo inalteradas as observações das linhas. Não é necessário permutar as observações das linhas além das observações das colunas. Apenas um dos conjuntos precisa ser permutado para se obter probabilidade igual para qualquer conjunto possível de pares.

2. Calcule a estatística qui-quadrado de Pearson para os dados recém-formados. Denote essa estatística como \(X^{2∗}\) para distingui-la do valor calculado para a amostra original.

3. Repita os passos 1 e 2 \(B\) vezes, onde \(B\) é um número grande (por exemplo, 1000 ou mais).

4. (Opcional) Construa um gráfico da densidade estimada dos valores de \(X^{2∗}\). Isso serve como uma estimativa visual da distribuição exata de \(X^2\).

5. Calcule o \(p\)-valor como a proporção de valores de \(X^{2∗}\) maiores ou iguais ao \(X^2\) observado; isto é, calcule \((\# \; \mbox{de} \; X^{2∗}\geq X^2) / B\).

Observe que o \(p\)-valor pode variar de uma execução desses passos para outra. No entanto, os \(p\)-valores serão muito semelhantes, desde que se utilize um valor grande para \(B\). Além disso, note que poderíamos substituir a estatística qui-quadrado de Pearson pela estatística LRT para realizar um teste de permutação diferente para independência.

Exemplo 6.6: Biscoitos enriquecidos com fibras

A função chisq.test() realiza um teste de permutação utilizando a estatística \(X^2\) quando o argumento simulate.p.value = TRUE é especificado:

set.seed (8912)
chisq.test ( x = diet.table, correct = FALSE, simulate.p.value = TRUE, B = 1000)

## 
##  Pearson's Chi-squared test with simulated
##  p-value (based on 1000 replicates)
## 
## data:  diet.table
## X-squared = 16.943, df = NA, p-value = 0.03896

Utilizamos a função set.seed() no início para que possamos reproduzir os mesmos resultados sempre que executarmos o código. O valor \(B = 1000\) no argumento da função chisq.test() especifica o número de conjuntos de dados permutados. Obtemos um \(p\)-valor de 0.03896, o que indica evidência moderada contra a independência.

Observe que a função chisq.test() calcula seu \(p\)-valor como \[ \dfrac{1+\# \; \mbox{de} \; X^{2*}\geq X^2}{1+B}, \] o que difere ligeiramente da nossa fórmula de \(p\)-valor. Essa fórmula alternativa trata a amostra original como uma das permutações aleatórias e garante que o \(p\)-valor nunca seja exatamente 0 — situação que poderia ocorrer caso \(X^{2*} < X^2\) para todas as permutações. Ambas as fórmulas são amplamente utilizadas para calcular \(p\)-valores.

Executar o código anterior novamente, mas sem set.seed(8912), provavelmente resultará em um \(p\)-valor ligeiramente diferente. Como esse \(p\)-valor é uma proporção amostral, podemos utilizar um procedimento de intervalo de confiança da Seção 1.1.3 para estimar a probabilidade real que seria obtida com o uso de todas as permutações possíveis.

# Permuation test - just p-value

set.seed(8912)
chisq.test(x = diet.table, correct = FALSE, simulate.p.value = TRUE, B = 1000)

## 
##  Pearson's Chi-squared test with simulated
##  p-value (based on 1000 replicates)
## 
## data:  diet.table
## X-squared = 16.943, df = NA, p-value = 0.03896

# C.I. for p-value
set.seed(8912)
save.p <- chisq.test(x = diet.table, correct = FALSE, simulate.p.value = TRUE, B = 1000)
library(package = binom)
binom.confint(x = round(save.p$p.value*1000,0), n = 1000, conf.level = 1-0.05, methods = "wilson")

##   method  x    n  mean      lower      upper
## 1 wilson 39 1000 0.039 0.02865896 0.05286931

# Larger number of permutations
set.seed(8912)
save.p2 <- chisq.test(x = diet.table, correct = FALSE, simulate.p.value = TRUE, B = 100000)
binom.confint(x = round(save.p2$p.value*100000,0), n = 100000, conf.level = 1-0.05, methods = "wilson")

##   method    x     n    mean      lower      upper
## 1 wilson 4552 1e+05 0.04552 0.04424545 0.04682946

Um intervalo de confiança de Wilson de 95% é (0.029; 0.053), o que não altera nossa conclusão original sobre a independência. É possível utilizar um número muito maior de permutações, desde que a realização dos cálculos não leve muito tempo. Utilizando \(B = 100000\) permutações e a mesma semente anterior, obtemos um \(p\)-valor de 0.0455, com um intervalo de confiança de Wilson de 95% de (0.04438; 0.04697).

# Permutation test

# Put the data into its raw form
set1 <- as.data.frame(as.table(diet.table))
tail(set1)  # Notice 2 obs. for fiber = both and bloat = high

##    fiber  bloat Freq
## 11   gum medium    3
## 12  both medium    3
## 13  none   high    0
## 14  bran   high    0
## 15   gum   high    5
## 16  both   high    2

set2 <- set1[rep(1:nrow(set1), times = set1$Freq), -3]
tail(set2)  # Notice 2 obs. for fiber = both and bloat = high

##      fiber bloat
## 15.1   gum  high
## 15.2   gum  high
## 15.3   gum  high
## 15.4   gum  high
## 16    both  high
## 16.1  both  high

# Verify data is correct
xtabs(formula = ~ set2[,1] + set2[,2])

##          set2[, 2]
## set2[, 1] none low medium high
##      none    6   4      2    0
##      bran    7   4      1    0
##      gum     2   2      3    5
##      both    2   5      3    2

X.sq <- chisq.test(set2[,1], set2[,2], correct = FALSE)
X.sq$statistic

## X-squared 
##  16.94267

# Could specify the variables directly too in xtabs()
xtabs(formula = ~ fiber + bloat, data = set2)

##       bloat
## fiber  none low medium high
##   none    6   4      2    0
##   bran    7   4      1    0
##   gum     2   2      3    5
##   both    2   5      3    2

###########################################################
# Another way to put the data in a raw form using for loops
 
# Put data into its raw form
all.data <- matrix(data = NA, nrow = 0, ncol = 2)

# Put data in "raw" form
for (i in 1:nrow(diet.table)) {
  for (j in 1:ncol(diet.table)) {
    all.data <- rbind(all.data, matrix(data = c(i, j), nrow = diet.table[i,j], ncol = 2, byrow = T))
  }
 }

# Note that warning messages will be generated since diet.table[i,j] = 0 sometimes

# Verify data is correct
head(all.data)  # First 6 rows

##      [,1] [,2]
## [1,]    1    1
## [2,]    1    1
## [3,]    1    1
## [4,]    1    1
## [5,]    1    1
## [6,]    1    1

tail(all.data)  # Last 6 rows

##       [,1] [,2]
## [43,]    4    2
## [44,]    4    3
## [45,]    4    3
## [46,]    4    3
## [47,]    4    4
## [48,]    4    4

xtabs(formula = ~ all.data[,1] + all.data[,2])

##              all.data[, 2]
## all.data[, 1] 1 2 3 4
##             1 6 4 2 0
##             2 7 4 1 0
##             3 2 2 3 5
##             4 2 5 3 2

Infelizmente, a função chisq.test() não fornece informações sobre a distribuição de permutação além da posição relativa de \(X^2\). Para obter a distribuição de permutação e determinar se uma aproximação \(\chi_9^2\) é realmente adequada para \(X^2\), precisamos realizar alguns cálculos por conta própria.

Começamos esse processo organizando as contagens da tabela de contingência no formato de dados brutos. Isso é feito convertendo primeiramente a diet.table em um data frame. Em seguida, repetimos cada linha do data frame — utilizando a função rep() — de acordo com o número de vezes que uma determinada combinação de fiber (fibra) e bloat (distensão abdominal) é observada. Os dados brutos estão contidos no data frame set2, conforme mostrado acima.

# Another way to put the data in a raw form using for loops
#  and no warning messages

all.data2 <- matrix(data = NA, nrow = sum(diet.table), ncol = 2)
counter <- 1

# Put data in "raw" form
for (i in 1:nrow(diet.table)) {
 for (j in 1:ncol(diet.table)) {
  if (diet.table[i,j] != 0) {
   all.data2[counter:(counter+diet.table[i,j]-1),] <- matrix(data = c(i, j), 
                                                             nrow = diet.table[i,j], ncol = 2, byrow = T)
   counter <- counter + diet.table[i,j]
  }
}
}
 
# Verify data is correct
xtabs(formula = ~ all.data2[,1] + all.data2[,2])

##               all.data2[, 2]
## all.data2[, 1] 1 2 3 4
##              1 6 4 2 0
##              2 7 4 1 0
##              3 2 2 3 5
##              4 2 5 3 2

X.sq <- chisq.test(all.data[,1], all.data[,2], correct = F)
X.sq$statistic

## X-squared 
##  16.94267

Confimado! As funções xtabs() e chisq.test() confirmam que os dados brutos foram criados corretamente e que se obteve o mesmo valor de \(X^2\) de antes.

# Do one permutation to illustrate 

set.seed(4088)
set2.star <- data.frame(row = set2[,1], column = sample(set2[,2], replace = FALSE))
xtabs(formula = ~ set2.star[,1] + set2.star[,2])

##               set2.star[, 2]
## set2.star[, 1] none low medium high
##           none    3   6      2    1
##           bran    6   4      1    1
##           gum     5   4      3    0
##           both    3   1      3    5

X.sq.star <- chisq.test(set2.star[,1], set2.star[,2], correct = FALSE)
X.sq.star$statistic 

## X-squared 
##  14.63903

A função sample() permuta aleatoriamente as observações da coluna, e a função data.frame() combina as observações das linhas com essas observações permutadas da coluna para formar um conjunto de dados permutado. Observe que \(X^2 = 8,20\). Esse processo é repetido \(B = 1000\) vezes utilizando a função for().

#Repeat the permutation B times 
 
B <- 1000
X.sq.star.save <- matrix(data = NA, nrow = B, ncol = 1)

set.seed(1938)
# options(warn = -1)
for(i in 1:B) {
  set2.star <- data.frame(row = set2[,1], column = sample(set2[,2], replace = FALSE))
  X.sq.star <- chisq.test(set2.star[,1], set2.star[,2], correct = FALSE)
  X.sq.star.save[i,1] <- X.sq.star$statistic
}

mean(X.sq.star.save >= X.sq$statistic)

## [1] 0.039

# options(warn = 0)
 
summarize <- function(result.set, statistic, df, B, color.line = "red") {

par(mfrow = c(1,3), mar = c(5,4,4,0.5))

# Histogram
hist(x = result.set, main = "Histogram", freq = FALSE, xlab = expression(X^{"2*"}))
curve(expr = dchisq(x = x, df = df), col = color.line, add = TRUE, lwd = 2)
segments(x0 = statistic, y0 = -10, x1 = statistic, y1 = 10)
  
# Compare CDFs
plot.ecdf(x = result.set, verticals = TRUE, do.p = FALSE, main = "CDFs", lwd = 2, 
          col = "black", xlab = expression(X^"2*"), ylab = "CDF")
curve(expr = pchisq(q = x, df = df), col = color.line, add = TRUE, lwd = 2, lty = "dotted")
legend(x = df, y = 0.4, legend = c(expression(Perm.), substitute(chi[df1]^2, list(df1 = df))), 
       lwd = c(2,2), col = c("black", color.line), lty = c("solid", "dotted"), bty = "n")  # When expression() is removed, the substitute() part oddly does not work

# QQ-Plot
chi.quant <- qchisq(p = seq(from = 1/(B+1), to = 1-1/(B+1), by = 1/(B+1)), df = df)
plot(x = sort(result.set), y = chi.quant, main = "QQ-plot", 
     xlab = expression(X^{"2*"}), ylab = "Chi-square quantiles")
abline(a = 0, b = 1)
par(mfrow = c(1,1))

# p-value
mean(result.set >= statistic)
}

summarize(result.set = X.sq.star.save, statistic = X.sq$statistic, 
          df = (nrow(diet.table)-1)*(ncol(diet.table)-1), B = B)

## [1] 0.039

Figura 6.2: Distribuições de permutação e qui-quadrado. A linha vertical no histograma está traçada em \(X^2 = 16.94\).

qqplot <- data.frame(p = seq(from = 1/(B+1), to = 1-1/(B+1), by = 1/(B+1)),
  q = qchisq(p = seq(from = 1/(B+1), to = 1-1/(B+1), by = 1/(B+1)), df = 9),
  X.sq.star = sort(X.sq.star.save)) 
head(qqplot)

##             p        q X.sq.star
## 1 0.000999001 1.151664  1.138375
## 2 0.001998002 1.369859  1.138375
## 3 0.002997003 1.519046  1.138375
## 4 0.003996004 1.636266  1.608964
## 5 0.004995005 1.734478  1.671709
## 6 0.005994006 1.819896  1.671709

qqplot[495:505,]

##             p        q X.sq.star
## 495 0.4945055 8.287079  8.673763
## 496 0.4955045 8.297198  8.681232
## 497 0.4965035 8.307325  8.681232
## 498 0.4975025 8.317460  8.688702
## 499 0.4985015 8.327603  8.732026
## 500 0.4995005 8.337754  8.746965
## 501 0.5004995 8.347913  8.761905
## 502 0.5014985 8.358081  8.785808
## 503 0.5024975 8.368257  8.785808
## 504 0.5034965 8.378442  8.796265
## 505 0.5044955 8.388635  8.796265

##############################################################################
# Permutation test using boot()

library(boot)  # Already present in a default installation of R (do not need to download it separately) 
           
# Perform the test
 x.sq <- function(data, i) {
  perm.data <- data[i]
  chisq.test(all.data[,1], perm.data, correct = F)$statistic
 }


set.seed(6488)
perm.test <- boot(data = all.data[,2], statistic = x.sq, R = 1000, sim = "permutation")
names(perm.test)

##  [1] "t0"        "t"         "R"         "data"     
##  [5] "seed"      "statistic" "sim"       "call"     
##  [9] "stype"     "strata"

mean(perm.test$t >= perm.test$t0)

## [1] 0.041

O \(p\)-valor é 0.039, indicando evidência moderada contra a independência, o que está de acordo com nossos resultados anteriores. Note que as mensagens de aviso emitidas pelo R não são motivo de preocupação neste caso, pois são geradas quando a função chisq.test() encontra contagens esperadas baixas nas células; isso só seria um problema se estivéssemos comparando os valores calculados de \(X^{2∗}\) com a distribuição \(\chi_9^2\) para grandes amostras.

Se desejado, o uso de options(warn = -1) antes da função for() impedirá a exibição dos avisos. Isso deve ser feito apenas quando se tem certeza de que os avisos não são preocupantes. Alterar o valor do argumento warn para 0 permite que os avisos sejam exibidos novamente.

Criamos uma função chamada summarize() para gerar os gráficos da Figura 6.2 e calcular o \(p\)-valor. Observamos que a distribuição \(\chi_9^2\) se aproxima muito bem da distribuição de permutação, deixando pouca margem para dúvidas quanto à adequação da aproximação pela \(\chi_9^2\) para a estatística \(X^2\) sob a hipótese de independência. Por exemplo, o gráfico Q-Q apresenta os quantis de uma distribuição \(\chi_9^2\) em relação aos valores ordenados correspondentes de \(X^2\).

Esses valores mostrados graficamente são, em geral, muito semelhantes, como evidenciado pela grande maioria dos pontos situados sobre a linha de identidade (reta de 45 graus) que parte da origem, por exemplo, o valor \(\chi_{9, 0.5005}^2 = 8.348\) é mostrado contra o 501º valor ordenado de \(X^2\), que é 8.492.

Existem outras maneiras de obter a distribuição de permutação. Por exemplo, a função boot() do pacote boot oferece uma forma conveniente de realizar testes de permutação em geral, exigindo que o argumento sim = "permutation" seja especificado na chamada da função.

6.2.3 Regressão logística exata

Métodos de inferência exata para regressão logística oferecem uma alternativa aos métodos para grandes amostras discutidos no Capítulo 2. Nesse capítulo, realizamos inferências sobre um parâmetro de regressão \(\beta_j\) utilizando uma distribuição normal aproximada para o estimador correspondente \(\widehat{\beta}_j\).

O uso da distribuição normal justificava-se pelo fato de que os estimadores de máxima verossimilhança (MLEs) apresentam distribuição aproximadamente normal em grandes amostras. Métodos exatos são úteis em situações nas quais amostras pequenas podem não ser suficientes para que tais aproximações funcionem adequadamente.

Além disso, métodos exatos permitem a realização de estimação e inferência quando a convergência das estimativas de máxima verossimilhança pode não ocorrer, como em situações de separação completa (ver Seção 2.2.7).

A abordagem geral da regressão logística exata é semelhante à utilizada no teste exato de Fisher. Para cada parâmetro estudado, identifica-se primeiramente quais estatísticas contribuem ou não para a estimação desse parâmetro. As estatísticas que contribuem são denominadas estatísticas suficientes para o parâmetro.

Como demonstrado na seção anterior, pode haver muitas maneiras de permutar os dados observados que deixam inalterados os valores de certas estatísticas. Aplicamos essa abordagem à inferência sobre parâmetros de regressão mantendo fixas as variáveis explicativas e permutando as respostas observadas. Em seguida, concentramo-nos no subconjunto dessas permutações em que os valores de certas estatísticas suficientes permanecem constantes e analisamos a distribuição de outras estatísticas dentro desse subconjunto. Isso é denominado distribuição condicional exata dessas últimas estatísticas.

Para formalizar essas ideias, escrevemos a distribuição de probabilidade conjunta, também a função de verossimilhança, para regressão logística como: \[ \begin{array}{rcl} P(Y_1=y_1,\cdots,Y_n=y_n) & = & \displaystyle \prod_{i=1}^n P(Y_i=y_i) \\[0.8em] & = & \displaystyle \prod_{ì=1}^n \pi_i^{y_i}(1-\pi_i)^{1-y_i}\cdot \end{array} \]

Dado que \[ \pi_i=\dfrac{\exp\big(\beta_0+\beta_1 x_{i1}+\cdots+\beta_p x_{ip}\big)}{1+\exp\big(\beta_0+\beta_1 x_{i1}+\cdots+\beta_p x_{ip}\big)} \] e \[ 1-\pi_i=\dfrac{1}{1+\exp\big(\beta_0+\beta_1 x_{i1}+\cdots+\beta_p x_{ip}\big)}, \] podemos escrever a probabilidade conjunta de forma compacta como \[ \tag{6.4} P(Y_1=y_1,\cdots,Y_n=y_n) = \dfrac{\displaystyle \exp\left(\sum_{i=1}^n y_i\big(\beta_0+\beta_1 x_{i1}+\cdots+\beta_p x_{ip}\big)\right)}{\displaystyle \prod_{i=1}^n \left(1+\exp\big(\beta_0+\beta_1 x_{i1}+\cdots+\beta_p x_{ip}\big)\right)}\cdot \]

Aplicando o Teorema 6.2.10 de Casella and Berger (2002) à Equação (6.4), a estatística suficiente para o parâmetro de regressão \(\beta_j\) é \(\sum_{i=1}^n y_i x_{ij}\), \(j = 0,\cdots,p\), em que \(x_{i0}= 1\) para \(i = 1,\cdots, n\) corresponde ao parâmetro de intercepto \(\beta_0\).

Sem perda de generalidade, suponha que nosso interesse esteja em \(\beta_p\). A inferência sobre \(\beta_p\) é realizada utilizando a distribuição condicional exata de sua estatística suficiente, digamos \[ T = \sum_{i=1}^n Y_i x_{ip}, \] mantendo constantes os valores das outras estatísticas suficientes em seus valores observados.

Seja \(t = \sum_{i=1}^n y_i x_{ip}\) o valor observado de \(T\) e seja \(I\) um vetor que denota os valores das estatísticas suficientes para todos os outros parâmetros, \[ I = \Big\{ \sum_{i=1}^n y_i x_{ij} \; \text{ para } \; j = 0, \dots, p-1 \Big\}\cdot \] Denote uma permutação de \(y_1, \cdots, y_n\) por \(y_1^*, \cdots, y_n^*\). Mostra-se no Exercício 9 que a probabilidade conjunta de \(Y_1, \dots, Y_n\) condicionada a \(I\) é \[ \tag{6.5} P(Y_1=y_1,\cdots,Y_n=y_n|I) = \dfrac{\displaystyle \exp\left(\beta_p \sum_{i=1}^n y_i x_{ip} \right)}{\displaystyle \sum_R \exp\left(\beta_p \sum_{i=1}^n y_i^* x_{ip} \right)}, \] onde \(R\) é o conjunto de todas as permutações de \(y_1,\cdots, y_n\) tais que os valores em \(I\) permanecem inalterados.

A seguir, defina \(U\) como o número de valores possíveis que a soma \(\sum_{i=1}^n y_i^* x_{ip}\) pode assumir, conforme formada por diferentes permutações de \(y_1, \cdots, y_n\) em \(R\). Sejam esses valores distintos denotados por \(t_1, t_2, \cdots, t_U\). Além disso, defina \(c(t_u)\) como a contagem do número de permutações em \(R\) tais que \[ \sum_{i=1}^n y_i^* x_{ip} = t_u\cdot \] Então, utilizando a Equação 6.5, o Exercício 9 também mostra que a função de probabilidade (PMF) condicional exata de \(T\) dado \(I\) é \[ \tag{6.6} P(T=t_u|I)=\dfrac{c(t_u)\exp\big(\beta_p t_u\big)}{\displaystyle \sum_{\nu=1}^U c(t_\nu)\exp\big(\beta_p t_\nu \big)} \] para \(u=1,\cdots,U\).

Como encontrar o conjunto \(R\) não é uma tarefa trivial, foram desenvolvidos algoritmos específicos para identificar as permutações que compõem \(R\), por exemplo, veja Hirji et al. (1987) e para calcular a função de massa de probabilidade (PMF).

Mehta et al. (2000) propõem algoritmos de simulação de Monte Carlo nos quais um grande número de permutações dos dados, selecionadas aleatoriamente, é escolhido enquanto se mantém \(I\) fixo. Esses algoritmos estão disponíveis em alguns softwares, incluindo o LogXact, desenvolvido pelos próprios autores, mas não estão disponíveis no R no momento.

Uma vez obtida, essa PMF é utilizada de maneira semelhante à forma como as distribuições de permutação foram empregadas na Seção 6.2.2. Em termos simples, podemos calcular um \(p\)-valor com base em quão extremo é o valor observado \(t\) em relação à PMF. Probabilidades baixas indicam evidências contra a hipótese nula. Demonstraremos esse processo em breve, por meio de um exemplo.

Para estimar \(\beta_p\), pode-se obter uma estimativa de máxima verossimilhança condicional (CMLE) maximizando a Equação (6.5). No entanto, quando a variável aleatória \(\sum_{i=1}^n Y_i x_{ip}\) assume seu valor observado mínimo ou máximo possível, não existe uma estimativa finita.

Nesses casos, pode-se encontrar, em vez disso, uma estimativa não viesada pela mediana (MUE), a qual será sempre finita. A estimativa é calculada, essencialmente, encontrando-se a mediana dos valores \(t_1, \dots, t_u\) com base na distribuição condicional da Equação (6.6). Detalhes específicos do cálculo estão disponíveis em Mehta and Patel (1995).

A regressão logística exata é realizada no R por meio da função logistiX() do pacote logistiX. Esse pacote apresenta atualmente algumas limitações: (1) apenas variáveis explicativas binárias podem ser utilizadas, (2) não é possível realizar testes conjuntos para os parâmetros de regressão e (3) podem ocorrer problemas de esgotamento de memória (out-of-memory), mesmo ao utilizar a versão de 64 bits do R com grande quantidade de memória disponível.

Alternativamente, a função elrm() do pacote elrm (Zamar et al. 2007) fornece aproximações para a regressão logística exata utilizando métodos de Cadeia de Markov de Monte Carlo (MCMC). Não discutiremos os detalhes do funcionamento dos métodos MCMC; em vez disso, remetemos o leitor ao artigo correspondente sobre o pacote e também à Seção 6.6 para uma introdução a esses métodos.

A função elrm() supera as limitações da logistiX() ao permitir o uso de variáveis explicativas quantitativas, embora ainda sejam necessárias múltiplas tentativas para cada padrão de variável explicativa. A função também permite realizar testes conjuntos específicos para os parâmetros de regressão e é menos suscetível a problemas de esgotamento de memória. Discutiremos como utilizar ambos os pacotes no próximo exemplo.

Exemplo 6.7: Livre do câncer.

Mehta and Patel (1995) apresentam uma série de exemplos que demonstram a regressão logística exata. Em particular, a Seção 5.1 do artigo examina a proporção de indivíduos (\(\omega/n\)) que estavam em remissão de osteossarcoma ao longo de um período de três anos.

As variáveis explicativas incluídas no modelo de regressão logística foram:

1. infiltração linfocítica (LI; 1 = presente e 0 = ausente),

2. sexo (gender; 1 = masculino e 0 = feminino) e

3. presença de patologia osteoide (AOP; 1 = sim e 0 = não).

Abaixo, os dados são apresentados primeiro no formato EVP, formato de resposta binomial necessário para a função elrm() e, em seguida, em um formato no qual cada indivíduo amostrado corresponde a uma linha de um data frame, formato de resposta de Bernoulli necessário para a função logistiX().

# Number disease free ( w ) out of total ( n ) per EVP
set1 <- data.frame ( LI = c (0,0,0,0,1,1,1,1), 
                     gender = c (0,0,1,1,0,0,1,1), 
                     AOP = c (0,1,0,1,0,1,0,1), 
                     w = c (3,2,4,1,5,3,5,6), 
                     n = c (3,2,4,1,5,5,9,17) )
sum ( set1$n ) # Sample size

## [1] 46

# Transform data to one person per row
set1.y1 <- set1 [ rep (1: nrow ( set1 ) , times = set1$w ) , -c (4:5) ]
set1.y1$y <- 1
set1.y0 <- set1 [ rep (1: nrow ( set1 ) , times = set1$n - set1$w ) , -c (4:5) ]
set1.y0$y <- 0
set1.long <- data.frame ( rbind ( set1.y1 , set1.y0 ) , row.names = NULL )
head ( set1.long )

##   LI gender AOP y
## 1  0      0   0 1
## 2  0      0   0 1
## 3  0      0   0 1
## 4  0      0   1 1
## 5  0      0   1 1
## 6  0      1   0 1

nrow ( set1.long ) # Sample size

## [1] 46

ftable ( formula = y ~ LI + gender + AOP , data = set1.long )

##               y  0  1
## LI gender AOP        
## 0  0      0      0  3
##           1      0  2
##    1      0      0  4
##           1      0  1
## 1  0      0      0  5
##           1      2  3
##    1      0      4  5
##           1     11  6

O resumo da tabela de contingência fornecido por ftable() mostra que todos os indivíduos sem infiltração linfocítica (lymphocytic infiltration) permanecem livres da doença por três anos. Portanto, ocorre uma separação completa, o que gera problemas ao ajustar um modelo de regressão logística por meio da estimativa de máxima verossimilhança e da função glm():

# Regular logistic regression
mod.fit <- glm ( formula = w/n ~ LI + gender + AOP , data = set1 , 
                 family = binomial ( link = logit ) , weights = n , trace = TRUE , 
                 epsilon = 1e-8) # Default epsilon value specified

## Deviance = 2.943682 Iterations - 1
## Deviance = 2.039803 Iterations - 2
## Deviance = 1.774611 Iterations - 3
## Deviance = 1.681279 Iterations - 4
## Deviance = 1.647388 Iterations - 5
## Deviance = 1.634979 Iterations - 6
## Deviance = 1.630422 Iterations - 7
## Deviance = 1.628747 Iterations - 8
## Deviance = 1.628131 Iterations - 9
## Deviance = 1.627904 Iterations - 10
## Deviance = 1.62782 Iterations - 11
## Deviance = 1.62779 Iterations - 12
## Deviance = 1.627779 Iterations - 13
## Deviance = 1.627774 Iterations - 14
## Deviance = 1.627773 Iterations - 15
## Deviance = 1.627772 Iterations - 16
## Deviance = 1.627772 Iterations - 17
## Deviance = 1.627772 Iterations - 18
## Deviance = 1.627772 Iterations - 19
## Deviance = 1.627772 Iterations - 20

round ( summary ( mod.fit ) $coefficients , 4)

##             Estimate Std. Error z value Pr(>|z|)
## (Intercept)  23.4920 11084.3781  0.0021   0.9983
## LI          -21.3842 11084.3781 -0.0019   0.9985
## gender       -1.6362     0.9123 -1.7935   0.0729
## AOP          -1.2204     0.7712 -1.5825   0.1135

# A strictor convergence criteria shows the non-convergence
mod.fit <- glm(formula = w/n ~ LI + gender + AOP, data = set1, family = binomial(link = logit), 
               weights = n, trace = TRUE, epsilon = 0.00000000001)

## Deviance = 2.943682 Iterations - 1
## Deviance = 2.039803 Iterations - 2
## Deviance = 1.774611 Iterations - 3
## Deviance = 1.681279 Iterations - 4
## Deviance = 1.647388 Iterations - 5
## Deviance = 1.634979 Iterations - 6
## Deviance = 1.630422 Iterations - 7
## Deviance = 1.628747 Iterations - 8
## Deviance = 1.628131 Iterations - 9
## Deviance = 1.627904 Iterations - 10
## Deviance = 1.62782 Iterations - 11
## Deviance = 1.62779 Iterations - 12
## Deviance = 1.627779 Iterations - 13
## Deviance = 1.627774 Iterations - 14
## Deviance = 1.627773 Iterations - 15
## Deviance = 1.627772 Iterations - 16
## Deviance = 1.627772 Iterations - 17
## Deviance = 1.627772 Iterations - 18
## Deviance = 1.627772 Iterations - 19
## Deviance = 1.627772 Iterations - 20
## Deviance = 1.627772 Iterations - 21
## Deviance = 1.627772 Iterations - 22
## Deviance = 1.627772 Iterations - 23
## Deviance = 1.627772 Iterations - 24
## Deviance = 1.627772 Iterations - 25

# summary(mod.fit)
round(summary(mod.fit)$coefficients, 4)

##             Estimate  Std. Error z value Pr(>|z|)
## (Intercept)  28.4920 135035.6777  0.0002   0.9998
## LI          -26.3842 135035.6777 -0.0002   0.9998
## gender       -1.6362      0.9123 -1.7935   0.0729
## AOP          -1.2204      0.7712 -1.5825   0.1135

# Fitting the model to the Bernoulli data format
mod.fit <- glm(formula = y ~ LI + gender + AOP, data = set1.long, family = binomial(link = logit), 
               trace = TRUE)

## Deviance = 45.0735 Iterations - 1
## Deviance = 43.51496 Iterations - 2
## Deviance = 43.04841 Iterations - 3
## Deviance = 42.88841 Iterations - 4
## Deviance = 42.83084 Iterations - 5
## Deviance = 42.80983 Iterations - 6
## Deviance = 42.80212 Iterations - 7
## Deviance = 42.79929 Iterations - 8
## Deviance = 42.79825 Iterations - 9
## Deviance = 42.79786 Iterations - 10
## Deviance = 42.79772 Iterations - 11
## Deviance = 42.79767 Iterations - 12
## Deviance = 42.79765 Iterations - 13
## Deviance = 42.79765 Iterations - 14
## Deviance = 42.79764 Iterations - 15
## Deviance = 42.79764 Iterations - 16
## Deviance = 42.79764 Iterations - 17

summary(mod.fit)

## 
## Call:
## glm(formula = y ~ LI + gender + AOP, family = binomial(link = logit), 
##     data = set1.long, trace = TRUE)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)  
## (Intercept)   19.9673  1902.5542   0.010   0.9916  
## LI           -17.8595  1902.5540  -0.009   0.9925  
## gender        -1.6362     0.9123  -1.794   0.0729 .
## AOP           -1.2204     0.7712  -1.582   0.1135  
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 60.603  on 45  degrees of freedom
## Residual deviance: 42.798  on 42  degrees of freedom
## AIC: 50.798
## 
## Number of Fisher Scoring iterations: 17

Curiosamente, a função glm() encerra seu procedimento numérico iterativo após 25 iterações, sem emitir mensagens de aviso, pois a variação relativa na deviance residual fica abaixo do valor padrão para o parâmetro epsilon.

Isso pode levar a crer que a convergência das estimativas de regressão de fato ocorreu. No entanto, deve-se ter sérias ressalvas quanto a essas estimativas, devido aos valores extremamente elevados de \(\sqrt{\widehat{\mbox{Var}}(\widehat{\beta}_0)}\) e \(\sqrt{\widehat{\mbox{Var}}(\widehat{\beta}_1)}\).

De fato, ao tornar o critério de convergência mais rigoroso — reduzindo o valor de epsilon em relação ao padrão —, as estimativas de \(\beta_0\) e \(\beta_1\) continuam a divergir de zero indefinidamente. Portanto, os resultados fornecidos pela função glm() não devem ser utilizados.

Como alternativa, realizamos primeiramente uma regressão logística exata utilizando a função logitiX(), com o formato de resposta de Bernoulli exigido para os dados. A função não utiliza um argumento de formula; em vez disso, ela conta com um argumento x para um data frame contendo os valores das variáveis explicativas e um argumento y para um data frame contendo os valores da variável resposta. A seguir, apresentamos como estimar o modelo:

# logistiX

library(package = logistiX)

mod.fit.logistiX <- logistiX(x = set1.long[,1:3], y = set1.long[,4], alpha = 0.05)
summary(mod.fit.logistiX)  # No intercept, but otherwise very similar to Table 3 in the paper

## Exact logistic regression
## 
## Call:
## logistiX(x = set1.long[, 1:3], y = set1.long[, 4], alpha = 0.05)
## 
## Estimation method:           LX 
## CI method:                   exact  
## Test method:                 TST
## 
## Summary of estimates, confidence intervals and parameter hypotheses tests:
## 
##   estimates     2.5 %    97.5 % statistic     pvalue
## 1 -1.886007      -Inf 0.1614947        19 0.07418173
## 2 -1.547928 -4.023839 0.3627064        16 0.13915271
## 3 -1.156158 -2.997241 0.5113281        12 0.21815408
##   cardinality
## 1           8
## 2          10
## 3          12

# The p-value is a little different because they are using a little different testing method
names(mod.fit.logistiX)

## [1] "estout"  "ciout"   "distout" "tobs"    "call"

mod.fit.logistiX$estout  # Estimates from four different methods

##    varnum method    estimate
## 1       1    MUE   -1.886007
## 2       1    MLE -999.000000
## 3       1    LX    -1.886007
## 4       1   CCFL   -2.414586
## 5       2    MUE   -1.506908
## 6       2    MLE   -1.547928
## 7       2    LX    -1.547928
## 8       2   CCFL   -1.416228
## 9       3    MUE   -1.140495
## 10      3    MLE   -1.156158
## 11      3    LX    -1.156158
## 12      3   CCFL   -1.106643

print( mod.fit.logistiX$ciout, digits=3 )# CIs for four different methods, TST-Pmid row gives the mid-p correction

##    var   method   lower   upper p-value (2-sided)
## 1    1      TST -999.00  0.1615            0.0742
## 2    1 TST-Pmid -999.00 -0.1318            0.0371
## 3    1       SC -999.00  0.1273            0.0606
## 4    1  SC-Pmid -999.00 -0.2919            0.0421
## 5    2      TST   -4.02  0.3627            0.1392
## 6    2 TST-Pmid   -3.67  0.1690            0.0800
## 7    2       SC   -3.62  0.2337            0.1169
## 8    2  SC-Pmid   -3.26  0.0694            0.0874
## 9    3      TST   -3.00  0.5114            0.2182
## 10   3 TST-Pmid   -2.78  0.3408            0.1335
## 11   3       SC   -2.73  0.4229            0.1535
## 12   3  SC-Pmid   -2.50  0.2238            0.1111
##    p-value (LE) p-value (GE) chi2     z
## 1        0.0371        1.000   NA    NA
## 2        0.0185        0.981   NA    NA
## 3        0.0371        1.000 4.54 -2.13
## 4        0.0185        0.981 4.54 -2.13
## 5        0.0696        0.990   NA    NA
## 6        0.0400        0.960   NA    NA
## 7        0.0696        0.990 3.37 -1.84
## 8        0.0400        0.960 3.37 -1.84
## 9        0.1091        0.976   NA    NA
## 10       0.0667        0.933   NA    NA
## 11       0.1091        0.976 2.48 -1.57
## 12       0.0667        0.933 2.48 -1.57

mod.fit.logistiX$distout  # varnum = 1 matches Table 2 in the paper

##    varnum t.stat    counts
## 8       1     19  29445360
## 7       1     20 147312480
## 6       1     21 271271448
## 5       1     22 231819344
## 4       1     23  95325664
## 3       1     24  17473144
## 2       1     25   1204008
## 1       1     26     19448
## 17      2     14    299880
## 15      2     15   4898040
## 13      2     16  29445360
## 11      2     17  87836280
## 10      2     18 144347000
## 9       2     19 135419960
## 18      2     20  72090200
## 16      2     21  20663500
## 14      2     22   2795650
## 12      2     23    121550
## 30      3      8      1360
## 29      3      9     64600
## 28      3     10   1011160
## 27      3     11   7401120
## 26      3     12  29445360
## 25      3     13  68686800
## 24      3     14  97275360
## 23      3     15  84307080
## 22      3     16  44049720
## 21      3     17  13251160
## 20      3     18   2059720
## 19      3     19    123760

mod.fit.logistiX$tobs   # Observed values of the sufficient statistics

## [1] 29 19 16 12

Para o modelo de regressão logística \[ logit(\pi) = \beta_0 + \beta_1\times\text{LI} + \beta_2\times \text{gender} + \beta_3\times\text{AOP}, \] as estimativas são \(\widehat{\beta}_1\)=-0.8860 (MUE), \(\widehat{\beta}_2\) = -1.5480 (CMLE) e \(\widehat{\beta}_3\) = -1.1562 (CMLE). O componente estout de mod.fit.logistiX retorna as MUEs e CMLEs, apresentadas como method = MLE na saída, para cada parâmetro de inclinação. Além disso, as estimativas fornecidas nas linhas method = CCFL correspondem à abordagem de verossimilhança modificada de Firth, e as estimativas fornecidas nas linhas method = LX são aquelas relatadas no resumo do modelo, CMLEs quando a estimativa é finita; MUEs, caso contrário.

Essas últimas estimativas são as que o software LogXact também reportaria. Nenhuma estimativa de \(\beta_0\) é fornecida por logistiX() — provavelmente porque a inferência geralmente se concentra nos parâmetros que representam os efeitos das variáveis explicativas.

As distribuições condicionais exatas para as estatísticas suficientes de \(\beta_1\), \(\beta_2\) e \(\beta_3\) são fornecidas no componente distout de mod.fit.logistiX. Para fins de demonstração, apresenta-se abaixo a distribuição condicional correspondente a \(\beta_1\):

# Exact distribution for sufficient statistic of beta1
just.for.beta1 <- mod.fit.logistiX$distout$varnum == 1
distL1 <- mod.fit.logistiX$distout[just.for.beta1, ]
distL1$rel.freq <- round(distL1$counts/sum(distL1$counts), 4)
distL1

##   varnum t.stat    counts rel.freq
## 8      1     19  29445360   0.0371
## 7      1     20 147312480   0.1856
## 6      1     21 271271448   0.3417
## 5      1     22 231819344   0.2920
## 4      1     23  95325664   0.1201
## 3      1     24  17473144   0.0220
## 2      1     25   1204008   0.0015
## 1      1     26     19448   0.0000

mod.fit.logistiX$tobs[2]  # Sufficient stat for beta1 - t1 = 19 (counts for it are distL1$count[1])

## [1] 19

distL1$count[1]/sum(distL1$counts)  # One-sided p-value bottom p. 2151

## [1] 0.03709087

sum(distL1$counts[c(1,6:8)])/sum(distL1$counts)   # Two-tail test, matches Table 3

## [1] 0.06064205

# Exact distribution for sufficient statistic of beta2
just.for.beta2 <- mod.fit.logistiX$distout$varnum == 2
distgender <- mod.fit.logistiX$distout[just.for.beta2, ]
distgender$rel.freq <- round(distgender$counts/sum(distgender$counts), 4)
distgender

##    varnum t.stat    counts rel.freq
## 17      2     14    299880   0.0006
## 15      2     15   4898040   0.0098
## 13      2     16  29445360   0.0591
## 11      2     17  87836280   0.1764
## 10      2     18 144347000   0.2899
## 9       2     19 135419960   0.2720
## 18      2     20  72090200   0.1448
## 16      2     21  20663500   0.0415
## 14      2     22   2795650   0.0056
## 12      2     23    121550   0.0002

mod.fit.logistiX$tobs[3]  # Sufficient stat for beta2 - t2 = 16

## [1] 16

sum(distgender$count[1:3])/sum(distgender$counts)  # One-sided p-value

## [1] 0.06957636

sum(distgender$counts[c(1:3,8:10)])/sum(distgender$counts)   # Two-tail test, matches Table 3

## [1] 0.116935

2*sum(distgender$count[1:3])/sum(distgender$counts)  # P-value given by summary()

## [1] 0.1391527

# mid-p - see "TST-Pmid" rows in mod.fit.logistiX$ciout
pmf.gender <- distgender$count/sum(distgender$counts)  # PMF
2*(sum(pmf.gender[1:2]) + 0.5*pmf.gender[3])

## [1] 0.08001568

# Exact CI
confint(object = mod.fit.logistiX, level = 0.95, type = "exact")  # Another way to extract CI

##       2.5 %    97.5 %
## 1      -Inf 0.1614947
## 2 -4.023839 0.3627064
## 3 -2.997241 0.5113281
## attr(,"CL method")
## [1] "exact-TST"

plot(x = mod.fit.logistiX, var = 1)  # Exact distribution of sufficient statistic

## $dist
##   t.stat        score penalized.score
## 1     19 3.709087e-02    3.709087e-02
## 2     20 1.855623e-01    1.855623e-01
## 3     21 3.417073e-01    3.417073e-01
## 4     22 2.920114e-01    2.920114e-01
## 5     23 1.200770e-01    1.200770e-01
## 6     24 2.201006e-02    2.201006e-02
## 7     25 1.516629e-03    1.516629e-03
## 8     26 2.449769e-05    2.449769e-05
## 
## $likelihood
## [1] 0.03709087

box()

Defina \(T = \sum_{i=1}^n Y_i x_{i1}\). Os valores possíveis de \(T\) são apresentados na coluna t.stat como 19, 20, . . . , 26; as contagens correspondem aos valores \(c(t_u)\), e as probabilidades condicionais associadas, derivadas da Equação (6.6), constam na coluna rel.freq.

O valor observado para o teste de \(H_0: \beta_1 = 0\) contra \(H_a: \beta_1\neq 0\) é \(t = 19\), e o \(p\)-valor do teste bilateral é a soma das probabilidades dos resultados cuja probabilidade condicional não supera a do resultado \(t = 19\): \[ P(T=19|I)+P(T\geq 24|I)= 0.0371+0.0220+0.0015+0.0000 = 0.0606\cdot \]

Alternativamente, a saída de summary() calcula o \(p\)-valor como \[ 2\times\min\{0.5,P(T=19|I),P(T\geq 24|I)\}, \] o que resulta em \(2P(T = 19 | I) = 0.0742\).

A partir desses \(p\)-valores, observa-se que há evidências moderadas de que a infiltração linfocítica influencia a ocorrência ou não de um período de três anos livre da doença. Para este caso específico, provavelmente seria preferível um teste unilateral à esquerda, \(H_0: \beta_1\geq 0\) vs. \(H_a: \beta_1 < 0\), visto que, naturalmente, esperar-se-ia que a infiltração linfocítica reduzisse a probabilidade de permanecer livre da doença. O \(p\)-valor para esse teste é 0.0371.

Em seguida, realizamos a aproximação MCMC para a regressão logística exata utilizando a função elrm() com os dados no formato EVP exigido. Assim como na função glm(), o argumento formula especifica o modelo; no entanto, não é necessário utilizar o argumento weights, mesmo que os dados estejam no formato EVP.

# elrm

library(package = elrm)

# set.seed(8718)  # This does not help you reproduce the same sample.
#  The sampling is performed by a C program called by elrm(). It looks like
#  no seed number is passed into this program.
mod.fit.elrm1 <- elrm(formula = w/n ~ LI + gender + AOP, interest = ~ LI, iter = 101000, 
                      dataset = set1, burnIn = 1000, alpha = 0.05)
summary(mod.fit.elrm1)

O argumento interest especifica quais parâmetros de regressão são de interesse para fins de estimação e inferência. Ao contrário do que ocorre com a função logistiX(), apenas as variáveis explicativas identificadas nesse argumento têm informações retornadas sobre si.

É possível especificar mais de uma variável explicativa no argumento interest utilizando a sintaxe padrão para argumentos do tipo fórmula. Nesse caso, também é realizado um teste conjunto envolvendo os parâmetros de regressão correspondentes.

Os métodos MCMC implementados pela função elrm() geram uma sequência aleatória dependente de possíveis valores da estatística suficiente para o parâmetro de regressão de interesse, na qual os valores da amostra apresentam aproximadamente a mesma frequência relativa das probabilidades definidas pela Equação (6.6).

O argumento iter da função elrm() especifica o tamanho total da amostra, enquanto o argumento burnIn define o tamanho da amostra inicial a ser descartada; isso ajuda a garantir que a amostra seja representativa da distribuição correspondente. A partir da saída de summary(mod.fit.elrm1), observa-se que isso resulta em uma amostra de tamanho 100000 para fins de inferência.

O método plot(), aplicável ao objeto mod.fit.elrm1, exibe o histórico do processo de amostragem e o histograma de frequências da distribuição dos valores da estatística suficiente.

# Estimate of exact distribution corresponding to beta1's sufficient statistic
mod.fit.elrm1$distribution  # Similar to what was obtained by logistiX, but just in a different order

## $LI
##      LI    freq
## [1,] 26 0.00010
## [2,] 25 0.00176
## [3,] 24 0.02356
## [4,] 19 0.03979
## [5,] 23 0.12181
## [6,] 20 0.18201
## [7,] 22 0.28287
## [8,] 21 0.34810

sum(mod.fit.elrm1$distribution$LI[1:3,2])  # Two tail test

## [1] 0.02542

mod.fit.elrm1$distribution$LI[3,2]  # Left-tail test

##    freq 
## 0.02356

plot(mod.fit.elrm1)
options(width = 60)
names(mod.fit.elrm1)

##  [1] "coeffs"        "coeffs.ci"     "p.values"     
##  [4] "p.values.se"   "mc"            "mc.size"      
##  [7] "obs.suff.stat" "distribution"  "call.history" 
## [10] "dataset"       "last"          "r"            
## [13] "ci.level"

options(width = 115)
mod.fit.elrm1$coeffs

##       LI 
## -1.82249

mod.fit.elrm1$obs.suff.stat

## LI 
## 19

sum(set1$y*set1$x1)

## [1] 0

# mod.fit.elrm1$distribution$LI[,2]
# mod.fit.elrm1$distribution$LI[,1] == 19

Por exemplo, a probabilidade exata estimada de observar \(t = 19\) é 0.03755. Utilizando essa distribuição, obtemos uma estimativa do \(p\)-valor exato para um teste de \(H_0 : \beta_1 = 0\) contra \(H_a : \beta_1\neq 0\) como \[ \widehat{P}(T=19|I)+\widehat{P}(T\geq 24|I)=0.06177, \] valor que também é apresentado na saída gerada pela função summary().

Surpreendentemente, cada vez que a função elrm() é executada, uma amostra diferente é obtida, mesmo que a função set.seed() seja utilizada logo antes da execução. Isso impede a reprodução dos mesmos resultados em múltiplas execuções, o que consideramos bastante decepcionante. No entanto, desde que se utilize um tamanho de amostra grande, a variabilidade nos resultados entre diferentes execuções de elrm() deve ser pequena.

A continuação fornecemos o código que implementa os métodos de verossimilhança modificada propostos por Firth (1993), utilizando a função logistf() discutida na Seção 2.2.7. O modelo de regressão logística estimado é \[ logit(\widehat{\pi}) = 4.2905 - 2.4611\times\mbox{LI}-1.4153\times\mbox{gender} -1.1039\times\mbox{AOP}, \] o que leva a conclusões semelhantes às obtidas com os métodos exatos.

# Firth

library(package = logistf)
mod.fit.firth <- logistf(formula = y ~ LI + gender + AOP, data = set1.long)
mod.fit.firth

## logistf(formula = y ~ LI + gender + AOP, data = set1.long)
## Model fitted by Penalized ML
## Confidence intervals and p-values by Profile Likelihood 
## 
## Coefficients:
## (Intercept)          LI      gender         AOP 
##    4.290477   -2.461139   -1.415283   -1.103923 
## 
## Likelihood ratio test=14.18308 on 3 df, p=0.002666252, n=46

summary(mod.fit.firth)

## logistf(formula = y ~ LI + gender + AOP, data = set1.long)
## 
## Model fitted by Penalized ML
## Coefficients:
##                  coef  se(coef) lower 0.95 upper 0.95     Chisq            p method
## (Intercept)  4.290477 1.5609230   1.813811  9.3242542 16.601417 4.611654e-05      2
## LI          -2.461139 1.4405302  -7.362605 -0.1887330  4.659827 3.087630e-02      2
## gender      -1.415283 0.8017224  -3.250688  0.1151084  3.265496 7.075164e-02      2
## AOP         -1.103923 0.7010616  -2.604195  0.2806724  2.431282 1.189356e-01      2
## 
## Method: 1-Wald, 2-Profile penalized log-likelihood, 3-None
## 
## Likelihood ratio test=14.18308 on 3 df, p=0.002666252, n=46
## Wald test = 9.14392 on 3 df, p = 0.02743734

Além disso, o teste de hipótese envolvendo \(H_0 : \beta_1 = 0\) contra \(H_a : \beta_1\neq 0\) resulta em um \(p\)-valor de 0.0309, o que, novamente, conduz a conclusões similares às da regressão logística exata. Para este exemplo, os \(p\)-valores obtidos ao testar a significância de cada variável explicativa são ligeiramente menores na abordagem de verossimilhança modificada do que na regressão logística exata.

Tanto a regressão logística exata quanto a abordagem de verossimilhança modificada de Firth (1993) podem substituir a estimativa padrão de máxima verossimilhança quando ocorre separação completa. Heinze (2006) discute os méritos relativos dos dois procedimentos. Heinze observa que a abordagem de verossimilhança modificada pode ser aplicada em situações em que as variáveis explicativas são verdadeiramente contínuas ou quando há poucas observações por variável explicativa.

Métodos exatos geralmente não podem ser utilizados nessas situações devido a problemas na avaliação da distribuição condicional de uma estatística suficiente, pode haver apenas uma permutação de \(y_1,\cdots, y_n\) que satisfaça \(I\). Em um estudo de simulação bastante limitado, Heinze (2006) também demonstrou que tanto a verossimilhança modificada quanto os métodos exatos conduzem a testes conservadores.

No entanto, a abordagem de verossimilhança modificada pode produzir testes com maior poder. Heinze demonstra ainda que o cálculo de \(p\)-valores para testes exatos utilizando o método do mid-p-value, frequentemente empregado para limitar o conservadorismo de testes que envolvem distribuições discretas (veja o Exercício 10) permite que ambos os testes apresentem poderes comparáveis.

Contudo, não há garantia de que testes baseados no mid-p-value rejeitem a hipótese nula a uma taxa menor ou igual ao nível de erro do Tipo I. Esse mid-p-value está disponível no componente ciout do objeto de ajuste do modelo gerado pela função logistiX().

É também importante lembrar que a inferência utilizando a abordagem de verossimilhança modificada requer amostras grandes para que as aproximações distribucionais sejam precisas. Os métodos de inferência exata não apresentam essa exigência. Embora Heinze (2006) demonstre que as inferências baseadas na abordagem de verossimilhança modificada geralmente funcionam conforme o esperado, tais conclusões basearam-se em um conjunto limitado — ainda que realista — de simulações que utilizaram amostras de tamanho moderado.

6.2.4 Procedimentos adicionais de inferência exata

Métodos de inferência exata são utilizados em muitos outros contextos que envolvem dados categóricos, e um grande número de pacotes do R inclui funções para realizar esses métodos. Um levantamento geral dos pacotes do R disponíveis atualmente pode ser obtido simplesmente pesquisando pelo termo “exact” na página do CRAN que lista todos os pacotes do R: Available CRAN Packages by Name.

Por exemplo, o pacote exact2x2 disponibiliza a função exact2x2(), que não apenas realiza o teste exato de Fisher, mas também oferece uma alternativa baseada no método de Blaker — menos conservadora; o intervalo de Blaker para uma única probabilidade binomial foi discutido na Seção 1.1.2. Esse pacote também inclui a função mcnemar.exact(), que fornece uma versão exata do teste de McNemar, discutido na Seção 1.2.6. Além disso, o pacote exactLogLinTest permite realizar inferência exata para modelos de regressão de Poisson.

6.3 Dados categóricos em delineamentos amostrais complexos

Todos os métodos estatísticos examinados até o momento pressupõem que dispomos de uma amostra aleatória simples de unidades (animais, lances livres, etc.) proveniente de uma população infinita. Essa premissa nos permite formular os modelos habituais: binomial, Poisson e multinomial.

Embora esses modelos sejam convenientes para o desenvolvimento matemático de métodos de análise e distribuições amostrais, eles podem não refletir a maneira como os dados são efetivamente coletados. Métodos de amostragem mais complexos são frequentemente empregados em pesquisas, sobretudo quando realizadas com populações humanas. Por exemplo, grandes pesquisas nacionais — como a National Health Interview Survey, do Centers for Disease Control and Prevention (CDC), e a General Social Survey, do Statistics Canada — apresentam complexidades como estratificação, agrupamento (clustering) e amostragem com probabilidades desiguais.

Quando são utilizados planejamentos amostrais complexos, as observações resultantes deixam de ser independentes e podem apresentar outras características que invalidam ainda mais os nossos modelos habituais. O objetivo desta seção é mostrar como realizar muitos dos mesmos tipos de análises estatísticas abordados em capítulos anteriores quando as unidades amostrais são selecionadas por meio de um plano amostral complexo.

Apresentamos métodos para calcular intervalos de confiança para uma proporção, realizar testes de independência e ajustar modelos de regressão.

6.3.1 O paradigma da amostragem em pesquisas

Os planos amostrais são frequentemente elaborados para aumentar a conveniência do processo de amostragem e reduzir a variabilidade de estatísticas de interesse específicas. Discutimos brevemente, a seguir, as características específicas de um plano amostral que permitem alcançar esses objetivos. Consulte S. Lohr (2010), Thompson (2002) ou outras obras similares sobre amostragem em pesquisas para mais detalhes sobre o uso dessas características.

Estratificação e Conglomerados

Dois aspectos fundamentais em planejamento de pesquisas complexas são a estratificação e o agrupamento (clustering). A estratificação consiste em classificar as unidades da população em grupos, denominados estratos, com base em características semelhantes e quantificáveis, antes da seleção da amostra. Por exemplo, indivíduos de uma população podem ser estratificados por gênero, renda, estado civil, bairro ou diversas outras características possíveis.

A amostragem é então realizada separadamente em cada estrato, seguindo um desenho baseado em probabilidades. A capacidade de controlar o tamanho da amostra em cada estrato permite garantir que as estimativas obtidas para cada um deles apresentem uma precisão razoável.

O agrupamento também envolve a organização de unidades em grupos, mas com uma finalidade totalmente diferente. Os agrupamentos são geralmente formados por conveniência: as unidades são reunidas de modo a facilitar a coleta conjunta de dados daquelas pertencentes a um mesmo grupo. Por exemplo, em pesquisas de porta em porta, é muito mais simples amostrar dez domicílios em um mesmo bairro do que selecionar um domicílio em cada um de dez bairros diferentes.

A desvantagem do agrupamento é que as unidades integrantes de um mesmo grupo tendem a apresentar semelhanças entre si; consequentemente, as respostas obtidas dentro do grupo também tendem a ser semelhantes e, portanto, positivamente correlacionadas. Isso significa que uma amostra composta por apenas um grupo não representa adequadamente a população como um todo, ao passo que uma amostra formada por múltiplos grupos contém conjuntos de dados que não são independentes.

Assim, a estratificação torna a amostragem um pouco menos conveniente, mas aumenta a precisão, ao passo que a amostragem por conglomerados torna o processo mais conveniente, porém reduz a precisão. Na prática, essas ferramentas são frequentemente utilizadas em conjunto — muitas vezes de maneiras que dificultam bastante a definição de um modelo de distribuição adequado para representar os dados. Os modelos usuais (binomial, multinomial e de Poisson), que pressupõem observações independentes, deixam de ser válidos e podem, de fato, representar de forma muito precária a estrutura real da amostra.

Para resumir o impacto que um plano amostral exerce sobre a variância de um parâmetro estimado, frequentemente calculam-se efeitos de plano (design effects) para uma pesquisa. O efeito de plano, ou deff, é a razão entre a variância da estimativa sob o plano amostral da pesquisa e a variância que o mesmo tamanho de amostra proporcionaria sob uma amostragem aleatória simples.

Por exemplo, no caso de amostragem aleatória simples proveniente de uma distribuição de Bernoulli, demonstramos na Seção 1.1.2 que a variância da proporção amostral é \[ \widehat{\mbox{Var}}_{SRS,n}(\widehat{\pi}) = \widehat{\mbox{Var}}(\widehat{\pi}) = \widehat{\pi}(1-\widehat{\pi})/n\cdot \]

Sob um planejamento amostral complexo, a variância da proporção amostral, \(\widehat{\mbox{Var}}_{DES,n}(\widehat{\pi})\), poderia ser bastante diferente. O deff mede a razão \(\widehat{\mbox{Var}}_{DES,n}(\widehat{\pi})/\widehat{\mbox{Var}}_{SRS,n}(\widehat{\pi})\). Na maioria das pesquisas, os valores de deff são superiores a 1.

Pesos amostrais

A análise de dados de pesquisas complexas é dificultada pela presença de pesos amostrais. As pesquisas — especialmente aquelas que utilizam estratificação — são frequentemente realizadas com amostragem de probabilidades desiguais, o que significa que nem todas as unidades têm a mesma probabilidade de serem incluídas na amostra.

Por exemplo, suponha que um governo regional queira construir uma nova prisão em uma cidade pequena e deseje avaliar o apoio ao projeto consultando a população. Além disso, suponha que 1000 pessoas vivam na cidade e que haja 1000000 de pessoas no estado fora dessa cidade.

Naturalmente, deseja-se garantir a inclusão tanto de moradores da cidade quanto de outros moradores do estado na amostra. Se uma amostra de tamanho total 50 fosse selecionada por meio de amostragem aleatória simples, haveria uma probabilidade de aproximadamente 95% de que nenhum morador da cidade fosse escolhido. Em vez disso, poderia fazer sentido selecionar, digamos, 10 pessoas da cidade e 40 do restante do estado, a fim de assegurar um tamanho de amostra adequado para estimar parâmetros para ambos os grupos.

Assim, cada morador da cidade incluído na amostra representa 100 membros da população local, enquanto cada pessoa de fora da cidade na amostra representa 25000 membros do restante da população. Ao elaborar estimativas dos totais populacionais, multiplicar as respostas dos moradores da cidade por 100 e as respostas das pessoas de fora por 25000 tenderá a fornecer estimativas não viesadas dos totais populacionais para toda a região.

Essa é a base para os pesos amostrais: para cada unidade amostrada, seu peso estima quantos membros da população aquela unidade representa. Os pesos amostrais também podem incluir ajustes para dados ausentes e/ou não resposta. Consulte S. Lohr (2010) para obter detalhes.

Os pesos podem ser constantes, caso todos os membros da população total tenham probabilidade igual de serem incluídos na amostra, ou podem variar consideravelmente de acordo com o tamanho dos estratos e outras características do planejamento amostral. Frequentemente, os pesos são ajustados de modo que sua soma em toda a amostra seja aproximadamente igual ao tamanho da população. Às vezes, são ajustados para que sua soma seja igual ao tamanho da amostra; nesse caso, eles variam em torno de 1.

As escalas são importantes apenas para a interpretação das estimativas de contagem que elas podem gerar. É possível converter pesos ou contagens de uma escala para a outra multiplicando os pesos por uma constante que depende dos tamanhos da população e da amostra. Nesta seção, geralmente assumimos que os pesos estão ajustados para produzir contagens populacionais.

6.3.2 Visão geral das abordagens de análise

Duas abordagens principais surgiram para a análise de dados de pesquisas complexas: a análise baseada no plano amostral (design-based) e a análise baseada em modelos (model-based). Elas possuem finalidades e pressupostos distintos e podem produzir resultados substancialmente diferentes; portanto, é importante avaliar, primeiramente, qual método é o mais adequado para um determinado problema. Binder and Roberts (2003) e Binder and Roberts (2009) apresentam excelentes discussões sobre as diferenças entre essas duas abordagens.

A inferência baseada no planejamento amostral pressupõe a existência de uma população finita e fixa, da qual a amostra foi extraída e sobre a qual se pretende realizar inferências. Já a inferência baseada em modelos pressupõe que a população é uma entidade transitória, em constante mudança, sendo ela própria uma amostra extraída de uma “superpopulação” segundo determinado modelo.

Como exemplo para destacar as diferenças entre essas duas abordagens, suponha que se realize uma pesquisa com uma amostra selecionada de alunos do primeiro ano de uma determinada universidade. Se o interesse recair especificamente sobre os alunos do primeiro ano daquela universidade naquele ano letivo, então uma abordagem baseada no plano amostral seria apropriada. Se, por outro lado, o objetivo for obter informações sobre alunos do primeiro ano de forma mais ampla, e os resultados forem aplicados a outros anos ou outras universidades, então os alunos do primeiro ano da universidade selecionada constituem, eles próprios, uma amostra de uma superpopulação maior.

Nesse caso, uma abordagem baseada em modelos provavelmente seria mais adequada. O uso de uma abordagem inadequada pode levar a estimativas viesadas e inconsistentes, o que significa que elas estimam um parâmetro populacional incorreto. Além disso, os erros-padrão calculados com base na abordagem incorreta podem diferir drasticamente dos valores corretos, resultando em intervalos de confiança ou resultados de testes inadequados. Portanto, a escolha da abordagem apropriada é um primeiro passo crucial.

Análise baseada no plano amostral

Se as unidades forem selecionadas de uma população finita com probabilidades conhecidas, essas probabilidades de inclusão podem ser utilizadas para construir os pesos da pesquisa.

Os métodos para a construção de pesos são abordados em obras de referência sobre amostragem em pesquisas, por exemplo, S. Lohr (2010) ou Heeringa et al. (2010) e fogem ao escopo deste texto. De posse dos pesos, a abordagem geral para a inferência baseada no plano amostral com dados categóricos segue os passos descritos a seguir.

Primeiramente, os pesos são utilizados para formar contagens ponderadas de respostas em cada categoria de resposta, simplesmente somando-se os pesos de todas as unidades pertencentes a essa categoria. Essas contagens ponderadas estimam os totais populacionais correspondentes.

A matriz de variância das contagens ponderadas é obtida por meio de um dos vários métodos padrão na análise de pesquisas amostrais S. L. Lohr (2010). Em seguida, quaisquer estatísticas ou fórmulas normalmente expressas como funções de contagens amostrais — incluindo a maioria das estatísticas abordadas nos Capítulos 1 a 4 — são reescritas em termos das contagens ponderadas.

O método delta é aplicado, conforme descrito em E. L. Korn and Graubard (1999), para “linearizar” essas funções em relação às contagens ponderadas. Tais aproximações lineares tornam relativamente simples o cálculo da variância de qualquer estatística.

A normalidade assintótica de muitas estatísticas é estabelecida mediante formas do teorema do limite central adequadas a problemas envolvendo populações finitas (ver, por exemplo, Binder 1983). Testes do tipo Wald e intervalos de confiança são geralmente construídos a partir das estimativas resultantes. Análises adicionais baseadas em estatísticas de teste qui-quadrado de Pearson e da razão de verossimilhança podem ser substituídas por cálculos análogos realizados sobre as estimativas ponderadas.

São derivadas distribuições amostrais aproximadas para as estatísticas Rao and A. J. Scott (1984) que levam em conta tanto a variabilidade dos pesos quanto as correlações entre as observações decorrentes do planejamento amostral.

Alternativamente, métodos de reamostragem — em particular, jackknife, bootstrap e replicação repetida balanceada — são frequentemente utilizados para gerar conjuntos de réplicas de pesos amostrais, especialmente em grandes pesquisas governamentais. A estatística de interesse é calculada para cada conjunto de réplicas, de modo que a variabilidade entre essas estatísticas replicadas possa ser usada para estimar o erro padrão da estatística. Isso evita a necessidade de obter aproximações por meio do método delta. Para mais detalhes, consulte obras como E. L. Korn and Graubard (1999) ou S. L. Lohr (2010).

Vale ressaltar que testes de hipóteses não são comumente realizados em análises estritamente baseadas no delineamento amostral (design-based). Isso ocorre porque não é razoável esperar que as hipóteses nulas sejam exatamente verdadeiras para a população finita à qual se aplicam. Por exemplo, uma hipótese nula de que uma proporção populacional é igual a 0.5 não pode ser verdadeira se o tamanho total da população for ímpar! Assim, quando realizamos testes de hipóteses em uma análise baseada no delineamento, geralmente estamos pressupondo a existência de uma superpopulação que gerou a população finita atual, por exemplo, há um fluxo constante de pessoas entrando e saindo de várias faixas etárias, e as hipóteses destinam-se a essa superpopulação.

A decisão de utilizar a inferência baseada no delineamento neste caso ainda pode ser justificada quando não acreditamos que um modelo consiga contemplar adequadamente todas as características do delineamento amostral. Veja Binder and Roberts (2009) para uma excelente discussão sobre o assunto.

Análise baseada em modelos

Utilizando métodos da Seção 6.5, é possível levar em conta explicitamente o agrupamento (clustering) ao incluir um fator de efeito aleatório correspondente no modelo. Além disso, estratos podem ser incluídos como efeitos fixos no modelo para permitir o cálculo de estimativas separadas para cada estrato.

Assim, é possível considerar muitas das características de um delineamento amostral complexo mediante a ampliação adequada do modelo. Se o modelo ampliado estiver corretamente especificado, podem-se utilizar os procedimentos de análise usuais (por exemplo, modelos lineares (mistos) generalizados) destinados a amostras aleatórias simples, ignorando-se o fato de que os dados provêm de um delineamento diferente.

As estimativas e os erros-padrão obtidos a partir do modelo constituem, então, estimativas adequadas das quantidades populacionais correspondentes. Binder and Roberts (2009) sugerem comparar as magnitudes dos erros-padrão baseados no delineamento e daqueles baseados no modelo. Se forem semelhantes, o modelo parece incorporar com sucesso as características do delineamento, e as inferências resultantes têm maior probabilidade de serem confiáveis do que na situação em que os erros-padrão diferem substancialmente.

Comparação

As estimativas de contagens populacionais baseadas no delineamento amostral são não viesadas, e espera-se que as estimativas subsequentes baseadas nessas contagens também sejam não viesadas — ou quase isso —, dependendo da estrutura da estimativa. Estimativas baseadas em modelos que ignoram os pesos podem apresentar viés — por vezes, um viés acentuado — ao estimar parâmetros da população finita da qual a amostra foi extraída.

No entanto, as estimativas baseadas no delineamento tendem a apresentar maior variabilidade do que as estimativas baseadas em modelos, e essa diferença se acentua à medida que aumenta a variabilidade dos pesos. Não existe uma preferência universal por uma abordagem em detrimento da outra, uma vez que o equilíbrio entre viés e variância depende fortemente de cada caso. Ainda assim, E. Korn and Graubard (1999) observam: “Em suma, a estimação ponderada, quando utilizada em conjunto com a estimação da variância baseada no delineamento da pesquisa, produzirá análises adequadas na maioria das situações.”

Como as análises baseadas em modelos utilizam técnicas já abordadas em outra parte, discutiremos aqui apenas os métodos de análise baseados no delineamento amostral. Iniciamos nossa discussão apresentando agora um exemplo e o pacote do R utilizado para análises baseadas no delineamento.

Exemplo 6.8: NHANES 1999-2000

A Pesquisa Nacional de Exame de Saúde e Nutrição (The National Health and Nutrition Examination Survey - NHANES), dos Centros de Controle e Prevenção de Doenças (U.S. Centers for Disease Control and Prevention - CDC) dos EUA, é um programa que realiza uma série de levantamentos sobre diversas questões de saúde desde a década de 1960. Entre as muitas perguntas feitas no período de 1999–2000, incluem-se questões sobre o uso de tabaco ao longo da vida e sobre sintomas respiratórios.

Especificamente, pergunta-se aos participantes se eles já consumiram pelo menos 100 cigarros ou se fumaram cachimbo ou charuto, ou ainda se utilizaram rapé ou tabaco de mascar pelo menos 20 vezes, em cada uma dessas modalidades.

As respostas são registradas como uma variável binária para cada um dos cinco itens relacionados ao tabaco. Os participantes também são questionados sobre sintomas respiratórios: tosse persistente, expectoração, chiado ou sibilos no peito e tosse seca à noite. A presença de cada um dos quatro sintomas também é registrada como uma resposta binária separada para cada sintoma.

Por fim, existem pesos associados a cada participante e um conjunto adicional de 52 pesos de réplica jackknife a serem utilizados para a estimativa da variância (a Seção 6.3.4 apresenta um exemplo de como eles são utilizados).

A população sobre a qual se podem fazer inferências compreende todos os adultos com 20 anos ou mais residentes nos Estados Unidos à época da realização da pesquisa. Consulte NHANES para obter uma descrição completa do programa NHANES, dos questionários e dos métodos de amostragem utilizados.

Utilizaremos esses dados para demonstrar diversas formas de análise, examinando as relações entre variáveis de uso de tabaco e de sintomas respiratórios que, naturalmente, poderiam ser de interesse para um pesquisador da área de saúde pública.

O código e a saída de dados abaixo mostram uma pequena parte dos dados. A idade aparece em primeiro lugar. Em seguida, vêm os cinco indicadores de tabagismo (com o prefixo sm_), seguidos pelos quatro indicadores de sintomas respiratórios (com o prefixo re_). Logo após, apresentam-se os pesos amostrais fornecidos com os dados (wtint2yr) e, por último, os 52 conjuntos de pesos de réplica jackknife, jrep01 a jrep52 (apenas dois são exibidos abaixo).

Observe que esses pesos de réplica já estão na mesma escala que os pesos amostrais originais; em algumas pesquisas, esses pesos de réplica são apenas “fatores de ajuste” (números que variam em torno de 1) que precisam ser multiplicados pelos pesos originais para criar novos pesos combinados. Fica evidente, a partir dos pesos, que alguns sujeitos representam um número de membros da população substancialmente maior do que outros. Por exemplo, a observação nº 5 representa 92603 indivíduos na população, enquanto a observação nº 6 representa apenas 1647.

library(knitr)
URL.address = "https://estatistica.c3sl.ufpr.br/~lucambio/ADC/SmokeRespAge.txt"
smoke.resp <- read.table ( file = URL.address, header = TRUE , sep = " ")
kable(smoke.resp[1:6, 1:10], caption = "Primeiras linhas e colunas dos dados de fumo")

Primeiras linhas e colunas dos dados de fumo

age	sm_cigs	sm_pipe	sm_cigar	sm_snuff	sm_chew	re_cough	re_phlegm	re_wheez	re_night
77	0	1	1	0	0	0	0	0	0
49	1	1	1	0	1	0	0	0	0
59	1	0	0	0	0	0	0	0	0
43	1	0	0	0	0	0	0	0	0
37	0	1	1	0	0	0	0	1	0
70	1	0	0	0	0	0	0	0	0

O pacote survey no R, desenvolvido por Thomas Lumley, realiza uma ampla gama de análises estatísticas para dados provenientes de planos amostrais complexos. O pacote contém funções que executam diversas análises comuns para dados categóricos. Em particular, oferece recursos para a análise de proporções únicas, tabelas de contingência e modelos de regressão logística, de Poisson e certos modelos de regressão multinomial para respostas ordinais.

Modelos de regressão multinomial para respostas nominais e técnicas de seleção automatizada de modelos não estão disponíveis, e a capacidade para diagnósticos de modelos é bastante limitada. Lumley (2010) descreve o pacote com muito mais detalhes do que é possível abordar aqui.

Além disso, o pacote é atualizado frequentemente; portanto, recomenda-se consultar a documentação antes de utilizar os programas apresentados a seguir, para verificar se foram adicionadas funções que substituem aquelas utilizadas em nossos programas. A versão 4.5 foi utilizada para os cálculos desta seção.

library(survey)
jdesign <- svrepdesign( data = smoke.resp[ , c (1:10) ], weights = smoke.resp[ ,11] , 
                        repweights = smoke.resp[ ,12:63], type = "JK1", 
                        combined.weights = TRUE , scale = 51/52)

Após carregar o pacote survey, precisamos converter nossos dados em um objeto que contenha informações sobre o plano amostral, para que as funções de análise possam calcular corretamente as estatísticas e suas variâncias.

Utilizamos svrepdesign() neste caso porque nosso plano amostral possui pesos de réplica; outras funções permitem que o usuário especifique, em vez disso, identificadores de estratificação e de agrupamento (clustering) que podem ser usados na estimação da variância. Os argumentos identificam as colunas do data frame que contêm as variáveis de análise (data), os pesos originais da pesquisa (weights) e os pesos de réplica (repweights).

A descrição do plano da pesquisa recomenda o uso da versão leave-one-out (deixar um de fora) do método jackknife, a qual é selecionada aqui por meio do argumento type = "JK1". Como mencionado anteriormente, os pesos de réplica estão na mesma escala que os pesos da pesquisa; portanto, define-se combined.weights = TRUE.

O parâmetro scale = 51/52 relaciona a existência de 52 pesos de réplica à fórmula para estimativas de variância via jackknife do tipo leave-one-out (S. Lohr 2010, pg. 380). O código abaixo cria um objeto da classe svyrep.design, que pode ser utilizado para todas as análises no pacote survey.

class(jdesign)

## [1] "svyrep.design"

6.3.3 Contagens de células ponderadas

A primeira e mais fundamental etapa na análise de dados categóricos provenientes de uma pesquisa complexa é estimar a contagem populacional de unidades em cada categoria.

A estimativa dessas contagens pode não apenas ser um dos principais objetivos da análise, mas também servir de base para quaisquer cálculos subsequentes, como aqueles descritos nas Seções 6.3.4 a 6.3.6.

Suponha que a população consista em \(N\) unidades e que a resposta \(Y\) apresente categorias \(1,\cdots,I\), contendo \(N_1,N_2,\cdots,N_I\) membros da população, respectivamente, de modo que \(\sum_{i=1}^{I} N_i = N\). Considere que a amostra consista em \(n\) unidades selecionadas da população segundo um determinado plano amostral.

Para cada unidade amostrada, defina seu peso amostral como \(\omega_s\), \(s=1,\cdots,n\) e sua resposta observada como \(y_s\). Por exemplo, no Exemplo 6.8, apresentamos informações sobre as unidades amostradas \(s=1,\cdots,6\), provenientes de uma amostra de \(n = 4852\) do conjunto de dados NHANES. A variável wtint2yr nesse exemplo corresponde a \(\omega_s\).

Como o peso amostral \(\omega_s\) é o número de unidades populacionais representadas pela unidade amostrada \(s\), a estimativa de \(N_i\) é simplesmente a soma dos pesos de todas as unidades amostradas na categoria \(i\): \[ \tag{6.7} \widehat{N}_i=\sum_{s=1}^n \omega_s \pmb{I}(y_s=i), \qquad i=1,\cdots,I, \] onde \(\pmb{I}(y_s = i)\) indica se a unidade \(s\) pertence ou não à categoria \(i\), 1 para sim, 0 para não. De forma semelhante, podemos estimar o total populacional como \[ \widehat{N} = \sum_{s=1}^n \omega_s = \sum_{i=1}^I \widehat{N}_i\cdot \]

Para maior conveniência, agrupamos as contagens ponderadas das células em um vetor, \[ \widehat{\pmb{N}} = (\widehat{N}_1,\widehat{N}_2,\cdots,\widehat{N}_I)^\top\cdot \] A matriz de covariância de \(\widehat{\pmb{N}}\), \(\widehat{\mbox{Var}}(\widehat{\pmb{N}})\), não apenas mede a variabilidade de \(\widehat{\pmb{N}}\), mas também serve de base para o cálculo de variâncias, intervalos de confiança e estatísticas de teste para funções de \(\widehat{\pmb{N}}\).

Essa matriz de covariância pode ser obtida utilizando métodos de linearização, jackknife e bootstrap, conforme descrito anteriormente e discutido em detalhes em obras de referência sobre análise de pesquisas amostrais (por exemplo, S. L. Lohr 2010). Geralmente, não apresentamos aqui os detalhes desses métodos; em vez disso, recorremos a funções do pacote survey para realizar os cálculos, sempre que possível.

Nem sempre é simples determinar os graus de liberdade para \(\widehat{\mbox{Var}}(\widehat{\pmb{N}})\), digamos \(\kappa\). O padrão é utilizar (# número de clusters) − (# número de estratos), embora Rust and Rao (1996) indiquem que isso geralmente resulta em uma superestimativa.

No exemplo da NHANES, os 52 pesos de réplica foram formados a partir de 52 subgrupos aleatórios, ignorando o agrupamento e a estratificação do desenho amostral. Isso resulta em \(\kappa = 52-1 = 51\) graus de liberdade para \(\widehat{\mbox{Var}}(\widehat{\pmb{N}})\).

Exemplo 6.9: NHANES 1999-2000

Para cada uma das 9 respostas binárias sobre o uso de tabaco e sintomas respiratórios, podemos estimar o total populacional utilizando a contagem ponderada das respostas positivas. O código abaixo demonstra os cálculos para o primeiro item relacionado ao tabaco: o uso de cigarros. O resultado representa o número estimado de indivíduos na população que fumaram pelo menos 100 cigarros ao longo da vida.

# Get weighted estimate of a proportion and a confidence interval
# Showing both certain manual calculations and functions to perform them.

# Total sample size for manual calculations
Nhat <- sum(smoke.resp$wtint2yr)
Nhat

## [1] 191125474

# Manually calculate a weighted count for cigarette smoking
wt_cig <- smoke.resp$sm_cigs * smoke.resp$wtint2yr  
totcigwt <- sum(wt_cig) 
totcigwt

## [1] 94480990

A variância dessa estimativa pode ser encontrada repetindo o cálculo em cada um dos 52 conjuntos de pesos de replicação jackknife. Seja \(\widehat{N}_i^{(r)}\) a contagem populacional estimada para a categoria \(i\) do conjunto de pesos de replicação \(r\). Então, a variância é encontrada a partir da fórmula para estimativas de variância jackknife leave-one-out (S. Lohr 2010, pg. 381), \[ \tag{6.8} \widehat{\mbox{Var}}\big(\widehat{N}_i \big)=\dfrac{R-1}{R}\sum_{r=1}^R \big(\widehat{N}_i^{(r)}- \widehat{N}_i\big)^2\cdot \]

De forma mais geral, a variância de um vetor completo de contagens é \[ \widehat{\mbox{Var}}\big(\widehat{\pmb{N}} \big)=\dfrac{R-1}{R}\sum_{r=1}^R \big(\widehat{\pmb{N}}^{(r)}- \widehat{\pmb{N}}\big)\big(\widehat{\pmb{N}}^{(r)}- \widehat{\pmb{N}}\big)^\top\cdot \]

A Equação (6.8) pode ser calculada no R da seguinte forma:

# Calculation below matches the standard error produced later.
#  52 replicate weights start in column 12
Nhat.reps <- numeric(length = 52)
for(r in 1:52){
 Nhat.reps[r] <- sum(smoke.resp$sm_cigs * smoke.resp[,r+11])
}
sum.sq <- var(Nhat.reps)*51
var.tot <- sum.sq*(51/52) 
sqrt(var.tot)  # Estimated standard error

## [1] 2483739

A função svytotal() realiza esses cálculos automaticamente:

# Automatically calculate the same weighted count (and the standard error!)
svytotal(x = ~ sm_cigs, design = jdesign)

##            total      SE
## sm_cigs 94480990 2483739

A documentação do NHANES 1999-2000 indica que o procedimento jackknife utilizado para estimar variâncias pode subestimar a verdadeira variância amostral para algumas estatísticas.

Recomenda-se cautela ao interpretar resultados “marginalmente significativos” quando essas variâncias são utilizadas em testes de hipóteses ou intervalos de confiança.

6.3.4 Inferência sobre proporções populacionais

Defina as proporções populacionais para cada categoria, também chamadas de probabilidades de célula, como \(\pi_i = N_i/N\), \(i = 1,\cdots, I\). As proporções populacionais são estimadas como \[ \widehat{\pi}_i=\widehat{N}_i/\widehat{N}, \qquad i=1,\cdots,I\cdot \] Usamos \(\widehat{N}\) no denominador mesmo quando \(N\) é conhecido, de modo que as proporções estimadas somem 1 em todas as categorias.

Observe que \(\widehat{\pi}_i\) é uma razão de duas estimativas ponderadas baseadas em observações correlacionadas. Sua estimativa de variância não é simplesmente a fórmula usual para a variância de uma proporção binomial, \(\widehat{\pi}(1-\widehat{\pi})/n\), conforme apresentado na Equação (1.3). Em vez disso, usando o método delta, pode-se mostrar que \[ \tag{6.9} \widehat{\mbox{Var}}(\widehat{\pi}_i)=\dfrac{\widehat{\mbox{Var}}(\widehat{N}_i)+\widehat{\pi}_i^2 \, \widehat{\mbox{Var}}(\widehat{N})-2\widehat{\pi}_i^2 \, \widehat{\mbox{Cov}}(\widehat{N}_i,\widehat{N})}{\widehat{N}^2}, \] onde as estimativas necessárias de variâncias e covariâncias baseadas no delineamento experimental são todas encontradas a partir de \(\widehat{\mbox{Var}}\big(\widehat{\pmb{N}} \big)\). Alternativamente, essa variância pode ser calculada diretamente usando um método de replicação.

Por exemplo, o método jackknife leave-one-out com R pesos de replicação resulta na fórmula \[ \tag{6.10} \widehat{\mbox{Var}}\big(\widehat{\pi}_i \big)=\dfrac{R-1}{R}\sum_{r=1}^R \big(\widehat{\pi}_i^{(r)}-\widehat{\pi}_i \big)^2, \] onde \(\widehat{\pi}_i^{(r)}\) é estimado a partir do \(r\)-ésimo conjunto de pesos replicados.

Os métodos para formar intervalos de confiança para as proporções verdadeiras são análogos aos da Seção 1.1.2. O intervalo de Wald fornece um cálculo simples. \[ \widehat{\pi}_i\pm Z_{1-\alpha/2}\sqrt{\widehat{\mbox{Var}}\big(\widehat{\pi}_i\big)}, \] mas com as deficiências observadas na Seção 1.1.2. Como \(\widehat{\mbox{Var}}\big(\widehat{\pmb{N}} \big)\) é baseado em um cálculo de soma de quadrados, um valor crítico \(t_{\kappa,1-\alpha/2}\) pode ser usado em vez de \(Z_{1-\alpha/2}\). No entanto, isso faz pouca diferença prática, a menos que \(\kappa< 30\).

Kott and Carr (1997) propõem um intervalo de confiança mais preciso para \(\widehat{\pi}_i\) usando uma modificação do intervalo de escore de Wilson dado pela Equação (1.4). Fazendo uma analogia com a variância binomial, \(\widehat{\pi}_i(1-\widehat{\pi}_i)/n\), eles definem o tamanho efetivo da amostra para estimar proporções \(\pi\), \(i = 1,\cdots, I\), como o valor \[ n_i^∗ = \dfrac{\widehat{\pi}_i(1-\widehat{\pi}_i}{\widehat{\mbox{Var}}\big(\widehat{\pi}_i\big)}\cdot \] Então, um intervalo de confiança de \(100(1-\alpha)\%\) para \(\pi_i\) é \[ \tag{6.11} \dfrac{2n_i^* \, \widehat{\pi}_i +t_{\kappa,1-\alpha/2}^2\pm t_{\kappa,1-\alpha/2}\sqrt{t_{\kappa,1-\alpha/2}^2+4n_i^* \, \widehat{\pi}_i(1-\widehat{\pi}_i)}}{2\big(n_i^*+t_{\kappa,1-\alpha/2}^2 \big)}\cdot \]

As pesquisas geralmente se preocupam mais em estimar quantidades populacionais do que em testar hipóteses, mas, caso seja necessário testar \(H_0: \pi_i = \pi_{i0}\), utilizam-se os testes de Wald usuais (ver Seção 1.1.2).

A estatística de teste é \[ Z=\dfrac{\widehat{\pi}_i-\pi_{i0}}{\widehat{\mbox{Var}}\big(\widehat{\pi}_i\big)}, \] onde as quantidade \(\widehat{\pi}_i\) e \({\widehat{\mbox{Var}}\big(\widehat{\pi}_i\big)}\) são estimados a partir da pesquisa usando os métodos descritos acima.

A regra de decisão é encontrada comparando \(Z\) ao valor crítico apropriado da distribuição normal padrão (ou \(t_\kappa\)) de acordo com a hipótese alternativa que está sendo testada.

Exemplo 6.10: NHANES 1999-2000

Estimamos a proporção da população que fumou pelo menos 100 cigarros ao longo da vida utilizando um intervalo de confiança de 95%. A função svymean() estima médias e erros-padrão levando em conta o desenho amostral. Visto que proporções são médias de variáveis binárias, podemos utilizar essa função para estimar \(\pi_i\).

# Get weighted proportion of cigarette smokers manually 
totcigwt/Nhat

## [1] 0.4943401

# Automatically calculate proportion of cig smokers as mean of a binary
cigprop <- svymean(x = ~ sm_cigs, design = jdesign)
cigprop

##            mean     SE
## sm_cigs 0.49434 0.0131

Encontramos \(\widehat{\pi}_i = 0.49\), portanto, quase metade da população consumiu pelo menos 100 cigarros. O erro padrão estimado é \(\sqrt{\widehat{\mbox{Var}}\big(\widehat{\pi}_i\big)}= 0.013\). A função svymean() reconhece o conteúdo do delineamento jdesign e utiliza a Equação (6.10) em vez da Equação (6.9) para este cálculo.

Um intervalo de confiança baseado na distribuição \(t\)_Student é obtido a partir de:

# Confidence interval for true proportion
confint(object = cigprop, level = 0.95, df = 51)

##             2.5 %    97.5 %
## sm_cigs 0.4679677 0.5207125

# Confidence interval for true proportion (Wald)
confint(object = cigprop, level = 0.95)

##             2.5 %   97.5 %
## sm_cigs 0.4685933 0.520087

# NOTE: Can get proportions for both levels of the variable by treating it as a factor
cigprop2 <- svymean(x = ~ factor(sm_cigs), design = jdesign)
cigprop2

##                     mean     SE
## factor(sm_cigs)0 0.50566 0.0131
## factor(sm_cigs)1 0.49434 0.0131

Um intervalo de Wald pode ser obtido a partir do código acima omitindo-se o argumento df.

Um intervalo de escore de Wilson requer alguns cálculos adicionais. Primeiro, devemos armazenar a proporção estimada e o erro padrão e, em seguida, calcular o tamanho efetivo da amostra. Depois, o intervalo é calculado de acordo com a Equação (6.11).

# Wilson Score Interval preliminary calculations
pihat <- coef(cigprop) 
# Effective sample size for Wilson Score interval 
eff_sample <- pihat*(1-pihat)/vcov(cigprop)
round(eff_sample, 3)

##          sm_cigs
## sm_cigs 1448.545

tcrit <- qt(p = c(0.025, 0.975), df = 51)
# Wilson Score interval 
j.Wilsonci_wt <- (((2*eff_sample*pihat + tcrit[2]^2) +
          tcrit*sqrt(tcrit[2]^2 + 4*eff_sample*pihat*(1-pihat))) 
          / (2*(eff_sample + tcrit[2]^2)))
round(j.Wilsonci_wt, digits = 3)

## [1] 0.468 0.521

# Other confidence intervals are available from svyciprop(); much like binom.confint
#  Works on one variable at a time. 
#  Specific interest: "beta" analogous to Clopper-Pearson 
#  Other methods include "logit" (logit transformation, default), 
#   "likelihood" (LR based on Rao-Scott), "asin" (arcsin-square-root transform),
#   and "mean" (Wald)
svyciprop(formula = ~ sm_cigs, design = jdesign, method = "beta", level = 0.95)

##                2.5% 97.5%
## sm_cigs 0.494 0.468 0.521

# factor() does not work here.

Os intervalos de confiança são essencialmente os mesmos — aproximadamente 0.468 a 0.521 — devido ao grande tamanho da amostra desta pesquisa.

6.3.5 Tabelas de contingência e modelos log-lineares

Métodos para a análise de tabelas de contingência são apresentados nas Seções 1.2, 3.2 e 4.2.4. Análises mais simples para tabelas de contingência de duas entradas concentram-se em testes de independência entre as variáveis de linha e de coluna.

Modelos log-lineares para tabelas de duas entradas ou de dimensões maiores permitem análises mais detalhadas, incluindo testes para diversas formas de associação ou outras características do modelo, bem como estimativas de proporções ou razões de chances (odds ratios).

As mesmas análises são frequentemente realizadas quando os dados provêm de uma pesquisa complexa. A principal diferença reside na forma como os cálculos são efetuados. Em primeiro lugar, a tabela é construída a partir das contagens ponderadas pela pesquisa \(\widehat{\pmb{N}}\) ou das proporções correspondentes, em vez das contagens ou proporções amostrais.

Por exemplo, um modelo loglinear para dois fatores independentes é: \[ \log(N_{ij})=\beta_0+\beta_I^X+\beta_J^Z, \qquad i=1,\cdots,I, \quad j=1,\dots,J, \] o que é simplesmente a Equação (4.3), exceto pelo fato de modelar \(\log(N_{ij})\) em vez de \(\log(\mu_{ij})\). Em segundo lugar, a variância \(\widehat{\mbox{Var}}\big(\widehat{\pmb{N}}\big)\) é calculada com base no delineamento amostral, e não em um modelo de Poisson. Por fim, os graus de liberdade do erro para qualquer teste ou intervalo de confiança derivado de um modelo devem ser ajustados para \(\kappa-p-1\), em que \(p\) é o número de parâmetros estimados no modelo.

Note que essa última condição limita o tamanho dos modelos que podem ser considerados sem o uso de técnicas especiais de estimação (E. Korn and Graubard 1999, Seção 5.2).

Começamos considerando uma tabela de contingência de dupla entrada formada pelas variáveis \(X\), com \(I\) categorias, e \(Y\), com \(J\) categorias. Utilizando a mesma notação da Seção 3.2.1, seja \(\pi_{ij}\) a proporção da população que satisfaz \(X = i\) e \(Y = j\). Testar a independência entre \(X\) e \(Y\) implica testar a hipótese \(H_0 : \pi_{ij} = \pi_{i+}+ \pi_{+j}\), em que \(\pi_{i+}\) e \(\pi_{+j}\) são as proporções marginais populacionais para \(X = i\) e para \(Y = j\), respectivamente.

Normalmente, utilizar-se-ia um teste de Pearson ou um teste da razão de verossimilhança (LR) para independência, a fim de comparar as contagens observadas com aquelas esperadas sob a hipótese nula, conforme discutido nas Seções 1.2.3, 3.2.3 e 4.2.4. No contexto de um modelo log-linear para dados de pesquisa amostral, esses dois conjuntos de contagens são obtidos a partir de ajustes de modelo distintos realizados sobre dados ponderados.

As contagens “observadas” provêm de um modelo log-linear saturado, enquanto as contagens esperadas estimadas derivam de um ajuste de modelo que satisfaz a hipótese nula. Embora seja simples calcular essas estatísticas com dados de pesquisa ponderados, determinar a distribuição de probabilidade das estatísticas resultantes — a qual deve levar em conta o plano amostral — não é tão simples.

Testes de independência: métodos de Rao-Scott

O uso de uma distribuição \(\chi^2\) para as estatísticas de Pearson e da razão de verossimilhança (LRT) é tipicamente justificado pela adequação do modelo de amostragem subjacente — seja Poisson ou multinomial — aos dados. No entanto, esses modelos de amostragem podem representar mal os dados provenientes de desenhos amostrais complexos; portanto, não se deve esperar que a distribuição \(\chi^2\) resultante aproxime com precisão a verdadeira distribuição de probabilidade de qualquer estatística de teste.

De fato, há muitas evidências indicando que o uso ingênuo de distribuições \(\chi^2\) com estatísticas de Pearson calculadas a partir de dados de pesquisas amostrais pode resultar em análises muito inadequadas, por exemplo, Rao and Scott (1981); Scott and Rao (1981); Thomas and Rao (1987); Thomas et al. (1996). Em particular, em muitos planos amostrais, o teste tende a rejeitar a hipótese nula com muito mais frequência do que o nível \(\alpha\) especificado.

Como as estatísticas de Pearson são amplamente utilizadas na análise de dados categóricos, @Rao and Scott (1981), Rao and Alastair J. Scott (1984) desenvolveram correções para melhorar seu desempenho em planos amostrais complexos. Essas correções são semelhantes às bem conhecidas correções de Satterthwaite (1946), comuns na análise de modelos lineares. Seja \(X^2\) a estatística de teste de Pearson para um teste específico e suponha que \(X^2\) teria \(\nu\) graus de liberdade sob amostragem aleatória simples, por exemplo, em uma tabela de contingência de dupla entrada, \(\nu = (I − 1)(J − 1)\). Os métodos de Rao-Scott comparam a média e a variância de \(X^2\) sob o plano amostral efetivo com as médias e variâncias de membros da família de distribuições \(\chi^2\).

Utilizando o fato de que a média e a variância da distribuição \(\chi^2_\nu\) são, respectivamente, \(\nu\) e \(2\nu\), realizam-se então ajustes relativamente simples na estatística de teste e nos graus de liberdade, melhorando a correspondência entre a distribuição \(\chi^2\) e a distribuição real de \(X^2\).

Correção de primeira ordem

A forma mais simples de correção de Rao-Scott garante que a média da distribuição da estatística de teste e a média da distribuição amostral escolhida sejam iguais. Isso é chamado de correção de primeira ordem, pois baseia-se na igualdade das médias (primeiros momentos) das duas distribuições.

Para facilitar a notação e permitir a extensão para modelos log-lineares maiores, seja \(K\) o número de células na tabela e renomeiem-se as probabilidades \(\pi_{ij}\), \(i = 1,\cdots,I\); \(j = 1,\cdots,J\), como \(\pi_k\), \(k = 1,\cdots,K\). Para cada \(\pi_k\), seja \(\pi_{0k}\) o seu valor sob a hipótese nula.

Recordando a definição de deff da Seção 6.3.1, seja \(d_k^0\) o deff correspondente a \(\widehat{\pi}_k\) sob a hipótese nula: \[ d_k^0=\dfrac{n\mbox{Var}_0\big(\widehat{\pi}_k\big)}{\pi_{0k}(1-\pi_{0k})}, \] onde \(\mbox{Var}_0\big(\widehat{\pi}_k\big)\) é a variância de \(\widehat{\pi}_k\) sob a hipótese nula.

Suponha que cada estimativa de probabilidade tenha o mesmo deff, \(d_{k}^0 = d_0\), e, além disso, que as covariâncias estimadas pela pesquisa, \[ \widehat{\mbox{Cov}}(\widehat{\pi}_{k_1}, \widehat{\pi}_{k_2})=d^0 (-\pi_{0k_1} \pi_{0k_2}), \] para todos os pares \((k_1, k_2)\). Nessas condições, \(X^2\) tem uma distribuição assintoticamente equivalente à de \(d^0 W\), onde \(W \sim \chi^2_\nu\). Portanto, a distribuição de \(X^2/d^0\) é aproximadamente \(\chi^2_\nu\). Note que, sob amostragem aleatória simples, \(d^0 = 1\); assim, a estatística de teste permanece sendo \(X^2\).

Na prática, \(\mbox{Var}_0\big(\widehat{\pi}_k\big)\) raramente é conhecido antecipadamente, e nem todas as \(k\) células têm exatamente o mesmo deff devido ao acaso, portanto, esse ajuste simples geralmente não está disponível. Em vez disso, pode-se estimar um deff médio em todas as células usando técnicas matriciais descritas em Rao and Scott (1981) e Scott (2007).

Chame a estimativa resultante de \(\overline{d}\). Então, o teste de Rao-Scott de primeira ordem aproxima os \(p\)-valores e os valores críticos para testes envolvendo \(X^2\) comparando \[ X^2_{RS_1}=X^2/\overline{d}, \] com uma distribuição \(\chi^2_\nu\).

Este procedimento funciona muito bem desde que não haja muita variabilidade entre os \(d^0_k\). Este teste geralmente está disponível como o valor do argumento "Chisq" nos procedimentos de teste do pacote survey.

Correção de segunda ordem

De forma mais geral, quando as deffs não são todas aproximadamente iguais, \(X^2\) tem uma distribuição que é assintoticamente equivalente a \(\sum_{\ell=1}^\nu \delta_\ell W_\ell\), onde \(W_\ell\), \(\ell = 1,\cdots,\nu\), são variáveis aleatórias \(\chi^2_1\) independentes e \(\delta_\ell\), \(\ell = 1,\cdots,\nu\), são quantidades chamadas de deffs generalizadas.

As \(\delta_\ell\)’s são encontradas usando técnicas matriciais descritas em Rao and Scott (1981) e Scott (2007). Seja \(c\) o coeficiente de variação entre as \(\delta_\ell\)’s: \[ c^2 = \sum_{\ell=1}^\nu \big(\delta_\ell-\overline{\delta}\big)^2 /\big(\nu\overline{\delta}^2 \big), \] onde \(\overline{\delta}=\overline{d}\) é a deff generalizada média.

Então, o teste de Rao-Scott com correção de segunda ordem compara \[ X^2_{RS_2}=X^2/\big(\overline{d}(1+c^2)\big), \] com uma distribuição \(\chi^2_{\nu/(1+c^2)}\).

Abordagens adicionais

Thomas and Rao (1987) propõem versões modificadas dos testes de Rao-Scott que utilizam distribuições \(F\) em vez de \(\chi^2\). Em particular, eles comparam a estatística \[ \tag{6.12} F_{TR}=X^2_{RS_1}/\nu=X^2/(\nu\delta), \] à distribuição \(F_{\nu/(1+c^2),\kappa\nu/(1+c^2)}\), onde \(\kappa\) são, novamente, os graus de liberdade associados à estimativa de variância \(\widehat{\mbox{Var}}\big(\pmb{N}\big)\).

Simulações realizadas por Thomas and Rao (1987), Thomas et al. (1996) e Rao and Thomas (2003) demonstram que esse teste \(F\) apresenta desempenho satisfatório na maioria das condições, sendo adequado para uso como procedimento principal em testes de Pearson com dados de pesquisas amostrais complexas. Na verdade, esse é o procedimento padrão para funções que realizam testes do tipo Pearson no pacote survey, e ele também pode ser especificado como o valor do argumento "F" para os argumentos de teste nessas funções.

Existem também outros métodos para calcular \(p\)-valores e valores críticos a partir de \(X^2\). Em particular, survey pode calcular uma “aproximação de ponto de sela” para a combinação linear de qui-quadrados com deffs estimados, \[ \sum_{\ell=1}^\nu \widehat{\delta}_\ell W_\ell, \] o valor do argumento saddlepoint (ponto de sela) em testes (Kuonen 1999).

Não investigamos o uso desse método para aproximar a distribuição das estatísticas de Pearson neste contexto, mas esperamos que ele seja eficaz quando o tamanho da amostra for grande, de modo que as estimativas dos deff’s generalizados sejam bastante precisas.

A diferença entre os deviances dos modelos — que é um teste de razão de verossimilhança quando modelos de amostragem padrão são usados — pode ser corrigida da mesma maneira que a estatística de Pearson para fornecer um teste de comparação de modelos viável para comparar quaisquer dois modelos aninhados. Assim, os pilares da modelagem categórica e das análises de tabelas de contingência têm análogos úteis que podem ser aplicados no contexto de pesquisas complexas. Esses procedimentos são demonstrados nos exemplos a seguir.

Inferência sobre razões de chances

As razões de chances são apresentadas na Seção 1.2.5 e discutidas mais detalhadamente no contexto de um modelo log-linear na Seção 4.2.4. Para simplificar a notação, suponha que \(X\) e \(Y\) sejam variáveis binárias, embora possam, alternativamente, representar quaisquer duas linhas ou colunas de uma tabela maior.

Construa a tabela \(2\times 2\) resultante de totais populacionais estimados, utilizando a mesma abordagem apresentada na Equação 6.7. A razão de chances populacional é \[ OR=\dfrac{\pi_{11}(1-\pi_{11})}{\pi_{21}(1-\pi_{21})}=\dfrac{N_{11}\times N_{22}}{N_{21}\times N_{12}}\cdot \]

Defina \(\widehat{N}_{ij}\) como a contagem ponderada para \(X = i\), \(Y = j\), \(i = 1, 2\); \(j = 1, 2\). A razão de chances da população é então estimada por \[ \widehat{OR}=\dfrac{\widehat{N}_{11}\times \widehat{N}_{22}}{\widehat{N}_{21}\times \widehat{N}_{12}}\cdot \] Assim como na Seção 1.2.5, geralmente é mais preciso basear a inferência em \(\log\big(\widehat{OR}\big)\) do que no próprio \(\widehat{OR}\). Utilizando o método delta para estimar a variância de \(\log\big(\widehat{OR}\big)\) leva à expressão \[ \widehat{\mbox{Var}}\big(\log\big(\widehat{OR}\big)\big)=\pmb{a}^\top \widehat{\mbox{Var}}\big(\widehat{\pmb{N}} \big)\pmb{a}, \] onde \(\widehat{\pmb{N}}=(\widehat{N}_{11},\widehat{N}_{12},\widehat{N}_{21},\widehat{N}_{22})\), \(\widehat{\mbox{Var}}\big(\widehat{\pmb{N}} \big)\) é a matriz \(4\times 4\) de variância calculada usando algum método que leve em consideração o plano da pesquisa, e \(\pmb{a}=(1/\widehat{N}_{11},-1/\widehat{N}_{12},-1/\widehat{N}_{21},1/\widehat{N}_{22})^\top\) é o vetor de derivadas de \(\log(OR)\) em relação a \(N_{11}\), \(N_{12}\), \(N_{21}\) e \(N_{22}\), avaliado em \(\widehat{\pmb{N}}\).

A inferência é realizada calculando-se intervalos de Wald para o \(\log(OR)\), conforme a Seção 1.2.5, o que resulta no intervalo de confiança \[ \exp \left( \log\big(\widehat{OR}\big)\pm Z_{1-\alpha/2} \sqrt{\widehat{\mbox{Var}}\big(\log\big(\widehat{OR}\big)\big)}\right)\cdot \]

Assim como no caso do intervalo de confiança para \(\pi_i\), um valor crítico \(t_{\kappa,1-\alpha/2}\) pode ser usado em lugar de \(Z_{1-\alpha/2}\). Também, \(\widehat{\mbox{Var}}\big(\log\big(\widehat{OR}\big)\big)\) pode ser estimada diretamente utilizando um método de replicação, quando disponível.

Testes de hipóteses podem ser realizados utilizando uma estatística de teste de Wald e uma região de rejeição ou um \(p\)-valor baseados na distribuição normal padrão (ou \(t_\kappa\)). Isso equivale a determinar se o intervalo de confiança contém o valor hipotetizado.

Os cálculos de razões de chances e de seus intervalos de confiança ou testes de hipóteses são realizados mais facilmente no contexto de um modelo log-linear. Como observado anteriormente nesta seção, os modelos são parametrizados exatamente da mesma forma que na Seção 4.2.4, embora sejam aplicados aos totais populacionais \(N_{ij}\) em uma tabela \(I \times J\), em vez de às médias populacionais \(\mu_{ij}\).

Um modelo com apenas efeitos principais representa a independência entre \(X\) e \(Y\). Um modelo saturado permite que as razões de chances entre cada par de linhas e colunas sejam estimadas pelo modelo por meio dos parâmetros de interação \(XY\).

Exemplo 6.11: NHANES 1999-2000

Examinamos a associação entre Y = presença de quaisquer sintomas respiratórios e X = qualquer uso de tabaco. Definimos “quaisquer sintomas respiratórios” (anyresp) como TRUE (1) se qualquer uma das variáveis binárias referentes a tosse persistente, expectoração, chiado/sibilo no peito ou tosse seca noturna for igual a 1, e como FALSE (0) se todas as variáveis binárias forem iguais a 0.

De modo semelhante, “qualquer uso de tabaco” (anysmoke) é definido como TRUE (1) se qualquer uma das variáveis binárias referentes a cigarros, cachimbo, charuto, rapé ou tabaco de mascar for igual a 1, e como FALSE (0) se todas forem iguais a 0. Primeiramente, criamos as novas variáveis ​​binárias aplicando update() ao objeto existente criado por svyrepdesign().

Em seguida, calculamos os totais da tabela utilizando svytable(). O resumo desse objeto fornece os totais estimados e um teste de independência utilizando o teste F de Thomas-Rao padrão. Testes de independência também podem ser realizados utilizando svychisq(), em que o argumento statistic controla o tipo de teste utilizado.

library(survey)

# Get data and jackknife reps entered into a survey design object
# Even though this is technically a stratified design, there is no information on
#  separate scales for each jackknife replicate, so we use type = "JK1" with a single 
#  scale in scales = 51/52. Ordinarily, type = "JKn" is used for stratified designs.
# Observed responses are in columns 1-10, weights in column 11, and replicate weights in 12-63.

jdesign <- svrepdesign(data = smoke.resp[, c(1:10)], weights = smoke.resp[,11], 
            repweights = smoke.resp[,12:63], type = "JK1", 
            combined.weights = TRUE, scale = 51/52)

##################################################################
# Simple crosstabulation and tests
# 

# Create variables for any respiratory symptoms and any tobacco use
# Add binaries and assign new binary according to whether sum > 0
jdesign <- update(object = jdesign, anytob = (sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew > 0), 
         anyresp = (re_cough + re_phlegm + re_wheez + re_night > 0))

head(jdesign$variables, n = 2)

##   age sm_cigs sm_pipe sm_cigar sm_snuff sm_chew re_cough re_phlegm re_wheez re_night anytob anyresp
## 1  77       0       1        1        0       0        0         0        0        0   TRUE   FALSE
## 2  49       1       1        1        0       1        0         0        0        0   TRUE   FALSE

# Table of weighted counts
wt.table <- svytable(formula = ~ anytob + anyresp, design = jdesign)
wt.table

##        anyresp
## anytob     FALSE     TRUE
##   FALSE 73873587 13006040
##   TRUE  75870428 28375419

summary(wt.table)

##        anyresp
## anytob     FALSE     TRUE
##   FALSE 73873587 13006040
##   TRUE  75870428 28375419
## 
##  Pearson's X^2: Rao & Scott adjustment
## 
## data:  svychisq(~anytob + anyresp, design = jdesign, statistic = "F")
## F = 40.183, ndf = 1, ddf = 51, p-value = 6.016e-08

# Get proportions by dividing by estimated total population size
totpop <- sum(smoke.resp$wtint2yr)
round(wt.table/totpop, digits = 3)

##        anyresp
## anytob  FALSE  TRUE
##   FALSE 0.387 0.068
##   TRUE  0.397 0.148

# Get proportions and standard errors for crosstabulation a different way
# Also available in more cryptic form from wt.table$prob.table
props22 <- svymean(x = ~ interaction(anytob, anyresp), design = jdesign, return.replicates = TRUE)
props22

##                                            mean     SE
## interaction(anytob, anyresp)FALSE.FALSE 0.38652 0.0113
## interaction(anytob, anyresp)TRUE.FALSE  0.39697 0.0114
## interaction(anytob, anyresp)FALSE.TRUE  0.06805 0.0055
## interaction(anytob, anyresp)TRUE.TRUE   0.14847 0.0089

names(props22)

## [1] "mean"       "replicates"

# Odds Ratio; order of terms is available from output.
ORhat <- props22$mean[1]*props22$mean[4]/(props22$mean[2]*props22$mean[3])
ORhat

## interaction(anytob, anyresp)FALSE.FALSE 
##                                 2.12429

OR.reps <- props22$replicates[,1] * props22$replicates[,4] /
      (props22$replicates[,2] * props22$replicates[,3])
reps <- length(OR.reps)

var.logOR = (reps - 1)*var(log(OR.reps))*((reps - 1)/reps)

# Normal-based confidence interval
exp(log(ORhat) + qnorm(p = c(0.025, 0.975))*sqrt(var.logOR))

## [1] 1.677367 2.690294

# t-based confidence interval
exp(log(ORhat) + qt(p = c(0.025, 0.975), df = reps-1)*sqrt(var.logOR))

## [1] 1.667768 2.705778

# Tests for independence
# Rao-Scott 2nd-order F approx (also default)
svychisq(formula = ~ anytob + anyresp, design = jdesign, statistic = "F")

## 
##  Pearson's X^2: Rao & Scott adjustment
## 
## data:  svychisq(formula = ~anytob + anyresp, design = jdesign, statistic = "F")
## F = 40.183, ndf = 1, ddf = 51, p-value = 6.016e-08

# Rao-Scott 1st-order Chi-Square
svychisq(formula = ~ anytob + anyresp, design = jdesign, statistic = "Chisq")

## 
##  Pearson's X^2: Rao & Scott adjustment
## 
## data:  svychisq(formula = ~anytob + anyresp, design = jdesign, statistic = "Chisq")
## X-squared = 106.41, df = 1, p-value = 2.312e-10

# Saddlepoint approximation to linear comb of chi-squares for Pearson Stat 
svychisq(formula = ~ anytob + anyresp, design = jdesign, statistic = "saddlepoint")

## 
##  Pearson's X^2: Rao & Scott adjustment
## 
## data:  svychisq(formula = ~anytob + anyresp, design = jdesign, statistic = "saddlepoint")
## X-squared = 106.41, p-value = 2.561e-10

Os totais mostram números semelhantes de pessoas que não apresentam sintomas respiratórios (anyresp = FALSE), independentemente do uso de tabaco. No entanto, há um número ligeiramente maior de pessoas que fizeram uso de tabaco e apresentaram sintomas respiratórios do que de pessoas que não fizeram uso de tabaco e apresentaram sintomas respiratórios.

Isso sugere que pode haver uma associação entre o uso de tabaco e sintomas respiratórios. Os testes de Rao-Scott confirmam isso, com \(F_{TR} = 40.1\) e um \(p\)-valor de \(6.0\times 10^{-8}\).

Mostramos acima que os totais das células podem ser convertidos em proporções dividindo-os pelo tamanho total estimado da população. Aqui, apresentamos um método alternativo para calcular essas proporções e a razão de chances diretamente utilizando a função svymean(). Essa função também oferece o recurso adicional de salvar os cálculos de proporção de cada réplica jackknife, permitindo-nos estimar a variância dos valores do logaritmo da razão de chances para construir um intervalo de confiança.

Utilizamos as proporções das réplicas para calcular a estimativa da razão de chances para cada réplica e, em seguida, aplicamos uma variante da Equação 6.9 para estimar a variância de \(\log\big(\widehat{OR}\big)\). Por fim, cria-se um intervalo de confiança utilizando a aproximação da distribuição \(t_{51}\) para a distribuição amostral do \(\log(\widehat{OR})\). Observe que o argumento de entrada para svymean() utiliza a função interaction(). Essa função cria um novo fator a partir de todas as combinações dos fatores fornecidos como seus argumentos e deve ser utilizada aqui em vez de outros operadores de interação, como “:” ou “*”.

As proporções refletem o mesmo padrão observado anteriormente. Calculamos um intervalo de confiança para a \(\widehat{OR}=2.1\), baseado na distribuição \(t\), variando de 1.7 a 2.7. Isso constitui uma forte evidência de associação positiva entre o uso de qualquer produto de tabaco e a presença de quaisquer sintomas respiratórios.

Alternativamente, essa análise pode ser realizada ajustando-se um modelo log-linear saturado \(2\times 2\), determinando-se um intervalo de confiança para o parâmetro de associação — equivalente a \(\log(\widehat{OR})/4\) — e reescalonando e exponenciando os resultados.

Tabelas multidimensionais

A abordagem de modelagem log-linear para a análise de tabelas construídas a partir de mais de duas variáveis foi descrita na Seção 4.2.5. As mesmas análises podem ser aplicadas a dados de uma pesquisa amostral complexa, com as modificações descritas anteriormente, utilizando a função svyloglin() do pacote survey.

Critérios de informação geralmente não estão disponíveis para uso na seleção de modelos, pois o ajuste de modelos baseado no delineamento não utiliza verossimilhanças verdadeiras. Em vez disso, utilizam-se combinações de procedimentos de seleção progressiva (forward) e regressiva (backward). O exemplo abaixo demonstra uma abordagem possível para a seleção de modelos: primeiramente, escolhe-se a complexidade das possíveis interações no modelo e, em seguida, determina-se quais interações desse nível são necessárias.

Razões de chances (odds ratios) podem ser calculadas para qualquer comparação que possa ser expressa como uma combinação de parâmetros do modelo. Como sempre, o passo fundamental é identificar quais parâmetros do modelo estão relacionados às razões de chances em questão. As razões de chances são estimadas principalmente a partir de parâmetros que representam interações de duas vias, embora possam ser afetadas por interações de ordem superior.

Reiterando a Equação (4.5), a razão de chances entre os níveis \(i\) e \(i'\) da variável \(X\) e os níveis \(j\) e \(j`\) da variável \(Y\) é \[ OR_{\,i i`, j j`} = \exp\big(\beta_{ij'}^{XY}+\beta_{i'j'}^{XY}-\beta_{i'j}^{XY}-\beta_{ij'}^{XY} \big), \] onde cada \(\beta_{ij}^{XY}\) é um parâmetro da interação \(X:Y\) em um modelo gerado por svyloglin().

Observe que a função svyloglin() utiliza uma disposição dos fatores anterior à estimação diferente daquela empregada pela maioria das outras funções de ajuste de modelos. Especificamente, ela utiliza um conjunto de contrastes do tipo “soma igual a zero” para representar os fatores, em vez do padrão habitual de definir o primeiro nível como zero, conforme descrito na Seção 2.2.6.

É preciso ter certo cuidado quando o modelo também inclui interações de ordem superior. Lembre-se das regras básicas que regem a identificação dos termos envolvidos nas razões de chances:

1. As razões de chances são sempre iguais a 1 para qualquer par de variáveis que não estejam envolvidas conjuntamente em interações de dois fatores ou de ordem superior.

2. Se um par de variáveis estiver envolvido em uma interação de dois fatores, mas não aparecer conjuntamente em interações de ordem superior, então as razões de chances entre elas são estimadas a partir dos parâmetros da interação de dois fatores, e seus valores permanecem constantes em todos os níveis das outras variáveis.

3. Se um par de variáveis aparecer conjuntamente tanto em uma interação de dois fatores quanto em interações de três fatores ou de ordem superior, então as razões de chances entre elas variam dependendo dos níveis dos outros fatores com os quais elas aparecem nos termos do modelo. Nesse caso, deve-se estimar as razões de chances separadamente para cada nível desses outros fatores; mas não para variáveis com as quais elas não estejam envolvidas em interações de três fatores ou de ordem superior.

Exemplo 6.12: NHANES 1999-2000

Em que medida o uso de um produto de tabaco se relaciona com o uso de outros? As pessoas que utilizam um produto o fazem de forma essencialmente independente em relação a outros produtos, ou existem certos produtos que tendem a ser utilizados em conjunto ou separadamente?

Para abordar essas questões, busca-se um modelo log-linear que descreva as associações entre as cinco diferentes variáveis binárias de uso de tabaco.

As contagens para certas células da tabela \(2^5\) completa são apresentadas a seguir:

alltob <- svytable ( formula = ~ interaction( sm_cigs, sm_pipe, sm_cigar, sm_snuff, sm_chew ), 
                     design = jdesign )
cbind( alltob )

##                alltob
## 0.0.0.0.0 86879626.67
## 1.0.0.0.0 64660110.33
## 0.1.0.0.0  1248006.32
## 1.1.0.0.0  3231185.68
## 0.0.1.0.0  3707643.80
## 1.0.1.0.0  7818299.70
## 0.1.1.0.0  1090153.74
## 1.1.1.0.0  7081125.82
## 0.0.0.1.0   734737.36
## 1.0.0.1.0  1840769.79
## 0.1.0.1.0    90475.01
## 1.1.0.1.0   246303.05
## 0.0.1.1.0   230120.55
## 1.0.1.1.0   648888.53
## 0.1.1.1.0    29279.37
## 1.1.1.1.0   598799.78
## 0.0.0.0.1   996361.91
## 1.0.0.0.1  1031989.95
## 0.1.0.0.1        0.00
## 1.1.0.0.1   209930.33
## 0.0.1.0.1    65287.94
## 1.0.1.0.1   684553.62
## 0.1.1.0.1   193545.54
## 1.1.1.0.1  1977325.20
## 0.0.0.1.1   791796.99
## 1.0.0.1.1  1407859.91
## 0.1.0.1.1        0.00
## 1.1.0.1.1   106194.90
## 0.0.1.1.1   455810.53
## 1.0.1.1.1  1532560.24
## 0.1.1.1.1   131638.59
## 1.1.1.1.1  1405092.65

Por exemplo, estimamos que mais de 86 milhões de pessoas não utilizaram nenhum dos produtos de tabaco nas quantidades exigidas (combinação 0.0.0.0.0), enquanto mais de 64 milhões utilizaram apenas cigarros (combinação 1.0.0.0.0).

Observe que há duas contagens iguais a zero, ambas envolvendo respostas positivas para cachimbo e tabaco de mascar combinadas com respostas negativas para cigarros e charutos. Veremos em breve que isso causa problemas em comparações que envolvem modelos contendo a interação de quarta ordem dessas quatro variáveis.

A seleção do modelo baseia-se inicialmente na comparação de modelos de ordens crescentes, conforme são convenientemente construídos na função svyloglin(). Começamos apenas com os efeitos principais e, em seguida, adicionamos interações atualizando a fórmula do objeto do modelo para incluir todas as interações de segunda ordem, depois todas as de terceira ordem, todas as de quarta ordem e, finalmente, a interação de quinta ordem (o modelo saturado). Utilizamos a função update() para construir os novos modelos com base no modelo original, conforme recomendado pelo autor do pacote survey (Lumley, 2011, p. 124).

Isso facilita a construção de modelos complexos e é computacionalmente mais eficiente do que reescrever modelos inteiros em múltiplas chamadas da função svyloglin(). As comparações entre modelos são realizadas utilizando estatísticas de deviance ou estatísticas de Pearson (chamadas de “Score” na saída), ambas utilizando as correções \(F\) de Thomas-Rao padrão fornecidas pela função do método anova(). A saída exibe todos os termos dos dois modelos comparados; portanto, editamos os resultados para fins de concisão.

ll.tob1 <- svyloglin ( formula = ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew, 
                       design = jdesign )
ll.tob2 <- update ( object = ll.tob1, formula = ~ .^2)
ll.tob3 <- update ( object = ll.tob1, formula = ~ .^3)
ll.tob4 <- update ( object = ll.tob1, formula = ~ .^4)
ll.tob5 <- update ( object = ll.tob1, formula = ~ .^5)
anova ( ll.tob4, ll.tob5 )

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew + 
##     sm_cigs:sm_pipe:sm_cigar:sm_snuff + sm_cigs:sm_pipe:sm_cigar:sm_chew + 
##     sm_cigs:sm_pipe:sm_snuff:sm_chew + sm_cigs:sm_cigar:sm_snuff:sm_chew + 
##     sm_pipe:sm_cigar:sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew + 
##     sm_cigs:sm_pipe:sm_cigar:sm_snuff + sm_cigs:sm_pipe:sm_cigar:sm_chew + 
##     sm_cigs:sm_pipe:sm_snuff:sm_chew + sm_cigs:sm_cigar:sm_snuff:sm_chew + 
##     sm_pipe:sm_cigar:sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar:sm_snuff:sm_chew 
## Deviance= 4.030334e-12 p= 1 
## Score= 5.584675e-12 p= 1

#anova ( ll.tob3, ll.tob5 )
#anova ( ll.tob2, ll.tob5 )
#anova ( ll.tob1, ll.tob5 )
anova ( ll.tob3, ll.tob4 )

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew + 
##     sm_cigs:sm_pipe:sm_cigar:sm_snuff + sm_cigs:sm_pipe:sm_cigar:sm_chew + 
##     sm_cigs:sm_pipe:sm_snuff:sm_chew + sm_cigs:sm_cigar:sm_snuff:sm_chew + 
##     sm_pipe:sm_cigar:sm_snuff:sm_chew 
## Deviance= 8.033536 p= 0.0200117 
## Score= 7.317034 p= 0.0231562

anova ( ll.tob2, ll.tob3 )

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew 
## Deviance= 45.02365 p= 0.001452548 
## Score= 55.94341 p= 4.262352e-34

anova ( ll.tob1, ll.tob2 )

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew 
## Deviance= 2227.541 p= 0 
## Score= 29924.8 p= 0

Vários testes que comparam modelos de ordem inferior ao modelo saturado apresentam erros computacionais, por exemplo, anova ( ll.tob3, ll.tob5 ). Além disso, outros dois testes suscitam certa preocupação. Em um deles, a comparação entre os modelos ll.tob3 e ll.tob4 resulta em estatísticas de “Deviance” e “Score” com valores diferentes, mas com \(p\)-valores exatamente iguais até a oitava casa decimal. No outro, a comparação entre os modelos de quarta e quinta ordem também não parece plausível: ela gera estatísticas de teste essencialmente nulas, porém com \(p\)-valores praticamente idênticos aos relatados no teste anterior, que apresentava estatísticas de teste muito mais elevadas.

Isso não é possível e indica um problema na apresentação dos \(p\)-valores pela função de método anova.svyloglin(), talvez decorrente da presença de contagens iguais a zero nesses modelos. Portanto, é importante sempre verificar os modelos ajustados para garantir que nenhuma célula apresente contagens estimadas essencialmente iguais a zero. Caso isso ocorra, os cálculos subsequentes devem ser interpretados com cautela. A seguir, mostramos como evitar o uso de modelos que resultam em contagens iguais a zero. As contagens estimadas pelo modelo podem ser visualizadas utilizando fitted(object$model), em que object é o objeto do modelo ajustado.

Partindo, em vez disso, do modelo mais simples e avançando na análise, a comparação entre os modelos de primeira e segunda ordem, ll.tob1 e ll.tob2, demonstra de forma inequívoca a existência de algum tipo de associação entre o uso de diferentes produtos de tabaco. A estatística \(X^2 = 29924,8\), com um \(p\)-valor essencialmente igual a 0, rejeita claramente o modelo nulo mais simples de independência mútua em favor de um modelo que incorpora associações aos pares.

Além disso, a comparação do modelo de segunda ordem com o modelo de terceira ordem, ll.tob3, resulta em \(X^2 = 55,97\) com um \(p\)-valor de 0.047, sugerindo que os níveis de pelo menos algumas associações entre pares de produtos de tabaco podem depender do uso de um terceiro produto. Como observado anteriormente, a comparação entre os modelos de terceira e quarta ordem resulta em um erro. A razão para isso torna-se evidente ao examinar as estimativas dos parâmetros e os intervalos de confiança de ambos os modelos.

Para ll.tob4, todos os efeitos que podem ser formados a partir de combinações de sm_cigs, sm_pipe, sm_cigar e sm_chew apresentam intervalos de confiança que variam, no mínimo, de −200 a 200. Esses valores não fazem sentido, visto que seriam exponenciados para gerar contagens de células e razões de chances (odds ratios). Eles refletem, mais uma vez, o impacto adverso de contagens nulas no modelo log-linear. Demonstramos que a exclusão do termo de interação de quarta ordem para essas variáveis resulta em um modelo com ajuste adequado, porém com pouquíssima melhoria em relação ao modelo de terceira ordem, \(X^2 = 2.11\); \(p\)-valor = 0.83. Portanto, passamos a trabalhar com o modelo de terceira ordem.

Existem várias possibilidades para desenvolver um modelo final. Poderíamos simplesmente utilizar o modelo completo de terceira ordem como nosso modelo final, particularmente se não estivéssemos interessados em uma explicação parcimoniosa para as associações presentes nos dados. Alternativamente, poderíamos aplicar a eliminação regressiva (backward elimination) ou a seleção progressiva (forward selection) aos termos de terceira ordem do modelo, tendo em mente que a escolha do nível de significância para adicionar ou remover um termo não tem relação com as taxas de erro do Tipo I em quaisquer testes.

Apresentamos os resultados da eliminação regressiva. Eles mostram que existe claramente uma interação sm_pipe:sm_snuff:sm_chew e que poderia haver duas interações de três vias adicionais caso fosse utilizado um nível de corte de 0.10 ou superior. Para simplificar nossa demonstração, optamos pelo modelo que inclui apenas uma interação adicional de três vias. Esse modelo é denominado ll.tob39 no programa.

As razões de chances estimadas pelo modelo podem ser calculadas entre cada par de fatores, seja por meio da manipulação manual de estimativas de parâmetros selecionadas do modelo, ou por cálculos mais automatizados disponíveis na função svycontrast(). A ordem das estimativas dos parâmetros é determinada utilizando-se summary(ll.tob39) ou coef(ll.tob39).

Isso revela que as estimativas dos parâmetros seguem a ordem 1, 2, 3, 4, 5, (12), (13), (14), (15), (23), (24), (25), (34), (35), (45), (245), onde 1=sm_cigs, 2=sm_pipe, 3=sm_cigar, 4=sm_snuff, 5=sm_chew, e dois ou mais números entre parênteses indicam uma interação entre as variáveis correspondentes. Os coeficientes aplicados às estimativas dos parâmetros devem ser atribuídos de modo a corresponder a essa ordem. Um comentário detalhado no programa referente a este exemplo explica que o coeficiente deve ser 4 para razões de chances entre variáveis ​​com dois níveis.

Por exemplo, a razão de chances entre cigarro e cachimbo é determinada pelo vetor de coeficientes (0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0). Esses coeficientes são inseridos na função svycontrast() conforme mostrado abaixo. As abreviações utilizadas são: ct=cigarros, pi=cachimbos, cr=charutos, sn=rapé (snuff) e ch=tabaco de mascar (chew).

# Loglinear model analysis of 2-way contingency table

#####################################################################
# IMPORTANT NOTE ABOUT PARAMETERIZATION OF MODELS IN svyloglin():
#
## The parameterization used by svyloglin is unfortunately rather different 
#   from that used in other models we've seen. 
## Each factor is parameterized using "sum-to-zero" contrasts, which 
#   force parameter estimates to sum to zero across all values of an index (subscript), 
#   for each value of any other index.
## For example, suppose X has 3 levels. Then the model that is fit is
#    N_i = beta_0 + betaX_i,    where betaX_3 = - (betaX_1 + betaX_2)
#   Thus, betaX_1 + betaX_2 + betaX_3 = 0
## As another example, suppose an additional variable Y has 4 levels. 
#   Then there should be (3-1)(4-1) = 6 separate association parameters. 
#   In this case the model is
#    N_ij = beta_0 + betaX_i + betaY_j + betaXY_ij, 
#   where
#   1. betaX_3 = -(betaX_1 + betaX_2)
#   2. betaY_4 = -(betaY_1 + betaY_2 + betaY_3)
#   3. betaXY_3j = -(betaXY_1j + betaXY_2j) for j = 1, 2, or 3,
#   4. betaXY_i4 = -(betaXY_i1 + betaXY_i2 + betaXY_i3) for i = 1, or 2,
# and 5. betaXY_34 = betaXY_11 + betaXY_ 12+ betaXY_12 + betaXY_21 + betaXY_22 + betaXY_23
#
## This makes finding odds ratios from loglinear models rather tricky! 
#
## A simplification that occurs when a variable has two levels is that any parameters that
#   are formed for its first level simply have their signs reversed for their second level.
## For exammple, in a 2x2 table, a saturated model has parameters
#   betaX_1, betaX_2 = -betaX_1 (so only betaX_1 is estimated)
#   betaY_1, betaY_2 = -betaY_1 (so only betaY_1 is estimated)
#   betaXY_11, betaXY_12 = -betaXY_11, betaXY_21 = -betaXY_11, and betaXY_22 = +betaXY_11 
#    (so only betaXY_11 is estimated).
# An OR for this table is found from 
#  OR_12.12 = betaXY_11 - betaXY_12 - betaXY_21 + betaXY_22 = 4betaXY_11.
# For larger tables, the formulas can be cumbersome to work out, especially if more than 
#  two variables are involved. For example, for a 3-way interaction, betaXYZ_ijk has the 
#  sum-to-zero restrictions placed on 
#  1. i for each jk combination, 
#  2. j for each ik combination, 
#  3. k for each ij combination, 
#  and these restrictions become more complicated when the levels of two or all three 
#  variables are set to their last value. 
#
# In summary, USE CARE when calculating odds ratios from svyloglin fits. WRITE OUT THE MODEL
#  with all of its sum-to-zero 
#####################################################################
totsamp <- nrow(smoke.resp)

# Fit loglinear model to weighted counts and examine summary
ll_mod1 <- svyloglin(formula = ~ anytob*anyresp, design = jdesign)
summary(ll_mod1)

## Loglinear model: svyloglin(formula = ~anytob * anyresp, design = jdesign)
##                        coef         se             p
## anytob1          -0.2016953 0.03445298  4.792597e-09
## anyresp1          0.6801113 0.02483944 4.707117e-165
## anytob1:anyresp1  0.1883594 0.03008663  3.835768e-10

ll_mod0 <- svyloglin(formula = ~ anytob + anyresp, design = jdesign)
# Rao-Scott test
RStest <- anova(ll_mod0, ll_mod1)
RStest  # Default is F-test

## Analysis of Deviance Table
##  Model 1: y ~ anytob + anyresp
## Model 2: y ~ anytob + anyresp + anytob:anyresp 
## Deviance= 109.0062 p= 1.507273e-17 
## Score= 106.4096 p= 3.090577e-17

# Second-order RS F-test as in book
print(RStest, pval = "F")

## Analysis of Deviance Table
##  Model 1: y ~ anytob + anyresp
## Model 2: y ~ anytob + anyresp + anytob:anyresp 
## Deviance= 109.0062 p= 1.507273e-17 
## Score= 106.4096 p= 3.090577e-17

# First-order RS test as in book
print(RStest, pval = "chisq")

## Analysis of Deviance Table
##  Model 1: y ~ anytob + anyresp
## Model 2: y ~ anytob + anyresp + anytob:anyresp 
## Deviance= 109.0062 p= 1.399916e-10 
## Score= 106.4096 p= 2.3122e-10

# Pearson Statistic (Same as first-order RS), 
#  but estimating the true asymptotic dist using saddlepoint approximation
print(RStest, pval = "saddlepoint")

## Analysis of Deviance Table
##  Model 1: y ~ anytob + anyresp
## Model 2: y ~ anytob + anyresp + anytob:anyresp 
## Deviance= 109.0062 p= 1.551272e-10 
## Score= 106.4096 p= 2.560625e-10

# Estimate and confidence interval fo Odds Ratio 
# Manually from earlier table counts
(wt.table[1]* wt.table[4])/ (wt.table[2]* wt.table[3])

## [1] 2.12429

# From model. Note that association parameter is 1/4 * log(OR)!
cll <- coef(ll_mod1, intercept = TRUE) 
cll[3]

##  anyresp1 
## 0.6801113

exp(4*cll[3])  # Matches manual calculation

## anyresp1 
## 15.18708

exp(4*confint(ll_mod1))[c(3,6)]

## [1] 1.677933 2.689385

# Estimated counts in each cell
# Parameters produced by loglin are on *sample size* scale. 
# Need to be multiplied by Popsize/Sampsize to reflect population counts, 
# or by 1/Sampsize top reflect proportions
# The (1,1) total
exp(cll[1] + cll[2] + cll[3] + cll[4])*totpop/totsamp

## (Intercept) 
##    73873587

# The (1,-1) = (1,2) total
exp(cll[1] + cll[2] - cll[3] - cll[4])*totpop/totsamp

## (Intercept) 
##    13006040

# The (-1,1) = (2,1) total
exp(cll[1] - cll[2] + cll[3] - cll[4])*totpop/totsamp

## (Intercept) 
##    75870428

# The (-1,-1) = (2,2) total
exp(cll[1] - cll[2] - cll[3] + cll[4])*totpop/totsamp

## (Intercept) 
##    28375419

##################################################################
# Loglinear model analysis of 5-way contingency table
#  Table is for all different tobacco use variables
# 
# First print out table of counts
alltob <- svytable(formula = ~ interaction(sm_cigs, sm_pipe, sm_cigar, sm_snuff, sm_chew), design = jdesign)
alltob

## interaction(sm_cigs, sm_pipe, sm_cigar, sm_snuff, sm_chew)
##   0.0.0.0.0   1.0.0.0.0   0.1.0.0.0   1.1.0.0.0   0.0.1.0.0   1.0.1.0.0   0.1.1.0.0   1.1.1.0.0   0.0.0.1.0 
## 86879626.67 64660110.33  1248006.32  3231185.68  3707643.80  7818299.70  1090153.74  7081125.82   734737.36 
##   1.0.0.1.0   0.1.0.1.0   1.1.0.1.0   0.0.1.1.0   1.0.1.1.0   0.1.1.1.0   1.1.1.1.0   0.0.0.0.1   1.0.0.0.1 
##  1840769.79    90475.01   246303.05   230120.55   648888.53    29279.37   598799.78   996361.91  1031989.95 
##   0.1.0.0.1   1.1.0.0.1   0.0.1.0.1   1.0.1.0.1   0.1.1.0.1   1.1.1.0.1   0.0.0.1.1   1.0.0.1.1   0.1.0.1.1 
##        0.00   209930.33    65287.94   684553.62   193545.54  1977325.20   791796.99  1407859.91        0.00 
##   1.1.0.1.1   0.0.1.1.1   1.0.1.1.1   0.1.1.1.1   1.1.1.1.1 
##   106194.90   455810.53  1532560.24   131638.59  1405092.65

cbind(alltob)

##                alltob
## 0.0.0.0.0 86879626.67
## 1.0.0.0.0 64660110.33
## 0.1.0.0.0  1248006.32
## 1.1.0.0.0  3231185.68
## 0.0.1.0.0  3707643.80
## 1.0.1.0.0  7818299.70
## 0.1.1.0.0  1090153.74
## 1.1.1.0.0  7081125.82
## 0.0.0.1.0   734737.36
## 1.0.0.1.0  1840769.79
## 0.1.0.1.0    90475.01
## 1.1.0.1.0   246303.05
## 0.0.1.1.0   230120.55
## 1.0.1.1.0   648888.53
## 0.1.1.1.0    29279.37
## 1.1.1.1.0   598799.78
## 0.0.0.0.1   996361.91
## 1.0.0.0.1  1031989.95
## 0.1.0.0.1        0.00
## 1.1.0.0.1   209930.33
## 0.0.1.0.1    65287.94
## 1.0.1.0.1   684553.62
## 0.1.1.0.1   193545.54
## 1.1.1.0.1  1977325.20
## 0.0.0.1.1   791796.99
## 1.0.0.1.1  1407859.91
## 0.1.0.1.1        0.00
## 1.1.0.1.1   106194.90
## 0.0.1.1.1   455810.53
## 1.0.1.1.1  1532560.24
## 0.1.1.1.1   131638.59
## 1.1.1.1.1  1405092.65

# Note that there are two zero counts. These do not bode well for saturated model
#
# Fit series of models from main effects (independence) to saturated model 
#  to find approximate order of model.

ll.tob1 <- svyloglin(formula = ~  sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew, design = jdesign)
# update(..., formula = ~ .) produces the same model as before. 
# Terms can be added with "+ <termname>", or removed with "- <termname>".
# Below we use ^2 to add all terms up to 2-way combinations, ^3 for all terms up to 3-way combinations, and so forth.
ll.tob2 <- update(object = ll.tob1, formula = ~ .^2)
ll.tob3 <- update(object = ll.tob1, formula = ~ .^3)
ll.tob4 <- update(object = ll.tob1, formula = ~ .^4)
ll.tob5 <- update(object = ll.tob1, formula = ~ .^5)
# Compare models in sequence, testing H0: Simpler model suffices
# Where we reject this hypothesis tells us where to start
anova(ll.tob4, ll.tob5)

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew + 
##     sm_cigs:sm_pipe:sm_cigar:sm_snuff + sm_cigs:sm_pipe:sm_cigar:sm_chew + 
##     sm_cigs:sm_pipe:sm_snuff:sm_chew + sm_cigs:sm_cigar:sm_snuff:sm_chew + 
##     sm_pipe:sm_cigar:sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew + 
##     sm_cigs:sm_pipe:sm_cigar:sm_snuff + sm_cigs:sm_pipe:sm_cigar:sm_chew + 
##     sm_cigs:sm_pipe:sm_snuff:sm_chew + sm_cigs:sm_cigar:sm_snuff:sm_chew + 
##     sm_pipe:sm_cigar:sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar:sm_snuff:sm_chew 
## Deviance= 4.030334e-12 p= 1 
## Score= 5.584675e-12 p= 1

#anova(ll.tob3, ll.tob5)
#anova(ll.tob2, ll.tob5)
#anova(ll.tob1, ll.tob5)
anova(ll.tob3, ll.tob4)

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew + 
##     sm_cigs:sm_pipe:sm_cigar:sm_snuff + sm_cigs:sm_pipe:sm_cigar:sm_chew + 
##     sm_cigs:sm_pipe:sm_snuff:sm_chew + sm_cigs:sm_cigar:sm_snuff:sm_chew + 
##     sm_pipe:sm_cigar:sm_snuff:sm_chew 
## Deviance= 8.033536 p= 0.0200117 
## Score= 7.317034 p= 0.0231562

anova(ll.tob2, ll.tob3)

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew 
## Deviance= 45.02365 p= 0.001452548 
## Score= 55.94341 p= 4.262352e-34

anova(ll.tob1, ll.tob2)

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew 
## Deviance= 2227.541 p= 0 
## Score= 29924.8 p= 0

# Comparison of models 3 and 4 is impossible: same p-value from different test stats
#  Figure out why. Look at parameter estimates and confidence intervals for models
round(cbind(coef(ll.tob3), confint(ll.tob3)), digits = 2)

##                                    2.5 % 97.5 %
## sm_cigs1                     -0.67 -0.85  -0.49
## sm_pipe1                      0.82  0.61   1.03
## sm_cigar1                     0.01 -0.17   0.19
## sm_snuff1                     0.75  0.49   1.01
## sm_chew1                      0.72  0.54   0.90
## sm_cigs1:sm_pipe1             0.29  0.14   0.44
## sm_cigs1:sm_cigar1            0.20  0.08   0.31
## sm_cigs1:sm_snuff1            0.10 -0.08   0.28
## sm_cigs1:sm_chew1             0.07 -0.09   0.23
## sm_pipe1:sm_cigar1            0.67  0.50   0.83
## sm_pipe1:sm_snuff1           -0.04 -0.25   0.18
## sm_pipe1:sm_chew1             0.10 -0.07   0.27
## sm_cigar1:sm_snuff1           0.19  0.00   0.38
## sm_cigar1:sm_chew1            0.34  0.17   0.52
## sm_snuff1:sm_chew1            0.82  0.65   0.99
## sm_cigs1:sm_pipe1:sm_cigar1   0.02 -0.07   0.11
## sm_cigs1:sm_pipe1:sm_snuff1   0.01 -0.20   0.21
## sm_cigs1:sm_pipe1:sm_chew1   -0.01 -0.21   0.20
## sm_cigs1:sm_cigar1:sm_snuff1  0.09 -0.10   0.29
## sm_cigs1:sm_cigar1:sm_chew1  -0.04 -0.23   0.14
## sm_cigs1:sm_snuff1:sm_chew1   0.09 -0.03   0.20
## sm_pipe1:sm_cigar1:sm_snuff1  0.13 -0.04   0.30
## sm_pipe1:sm_cigar1:sm_chew1  -0.06 -0.24   0.13
## sm_pipe1:sm_snuff1:sm_chew1   0.18  0.06   0.29
## sm_cigar1:sm_snuff1:sm_chew1  0.04 -0.12   0.19

round(cbind(coef(ll.tob4), confint(ll.tob4)), digits = 2)

##                                               2.5 % 97.5 %
## sm_cigs1                              -2.11 -303.24 299.03
## sm_pipe1                               2.22 -285.42 289.86
## sm_cigar1                             -1.36 -281.43 278.70
## sm_snuff1                              0.75    0.46   1.03
## sm_chew1                               2.15 -280.41 284.71
## sm_cigs1:sm_pipe1                      1.69 -336.17 339.56
## sm_cigs1:sm_cigar1                    -1.17 -199.80 197.45
## sm_cigs1:sm_snuff1                     0.06   -0.19   0.31
## sm_cigs1:sm_chew1                      1.53 -231.73 234.79
## sm_pipe1:sm_cigar1                     2.05 -267.64 271.75
## sm_pipe1:sm_snuff1                    -0.07   -0.30   0.16
## sm_pipe1:sm_chew1                     -1.29 -269.77 267.18
## sm_cigar1:sm_snuff1                    0.16   -0.10   0.42
## sm_cigar1:sm_chew1                     1.80 -355.95 359.55
## sm_snuff1:sm_chew1                     0.81    0.50   1.12
## sm_cigs1:sm_pipe1:sm_cigar1            1.43 -286.54 289.40
## sm_cigs1:sm_pipe1:sm_snuff1            0.00   -0.24   0.24
## sm_cigs1:sm_pipe1:sm_chew1            -1.42 -311.13 308.29
## sm_cigs1:sm_cigar1:sm_snuff1           0.04   -0.22   0.30
## sm_cigs1:sm_cigar1:sm_chew1            1.43 -263.54 266.40
## sm_cigs1:sm_snuff1:sm_chew1            0.11   -0.10   0.32
## sm_pipe1:sm_cigar1:sm_snuff1           0.20   -0.05   0.44
## sm_pipe1:sm_cigar1:sm_chew1           -1.56 -295.31 292.19
## sm_pipe1:sm_snuff1:sm_chew1            0.22   -0.11   0.54
## sm_cigar1:sm_snuff1:sm_chew1          -0.03   -0.28   0.23
## sm_cigs1:sm_pipe1:sm_cigar1:sm_snuff1  0.13   -0.18   0.43
## sm_cigs1:sm_pipe1:sm_cigar1:sm_chew1  -1.54 -277.40 274.32
## sm_cigs1:sm_pipe1:sm_snuff1:sm_chew1   0.02   -0.21   0.25
## sm_cigs1:sm_cigar1:sm_snuff1:sm_chew1 -0.05   -0.20   0.10
## sm_pipe1:sm_cigar1:sm_snuff1:sm_chew1  0.05   -0.19   0.29

# Clearly the sm_cigs:sm_pipe:sm_cigar:sm_chew effect is causing problems
# Refit model 4 without that one 4-way interaction.
ll.tob4a <- update(object = ll.tob4, formula = ~ .-sm_cigs:sm_pipe:sm_cigar:sm_chew)
round(cbind(coef(ll.tob4a), confint(ll.tob4a)), digits = 2)

##                                             2.5 % 97.5 %
## sm_cigs1                              -0.64 -0.82  -0.46
## sm_pipe1                               0.81  0.62   0.99
## sm_cigar1                              0.04 -0.12   0.21
## sm_snuff1                              0.76  0.53   0.99
## sm_chew1                               0.73  0.57   0.89
## sm_cigs1:sm_pipe1                      0.26  0.08   0.43
## sm_cigs1:sm_cigar1                     0.25  0.09   0.41
## sm_cigs1:sm_snuff1                     0.08 -0.12   0.27
## sm_cigs1:sm_chew1                      0.07 -0.09   0.23
## sm_pipe1:sm_cigar1                     0.62  0.46   0.78
## sm_pipe1:sm_snuff1                    -0.05 -0.21   0.10
## sm_pipe1:sm_chew1                      0.09 -0.05   0.24
## sm_cigar1:sm_snuff1                    0.18  0.02   0.34
## sm_cigar1:sm_chew1                     0.35  0.18   0.53
## sm_snuff1:sm_chew1                     0.78  0.58   0.98
## sm_cigs1:sm_pipe1:sm_cigar1           -0.03 -0.20   0.14
## sm_cigs1:sm_pipe1:sm_snuff1            0.02 -0.16   0.20
## sm_cigs1:sm_pipe1:sm_chew1             0.00 -0.19   0.19
## sm_cigs1:sm_cigar1:sm_snuff1           0.05 -0.10   0.21
## sm_cigs1:sm_cigar1:sm_chew1           -0.05 -0.24   0.14
## sm_cigs1:sm_snuff1:sm_chew1            0.08 -0.06   0.22
## sm_pipe1:sm_cigar1:sm_snuff1           0.15  0.00   0.29
## sm_pipe1:sm_cigar1:sm_chew1           -0.07 -0.29   0.14
## sm_pipe1:sm_snuff1:sm_chew1            0.22  0.05   0.39
## sm_cigar1:sm_snuff1:sm_chew1          -0.01 -0.21   0.19
## sm_cigs1:sm_pipe1:sm_cigar1:sm_snuff1  0.06 -0.12   0.24
## sm_cigs1:sm_pipe1:sm_snuff1:sm_chew1   0.02 -0.12   0.16
## sm_cigs1:sm_cigar1:sm_snuff1:sm_chew1 -0.02 -0.15   0.11
## sm_pipe1:sm_cigar1:sm_snuff1:sm_chew1  0.05 -0.15   0.26

anova(ll.tob3, ll.tob4a)

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew + 
##     sm_cigs:sm_pipe:sm_cigar:sm_snuff + sm_cigs:sm_pipe:sm_snuff:sm_chew + 
##     sm_cigs:sm_cigar:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff:sm_chew 
## Deviance= 1.951636 p= 0.9933107 
## Score= 2.110058 p= 0.9999997

# Fit is fine now, and the 4-way interactions are not needed in the model.

# From 3rd order CIs, begin backward elimination of 3rd-order effects
# Compute p-values in compressed form, then update model and repeat.
round(2*(1 - pnorm(abs(coef(ll.tob3)/sqrt(diag(vcov(ll.tob3))))))[-c(1:15)], digits = 3)

##  sm_cigs1:sm_pipe1:sm_cigar1  sm_cigs1:sm_pipe1:sm_snuff1   sm_cigs1:sm_pipe1:sm_chew1 
##                        0.657                        0.955                        0.957 
## sm_cigs1:sm_cigar1:sm_snuff1  sm_cigs1:sm_cigar1:sm_chew1  sm_cigs1:sm_snuff1:sm_chew1 
##                        0.358                        0.642                        0.128 
## sm_pipe1:sm_cigar1:sm_snuff1  sm_pipe1:sm_cigar1:sm_chew1  sm_pipe1:sm_snuff1:sm_chew1 
##                        0.134                        0.569                        0.002 
## sm_cigar1:sm_snuff1:sm_chew1 
##                        0.633

ll.tob31 <- update(ll.tob3, formula = ~ .-sm_cigs:sm_pipe:sm_chew)
round(2*(1 - pnorm(abs(coef(ll.tob31)/sqrt(diag(vcov(ll.tob31))))))[-c(1:15)], digits = 3)

##  sm_cigs1:sm_pipe1:sm_cigar1  sm_cigs1:sm_pipe1:sm_snuff1 sm_cigs1:sm_cigar1:sm_snuff1 
##                        0.681                        0.970                        0.299 
##  sm_cigs1:sm_cigar1:sm_chew1  sm_cigs1:sm_snuff1:sm_chew1 sm_pipe1:sm_cigar1:sm_snuff1 
##                        0.500                        0.116                        0.136 
##  sm_pipe1:sm_cigar1:sm_chew1  sm_pipe1:sm_snuff1:sm_chew1 sm_cigar1:sm_snuff1:sm_chew1 
##                        0.568                        0.002                        0.638

ll.tob32 <- update(ll.tob31, formula = ~ .-sm_cigs:sm_pipe:sm_snuff)
round(2*(1 - pnorm(abs(coef(ll.tob32)/sqrt(diag(vcov(ll.tob32))))))[-c(1:15)], digits = 3)

##  sm_cigs1:sm_pipe1:sm_cigar1 sm_cigs1:sm_cigar1:sm_snuff1  sm_cigs1:sm_cigar1:sm_chew1 
##                        0.685                        0.268                        0.499 
##  sm_cigs1:sm_snuff1:sm_chew1 sm_pipe1:sm_cigar1:sm_snuff1  sm_pipe1:sm_cigar1:sm_chew1 
##                        0.116                        0.137                        0.568 
##  sm_pipe1:sm_snuff1:sm_chew1 sm_cigar1:sm_snuff1:sm_chew1 
##                        0.002                        0.638

ll.tob33 <- update(ll.tob32, formula = ~ .-sm_cigs:sm_pipe:sm_cigar)
round(2*(1 - pnorm(abs(coef(ll.tob33)/sqrt(diag(vcov(ll.tob33))))))[-c(1:15)], digits = 3)

## sm_cigs1:sm_cigar1:sm_snuff1  sm_cigs1:sm_cigar1:sm_chew1  sm_cigs1:sm_snuff1:sm_chew1 
##                        0.274                        0.510                        0.119 
## sm_pipe1:sm_cigar1:sm_snuff1  sm_pipe1:sm_cigar1:sm_chew1  sm_pipe1:sm_snuff1:sm_chew1 
##                        0.131                        0.575                        0.002 
## sm_cigar1:sm_snuff1:sm_chew1 
##                        0.636

ll.tob34 <- update(ll.tob33, formula = ~ .-sm_cigar:sm_snuff:sm_chew)
round(2*(1 - pnorm(abs(coef(ll.tob34)/sqrt(diag(vcov(ll.tob34))))))[-c(1:15)], digits = 3)

## sm_cigs1:sm_cigar1:sm_snuff1  sm_cigs1:sm_cigar1:sm_chew1  sm_cigs1:sm_snuff1:sm_chew1 
##                        0.286                        0.517                        0.098 
## sm_pipe1:sm_cigar1:sm_snuff1  sm_pipe1:sm_cigar1:sm_chew1  sm_pipe1:sm_snuff1:sm_chew1 
##                        0.145                        0.543                        0.001

ll.tob35 <- update(ll.tob34, formula = ~ .-sm_pipe:sm_cigar:sm_chew)
round(2*(1 - pnorm(abs(coef(ll.tob35)/sqrt(diag(vcov(ll.tob35))))))[-c(1:15)], digits = 3)

## sm_cigs1:sm_cigar1:sm_snuff1  sm_cigs1:sm_cigar1:sm_chew1  sm_cigs1:sm_snuff1:sm_chew1 
##                        0.249                        0.422                        0.097 
## sm_pipe1:sm_cigar1:sm_snuff1  sm_pipe1:sm_snuff1:sm_chew1 
##                        0.134                        0.001

ll.tob36 <- update(ll.tob35, formula = ~ .-sm_cigs:sm_cigar:sm_chew)
round(2*(1 - pnorm(abs(coef(ll.tob36)/sqrt(diag(vcov(ll.tob36))))))[-c(1:15)], digits = 3)

## sm_cigs1:sm_cigar1:sm_snuff1  sm_cigs1:sm_snuff1:sm_chew1 sm_pipe1:sm_cigar1:sm_snuff1 
##                        0.289                        0.102                        0.124 
##  sm_pipe1:sm_snuff1:sm_chew1 
##                        0.001

ll.tob37 <- update(ll.tob36, formula = ~ .-sm_cigs:sm_cigar:sm_snuff)
round(2*(1 - pnorm(abs(coef(ll.tob37)/sqrt(diag(vcov(ll.tob37))))))[-c(1:15)], digits = 3)

##  sm_cigs1:sm_snuff1:sm_chew1 sm_pipe1:sm_cigar1:sm_snuff1  sm_pipe1:sm_snuff1:sm_chew1 
##                        0.070                        0.074                        0.001

# All vars "significant" at 0.10 level. This is where AIC might stop 
# If we use a 0.05 level for no apparent reason, we continue:
ll.tob38 <- update(ll.tob37, formula = ~ .-sm_pipe:sm_cigar:sm_snuff)
round(2*(1 - pnorm(abs(coef(ll.tob38)/sqrt(diag(vcov(ll.tob38))))))[-c(1:15)], digits = 3)

## sm_cigs1:sm_snuff1:sm_chew1 sm_pipe1:sm_snuff1:sm_chew1 
##                       0.078                       0.000

ll.tob39 <- update(ll.tob38, formula = ~ .-sm_cigs:sm_snuff:sm_chew)
round(2*(1 - pnorm(abs(coef(ll.tob39)/sqrt(diag(vcov(ll.tob39))))))[-c(1:15)], digits = 3)

## sm_pipe1:sm_snuff1:sm_chew1 
##                           0

# Conclusion: CLEARLY there is a 3-way interaction among pipe, snuff, chew.
# This model fits well relative to the full third-order model:
anova(ll.tob39, ll.tob3)

## Analysis of Deviance Table
##  Model 1: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_pipe:sm_snuff:sm_chew
## Model 2: y ~ sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew + sm_cigs:sm_pipe + 
##     sm_cigs:sm_cigar + sm_cigs:sm_snuff + sm_cigs:sm_chew + sm_pipe:sm_cigar + 
##     sm_pipe:sm_snuff + sm_pipe:sm_chew + sm_cigar:sm_snuff + 
##     sm_cigar:sm_chew + sm_snuff:sm_chew + sm_cigs:sm_pipe:sm_cigar + 
##     sm_cigs:sm_pipe:sm_snuff + sm_cigs:sm_pipe:sm_chew + sm_cigs:sm_cigar:sm_snuff + 
##     sm_cigs:sm_cigar:sm_chew + sm_cigs:sm_snuff:sm_chew + sm_pipe:sm_cigar:sm_snuff + 
##     sm_pipe:sm_cigar:sm_chew + sm_pipe:sm_snuff:sm_chew + sm_cigar:sm_snuff:sm_chew 
## Deviance= 15.78151 p= 0.6533011 
## Score= 16.41867 p= 0.8709744

# Odds ratios from selected model; ct = cigarette, pi = pipe
#  cr = cigar, sn = snuff, ch = chew
# First 5 coefficients are for main effects; next 10 are 2-way interactions;
#  last is 3-way interaction.
coef(ll.tob39)

##                    sm_cigs1                    sm_pipe1                   sm_cigar1                   sm_snuff1 
##                -0.651674047                 0.843191465                 0.008762443                 0.901038067 
##                    sm_chew1           sm_cigs1:sm_pipe1          sm_cigs1:sm_cigar1          sm_cigs1:sm_snuff1 
##                 0.687319845                 0.303730167                 0.247993998                 0.174527260 
##           sm_cigs1:sm_chew1          sm_pipe1:sm_cigar1          sm_pipe1:sm_snuff1           sm_pipe1:sm_chew1 
##                 0.069093595                 0.716186234                -0.116939444                 0.105943349 
##         sm_cigar1:sm_snuff1          sm_cigar1:sm_chew1          sm_snuff1:sm_chew1 sm_pipe1:sm_snuff1:sm_chew1 
##                 0.218943517                 0.359213919                 0.746143555                 0.244595701

logORs <- svycontrast(stat = ll.tob39, contrasts = list( 
  ct.pi = c(0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), 
  ct.cr = c(0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0), 
  ct.sn = c(0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0), 
  ct.ch = c(0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0), 
  sn.ch.pi0 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 4), 
  sn.ch.pi1 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4,-4) 
  )) 
logORs

##           contrast     SE
## ct.pi      1.21492 0.1681
## ct.cr      0.99198 0.1454
## ct.sn      0.69811 0.2543
## ct.ch      0.27637 0.2173
## sn.ch.pi0  3.96296 0.4115
## sn.ch.pi1  2.00619 0.3531

ORs <- as.data.frame(logORs) 
ORs$OR <- exp(ORs$contrast) 
# Calculate degrees of freedom for t distribution
df <- ll.tob39$df.null - length(coef(ll.tob39)) - 1
# Confidence intervals
ORs$lower.CI <- exp((ORs$contrast + qt(.025, df)*ORs$SE)) 
ORs$upper.CI <- exp((ORs$contrast + qt(.975, df)*ORs$SE)) 
round(ORs[,3:5], 2)

##              OR lower.CI upper.CI
## ct.pi      3.37     2.39     4.74
## ct.cr      2.70     2.01     3.62
## ct.sn      2.01     1.20     3.37
## ct.ch      1.32     0.85     2.05
## sn.ch.pi0 52.61    22.80   121.41
## sn.ch.pi1  7.43     3.63    15.24

####################################################################
# Larger two-way table: how is model parameterized?

# Count number of types of tobacco used and number of respiratory symptoms, 
# and make a table out of these
jdesign2 <- update(object = jdesign, tob = sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew, 
          resp = re_cough + re_phlegm + re_wheez + re_night)

tab54i <- svyloglin(formula = ~ tob + resp, design = jdesign2)
tab54 <- svyloglin(formula = ~ tob * resp, design = jdesign2)
summary(tab54)

## Loglinear model: svyloglin(formula = ~tob * resp, design = jdesign2)

##                   coef       se         p
## tob1        1.63835115      NaN       NaN
## tob2        2.31373804      NaN       NaN
## tob3        0.73273313      NaN       NaN
## tob4        0.64399465      NaN       NaN
## tob5        0.07846001      NaN       NaN
## resp1       2.91490642      NaN       NaN
## resp2       1.50475636      NaN       NaN
## resp3       0.37436162      NaN       NaN
## resp4       0.11674088      NaN       NaN
## tob1:resp1  0.42529041      NaN       NaN
## tob2:resp1 -0.57935208      NaN       NaN
## tob3:resp1 -0.49176666      NaN       NaN
## tob4:resp1 -0.89100301      NaN       NaN
## tob5:resp1 -1.31339205      NaN       NaN
## tob1:resp2 -0.14050084      NaN       NaN
## tob2:resp2 -0.70606432      NaN       NaN
## tob3:resp2 -0.45461076      NaN       NaN
## tob4:resp2 -0.64112477 1.705208 0.7069315
## tob5:resp2 -1.24701700      NaN       NaN
## tob1:resp3 -0.67324092      NaN       NaN
## tob2:resp3 -0.69796926      NaN       NaN
## tob3:resp3 -0.77347570 3.249733 0.8118717
## tob4:resp3 -0.87093656 3.148329 0.7820608
## tob5:resp3 -0.80204154      NaN       NaN
## tob1:resp4 -1.42827623 2.053295 0.4866781
## tob2:resp4 -0.88804044      NaN       NaN
## tob3:resp4 -1.13210600      NaN       NaN
## tob4:resp4 -0.59474424      NaN       NaN
## tob5:resp4 -0.64219434      NaN       NaN

svymean(x = ~ as.factor(tob), design = jdesign2)

##                      mean     SE
## as.factor(tob)0 0.4545685 0.0130
## as.factor(tob)1 0.3732985 0.0099
## as.factor(tob)2 0.0847092 0.0071
## as.factor(tob)3 0.0573304 0.0052
## as.factor(tob)4 0.0227417 0.0035
## as.factor(tob)5 0.0073517 0.0020

wt.tab54 <- svytable(formula = ~ tob + resp, design = jdesign2)
wt.tab54

##    resp
## tob          0          1          2          3          4
##   0 73873586.6 10241151.2  1941147.4   705127.4   118614.2
##   1 53149023.9 11429953.8  3720796.5  2377966.8   669118.7
##   2 11937446.8  3024319.4   709940.9   383343.2   135029.0
##   3  7328020.5  2296608.8   589327.7   600374.7   142965.1
##   4  2728581.1   711775.1   358648.5   325241.9   222272.1
##   5   727355.6   249225.9   150853.8   277657.3        0.0

wt.tab54[1,1]*wt.tab54[2,2]/(wt.tab54[2,1]*wt.tab54[1,2])

## [1] 1.551278

c54 <- coef(tab54, intercept = TRUE)

# Parameters produced by loglin are on *sample size* scale. 
# Need to be multiplied by Popsize/Sampsize to reflect population counts, 
# or by 1/Sampsize top reflect proportions
# The (1,1) total
exp(c54[1] + c54[2] + c54[7] + c54[11])

## (Intercept) 
##    1875.389

# This reproduces the (1,1) total from svytable():
exp(c54[1] + c54[2] + c54[7] + c54[11]) * totpop / totsamp

## (Intercept) 
##    73873587

summary(wt.tab54)

##    resp
## tob        0        1        2        3        4
##   0 73873587 10241151  1941147   705127   118614
##   1 53149024 11429954  3720797  2377967   669119
##   2 11937447  3024319   709941   383343   135029
##   3  7328020  2296609   589328   600375   142965
##   4  2728581   711775   358648   325242   222272
##   5   727356   249226   150854   277657        0
## 
##  Pearson's X^2: Rao & Scott adjustment
## 
## data:  svychisq(~tob + resp, design = jdesign2, statistic = "F")
## F = 6.6343, ndf = 11.502, ddf = 586.601, p-value = 7.292e-11

# Get proportions by dividing by estimated total population size
round(wt.tab54/totpop, digits = 3)

##    resp
## tob     0     1     2     3     4
##   0 0.387 0.054 0.010 0.004 0.001
##   1 0.278 0.060 0.019 0.012 0.004
##   2 0.062 0.016 0.004 0.002 0.001
##   3 0.038 0.012 0.003 0.003 0.001
##   4 0.014 0.004 0.002 0.002 0.001
##   5 0.004 0.001 0.001 0.001 0.000

# Get proportions and standard errors for crosstabulation a different way
# Also available is n\more cryptic form from 
svymean(x = ~ interaction(tob,resp), design = jdesign2)

##                                 mean     SE
## interaction(tob, resp)0.0 0.38651879 0.0113
## interaction(tob, resp)1.0 0.27808446 0.0092
## interaction(tob, resp)2.0 0.06245869 0.0060
## interaction(tob, resp)3.0 0.03834141 0.0041
## interaction(tob, resp)4.0 0.01427639 0.0022
## interaction(tob, resp)5.0 0.00380564 0.0017
## interaction(tob, resp)0.1 0.05358339 0.0050
## interaction(tob, resp)1.1 0.05980340 0.0048
## interaction(tob, resp)2.1 0.01582374 0.0027
## interaction(tob, resp)3.1 0.01201624 0.0019
## interaction(tob, resp)4.1 0.00372412 0.0011
## interaction(tob, resp)5.1 0.00130399 0.0007
## interaction(tob, resp)0.2 0.01015640 0.0020
## interaction(tob, resp)1.2 0.01946782 0.0027
## interaction(tob, resp)2.2 0.00371453 0.0010
## interaction(tob, resp)3.2 0.00308346 0.0010
## interaction(tob, resp)4.2 0.00187651 0.0008
## interaction(tob, resp)5.2 0.00078929 0.0004
## interaction(tob, resp)0.3 0.00368934 0.0012
## interaction(tob, resp)1.3 0.01244191 0.0019
## interaction(tob, resp)2.3 0.00200571 0.0008
## interaction(tob, resp)3.3 0.00314126 0.0011
## interaction(tob, resp)4.3 0.00170172 0.0009
## interaction(tob, resp)5.3 0.00145275 0.0007
## interaction(tob, resp)0.4 0.00062061 0.0003
## interaction(tob, resp)1.4 0.00350094 0.0012
## interaction(tob, resp)2.4 0.00070649 0.0006
## interaction(tob, resp)3.4 0.00074802 0.0005
## interaction(tob, resp)4.4 0.00116296 0.0008
## interaction(tob, resp)5.4 0.00000000 0.0000

tab24 <- svyloglin(formula = ~ tob * anyresp, design = jdesign2)
coef(tab24, intercept = TRUE)

##   (Intercept)          tob1          tob2          tob3          tob4          tob5      anyresp1 tob1:anyresp1 
##    5.04486005    1.62324069    1.62655729    0.15296531   -0.17027459   -1.06817693    0.42806986    0.44040088 
## tob2:anyresp1 tob3:anyresp1 tob4:anyresp1 tob5:anyresp1 
##    0.10782867    0.08800116   -0.07673377   -0.16675511

Para pares de fatores não envolvidos na interação de três vias, calcula-se uma única razão de chances (odds ratio). Todas essas associações são positivas; no entanto, o intervalo de confiança para a razão de chances entre o uso de cigarros e o de tabaco de mascar inclui o valor 1, indicando que pessoas que já usaram cigarros têm, em geral, maior probabilidade de ter usado cachimbos, charutos ou tabaco de aspirar (snuff) do que aquelas que nunca usaram cigarros.

Para associações envolvendo cachimbos, tabaco de aspirar e tabaco de mascar, calcula-se uma razão de chances distinta para cada nível da terceira variável. Indicamos essas razões mencionando a terceira variável e o nível (0 ou 1). Os resultados dessa análise revelam um cenário um pouco diferente. Por exemplo, o uso de tabaco de aspirar e o de tabaco de mascar — as duas formas que não são fumadas — apresentam uma associação muito forte, tanto entre usuários de cachimbo (pi1) quanto entre não usuários de cachimbo (pi0). Contudo, essa associação é muito mais intensa entre os não usuários de cachimbo: estima-se que a chance de uso de tabaco de aspirar seja 52 vezes maior entre usuários de tabaco de mascar do que entre não usuários desse produto, intervalo de confiança de 95%: 23 a 121.

Métodos alternativos de estimação de modelos e inferência

Um método alternativo foi proposto por Clogg and Eliason (1987) para incorporar pesos amostrais em uma análise de modelo log-linear. A ideia consiste em agregar os pesos amostrais correspondentes aos indivíduos em cada célula da tabela sob análise.

O peso médio é utilizado como um termo de offset em um modelo de regressão de taxas de Poisson (ver Seção 4.3), e a análise é realizada como se os dados fossem provenientes de uma amostra aleatória simples. Essa abordagem foi recomendada por Agresti (2002), pg. 391) e utilizada em diversos estudos, por exemplo, Schwartz and Mare (2005); Vermunt and Magidson (2007) e Beller (2009).

Essa abordagem foi examinada recentemente por Skinner and Vallet (2010) e Loughin and Bilder (2010), que constataram ser ela inadequada para a finalidade a que se destina. A abordagem apresenta duas falhas principais:

1. Embora os pesos amostrais sejam incorporados à análise, outras características do plano amostral (agrupamento e estratificação) não o são. Isso significa que os erros-padrão não podem ser estimados adequadamente e, consequentemente, não se pode confiar nas inferências.

2. Mesmo nos raros casos em que o plano amostral exerce pouca influência sobre os erros-padrão, o método baseia-se em uma aproximação que pressupõe a constância dos pesos amostrais entre todos os membros de uma determinada célula da tabela (Loughin and Bilder 2010). O procedimento é fortemente prejudicado quando há variabilidade entre os pesos dentro de uma célula. Os erros-padrão e os testes do modelo são afetados negativamente por essa variabilidade, resultando em inferências excessivamente liberais, com margens de erro potencialmente elevadas.

Diante desses problemas, desaconselhamos fortemente o uso deste procedimento como um substituto rápido para uma análise completa baseada no plano amostral.

6.3.6 Regressão logística

A regressão logística é abordada em detalhes no Capítulo 2. Os mesmos princípios ali apresentados aplicam-se à análise de dados de pesquisas amostrais com pesos. Descrevemos aqui como implementar uma análise de regressão logística utilizando o pacote survey. Mais detalhes estão disponíveis em Lumley (2010), Capítulo 6. Uma discussão detalhada da teoria é apresentada em Heeringa et al. (2010).

Para começar, podem ser gerados gráficos de respostas binárias ou de proporções estimadas em função de variáveis explicativas escolhidas. O ponto importante a lembrar é que cada unidade amostrada representa um número diferente de membros da população, de acordo com os pesos da pesquisa.

Gráficos de bolhas, como a Figura 2.5 na Seção 2.2.4, podem ser criados utilizando os pesos totais — em vez dos tamanhos da amostra — para definir a largura das bolhas. O pacote survey dispõe de uma função de plotagem, svyplot(), capaz de realizar essa tarefa automaticamente.

Um modelo logístico é ajustado utilizando a função svyglm(). Essa função replica a função glm() descrita na Seção 2.2.1, exceto pelo fato de que o ajuste do modelo não utiliza a estimação por máxima verossimilhança, uma vez que a verossimilhança binomial é inadequada para dados de pesquisa amostral ponderados e correlacionados. Em vez disso, utiliza-se uma pseudoverossimilhança que se assemelha à verossimilhança binomial aplicada a contagens ponderadas, em vez de contagens amostrais, consulte a Seção 6.4.3 para uma breve descrição da pseudoverossimilhança.

Testes de Wald para os coeficientes do modelo estão disponíveis no summary() do modelo, enquanto os intervalos de confiança para os coeficientes são obtidos utilizando confint(). Os erros-padrão são calculados internamente por meio de linearização ou de métodos de replicação.

Os testes são versões dos testes \(t\) com correção de segunda ordem de Rao-Scott: a estatística \(t\) é obtida da maneira usual, como a razão entre a estimativa e seu erro-padrão. O \(p\)-valor é calculado comparando-se o quadrado dessa estatística a uma distribuição \(F\), conforme a Equação 6.12. O intervalo de confiança padrão é do tipo Wald; intervalos \(t\) também podem ser gerados.

Existe um método anova() capaz de realizar testes de comparação de modelos — do tipo LRT ou baseados em Wald — em objetos resultantes de svyglm(). Isso exige que tanto o modelo completo quanto o reduzido (correspondente à hipótese nula) sejam ajustados aos dados.

Alternativamente, esses testes podem ser realizados diretamente no modelo completo utilizando a função regTermTest(). Isso é particularmente útil para testar a significância de grupos de coeficientes que representam um único fator, ou para verificar se todos os coeficientes de termos de uma determinada ordem — ou associados a uma variável específica — são diferentes de zero.

Assim como ocorre com os modelos log-lineares, o cálculo da razão de chances (odds ratio) e da probabilidade de sucesso exige um trabalho adicional. A parametrização da função svyglm() é exatamente a mesma da função glm(); portanto, o processo de estimar uma razão de chances ou uma probabilidade de sucesso a partir dos parâmetros do modelo é idêntico ao abordado nas Seções 2.2.3 a 2.2.5.

As razões de chances logarítmicas podem ser estimadas utilizando a função svycontrast() para calcular as combinações lineares adequadas dos coeficientes e os respectivos erros-padrão. A partir desses valores, obtêm-se as razões de chances e os intervalos de confiança correspondentes, utilizando-se novamente uma distribuição \(t\) com \(\kappa − p + 1\) graus de liberdade, em que \(p\) representa o número de parâmetros do modelo (E. Korn and Graubard 1999).

Probabilidades previstas e intervalos de confiança podem ser obtidos de maneira semelhante, utilizando a função svycontrast() para calcular os logits referentes às combinações desejadas de variáveis explicativas e seus respectivos erros-padrão. A função de ligação inversa do logit, \(\exp(\cdot)/(1 + \exp(\cdot))\), é aplicada a esses logits, bem como aos limites dos intervalos de confiança calculados na escala logit.

Alternativamente, se o interesse se restringir à visualização das probabilidades ajustadas para combinações de variáveis explicativas presentes nos dados, estas podem ser obtidas utilizando o método predict().

Exemplo 6.13: NHANES 1999-2000

Aqui, modelamos a presença de quaisquer sintomas respiratórios (anyresp) em função da age (idade) — uma covariável contínua — e dos fatores binários referentes a cada produto de tabaco. Começamos ajustando uma série de modelos: primeiro, apenas com a age (modelo M1); em seguida, adicionando os cinco fatores de uso de tabaco como efeitos principais (M2); e, por fim, incluindo interações entre a age e cada uma das variáveis binárias de tabaco (M3).

Observe o uso da família quasi-binomial. Isso se deve ao fato de estarmos modelando contagens de sucessos ponderadas pelo desenho amostral (survey-weighted). A documentação da função svyglm() explica: “Para as famílias binomial e Poisson, utilize family = quasibinomial() e family = quasipoisson() para evitar avisos sobre números não inteiros de sucessos. As versões ‘quasi’ desses objetos de família fornecem as mesmas estimativas pontuais e erros-padrão, sem gerar o aviso.”

Comparações sequenciais entre esses três modelos nos oferecem um ponto de partida para um processo de eliminação regressiva (backward elimination), até que se obtenha um modelo reduzido satisfatório. Utilizamos α = 0,15 nessa eliminação regressiva, pois esse valor demonstrou ser mais compatível com os resultados que métricas como o AIC alcançariam, caso estivessem disponíveis para esses modelos (Lee and Koval 1997; Shtatland et al. 2003).

library(survey)

# Get data and jackknife reps entered into a survey design object
# Even though this is technically a stratified design, there is no information on
#  separate scales for each jackknife replicate, so we use type = "JK1" with a single 
#  scale in scales = 51/52. Ordinarily, type = "JKn" is used for stratified designs.
# Observed responses are in columns 1-10, weights in column 11, and replicate weights in 12-63.

jdesign <- svrepdesign(data = smoke.resp[, c(1:10)], weights = smoke.resp[,11], 
            repweights = smoke.resp[,12:63], type = "JK1", 
            combined.weights = TRUE, scale = 51/52)

##################################################################
# Logistic regression analysis of the binary variable for any respiratory symptoms
#  against age and different forms of tobacco use
# Note: Documentation says:
#  "For binomial and Poisson families use family = quasibinomial() 
#  and family = quasipoisson() to avoid a warning about non-integer 
#  numbers of successes. The 'quasi' versions of the family objects 
#  give the same point estimates and standard errors and do not give the warning."
# 

# Create variable for any respiratory symptoms 
# Add binaries and assign new binary according to whether sum > 0
jdesign <- update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + re_night > 0))

# Model with age alone
m1 <- svyglm(formula = anyresp ~ age, design = jdesign, family = quasibinomial(link = "logit"))
summary(m1)

## 
## Call:
## svyglm(formula = anyresp ~ age, design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.529432   0.136873 -11.174 3.37e-15 ***
## age          0.005356   0.002362   2.268   0.0277 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 0.9999829)
## 
## Number of Fisher Scoring iterations: 4

# Model with age and all tobacco product main effects
m2 <- svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew, 
             design = jdesign, family = quasibinomial(link = "logit"))
summary(m2)

## 
## Call:
## svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew, design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -1.878405   0.155388 -12.089 9.90e-16 ***
## age          0.003158   0.002496   1.265    0.212    
## sm_cigs      0.703708   0.110491   6.369 8.83e-08 ***
## sm_pipe      0.276658   0.188565   1.467    0.149    
## sm_cigar    -0.002525   0.173494  -0.015    0.988    
## sm_snuff     0.191046   0.207186   0.922    0.361    
## sm_chew      0.316234   0.300679   1.052    0.299    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 0.9987106)
## 
## Number of Fisher Scoring iterations: 4

# Comparison of these models: anova() does LRT F-test by default.
anova(m1, m2)

## Working (Rao-Scott+F) LRT for sm_cigs sm_pipe sm_cigar sm_snuff sm_chew
##  in svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew, design = jdesign, family = quasibinomial(link = "logit"))
## Working 2logLR =  60.89088 p= 2.9541e-06 
## (scale factors:  1.8 1.1 1 0.73 0.33 );  denominator df= 45

# Adding age interactions with tobacco products
m3 <- svyglm(formula = anyresp ~ age * (sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew), 
             design = jdesign, family = quasibinomial(link = "logit"))
summary(m3)

## 
## Call:
## svyglm(formula = anyresp ~ age * (sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew), design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -2.098674   0.222370  -9.438 9.97e-12 ***
## age           0.007949   0.003986   1.994   0.0530 .  
## sm_cigs       0.793088   0.374301   2.119   0.0404 *  
## sm_pipe       1.467351   0.636315   2.306   0.0264 *  
## sm_cigar      0.280856   0.611786   0.459   0.6487    
## sm_snuff     -0.213388   0.742342  -0.287   0.7752    
## sm_chew       1.462042   1.181624   1.237   0.2232    
## age:sm_cigs  -0.001948   0.006715  -0.290   0.7732    
## age:sm_pipe  -0.021261   0.010792  -1.970   0.0558 .  
## age:sm_cigar -0.005636   0.010861  -0.519   0.6066    
## age:sm_snuff  0.005979   0.014409   0.415   0.6804    
## age:sm_chew  -0.023253   0.019833  -1.172   0.2480    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 1.000992)
## 
## Number of Fisher Scoring iterations: 4

# Comparison of m2 and m3 two ways. They have opposite default test statistics, even though they perform the same test.
anova(m2, m3)

## Working (Rao-Scott+F) LRT for age:sm_cigs age:sm_pipe age:sm_cigar age:sm_snuff age:sm_chew
##  in svyglm(formula = anyresp ~ age * (sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew), design = jdesign, family = quasibinomial(link = "logit"))
## Working 2logLR =  10.75146 p= 0.088422 
## (scale factors:  2.1 1.1 0.87 0.56 0.41 );  denominator df= 40

regTermTest(model = m3, test.terms = ~ age : (sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew))

## Wald test for age:sm_cigs age:sm_pipe age:sm_cigar age:sm_snuff age:sm_chew
##  in svyglm(formula = anyresp ~ age * (sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew), design = jdesign, family = quasibinomial(link = "logit"))
## F =  2.393247  on  5  and  40  df: p= 0.054497

regTermTest(model = m3, test.terms = ~ age : (sm_cigs + sm_pipe + sm_cigar + sm_snuff + sm_chew), 
            method = "LRT")

## Working (Rao-Scott+F) LRT for age:sm_cigs age:sm_pipe age:sm_cigar age:sm_snuff age:sm_chew
##  in svyglm(formula = anyresp ~ age * (sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew), design = jdesign, family = quasibinomial(link = "logit"))
## Working 2logLR =  10.75146 p= 0.088422 
## (scale factors:  2.1 1.1 0.87 0.56 0.41 );  denominator df= 40

# Backward elimination of interactions and main effects: Remove age:sm_cigs
m <- update(m3, formula = ~ . - age:sm_cigs) 
# svyglm(anyresp ~ age + sm_cigs + age * (sm_pipe + sm_cigar + sm_snuff + sm_chew) , design = jdesign.age,family = quasibinomial())
summary(m)

## 
## Call:
## svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew + age:sm_pipe + age:sm_cigar + age:sm_snuff + 
##     age:sm_chew, design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -2.055544   0.155001 -13.261  < 2e-16 ***
## age           0.006993   0.002523   2.771  0.00836 ** 
## sm_cigs       0.704414   0.112044   6.287 1.69e-07 ***
## sm_pipe       1.488632   0.614346   2.423  0.01989 *  
## sm_cigar      0.297823   0.584663   0.509  0.61321    
## sm_snuff     -0.206579   0.727958  -0.284  0.77801    
## sm_chew       1.468591   1.183896   1.240  0.22185    
## age:sm_pipe  -0.021721   0.010280  -2.113  0.04073 *  
## age:sm_cigar -0.006019   0.010431  -0.577  0.56705    
## age:sm_snuff  0.005913   0.014264   0.415  0.68062    
## age:sm_chew  -0.023424   0.019936  -1.175  0.24679    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 1.000756)
## 
## Number of Fisher Scoring iterations: 4

# Backward elimination of interactions: Remove age:sm_snuff
m <- update(m, formula = ~ . - age:sm_snuff)
summary(m)

## 
## Call:
## svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_cigar + 
##     sm_snuff + sm_chew + age:sm_pipe + age:sm_cigar + age:sm_chew, 
##     design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -2.061158   0.155788 -13.231  < 2e-16 ***
## age           0.007123   0.002492   2.858  0.00661 ** 
## sm_cigs       0.702735   0.110649   6.351 1.24e-07 ***
## sm_pipe       1.499782   0.603205   2.486  0.01697 *  
## sm_cigar      0.293431   0.583955   0.502  0.61795    
## sm_snuff      0.045049   0.241677   0.186  0.85303    
## sm_chew       1.341576   1.050052   1.278  0.20840    
## age:sm_pipe  -0.021836   0.010183  -2.144  0.03784 *  
## age:sm_cigar -0.005962   0.010422  -0.572  0.57034    
## age:sm_chew  -0.020815   0.016948  -1.228  0.22623    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 1.000311)
## 
## Number of Fisher Scoring iterations: 4

# Backward elimination of interactions: Remove sm_snuff
m <- update(m, formula = ~ . - sm_snuff)
summary(m)

## 
## Call:
## svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_cigar + 
##     sm_chew + age:sm_pipe + age:sm_cigar + age:sm_chew, design = jdesign, 
##     family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -2.059875   0.154983 -13.291  < 2e-16 ***
## age           0.007101   0.002483   2.860  0.00651 ** 
## sm_cigs       0.703722   0.110259   6.382 1.01e-07 ***
## sm_pipe       1.495299   0.599447   2.494  0.01654 *  
## sm_cigar      0.302777   0.600940   0.504  0.61695    
## sm_chew       1.385320   0.893300   1.551  0.12828    
## age:sm_pipe  -0.021739   0.010098  -2.153  0.03700 *  
## age:sm_cigar -0.006103   0.010610  -0.575  0.56817    
## age:sm_chew  -0.021300   0.015288  -1.393  0.17070    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 1.000369)
## 
## Number of Fisher Scoring iterations: 4

# Backward elimination of interactions: Remove age:sm_cigar
m <- update(m, formula = ~ . - age:sm_cigar)
summary(m)

## 
## Call:
## svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_cigar + 
##     sm_chew + age:sm_pipe + age:sm_chew, design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.040612   0.149232 -13.674  < 2e-16 ***
## age          0.006699   0.002357   2.842  0.00677 ** 
## sm_cigs      0.703334   0.110242   6.380 9.32e-08 ***
## sm_pipe      1.642247   0.590125   2.783  0.00791 ** 
## sm_cigar     0.023412   0.180664   0.130  0.89748    
## sm_chew      1.457675   0.844935   1.725  0.09151 .  
## age:sm_pipe -0.025006   0.009969  -2.508  0.01589 *  
## age:sm_chew -0.022963   0.014279  -1.608  0.11496    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 1.00011)
## 
## Number of Fisher Scoring iterations: 4

# Backward elimination of interactions: Remove sm_cigar
m <- update(m, formula = ~ . - sm_cigar)
summary(m)

## 
## Call:
## svyglm(formula = anyresp ~ age + sm_cigs + sm_pipe + sm_chew + 
##     age:sm_pipe + age:sm_chew, design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.039511   0.148635 -13.722  < 2e-16 ***
## age          0.006693   0.002360   2.836  0.00682 ** 
## sm_cigs      0.705353   0.110126   6.405 7.81e-08 ***
## sm_pipe      1.654550   0.611060   2.708  0.00954 ** 
## sm_chew      1.461494   0.829967   1.761  0.08505 .  
## age:sm_pipe -0.025002   0.009924  -2.519  0.01538 *  
## age:sm_chew -0.022896   0.014350  -1.596  0.11760    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 1.000086)
## 
## Number of Fisher Scoring iterations: 4

As evidências decorrentes da comparação entre os modelos m1 e m2 indicam fortemente que pelo menos um dos fatores relacionados ao uso de tabaco contribui significativamente para o modelo que já inclui a variável idade (estatística \(\mbox{LRT}\approx 60.9\); \(p\)-valor \(\approx\) 0). Os testes \(t\) associados às estimativas dos parâmetros (não apresentados) apontam o consumo de cigarros como o fator de maior contribuição, de longe (\(t = 6.4\); \(p\)-valor \(\approx\) 0; o próximo maior apresenta \(t = 1.47\); \(p\)-valor = 0.15).

A inclusão de interações entre idade (age)e uso de tabaco (tobacco) resulta em uma melhoria mais modesta em relação ao modelo contendo apenas efeitos principais (estatística \(\mbox{LRT} = 10.8\); \(p\)-valor = 0.09); portanto, consideramos o modelo mais completo entre eles para a eliminação regressiva (backward elimination) de termos individuais. Mantemos a hierarquia durante o processo, permitindo que o efeito principal de um fator de uso de tabaco seja considerado para eliminação apenas após a remoção de sua interação com a variável age.

Isso resulta no seguinte modelo final:

# all terms in model above are significant using alpha = 0.15 call this the final model
m.final <- svyglm(formula = anyresp ~ age + sm_cigs + age * (sm_pipe + sm_chew), 
                  design = jdesign, family = quasibinomial(link = "logit"))
summary(m.final)

## 
## Call:
## svyglm(formula = anyresp ~ age + sm_cigs + age * (sm_pipe + sm_chew), 
##     design = jdesign, family = quasibinomial(link = "logit"))
## 
## Survey design:
## update(object = jdesign, anyresp = (re_cough + re_phlegm + re_wheez + 
##     re_night > 0))
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -2.039511   0.148635 -13.722  < 2e-16 ***
## age          0.006693   0.002360   2.836  0.00682 ** 
## sm_cigs      0.705353   0.110126   6.405 7.81e-08 ***
## sm_pipe      1.654550   0.611060   2.708  0.00954 ** 
## sm_chew      1.461494   0.829967   1.761  0.08505 .  
## age:sm_pipe -0.025002   0.009924  -2.519  0.01538 *  
## age:sm_chew -0.022896   0.014350  -1.596  0.11760    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasibinomial family taken to be 1.000086)
## 
## Number of Fisher Scoring iterations: 4

Este modelo indica que a relação entre a presença de quaisquer sintomas respiratórios e a idade é influenciada pelo uso de cachimbo e tabaco de mascar, mas não pelo de outros produtos. O uso de cigarros apresenta uma relação muito significativa com a presença de sintomas respiratórios, independentemente da idade.

Observe que os sinais dos dois coeficientes de interação são negativos e possuem magnitudes maiores do que o efeito principal da idade. Isso implica que o modelo estima, na verdade, uma relação decrescente entre a presença de sintomas respiratórios e a idade para usuários de cachimbo e tabaco de mascar, o que é contraintuitivo.

Explorando melhor essas características, calculamos as razões de chances (odds ratios) que relacionam a alteração na presença de sintomas respiratórios a um aumento de 10 anos na idade, separadamente para:

1. pessoas cujo uso de tabaco não inclui cachimbo ou tabaco de mascar, e pessoas que utilizaram

2. apenas tabaco para cachimbo, e

3. apenas tabaco de mascar.

Com base na ordem das estimativas dos parâmetros no resultado anterior, as razões de chances estimadas para esses três casos são

1. \(\exp(10\widehat{\beta}_1)\),

2. \(\exp(10\widehat{\beta}_1 + 10\widehat{\beta}_5)\) e

3. \(\exp(10\widehat{\beta}_1 + 10\widehat{\beta}_6)\).

Os parâmetros de regressão estimados necessários para as razões de chances são inseridos na função svycontrast() conforme mostrado abaixo, o que nos permite obter as estimativas e os intervalos de confiança para essas razões de chances.

##################################################################
# CIs from reduced (final) model As exercise: repeat from full model (m3)

# Odds Ratios for symptoms with 10-year age change
# First for non-pipe users, then for pipe users, then chew users
logOR.age <- svycontrast(m.final, list(
  tenyr = c(0, 10, 0, 0, 0, 0, 0),
  tenyr_pipe = c(0, 10, 0, 0, 0, 10, 0),
  tenyr_chew = c(0, 10, 0, 0, 0, 0, 10)))
# Convert to data frame for computations
ORs.age <- as.data.frame(logOR.age)
ORs.age$OR <- exp(ORs.age$contrast)
ORs.age$lower.CI <- exp((ORs.age$contrast + qt(0.025, m.final$df.residual) * ORs.age$SE))
ORs.age$upper.CI <- exp((ORs.age$contrast + qt(0.975, m.final$df.residual) * ORs.age$SE))
round(ORs.age[,3:5],2)

##              OR lower.CI upper.CI
## tenyr      1.07     1.02     1.12
## tenyr_pipe 0.83     0.68     1.02
## tenyr_chew 0.85     0.64     1.13

Cada razão de chances (odds ratio) é interpretada como a alteração multiplicativa nas chances de apresentar sintomas respiratórios para cada aumento de 10 anos na idade, em uma pessoa que utilizou o produto de tabaco especificado. As razões de chances estimadas são superiores a 1 para indivíduos que não utilizam cachimbo ou tabaco de mascar; no entanto, o intervalo de confiança para pessoas sem histórico de uso de tabaco situa-se apenas entre 1,02 e 1,12, sugerindo um aumento estatisticamente significativo, porém muito pequeno, na probabilidade de sintomas com o avanço da idade.

O efeito geral da idade para usuários de cachimbo e tabaco de mascar não é claro, uma vez que ambas as razões de chances estimadas são inferiores a 1, mas seus respectivos intervalos de confiança incluem o valor 1. São apresentadas razões de chances adicionais focadas no uso de tabaco em idades específicas.

Abaixo, calculamos também os intervalos de confiança para as probabilidades de sintomas respiratórios em não usuários ou fumantes de cigarro de 20 anos de idade, bem como em não usuários, fumantes de cigarro e usuários dos três produtos com 50 anos de idade. Fica evidente que o uso de tabaco está associado a maiores probabilidades de sintomas respiratórios, embora não se possa inferir uma relação de causalidade a partir desta análise.

# Next ORs for each tobacco use. For pipe and chew, do separately at 20, 50, 80 years old
# Coefficients are found from differrence in logits between 
logOR.tob <- svycontrast(m.final, list(
  cigs = c(0, 0, 1, 0, 0, 0, 0),
  pipe.20 = c(0, 0, 1, 0, 0, 0, 20),
  pipe.50 = c(0, 0, 1, 0, 0, 0, 50),
  pipe.80 = c(0, 0, 1, 0, 0, 0, 80),
  chew.20 = c(0, 0, 0, 1, 0, 0, 20),
  chew.50 = c(0, 0, 0, 1, 0, 0, 50),
  chew.80 = c(0, 0, 0, 1, 0, 0, 80)))

# Convert object into data frame for further computations
ORs.tob <- rbind(as.data.frame(logOR.tob))
ORs.tob$OR <- exp(ORs.tob$contrast)
ORs.tob$lower.CI <- exp((ORs.tob$contrast + qt(0.025, m.final$df.residual) * ORs.tob$SE))
ORs.tob$upper.CI <- exp((ORs.tob$contrast + qt(0.975, m.final$df.residual) * ORs.tob$SE))
round(ORs.tob[,3:5],2)

##           OR lower.CI upper.CI
## cigs    2.02     1.62     2.53
## pipe.20 1.28     0.67     2.45
## pipe.50 0.64     0.14     2.86
## pipe.80 0.32     0.03     3.41
## chew.20 3.31     0.73    14.93
## chew.50 1.66     0.19    14.40
## chew.80 0.84     0.05    15.58

# Predicted P(symptoms) for a few cases
logits.reduced <- svycontrast(m.final, list(
 twenty_none = c(1, 20, 0, 0, 0, 0, 0),
 twenty_cig = c(1, 20, 1, 0, 0, 0, 0),
 fifty_none = c(1, 50, 0, 0, 0, 0, 0),
 fifty_cig = c(1, 50, 1, 0, 0, 0, 0),
 fifty_all = c(1, 50, 1, 1, 1, 50, 50)))

# Convert object into data frame for further computations
preds.reduced <- as.data.frame(logits.reduced)
preds.reduced$prob <- plogis(preds.reduced$contrast)
preds.reduced$lower.CI <- plogis(preds.reduced$contrast + qt(p = 0.025, 
                                        df = m.final$df.residual) * preds.reduced$SE)
preds.reduced$upper.CI <- plogis(preds.reduced$contrast + qt(p = 0.975, 
                                        df = m.final$df.residual) * preds.reduced$SE)
round(preds.reduced[,3:5], digits = 3)

##              prob lower.CI upper.CI
## twenty_none 0.129    0.106    0.157
## twenty_cig  0.231    0.196    0.271
## fifty_none  0.154    0.134    0.176
## fifty_cig   0.269    0.242    0.298
## fifty_all   0.431    0.334    0.533

Gráficos das probabilidades previstas pelo modelo e das proporções estimadas são apresentados na Figura 6.3. Cada bolha representa a estimativa amostral ponderada da proporção da população com sintomas respiratórios em cada idade (uma bolha por ano). Claramente, não há muitos dados para estimar as tendências referentes às pessoas que utilizaram tabaco de mascar ou cachimbos; portanto, os intervalos de confiança aqui são muito mais amplos e parecem não descartar uma reta com inclinação zero.

##################################################################
# Plot model fit

# First make plots of the fits. Will plot pi-hat against age for 
# No tobacco, Cigarettes only, Pipe only, and Chew only.
# Since cigarette:age and chew:age are not in the final model, the odds ratios for 
#  a given change in age should be the same as no-use in these plots.
# However, both pipe:age is in the model, so age-ORs will
#  change compared to no tobacco use.

# Start by computing Nhats for saturated model, including Y binary
# Use "interaction({all terms in model},Y)"
tab <- svytotal(x = ~ interaction(age, sm_cigs, sm_pipe, sm_chew, anyresp), 
        design = jdesign)
N1 <- coef(tab)
lenN <- length(N1)
# Calculate conditional proportions of success, failure
# Phat contains proportion of failure for each level of covariates, followed by prop of success 
Nhat0 <- N1[1:(lenN/2)]
Nhat1 <- N1[(lenN/2+1):lenN]
Nplus <- Nhat0 + Nhat1
# Nplus <- ((Nhat0 + Nhat1), (Nhat0 + Nhat1))
# NPlus is total of successes and failures. Eliminate combinations with none of either and compute proportions
Phat <- Nhat1[which(Nplus>0)]/Nplus[which(Nplus>0)]
Nplus <- Nplus[which(Nplus>0)]
len <- length(Phat)
head(Phat)

## interaction(age, sm_cigs, sm_pipe, sm_chew, anyresp)20.0.0.0.TRUE 
##                                                        0.03683252 
## interaction(age, sm_cigs, sm_pipe, sm_chew, anyresp)21.0.0.0.TRUE 
##                                                        0.09322954 
## interaction(age, sm_cigs, sm_pipe, sm_chew, anyresp)22.0.0.0.TRUE 
##                                                        0.19013595 
## interaction(age, sm_cigs, sm_pipe, sm_chew, anyresp)23.0.0.0.TRUE 
##                                                        0.14503194 
## interaction(age, sm_cigs, sm_pipe, sm_chew, anyresp)24.0.0.0.TRUE 
##                                                        0.11434690 
## interaction(age, sm_cigs, sm_pipe, sm_chew, anyresp)25.0.0.0.TRUE 
##                                                        0.12187713

len

## [1] 344

# Gather explanatories, predicted values, and CI into one data frame
X0 <- as.data.frame(model.matrix(m.final))
# Aggregate into exp var pattern form
X0 <- unique(X0)
ord <- order(X0$sm_chew, X0$sm_pipe, X0$sm_cigs, X0$age)
X0 <- X0[ord,]
# pred.dat <- aggregate(x = X0, by = list(model.dat$age, model.dat$sm_cigs, model.dat$sm_pipe, 
#                     model.dat$sm_cigar, model.dat$sm_chew, model.dat$sm_snuff),
#            FUN = mean)[,-c(1:4)]
# Add observed proportions to data set
pred.dat <- cbind(X0, Phat, Nplus) 

# Function for computing predicted values and CIs
ci.pi <- function(newdata, mod.fit.obj, alpha){
 lin.pred <- coef(predict(object = mod.fit.obj, newdata = newdata, type = "link"))
 SE.lin.pred <- sqrt(diag(vcov(predict(object = mod.fit.obj, newdata = newdata, 
                                       type = "link", vcov = TRUE))))
 CI.lp.lower <- lin.pred + qt(alpha/2, mod.fit.obj$df.residual) * SE.lin.pred
 CI.lp.upper <- lin.pred + qt(1-alpha/2, mod.fit.obj$df.residual) * SE.lin.pred
 pred <- plogis(lin.pred)
 CI.pi.lower <- exp(CI.lp.lower)/(1+exp(CI.lp.lower))
 CI.pi.upper <- exp(CI.lp.upper)/(1+exp(CI.lp.upper))
 list(pred = pred, lower = CI.pi.lower, upper = CI.pi.upper)
}

# Split window into 4 frames
par(mfrow = c(2,2))
# Plot of observed and predicted prob(resp symp) for non-users

notob <- which(pred.dat$sm_cigs + pred.dat$sm_pipe + pred.dat$sm_chew == 0)

symbols(x = pred.dat$age[notob], 
    y = pred.dat$Phat[notob], 
    xlab = "Age", ylab = "Estimated probability", 
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "No tobacco use",
    circles = sqrt(pred.dat$Nplus[notob]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, 
                       sm_cigar = 0, sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
   lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "red", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "red", 
      lty = "dashed", add = TRUE)
# Plot of observed and predicted prob(resp symp) for CIG-users

cigonly <- which((1 - pred.dat$sm_cigs) + pred.dat$sm_pipe + pred.dat$sm_chew == 0)

symbols(x = pred.dat$age[cigonly], 
    y = pred.dat$Phat[cigonly], 
    xlab = "Age", ylab = "Estimated probability", 
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "Cigarettes only",
    circles = sqrt(pred.dat$Nplus[cigonly]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 1, sm_pipe = 0, 
                    sm_cigar = 0, sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
   lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 1, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "red", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 1, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "red", 
      lty = "dashed", add = TRUE)
# Plot of observed and predicted prob(resp symp) for PIPE-users
pipeonly <- which(pred.dat$sm_cigs + (1 - pred.dat$sm_pipe) + pred.dat$sm_chew == 0)

symbols(x = pred.dat$age[pipeonly], 
    y = pred.dat$Phat[pipeonly], 
    xlab = "Age", ylab = "Estimated probability", 
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "Pipe only",
    circles = sqrt(pred.dat$Nplus[pipeonly]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 1, 
                    sm_cigar = 0, sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
      lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 1, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "red", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 1, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0), 
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "red", 
      lty = "dashed", add = TRUE)
# Plot of observed and predicted prob(resp symp) for CHEW-users
chewonly <- which(pred.dat$sm_cigs + pred.dat$sm_pipe + (1 - pred.dat$sm_chew) == 0)

symbols(x = pred.dat$age[chewonly], 
    y = pred.dat$Phat[chewonly], 
    xlab = "Age", ylab = "Estimated probability", 
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "Chew only",
    circles = sqrt(pred.dat$Nplus[chewonly]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, 
                    sm_cigar = 0, sm_snuff = 0, sm_chew = 1), 
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
      lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 1), 
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "red", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 1), 
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "red", 
      lty = "dashed", add = TRUE)

# Split window into 4 frames
par(mfrow = c(2,2))
# Plot of observed and predicted prob(resp symp) for non-users

symbols(x = pred.dat$age[notob],
    y = pred.dat$Phat[notob],
    xlab = "Age", ylab = "Estimated probability",
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "No tobacco use",
    circles = sqrt(pred.dat$Nplus[notob]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0,
                       sm_cigar = 0, sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
      lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "black", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "black", 
      lty = "dashed", add = TRUE)
# Plot of observed and predicted prob(resp symp) for CIG-users

symbols(x = pred.dat$age[cigonly],
    y = pred.dat$Phat[cigonly],
    xlab = "Age", ylab = "Estimated probability",
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "Cigarettes only",
    circles = sqrt(pred.dat$Nplus[cigonly]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 1, sm_pipe = 0,
                    sm_cigar = 0, sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
      lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 1, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "black", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 1, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "black", 
      lty = "dashed", add = TRUE)
# Plot of observed and predicted prob(resp symp) for PIPE-users

symbols(x = pred.dat$age[pipeonly],
    y = pred.dat$Phat[pipeonly],
    xlab = "Age", ylab = "Estimated probability",
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "Pipe only",
    circles = sqrt(pred.dat$Nplus[pipeonly]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 1,
                    sm_cigar = 0, sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
      lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 1, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "black", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 1, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 0),
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "black", 
      lty = "dashed", add = TRUE)
# Plot of observed and predicted prob(resp symp) for CHEW-users

symbols(x = pred.dat$age[chewonly],
    y = pred.dat$Phat[chewonly],
    xlab = "Age", ylab = "Estimated probability",
    panel.first = grid(col = "gray", lty = "dotted"), ylim = c(0,1), xlim = c(10,90), 
    main = "Chew only",
    circles = sqrt(pred.dat$Nplus[chewonly]),
    inches = 0.07)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0,
                    sm_cigar = 0, sm_snuff = 0, sm_chew = 1),
          mod.fit.obj = m.final, alpha = 0.05)$pred, col = "black", 
      lty = "solid", add = TRUE, lwd = 2)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 1),
          mod.fit.obj = m.final, alpha = 0.05)$lower, col = "black", 
      lty = "dashed", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(age = x, sm_cigs = 0, sm_pipe = 0, sm_cigar = 0, 
                                        sm_snuff = 0, sm_chew = 1),
          mod.fit.obj = m.final, alpha = 0.05)$upper, col = "black", 
      lty = "dashed", add = TRUE)

Figura 6.3: Modelo final ajustado aos dados de quatro casos de uso de tabaco. A linha contínua representa o modelo ajustado, e as linhas tracejadas indicam os intervalos de confiança de 95% pontuais para a probabilidade de sintomas respiratórios em cada idade. O tamanho das bolhas reflete o peso relativo da pesquisa para cada ano. Os tamanhos das bolhas em diferentes painéis não são comparáveis.

6.4 Dados do tipo “selecione todas as opções aplicáveis”

Perguntas de pesquisas frequentemente incluem a instrução “selecione todas as opções aplicáveis” ou “escolha quaisquer opções” ao solicitar que os indivíduos façam uma escolha a partir de uma lista predefinida de opções de resposta ou itens. Os indivíduos podem selecionar qualquer quantidade desses itens em suas respostas.

Por esse motivo, as variáveis categóricas que resumem essas respostas são denominadas variáveis categóricas de resposta múltipla (MRCVs; Bilder and Loughin (2004)). Na literatura das ciências sociais, a expressão “pick any/n” (lida como “escolher quaisquer opções dentre n”) é frequentemente utilizada para descrever os dados resultantes quando há n itens na lista. Coombs (1964) foi, provavelmente, o primeiro a cunhar essa terminologia.

Permitir que os indivíduos forneçam múltiplas respostas a uma única pergunta gera correlação entre essas respostas. Por isso, a análise de dados de MRCVs é mais desafiadora do que a análise de variáveis categóricas de resposta única (SRCVs) típicas. O objetivo desta seção é demonstrar como o teste qui-quadrado de Pearson pode ser estendido a essas situações de dados e examinar como modelos de regressão podem ser utilizados para explorar relações entre MRCVs.

6.4.1 Tabela de resposta aos itens

A Tabela 6.5 resume as respostas de 279 suinocultores do Kansas, consultados em uma pesquisa sobre suas práticas de manejo de dejetos suínos (Richert et al. 1995; Bilder and Loughin 2007).

\[ \begin{array}{c|c|c|c|c}\hline & \text{Lagoa} & \text{Fosso} & \text{Drenagem natural} & \text{Tanque de retenção} \\[0.8em]\hline \text{Nitrogênio} & 27 & 16 & 2 & 2 \\ \text{Fósforo} & 22 & 12 & 1 & 1 \\ \text{Sais} & 19 & 6 & 1 & 0 \\\hline \end{array} \] Tabela 6.5: Respostas positivas conjuntas para os dados de manejo de suínos.

Uma das perguntas solicitava aos produtores que selecionassem todos os métodos de armazenamento de dejetos suínos utilizados, dentre as seguintes opções: lagoa, fosso, drenagem natural e tanque de retenção. Outra pergunta pedia que selecionassem todos os contaminantes monitorados, dentre as opções: nitrogênio, fósforo e sais. Embora o resumo dessas contagens na Tabela 6.5 se assemelhe a uma tabela de contingência comum, existem várias distinções importantes.

Primeiro, como os produtores podiam selecionar todas as respostas aplicáveis à sua situação, um mesmo produtor pode contribuir para a contagem de mais de uma célula na tabela. Segundo, as respostas negativas não estão adequadamente representadas na Tabela 6.5.

Resulta então que produtores que não utilizavam nenhum dos métodos de armazenamento listados não foram contabilizados, independentemente dos contaminantes monitorados, e vice-versa. Portanto, há informações importantes ausentes nessa representação.

Uma maneira melhor de representar esses dados é considerar tanto as respostas positivas quanto as negativas para cada item. Especificamente, seja \(W_i\) a resposta binária (1 = positiva, 0 = negativa) para o item de linha \(i\), com \(i = 1,\cdots,I\), e seja \(Y_j\) a resposta binária para o item de coluna \(j\), com \(j = 1,\cdots,J\). Por exemplo, nos dados sobre gestão de dejetos suínos, \(Y_1 = 1\) significa que um produtor utiliza uma lagoa para o armazenamento de dejetos. Assim, tabelas de contingência \(2\times 2\) podem ser formadas a partir das variáveis binárias para cada combinação de um item de linha e um item de coluna.

A Tabela 6.6 apresenta duas das \(I\times J = 12\) tabelas possíveis para o exemplo de gestão de dejetos suínos. É importante notar que cada produtor aparece em exatamente uma célula de cada uma das tabelas; portanto, as contagens em cada tabela somam 279, o número de produtores participantes da pesquisa. Além disso, observe que as contagens na Tabela 6.5 correspondem apenas às contagens de células para a combinação de respostas \(W_i = 1\) e \(Y_j = 1\) dessas 12 tabelas.

Denominamos o conjunto completo de \(I\times J\) tabelas \(2\times 2\) como a tabela de resposta aos itens dos dados. A tabela de resposta aos itens constitui o resumo sobre o qual as inferências são construídas nas duas seções seguintes.

\[ \begin{array}{ccccccccc}\hline & & \text{Lagoa} & & & & & \text{Fosso} & \\ & & 0 & 1 & & & & 0 & 1 \\[0.8em]\hline \text{Nitrogêneo} & 0 & 123 & 116 & & \text{Nitrogênio} & 0 & 175 & 64 \\ & 1 & 13 & 27 & & & 1 & 24 & 16 \\\hline \end{array} \] Tabela 6.6: Duas tabelas de contingência \(2\times 2\) para os dados de manejo de dejetos suínos.

6.4.2 Teste de independência marginal

Procedimentos para testar a independência entre duas MRCVs foram desenvolvidos em uma série de artigos por Loughin and Scherer (1998), Agresti and Liu (1999), Thomas and Decady (2004) e Bilder and Loughin (2004). Esses artigos identificaram duas complicações principais que precisam ser abordadas ao se testar a independência:

1. Primeiro, a noção habitual de independência precisa ser redefinida no contexto de uma MRCV.

2. Segundo, a construção e a determinação da distribuição de probabilidade de qualquer estatística de teste sob uma hipótese nula são complicadas pelo fato de que muitas respostas nas células da Tabela 6.5 ou da 6.6 são fornecidas pelos mesmos indivíduos.

Nenhum dos modelos de amostragem usuais é adequado para essas contagens — elas não são contagens multinomiais nem contagens de Poisson independentes —, de modo que a teoria que leva ao uso de estatísticas de Pearson e aproximações pela distribuição qui-quadrado não se aplica mais. Mostramos a seguir como essas questões podem ser superadas.

Hipóteses de independência marginal

O interesse principal em muitos problemas que envolvem questões do tipo “selecione todas as opções aplicáveis” é determinar se a probabilidade de uma resposta positiva para cada item varia em função das respostas dadas a outras questões.

Por exemplo: a probabilidade de realizar testes para um determinado contaminante depende dos métodos de armazenamento de resíduos utilizados? Em outras palavras, cada uma das doze tabelas \(2\times 2\) da tabela de respostas aos itens é consistente com uma hipótese de independência, ou pelo menos uma delas indica uma associação entre a realização de testes para um contaminante e o uso de um método de armazenamento de resíduos? Cada uma dessas tabelas \(2\times 2\) é uma tabela marginal, pois resume os dados sem levar em conta as respostas aos demais itens.

A hipótese de que a independência se verifica em cada uma dessas tabelas é, portanto, denominada independência marginal simultânea aos pares (SPMI, na sigla em inglês), termo cunhado por Agresti and Liu (1999).

Definamos \(\gamma_{ij}=P(W_i=1, \, Y=1)\) como a probabilidade conjunta aos pares para \(i = 1,\cdots,I\) e \(j = 1,\cdots,J\). Além disso, definamos \(\gamma_{i+}=P(W_i=1)\) e \(\gamma_{+j}=P(Y_j=1)\) como probabilidades marginais de uma resposta positiva aos itens correspondentes.

As hipóteses para o SPMI são então: \[ \begin{array}{ccl} H_0 & : & \gamma_{ij}=\gamma_{i+}\gamma_{+j} \qquad \text{para} \quad i=1,\cdots,I \quad \text{e} \quad j=1,\cdots,J \\ H_a & : & \gamma_{ij}\neq \gamma_{i+}\gamma_{+j} \qquad \text{para ao menos um par } (i,j)\cdot \end{array} \]

Pode-se demonstrar que \(\gamma_{ij} = \gamma_{i+}\gamma_{+j}\) implica que \[ P(W_i = \omega_i, Y_j = y_j ) = P(W_i = \omega_i)P (Y_j = y_j ) \] para todas as combinações de \(\omega_i = 0\) ou 1 e \(y_j = 0\) ou 1; é por isso que a hipótese nula pode ser formulada utilizando apenas uma célula de cada tabela \(2\times 2\).

Em vez de formular hipóteses sobre as probabilidades conjuntas aos pares \(\gamma_{ij}\), poder-se-ia examinar as probabilidades conjuntas completas \(P(W_1 = \omega_1,\cdots, W_I = \omega_I , Y_1 = y_1 ,\cdots, Y_J = y_J )\) para cada uma das \(2^{I+J}\) combinações de respostas binárias. Uma forma diferente de independência envolvendo as probabilidades conjuntas, conhecida como independência conjunta, ocorre quando a combinação de respostas a uma pergunta é independente da combinação de respostas à outra: \[ \begin{array}{l} P(W_1 = \omega_1,\cdots, W_I = \omega_I , Y_1 = y_1,\cdots, Y_J = y_J ) = \\[0.8em] \qquad \qquad \qquad \qquad \qquad \qquad = P (W_1 = \omega_1 ,\cdots, W_I = \omega_I )P (Y_1 = y_1 ,\cdots, Y_J = y_J )\cdot \end{array} \]

Pode-se demonstrar que, se a independência conjunta se verifica, então a SPMI também se verifica; no entanto, é possível que a SPMI seja verdadeira mesmo quando a independência conjunta não o é. Berry and Mielke (2003) apresentam detalhes sobre o teste de independência conjunta. Contudo, constatamos que o teste de independência conjunta tem utilidade limitada, a menos que haja interesse nas combinações específicas de respostas \(\omega_1,\cdots,\omega_I\) e \(y_1 ,\cdots , y_J\).

Estatísticas do teste

Em seguida, desenvolvemos testes para SPMI. Tratando cada tabela \(2\times 2\) separadamente, as estimativas de máxima verossimilhança das probabilidades conjuntas aos pares são \[ \widehat{\gamma}_{ij}=m_{ij}/n, \qquad \widehat{\gamma}_{i+}=m_{i+}/n \quad \text{e} \qquad \widehat{\gamma}_{+j}=m_{+j}/n \] onde \(m_{ij}\) representa o número de respostas positivas para \(W_i = 1\) e \(Y_j = 1\) e \(n\) é o tamanho da amostra.

Seja \(X^2_{S,ij}\) a estatística de Pearson usual para testar a independência dentro da \((i,j)\)-ésima tabela de contingência \(2\times 2\). Então, a soma dessas estatísticas de Pearson é uma estatística natural para usar para testar a independência simultânea em todas as tabelas.

Podemos escrever isso como \[ \tag{6.13} \begin{array}{rcl} X^2_{S} & = &\displaystyle \sum_{i=1}^I \sum_{j=1}^J X^2_{S,ij} \\[0.8em] & = & \displaystyle \sum_{i=1}^I \sum_{j=1}^J \left( \dfrac{(m_{ij}-m_{i+}m_{+j}/n)^2}{m_{i+}m_{+j}/n} +\dfrac{(m_{i+}-m_{ij}-m_{i+}(n-m_{+j})/n)^2}{m_{i+}(n-m_{+j})/n}\right. \\[0.8em] & & \displaystyle \qquad + \dfrac{(m_{+j}-m_{ij}-m_{+j(n-m_{i+})/n})^2}{m_{+j}(n-m_{i+})/n}+\\[0.8em] & & \displaystyle \qquad \qquad + \left. \dfrac{(n-m_{i+}-m_{+j}+m_{ij}-(n-m_{i+})(n-m_{+j})/n)^2}{(n-m_{i+})(n-m_{+j})/n}\right) \\[0.8em] & = & \displaystyle n\sum_{i=1}^I \sum_{j=1}^J \dfrac{(\widehat{\gamma}_{ij}-\widehat{\gamma}_{i+}\widehat{\gamma}_{+j})^2}{\widehat{\gamma}_{i+}\widehat{\gamma}_{+j}(1-\widehat{\gamma}_{i+})(1-\widehat{\gamma}_{+j})}\cdot \end{array} \]

Se a coleçao de estatísticas \(X^2_{S,ij}\) fossem independentes, então \(X^2_S\) teria uma distribuição qui-quadrado \(\chi^2_{IJ}\) para grandes amostras, e o SPMI seria rejeitado se \(X^2_S > \chi^2_{IJ,1-\alpha}\). Infelizmente, é provável que as estatísticas de teste individuais sejam correlacionadas, pois as tabelas nas quais se baseiam são apenas resumos diferentes do mesmo conjunto de respostas.

Por exemplo, cada suinocultor está representado em cada uma das tabelas de contingência \(2\times 2\) (num total de \(I\times J\) tabelas) no exemplo de dados sobre manejo de suínos. Bilder and Loughin (2004) demonstram que ignorar a correlação e realizar o teste utilizando uma distribuição \(\chi^2_{IJ}\) resulta em um teste liberal — isto é, um teste que rejeita \(H_0\) com demasiada frequência quando a SPMI é verdadeira — sempre que existe uma associação de moderada a forte entre as respostas de um mesmo indivíduo dentro de uma MRCV, por exemplo, se os suinocultores que realizam testes para um contaminante também tendem a realizar testes para outro. Métodos de teste alternativos propostos por Bilder and Loughin (2004) são descritos a seguir.

Correção de Bonferroni

Em vez de combinar as estatísticas individuais das tabelas \(2\times 2\) em uma soma, pode-se calcular um \(p\)-valor para testar a independência em cada tabela e combinar esses resultados em um único teste. A maneira mais simples de fazer isso é utilizar a correção de Bonferroni nos testes individuais.

Para cada \(X^2_{S,ij}\), calcula-se um \(p\)-valor — digamos, \(p_{ij}\) — utilizando a aproximação usual de \(\chi^2_1\)₁ ou um método exato da Seção 6.2, e rejeita-se a SPMI se qualquer \(p_{ij}\) for menor que \(\alpha/IJ\). De forma equivalente, um \(p\)-valor ajustado (Westfall and Young 1993) para o teste global da SPMI pode ser calculado como \(\widetilde{p}= IJ\times \min_{ij}(p_{ij})\), sendo \(\widetilde{p}\) truncado em 1 caso esse produto exceda 1. Assim, a SPMI é rejeitada se \(\widetilde{p}<\alpha\).

Como frequentemente ocorre com a correção de Bonferroni, o teste global da SPMI pode ser conservador — ou seja, não rejeita a hipótese com a frequência devida quando a SPMI é verdadeira — caso o número de tabelas \(2\times 2\) seja elevado.

Aproximação bootstrap

Uma segunda abordagem proposta por Bilder and Loughin (2004) envolve o bootstrap. O bootstrap é uma técnica comumente utilizada para estimar a distribuição de probabilidade de uma estatística quando sua distribuição pode ser difícil de obter matematicamente ou quando as aproximações para grandes amostras podem ser inadequadas.

Aqui, concentram-nos na aplicação do bootstrap, em vez de nos detalhes sobre por que ele funciona bem nessa situação. Leitores interessados podem consultar Davison and Hinkley (1997) para mais detalhes sobre o bootstrap.

Para implementar o bootstrap, os dados são submetidos a uma nova amostragem (resampling) selecionando-se aleatoriamente uma combinação observada de linha e resposta \((\omega_1,\cdots,\omega_I)\) e combinando-a com uma combinação de coluna e resposta escolhida independentemente \((y_1,\cdots,y_J)\).

Por exemplo, as respostas de um agricultor sobre armazenamento de resíduos podem ser combinadas aleatoriamente com as respostas de outro agricultor sobre testes de contaminantes. A repetição desse processo n vezes forma uma “nova amostra” com características muito semelhantes às da amostra original — como tamanho da amostra, proporções de respostas positivas para cada item e associações entre os itens dentro de cada MRCV — garantindo, ao mesmo tempo, que os itens dos dois MRCVs diferentes sejam independentes entre si. Um grande número de novas amostras, digamos B, é criado dessa maneira. Essa forma de independência é, na verdade, independência conjunta. Como a independência conjunta implica SPMI, a nova amostragem também é realizada sob a hipótese nula de SPMI.

Para cada nova amostra b = 1,\(\cdots\), B, calcula-se a estatística de teste, agora denotada por \(X^{2*}_{S,b}\), utilizando-se um asterisco sobrescrito para diferenciá-la do valor observado da estatística original. O \(p\)-valor do teste é a proporção de valores de \(X^{2*}_{S,b}\) maiores ou iguais ao valor observado \(X^2_S\); isto é, calcula-se (número de \(X^{2*}_{S,b}\geq X^2_S\)) / B.

Esse \(p\)-valor mede o quão extrema é a estatística de teste original em relação à distribuição da mesma estatística sob a hipótese nula. Baixos \(p\)-valores indicam evidências contra a SPMI. Bilder and Loughin (2004) demonstram que esse teste mantém o nível de significância correto; ou seja, o teste rejeita a hipótese nula no nível \(\alpha\) estabelecido quando a SPMI é verdadeira.

A nova amostragem (resampling) é muito semelhante à permutação de dados, discutida na Seção 6.2. Permutações de observações resultam de uma amostragem “sem reposição” a partir de um conjunto de dados original. Assim, as mesmas observações são mantidas, mas sua ordem é aleatorizada. Novas amostras de observações resultam de uma amostragem “com reposição” a partir de um conjunto de dados original. Dessa forma, as observações em um conjunto de dados construído por nova amostragem assumem os mesmos valores daqueles presentes nos dados originais, mas esses valores ocorrem com frequências diferentes. Algumas observações podem ocorrer múltiplas vezes, enquanto outras podem não aparecer de forma alguma em uma reamostragem de n observações.

Correções de Rao-Scott

A estatística de teste \(X^2_S\) possui uma distribuição assintótica que é uma combinação linear de variáveis aleatórias \(\chi^2_1\) independentes (Bilder and Loughin 2004), sendo desconhecidos os coeficientes dessa combinação linear. Aproximações para essa distribuição podem ser obtidas utilizando os métodos de Rao-Scott descritos na Seção 6.3.5.

Uma correção de primeira ordem ajusta a estatística \(X^2_S\) para que ela tenha a mesma média que uma variável aleatória \(\chi^2_{IJ}\). Curiosamente, Thomas and Decady (2004) e Bilder and Loughin (2004) demonstram que esse fator de ajuste é simplesmente 1. Assim, para a correção de primeira ordem, a estatística \(X^2_S\) pode ser comparada a uma distribuição \(\chi^2_{IJ}\) — o que resulta no mesmo método de teste obtido ao tratar cada \(X^2_{S,ij}\) de forma ingênua como independente. No entanto, como mencionado anteriormente, realizar o teste dessa maneira resulta em um teste liberal.

Uma correção de segunda ordem ajusta \(X^2_S\) para que tenha a mesma média e variância que uma variável aleatória qui-quadrado \(\chi^2_{IJ}\). Para \(p = 1,\cdots, IJ\), definem-se \(\lambda_p\) como os coeficientes da aproximação distribucional para grandes amostras de \(X^2_S\) descrita anteriormente. Então, a distribuição da estatística \[ X^2_{RS2} = I\times J \dfrac{X^2_S}{\displaystyle \sum_{p=1}^{IJ} \lambda^2_p} \] pode ser aproximada por uma variável aleatória \(\chi^2\) qui-quadrado com \(I^2 J^2/\big(\sum_{p=1}^{IJ} \lambda_p^2\big)\) graus de liberdade (este valor pode não ser um número inteiro).

Valores de \(X^2_{RS}\) superiores ao quantil \(1-\alpha\) dessa distribuição qui-quadrado indicam evidência contra a SPMI. Bilder and Loughin (2004) mostram que esse procedimento de teste é, em geral, bastante bom, mas pode ser um pouco conservador.

A chave para implementar a correção de segunda ordem é estimar \(\lambda_p\) para \(p = 1,\cdots, IJ\). Esses coeficientes são funções da matriz de covariância de grandes amostras para as quantidades \(\widehat{\gamma}_{ij}-\widehat{\gamma}_{i+}\widehat{\gamma}_{+j}\). Detalhes sobre o cálculo são apresentados em Thomas and Decady (2004) e Bilder and Loughin (2004). Realizamos os cálculos aqui utilizando a função MI.test() do pacote MRCV.

Exemplo 6.14: Dados sobre o manejo de dejetos suínos

Examinamos agora formalmente os dados sobre o manejo de dejetos suínos descritos inicialmente na Seção 6.4.1.

Tanto os dados quanto as funções de análise correspondentes estão contidos no pacote MRCV. No R version 4.3.3 (2024-02-29) – “Angel Food Cake” considere os seguintes passos:

1. Instale o pacote remotes (caso ainda não tenha)

install.packages("remotes")

2. Instale o MRCV especificando o arquivo do CRAN

remotes::install_version("MRCV", version = "0.3-3", repos = "https://cloud.r-project.org")

O data frame farmer2, presente no pacote, contém as combinações de respostas \[ (\omega_1, \omega_2, \omega_3, y_1, y_2, y_3, y_4) \] para cada um dos \(n = 279\) produtores, sendo que os índices dos itens correspondem à ordem apresentada na Tabela 6.5.

As primeiras 6 observações são mostradas a seguir:

library(MRCV)

# Note that the row items are given first in the data set
#  W1 = nitrogen, W2 = phosphorus, W3 = salt
#  Y1 = lagoon, Y2 = pit, Y3 = natural drainage, Y4 = holding tank

head(farmer2)

##   w1 w2 w3 y1 y2 y3 y4
## 1  0  0  0  0  0  0  0
## 2  0  0  0  0  0  0  1
## 3  0  0  0  0  0  0  1
## 4  0  0  0  0  0  0  1
## 5  0  0  0  0  0  0  1
## 6  0  0  0  0  0  0  1

Por exemplo, o segundo agricultor não realizou testes para nenhum dos três contaminantes e utilizou apenas um tanque de armazenamento. O resumo desses dados, apresentado nas Tabelas 6.5 e 6.6, é obtido utilizando-se as funções marginal.table() e item.response.table(), respectivamente:

# Certifique-se de ter os pacotes instalados
# install.packages(c("MRCV", "knitr", "kableExtra"))

library(knitr)
library(kableExtra)

# 1. Armazena o resultado da tabela marginal
resultado <- marginal.table(data = farmer2, I = 3, J = 4)

# 2. Converte para matriz para facilitar a manipulação visual
matriz_resultado <- as.matrix(resultado)

# 3. Renderiza uma tabela estilizada
kable(matriz_resultado, caption = "Tabela Marginal de Respostas Positivas Pares") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                full_width = FALSE, 
                position = "center")

Tabela Marginal de Respostas Positivas Pares

	y1		y2		y3		y4
	count	%	count	%	count	%	count	%
w1	27	9.68	16	5.73	2	0.72	2	0.72
w2	22	7.89	12	4.30	1	0.36	1	0.36
w3	19	6.81	6	2.15	1	0.36	0	0.00

# 1. Gera a tabela de resposta dos itens
irt_resultado <- item.response.table(data = farmer2, I = 3, J = 4)

# 2. Converte a estrutura interna para uma matriz comum do R
matriz_irt <- as.matrix(irt_resultado)

# 3. Renderiza a tabela formatada
kable(matriz_irt, 
      digits = 0, 
      caption = "Tabela de Contingência de Resposta dos Itens (Contagens)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "bordered"), 
                full_width = FALSE, 
                position = "center")

Tabela de Contingência de Resposta dos Itens (Contagens)

		y1		y2		y3		y4
		0	1	0	1	0	1	0	1
w1	0	123	116	175	64	156	83	228	11
	1	13	27	24	16	38	2	38	2
w2	0	128	121	181	68	165	84	237	12
	1	8	22	18	12	29	1	29	1
w3	0	134	124	184	74	174	84	245	13
	1	2	19	15	6	20	1	21	0

Para realizar a correção de Bonferroni, utilizamos a função MI.test() com o argumento type = "bon". O argumento add.constant = FALSE na função MI.test() especifica que nenhuma constante deve ser adicionada às células da tabela de resposta ao item que apresentem contagens iguais a zero, a adição de pequenas constantes pode ser útil quando há contagens zero nas células. O argumento print.status = FALSE indica que não devem ser fornecidas atualizações de progresso do bootstrap.

MI.test( data = farmer2, I = 3, J = 4, type = "bon", add.constant = FALSE, print.status = FALSE )

## Test for Simultaneous Pairwise Marginal Independence (SPMI) 
##  
## Unadjusted Pearson Chi-Square Tests for Independence: 
## X^2_S = 64.83 
## X^2_S.ij = 
##       y1   y2    y3   y4
## w1  4.93 2.93 14.29 0.01
## w2  6.56 2.11 11.68 0.13
## w3 13.98 0.00  7.08 1.11
## 
## Bonferroni Adjusted Results: 
## p.adj = 0.0019 
## p.ij.adj = 
##    y1     y2     y3     y4    
## w1 0.3163 1.0000 0.0019 1.0000
## w2 0.1253 1.0000 0.0076 1.0000
## w3 0.0022 1.0000 0.0934 1.0000

O resultado fornece \(X_S^2 = 64.83\) e os valores individuais \(X_{S,ij}\). Por exemplo, \(X_{S,13} = 14.29\) para o teste de nitrogênio e drenagem natural, sendo este o maior valor entre as tabelas \(2\times 2\). Com uma aproximação \(\chi^2_1\) para o maior valor \(X_{ij}^2\), obtém-se um \(p\)-valor ajustado por Bonferroni de \(\widetilde{p} = 0.0019\), indicando forte evidência contra a SPMI.

O resultado também fornece cada um dos \(p\)-valores para as tabelas \(2\times 2\). Esses \(p\)-valores são corrigidos por Bonferroni utilizando \(\min\{IJ\times p_{ij} , 1\}\). No nível \(\alpha = 0.05\), as combinações com associação significativa são sal e lagoa, nitrogênio e drenagem natural, e fósforo e drenagem natural.

Para a aproximação bootstrap, reamostras são extraídas dos vetores de dados observados \((\omega_1,\omega_2,\omega_3)\) e \((y_1, y_2, y_3, y_4)\) de forma independente e com reposição a partir dos dados originais; em seguida, calcula-se \(X_{S,b}^{2^*}\) para cada reamostra.

Este processo é demonstrado abaixo para uma reamostra de tamanho n = 279:

# Example of one resample (SPMI test) for illustration purposes

I <- 3
J <- 4
n <- nrow(farmer2)

# Example resample
set.seed(7812)
iW <- sample(x = 1:n, size = n, replace = TRUE)
iY <- sample(x = 1:n, size = n, replace = TRUE)

# Use resampled index values to form resample
farmer2.star <- cbind(farmer2[iW, 1:I], farmer2[iY, (I+1):(I+J)])
head(farmer2.star)  # The row numbers here are from from iW

##     w1 w2 w3 y1 y2 y3 y4
## 75   0  0  0  1  0  0  0
## 9    0  0  0  0  0  1  0
## 256  1  1  0  1  0  0  0
## 157  0  0  0  0  0  0  0
## 242  1  0  0  0  1  0  0
## 147  0  0  0  1  1  0  0

MI.stat(data = farmer2.star, I = I, J = J, add.constant = FALSE)

## $X.sq.S
## [1] 17.44788
## 
## $X.sq.S.ij
##           y1       y2        y3          y4
## w1 0.9412803 2.023367 0.4167563 0.007350586
## w2 0.5177964 2.500335 0.6728595 0.154705323
## w3 0.7953081 8.950444 0.4136119 0.054060485
## 
## $valid.margins
## [1] 12

# Marginal table
marginal.table(data = farmer2.star, I = 3, J = 4)

	y1		y2		y3		y4
	count	%	count	%	count	%	count	%
w1	13	4.66	15	5.38	8	2.87	2	0.72
w2	11	3.94	13	4.66	6	2.15	2	0.72
w3	5	1.79	10	3.58	3	1.08	1	0.36

A função MI.stat() é utilizada para calcular \(X_{S,b}^{2^*} = 1.98\). Vamo repetir esse mesmo processo de reamostragem utilizando a função MI.test(), em que type = "boot" especifica o teste bootstrap, \(B\) especifica o número de reamostragens e print.status = FALSE indica que as atualizações de progresso do bootstrap não devem ser fornecidas.

set.seed(7812)
resultado <- MI.test(data = farmer2, I = 3, J = 4, B = 5000, type = "boot", 
                       add.constant = FALSE, plot.hist = TRUE, print.status = FALSE)

Figura 6.4: Histogramas das distribuições de probabilidade estimadas sob SPMI. As linhas verticais indicam o valor da estatística observada para os dados originais.

Por último, a opção type = "rs2" especifica um ajuste de segunda ordem de Rao-Scott:

# Rao-Scott
MI.test(data = farmer2, I = 3, J = 4, type = "rs2", add.constant = FALSE)

## Test for Simultaneous Pairwise Marginal Independence (SPMI) 
##  
## Unadjusted Pearson Chi-Square Tests for Independence: 
## X^2_S = 64.83 
## X^2_S.ij = 
##       y1   y2    y3   y4
## w1  4.93 2.93 14.29 0.01
## w2  6.56 2.11 11.68 0.13
## w3 13.98 0.00  7.08 1.11
## 
## Second-Order Rao-Scott Adjusted Results: 
## X^2_S.adj = 36.62 
## df.adj = 6.78 
## p.adj < 0.0001 
## 

Outros testes de independência envolvendo MRCVs

Os procedimentos de teste discutidos nesta seção podem ser estendidos a outras situações. Por exemplo, no caso de uma MRCV e uma SRCV comum, pode-se realizar um teste de independência marginal múltipla (MMI) (veja o Exercício 5).

Suponha que a SRCV seja a variável de linha com \(I\) níveis e a MRCV seja a variável de coluna com \(J\) itens. Então, a tabela de resposta ao item consiste em \(J\) tabelas de contingência \(I\times 2\) distintas, cada uma resumindo as contagens de um item ao longo dos níveis da SRCV. De forma análoga ao \(X^2_S\), estatísticas qui-quadrado de Pearson podem ser calculadas para cada uma das \(J\) tabelas de contingência, e a soma dessas estatísticas individuais fornece uma estatística de teste global para a MMI (Agresti and Liu 1999).

As abordagens de Bonferroni, bootstrap e Rao-Scott podem ser aplicadas, e cada uma apresenta propriedades semelhantes às observadas quando utilizadas para testar a SPMI (Bilder et al. 2000). Além disso, quando existe uma terceira SRCV, também é possível realizar um teste de independência marginal múltipla condicional a essa terceira variável (Bilder and Loughin 2002).

6.4.3 Modelagem de regressão

Como demonstrado nas Seções 4.2.3 e 4.2.4, os modelos de regressão de Poisson log-lineares são úteis para descrever relações entre variáveis categóricas e para estimar a força de associações utilizando razões de chances (odds ratios).

No contexto de MRCVs, podemos adaptar esses modelos tanto para testar a SPMI quanto para descrever associações entre MRCVs quando a SPMI não se verifica.

Considere primeiramente o modelo de regressão que assume independência entre os itens \(W_i\) e \(Y_j\): \[ \tag{6.14} \log\big(\mu_{ab(ij)} \big)=\beta_{0(ij)}+\beta_{a(ij)}^W+\beta_{b(ij)}^Y, \qquad a=1,2, \quad b=1,2, \] onde \(\mu_{ab(ij)}\) é a contagem esperada para a linha \(a\) e a coluna \(b\) da tabela de contingência \(2\times 2\) \((i, j)\)-ésima, que resume as respostas conjuntas aos pares.

Esta é simplesmente a Equação (4.3) com subscritos adicionais \((i, j)\) para identificar os dois itens que estão sendo modelados. Se a Equação (6.14) for aplicada a todas as \(IJ\) tabelas \(2\times 2\), este modelo representa o SPMI. As razões de chances (odds ratios) para cada tabela \(2\times 2\) são iguais a 1 na Equação (6.14).

Alternativamente, podemos considerar modelos que permitam que as razões de chances sejam diferentes de 1. Podem ser adicionados à Equação (6.14) parâmetros que relacionam as razões de chances aos itens das linhas e colunas, de maneira muito semelhante à forma como os modelos de ANOVA de dois fatores relacionam as médias aos níveis dos fatores.

Esses modelos de regressão incluem

1. Associação homogênea: \(\log\big(\mu_{ab(ij)} \big)=\beta_{0(ij)}+\beta_{a(ij)}^W+\beta_{b(ij)}^Y+\lambda_{ab}\)

2. Efeitos principais \(W\): \(\log\big(\mu_{ab(ij)} \big)=\beta_{0(ij)}+\beta_{a(ij)}^W+\beta_{b(ij)}^Y+\lambda_{ab}+\lambda_{ab(i)}^W\)

3. Efeitos principais \(Y\): \(\log\big(\mu_{ab(ij)} \big)=\beta_{0(ij)}+\beta_{a(ij)}^W+\beta_{b(ij)}^Y+\lambda_{ab}+\lambda_{ab(j)}^Y\)

4. Efeitos principais \(W\) e \(Y\): \(\log\big(\mu_{ab(ij)}\big)=\beta_{0(ij)}+\beta_{a(ij)}^W+\beta_{b(ij)}^Y+\lambda_{ab}+\lambda_{ab(i)}^W+\lambda_{ab(j)}^Y\)

5. Modelos saturado: \(\log\big(\mu_{ab(ij)} \big)=\beta_{0(ij)}+\beta_{a(ij)}^W+\beta_{b(ij)}^Y+\lambda_{ab(ij)}^{WY}\)

Cada um desses modelos permite que as razões de chances — digamos, \(OR_{ij}\) — em cada tabela de contingência \(2\times 2\) variem de uma maneira específica. Por exemplo, o modelo de associação homogênea utiliza o parâmetro de associação \(\lambda_{ab}\), que é o mesmo para todas as tabelas \(2\times 2\). Isso resulta na igualdade de todas as razões de chances, isto é, \[ OR_{11} = \cdots = OR_{IJ}, \] embora essas razões não sejam necessariamente iguais a 1.

Além disso, o modelo de efeitos principais de \(Y\) permite que as razões de chances variem entre os níveis da variável categórica de resposta múltipla (MRCV) \(Y\), mas elas permanecem iguais entre os níveis da MRCV \(W\); ou seja, \(OR_{1j} = \cdots = OR_{Ij}\) para \(j = 1,\cdots,J\).

Por fim, o modelo saturado é essencialmente a Equação (4.4) com subscritos adicionais \((i, j)\) para identificar os dois itens que estão sendo modelados. Esse modelo não pressupõe qualquer tipo de estrutura entre as razões de chances em relação às duas MRCVs.

Os três modelos anteriores são casos particulares do modelo saturado, nos quais especificamos uma associação situada entre a independência e a dependência completa, permitindo que as razões de chances variem de forma estruturada.

Uma função de verossimilhança única baseada na distribuição de Poisson pode ser escrita para qualquer uma das tabelas \(2\times 2\). No entanto, os parâmetros para as razões de chances na maioria desses modelos aplicam-se a várias tabelas simultaneamente; portanto, necessita-se de uma função de verossimilhança capaz de modelar essas tabelas ao mesmo tempo. Uma função de verossimilhança completa abrangendo todas as tabelas \(2\times 2\) não é tão simples de formular, pois isso exigiria especificar um modelo para as associações entre todos os itens dentro de cada MRCV.

Em vez disso, Bilder and Loughin (2007) propõem o uso de uma função de pseudoverossimilhança, um conceito desenvolvido por Rao and A. J. Scott (1984) para ajustar um modelo log-linear a dados de tabelas de contingência provenientes de amostragens complexas (ver Seção 6.3.5). Esse é o mesmo princípio utilizado nos métodos de equações de estimativa generalizadas de Zeger and Liang (1986), nos quais se emprega uma matriz de correlação de trabalho baseada na hipótese de independência. Veja também a Seção 6.5.5.

Para o contexto de MRCV, Bilder and Loughin (2007) constroem uma função de pseudoverossimilhança simplesmente multiplicando entre si cada uma das \(IJ\) funções de verossimilhança de Poisson individuais. Os estimadores de parâmetros resultantes da maximização da função de pseudoverossimilhança são consistentes e apresentam distribuição aproximadamente normal em grandes amostras — assim como os estimadores de máxima verossimilhança (MLEs) —, desde que os modelos para as tabelas individuais estejam corretos. As estimativas podem ser obtidas utilizando a função glm() com o argumento family = poisson(link = "log").

Essa abordagem de ajuste de modelos apresenta algumas desvantagens. Primeiramente, é provável que os erros-padrão fornecidos pela função glm() estejam incorretos, pois a função de verossimilhança utilizada no modelo não leva em conta as correlações entre as contagens nas \(IJ\) tabelas. Felizmente, esses erros-padrão podem ser corrigidos utilizando métodos do tipo “sanduíche” (sandwich methods), semelhantes aos empregados em equações de estimação generalizadas (ver Seção 6.5.5).

A função genloglin() do pacote MRCV realiza as correções necessárias e será abordada em um exemplo a seguir. Em segundo lugar, é provável que as estimativas dos parâmetros do modelo e as respectivas razões de chances (odds ratios) apresentem precisão reduzida em comparação com o que poderia ser obtido utilizando uma verossimilhança completa. Isso é inevitável, a menos que se desenvolva e utilize com precisão um modelo mais completo para as correlações entre os itens.

Como não utilizamos uma função de verossimilhança propriamente dita, critérios de informação não podem ser empregados para escolher entre modelos. Em vez disso, utilizam-se testes de hipóteses para essas comparações de modelos. Especificamente, pode-se calcular uma estatística de Pearson para comparar dois modelos, sendo um deles aninhado no outro.

A estatística tem a forma \[ X^2_M = \sum_{a,b,i,j} \dfrac{\left(\widehat{\mu}_{ab(ij)}^{(a)}-\widehat{\mu}_{ab(ij)}^{(0)} \right)^2}{\widehat{\mu}_{ab(ij)}^{(0)}}, \] onde \(\widehat{\mu}_{ab(ij)}^{(0)}\) e \(\widehat{\mu}_{ab(ij)}^{(a)}\) são as contagens previstas pelo modelo para os modelos de hipótese nula e alternativa, respectivamente.

Mais uma vez, a distribuição de \(X^2_M\) para grandes amostras é uma combinação linear de variáveis aleatórias \(\chi^2_1\) independentes. Correções de Rao-Scott de primeira e segunda ordem podem ser calculadas para avaliar o grau de extremidade de \(X^2_M\) sob a hipótese nula.

De forma semelhante à Seção 6.4.2, a correção de primeira ordem pode levar a um teste liberal, enquanto a correção de segunda ordem pode, por vezes, ser conservadora (Bilder and Loughin 2007). Cálculos análogos podem ser aplicados a estatísticas criadas com base em uma formulação de razão de verossimilhança.

Como alternativa à correção de Rao-Scott, o método bootstrap pode ser utilizado para estimar a distribuição de \(X^2_M\). Bilder and Loughin (2007) detalham uma abordagem de reamostragem semiparamétrica para estimar essa distribuição, utilizando o algoritmo de Gange (1995) para a geração de dados binários correlacionados. Essa forma de reamostragem é necessária — em vez daquela apresentada na Seção 6.4.2 — quando as estatísticas de teste são calculadas a partir de um modelo que não assume a SPMI.

Tanto o modelo da hipótese nula quanto o da hipótese alternativa são ajustados aos conjuntos de dados reamostrados, de modo que \(X^{2^*}_{M,b}\) possa ser calculado para cada reamostra. O \(p\)-valor do teste corresponde à proporção de valores de \(X^{2^*}_{M,b}\) maiores ou iguais ao valor observado de \(X^2_M\); isto é, calcula-se \[ B^{-1}(\text{número de } X^{2^*}_{M,b} \geq X^2_M); \] \(p\)-valores baixos indicam evidências contrárias ao modelo da hipótese nula.

Uma vez encontrado um modelo adequado, calculam-se as razões de chances estimadas pelo modelo e seus respectivos intervalos de confiança para examinar as associações entre as MRCVs. Também são calculados resíduos padronizados para verificar a existência de desvios em relação ao modelo especificado. Ilustramos o cálculo da razão de chances e do resíduo padronizado no exemplo a seguir.

Exemplo 6.15: Dados sobre o manejo de dejetos suínos

Para demonstrar o funcionamento da função genloglin(), vamos resumir as respostas binárias originais das variáveis categóricas de resposta múltipla (MRCV) em contagens de tabelas \(2\times 2\) utilizando item.response.table().

Desta vez, no entanto, adicionamos o argumento create.dataframe = TRUE à função item.response.table(), de modo que as contagens da tabela \(2\times 2\) sejam apresentadas em uma única coluna.

As colunas W e Y contêm os nomes dos itens envolvidos em uma determinada tabela, e wi e yj identificam as quatro combinações 0-1 da tabela.

Abaixo, apresentam-se o código e a saída:

# Regression modeling

mod.data.format <- item.response.table(data = farmer2, I = 3, J = 4, create.dataframe = TRUE)
head(mod.data.format)

##    W  Y wi yj count
## 1 w1 y1  0  0   123
## 2 w1 y1  0  1   116
## 3 w1 y1  1  0    13
## 4 w1 y1  1  1    27
## 5 w1 y2  0  0   175
## 6 w1 y2  0  1    64

tail(mod.data.format)

##     W  Y wi yj count
## 43 w3 y3  1  0    20
## 44 w3 y3  1  1     1
## 45 w3 y4  0  0   245
## 46 w3 y4  0  1    13
## 47 w3 y4  1  0    21
## 48 w3 y4  1  1     0

Aplicamos a função genloglin() para ajustar modelos a dados neste formato. A função reformata automaticamente os dados conforme descrito acima, permitindo que utilizemos simplesmente o data frame farmer2 no argumento data.

A função genloglin() utiliza a função glm() sobre as contagens resumidas para realizar o ajuste do modelo por pseudo-verossimilhança descrito anteriormente, corrigindo os erros-padrão por meio de um estimador sanduíche da matriz de covariância.

A função genloglin() inclui duas formas de especificar um modelo. Primeiramente, o argumento model aceita os nomes "spmi", "homogeneous", "w.main", "y.main", "wy.main" ou "saturated", em que as designações "w" e "y" correspondem aos nomes atribuídos por item.response.table().

Alternativamente, o argumento model pode assumir uma formulação semelhante ao argumento formula da função glm(). A seguir, utilizamos a primeira forma de especificar o modelo para estimar o modelo de efeitos principais de \(Y\):

 # Y-main effects model
 set.seed(8922)
 mod.fit1 <- genloglin(data = farmer2, I = 3, J = 4, model = "y.main", boot = TRUE, 
                       B = 2000, print.status = FALSE)
 # Equivalently, model = count ~ -1 + W:Y + wi:W:Y + yj:W:Y + wi:yj + wi:yj:Y
 #  W:Y   - Ww1:Yy1 to Ww3:Yy4 in output, beta_0(ij) in statement of model
 #  wi:W:Y - Ww1:Yy1:wi to Ww3:Yy4:wi in output, beta_a(ij) in statement of model
 #  yj:W:Y - Ww1:Yy1:yj to Ww3:Yy4:yj in output, beta_b(ij) in statement of model
 #  wi:yj  - wi:yj in output, lambda_ab in statement of model
 #  wi:yj:Y - Yy1:wi:yj to Yy4:wi:yj in output, lambda^Y_ab(ij) in statement of model
 # Also, equivalently, model = count ~ -1 + W:Y + wi%in%W:Y + yj%in%W:Y + wi:yj + wi:yj%in%Y
 #  This format helps to emphasize that a loglinear model under independence is essentially
 #  being fit to each 2x2 table due to the nested effects given. Then additional terms are
 #  added to the model to allow for OR_ij to not be equal to 1 and vary across the 2x2 tables.
 # Turn off buffered output (MISC > BUFFERED OUTPUT) if you would like to see the printed progress through
 #  the iterative proportional fitting algorithm.
 summary(mod.fit1)

## 
## Call:
## glm(formula = count ~ -1 + W:Y + wi %in% W:Y + yj %in% W:Y + 
##     wi:yj + wi:yj %in% Y, family = poisson(link = log), data = model.data)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.58007  -0.13272   0.00043   0.10282   0.79587  
## 
## Coefficients:
##            Estimate    RS SE z value Pr(>|z|)    
## Ww1:Yy1     4.83360  0.06535  73.969  < 2e-16 ***
## Ww2:Yy1     4.85571  0.06387  76.023  < 2e-16 ***
## Ww3:Yy1     4.87418  0.06314  77.199  < 2e-16 ***
## Ww1:Yy2     5.15802  0.04696 109.838  < 2e-16 ***
## Ww2:Yy2     5.19427  0.04411 117.750  < 2e-16 ***
## Ww3:Yy2     5.22544  0.04130 126.535  < 2e-16 ***
## Ww1:Yy3     5.04874  0.05335  94.641  < 2e-16 ***
## Ww2:Yy3     5.10777  0.04944 103.316  < 2e-16 ***
## Ww3:Yy3     5.15832  0.04644 111.083  < 2e-16 ***
## Ww1:Yy4     5.42726  0.02879 188.505  < 2e-16 ***
## Ww2:Yy4     5.46863  0.02517 217.282  < 2e-16 ***
## Ww3:Yy4     5.50264  0.02174 253.070  < 2e-16 ***
## wi:yj       1.15732  0.36998   3.128  0.00176 ** 
## Ww1:Yy1:wi -2.49781  0.31878  -7.835 4.66e-15 ***
## Ww2:Yy1:wi -2.83697  0.32435  -8.747  < 2e-16 ***
## Ww3:Yy1:wi -3.23836  0.29518 -10.971  < 2e-16 ***
## Ww1:Yy2:wi -1.93200  0.21221  -9.104  < 2e-16 ***
## Ww2:Yy2:wi -2.26237  0.23196  -9.753  < 2e-16 ***
## Ww3:Yy2:wi -2.65609  0.27727  -9.579  < 2e-16 ***
## Ww1:Yy3:wi -1.40657  0.18071  -7.784 7.11e-15 ***
## Ww2:Yy3:wi -1.75094  0.20186  -8.674  < 2e-16 ***
## Ww3:Yy3:wi -2.15624  0.23187  -9.299  < 2e-16 ***
## Ww1:Yy4:wi -1.77728  0.17390 -10.220  < 2e-16 ***
## Ww2:Yy4:wi -2.10603  0.19721 -10.679  < 2e-16 ***
## Ww3:Yy4:wi -2.47437  0.22939 -10.787  < 2e-16 ***
## Ww1:Yy1:yj -0.10323  0.13018  -0.793  0.42780    
## Ww2:Yy1:yj -0.06382  0.12579  -0.507  0.61193    
## Ww3:Yy1:yj -0.02894  0.12225  -0.237  0.81288    
## Ww1:Yy2:yj -0.98088  0.14513  -6.759 1.39e-11 ***
## Ww2:Yy2:yj -0.96360  0.13981  -6.892 5.49e-12 ***
## Ww3:Yy2:yj -0.94798  0.13645  -6.947 3.72e-12 ***
## Ww1:Yy3:yj -0.62780  0.13610  -4.613 3.97e-06 ***
## Ww2:Yy3:yj -0.68056  0.13375  -5.088 3.61e-07 ***
## Ww3:Yy3:yj -0.72599  0.13239  -5.484 4.16e-08 ***
## Ww1:Yy4:yj -2.98716  0.29995  -9.959  < 2e-16 ***
## Ww2:Yy4:yj -2.99510  0.29381 -10.194  < 2e-16 ***
## Ww3:Yy4:yj -2.96408  0.27975 -10.595  < 2e-16 ***
## Yy2:wi:yj  -0.70644  0.63025  -1.121  0.26233    
## Yy3:wi:yj  -3.56978  0.88623  -4.028 5.62e-05 ***
## Yy4:wi:yj  -1.39762  0.85852  -1.628  0.10354    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##         Null deviance: 25401.0663    Residual deviance:     5.8825
##         Number of Fisher Scoring iterations: 4

A saída começa com a chamada propriamente dita à função glm(). A sintaxe do modelo fornecida no argumento formula mostra a forma alternativa pela qual o modelo de efeitos principais de \(Y\) poderia ter sido especificado, em que os nomes das variáveis derivam do data frame criado pela função item.response.table().

Essa sintaxe utiliza efeitos aninhados para especificar, primeiramente, um modelo log-linear de independência para cada tabela \(2\times 2\), utilizando o trecho W:Y + wi%in%W:Y + yj%in%W:Y do código. Isso garante que as contagens marginais de cada tabela \(2\times 2\) coincidam entre os dados e o modelo, condição tipicamente exigida na modelagem log-linear de associações.

A sintaxe wi:yj + wi:yj%in%Y permite, então, que a associação dentro de cada tabela \(2\times 2\) varie da maneira especificada ao longo de toda a tabela de respostas do item. Como exemplo adicional dessa sintaxe, o modelo saturado pode ser especificado utilizando model = count ~ -1 + W:Y + wi%in%W:Y + yj%in%W:Y + wi:yj%in%W:Y na função genloglin(). Essa formulação amplia ainda mais o uso de efeitos aninhados, essencialmente estimando a Equação (4.4) para cada tabela \(2\times 2\).

Prosseguindo com a análise da saída, podemos relacionar os parâmetros estimados à especificação do modelo. Por exemplo, W:Y no argumento formula da função glm() corresponde aos termos de intercepto \(\beta_{0(ij)}\), listados na saída como Ww1:Yy1 a Ww3:Yy4.

Além disso, wi:yj%in%Y corresponde aos termos de efeito principal de \(Y\), \(\lambda_{ab(j)}^Y\), listados na saída como Yy2:wi:yj a Yy4:wi:yj; o termo Yy1:wi:yj não é estimado porque \(\lambda_{ab(1)}^Y\) é fixado em 0.

A seguir, verificamos o ajuste do modelo de efeitos principais de \(Y\) comparando-o ao modelo saturado, para determinar se a estrutura de associação mais simples é adequada. Como o argumento boot da função genloglin() foi definido anteriormente como TRUE (o valor padrão), podemos estimar a distribuição de \(X^2_M\) utilizando bootstrap.

Ao especificar type = "all" na função do método anova() abaixo, podemos visualizar os resultados tanto da abordagem de bootstrap quanto da abordagem de Rao-Scott de segunda ordem. Utilizamos em diversas funções a opção print.status = FALSE (por padrão TRUE) para suprimir a exibição de mensagens no console informando o avanço das reamostragens (resamples) do Bootstrap. Definir esse argumento como falso (FALSE) remove completamente essas notificações textuais sem alterar o cálculo estatístico ou os resultados gerados

# Model comparison tests
comp1 <- anova(object = mod.fit1, model.HA = "saturated", type = "all")
comp1

## 
## Model comparison statistics for 
## H0 = y.main 
## HA = saturated 
##  
## Pearson chi-square statistic = 5.34 
## LRT statistic = 5.88 
## 
## Second-Order Rao-Scott Adjusted Results: 
## Rao-Scott Pearson chi-square statistic = 10.85, df = 5.23, p = 0.0624 
## Rao-Scott LRT statistic = 11.96, df = 5.23, p = 0.0409 
## 
## Bootstrap Results: 
## Final results based on 2000 resamples 
## Pearson chi-square p-value = 0.031 
## LRT p-value = 0.017

# Compare Y-main effects model to W and Y-main effects model
comp2 <- anova(object = mod.fit1, model.HA = "wy.main", type = "all", print.status = FALSE)
comp2

## 
## Model comparison statistics for 
## H0 = y.main 
## HA = wy.main 
##  
## Pearson chi-square statistic = 0.14 
## LRT statistic = 0.14 
## 
## Second-Order Rao-Scott Adjusted Results: 
## Rao-Scott Pearson chi-square statistic = 0.28, df = 5.23, p = 0.9986 
## Rao-Scott LRT statistic = 0.28, df = 5.23, p = 0.9986 
## 
## Bootstrap Results: 
## Final results based on 2000 resamples 
## Pearson chi-square p-value = 0.517 
## LRT p-value = 0.5175 
## 
## -------------------------------------------------------------------------------------
##  
## Goodness of fit statistics for 
## H0 = y.main 
##  
## Pearson chi-square GOF statistic = 5.34 
## LRT GOF statistic = 5.88 
## 
## Second-Order Rao-Scott Adjusted Results: 
## Rao-Scott Pearson chi-square GOF statistic = 10.85, df = 5.23, p = 0.0624 
## Rao-Scott LRT GOF statistic = 11.96, df = 5.23, p = 0.0409 
## 
## Bootstrap Results: 
## Pearson chi-square GOF p-value = 0.031 
## LRT GOF p-value = 0.017

A partir da saída, tem-se \(X^2_M = 5.34\) e o \(p\)-valor correspondente é 0.031 utilizando a abordagem bootstrap. O \(p\)-valor utilizando a abordagem de Rao-Scott de segunda ordem é 0.0624. Ambos os \(p\)-valores indicam a existência de evidência marginal de problemas de ajuste no modelo mais simples de efeitos principais de \(Y\).

As razões de chances observadas e as razões de chances previstas pelo modelo para cada combinação \((W_i , Y_j )\) são obtidas utilizando a função predict():

 # Model estimated odds ratios
 options(width = 60)  # Helps with book formatting
 OR.mod <- predict(object = mod.fit1, alpha = 0.05, print.status = FALSE)
 OR.mod

## Observed odds ratios with 95% asymptotic confidence intervals 
##    y1                  y2                y3               
## w1 2.2 (1.08, 4.47)    1.82 (0.91, 3.65) 0.1 (0.02, 0.42) 
## w2 2.91 (1.25, 6.78)   1.77 (0.81, 3.88) 0.07 (0.01, 0.51)
## w3 10.27 (2.34, 44.98) 0.99 (0.37, 2.66) 0.1 (0.01, 0.78) 
##    y4               
## w1 1.09 (0.23, 5.12)
## w2 0.68 (0.09, 5.43)
## w3 0.45 (0.03, 7.83)
## 
## Model-predicted odds ratios with 95% asymptotic confidence intervals 
##    y1                y2                y3               
## w1 3.18 (1.54, 6.57) 1.57 (0.78, 3.18) 0.09 (0.02, 0.44)
## w2 3.18 (1.54, 6.57) 1.57 (0.78, 3.18) 0.09 (0.02, 0.44)
## w3 3.18 (1.54, 6.57) 1.57 (0.78, 3.18) 0.09 (0.02, 0.44)
##    y4               
## w1 0.79 (0.21, 2.98)
## w2 0.79 (0.21, 2.98)
## w3 0.79 (0.21, 2.98)
## 
## Bootstrap Results: 
## Final results based on 2000 resamples 
## Model-predicted odds ratios with 95% bootstrap BCa confidence intervals 
##    y1               y2                y3               
## w1 3.18 (1.53, 7.3) 1.57 (0.72, 3.16) 0.09 (0.03, 0.33)
## w2 3.18 (1.53, 7.3) 1.57 (0.72, 3.16) 0.09 (0.03, 0.33)
## w3 3.18 (1.53, 7.3) 1.57 (0.72, 3.16) 0.09 (0.03, 0.33)
##    y4              
## w1 0.79 (0.27, 3.5)
## w2 0.79 (0.27, 3.5)
## w3 0.79 (0.27, 3.5)

A primeira tabela apresenta as razões de chances observadas e os intervalos de confiança associados, utilizando a Equação (1.9). A segunda e a terceira tabelas apresentam as razões de chances previstas pelo modelo e os intervalos de confiança correspondentes. Esses valores são iguais em cada coluna, pois não são estimados efeitos de W no modelo de efeitos principais de Y.

Na segunda tabela, o intervalo de confiança é um intervalo de Wald, utilizando estimativas da razão de chances e da variância baseadas no modelo. A última tabela utiliza intervalos baseados em bootstrap, calculados pelo método \(\mbox{BC}_a\); consulte Davison and Hinkley (1997) para detalhes sobre o cálculo desse tipo de intervalo.

O método de intervalo de confiança bootstrap \(\mbox{BC}_a\) é um dos dois métodos baseados em bootstrap recomendados para a prática geral. Os limites inferior e superior desse intervalo correspondem a quantis específicos, calculados a partir das \(B\) estatísticas obtidas nos conjuntos de dados reamostrados.

Em vez de utilizar os quantis \(\alpha/2\) e \(1-\alpha/2\), determinam-se quantis ajustados que levam em consideração possíveis vieses e a instabilidade da variância da estatística em estudo.

O ajuste do modelo em cada tabela \(2\times 2\) é avaliado por meio dos resíduos padronizados de Pearson, obtidos utilizando a função residuals(). Tanto as variâncias baseadas no modelo (para grandes amostras) quanto as estimadas por bootstrap são utilizadas em seu cálculo:

# Standardized residuals
options(width = 55)  # Helps with book formatting
resid.mod <- residuals(object = mod.fit1)
resid.mod$std.pearson.res.asymp.var

		y1		y2		y3		y4
W		1	0	1	0	1	0	1	0
w1	1	-2.41	2.41	1.04	-1.04	0.28	-0.28	0.83	-0.83
	0	2.41	-2.41	-1.04	1.04	-0.28	0.28	-0.83	0.83
w2	1	-0.53	0.53	0.92	-0.92	-0.94	0.94	-0.29	0.29
	0	0.53	-0.53	-0.92	0.92	0.94	-0.94	0.29	-0.29
w3	1	2.93	-2.93	-1.70	1.70	0.32	-0.32	-0.63	0.63
	0	-2.93	2.93	1.70	-1.70	-0.32	0.32	0.63	-0.63

resid.mod$std.pearson.res.boot.var

		y1		y2		y3		y4
W		1	0	1	0	1	0	1	0
w1	1	-2.39	2.39	1.03	-1.03	0.31	-0.31	1.13	-1.13
	0	2.39	-2.39	-1.03	1.03	-0.31	0.31	-1.13	1.13
w2	1	-0.59	0.59	0.91	-0.91	-0.67	0.67	-0.44	0.44
	0	0.59	-0.59	-0.91	0.91	0.67	-0.67	0.44	-0.44
w3	1	2.83	-2.83	-1.73	1.73	0.24	-0.24	-0.87	0.87
	0	-2.83	2.83	1.73	-1.73	-0.24	0.24	0.87	-0.87

# Other ways to specify the same model
mod.fit2 <- genloglin(data = farmer2, I = 3, J = 4, 
        model = count ~ -1 + W:Y + wi:W:Y + yj:W:Y + wi:yj + wi:yj:Y, boot = FALSE)
# summary(mod.fit2)  # Same as summary(mod.fit1)
mod.fit3 <- genloglin(data = farmer2, I = 3, J = 4, 
        model = count ~ -1 + W:Y + wi%in%W:Y + yj%in%W:Y + wi:yj + wi:yj%in%Y, boot = FALSE)
# summary(mod.fit3)  # Same as summary(mod.fit1)

Com base nas diretrizes padrão (ver Seção 5.2.1), todos os resíduos padronizados são razoavelmente pequenos (inferiores a 2 em valor absoluto), exceto os referentes a \((W_1 , Y_1 )\) e \((W_3 , Y_1 )\), o que nos leva a uma conclusão sobre o ajuste global semelhante àquela obtida com o uso de \(X_M^2\).

Esses resíduos indicam, especificamente, que as associações entre contaminantes para o método de armazenamento de resíduos em lagoa não parecem ser tão homogêneas quanto as observadas nos demais métodos de armazenamento. Isso sugere que um novo modelo, que leve em conta essa heterogeneidade, poderia apresentar um ajuste potencialmente melhor. Construímos esse modelo adicionando um termo extra que força um ajuste perfeito às contagens na tabela de combinação \((W_3 , Y_1 )\).

 # Final model
 options(width = 80)
 set.seed(9912)
 mod.fit.final <- genloglin(data = farmer2, I = 3, J = 4, 
      model = count ~ -1 + W:Y + wi%in%W:Y + yj%in%W:Y + wi:yj + wi:yj%in%Y + wi:yj%in%W3:Y1, 
      boot = TRUE, B = 2000, print.status = FALSE)
 summary(mod.fit.final)  # Excluded to save space

## 
## Call:
## "glm(formula = count ~ -1 + W:Y + wi %in% W:Y + yj %in% W:Y + wi:yj + wi:yj %in% Y + wi:yj %in% W3:Y1 , family = poisson(link = log), data = model.data)"
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -0.72074  -0.08337   0.00000   0.07956   0.52505  
## 
## Coefficients:
##             Estimate    RS SE z value Pr(>|z|)    
## Ww1:Yy1      4.81937  0.06681  72.136  < 2e-16 ***
## Ww2:Yy1      4.84508  0.06488  74.674  < 2e-16 ***
## Ww3:Yy1      4.89784  0.06228  78.646  < 2e-16 ***
## Ww1:Yy2      5.15802  0.04696 109.838  < 2e-16 ***
## Ww2:Yy2      5.19427  0.04411 117.750  < 2e-16 ***
## Ww3:Yy2      5.22544  0.04130 126.535  < 2e-16 ***
## Ww1:Yy3      5.04874  0.05335  94.641  < 2e-16 ***
## Ww2:Yy3      5.10777  0.04944 103.316  < 2e-16 ***
## Ww3:Yy3      5.15832  0.04644 111.083  < 2e-16 ***
## Ww1:Yy4      5.42726  0.02879 188.505  < 2e-16 ***
## Ww2:Yy4      5.46863  0.02517 217.282  < 2e-16 ***
## Ww3:Yy4      5.50264  0.02174 253.070  < 2e-16 ***
## wi:yj        0.90731  0.36813   2.465 0.013715 *  
## Ww1:Yy1:wi  -2.32507  0.30307  -7.672 1.69e-14 ***
## Ww2:Yy1:wi  -2.66051  0.30915  -8.606  < 2e-16 ***
## Ww3:Yy1:wi  -4.20469  0.71236  -5.902 3.58e-09 ***
## Ww1:Yy2:wi  -1.93200  0.21221  -9.104  < 2e-16 ***
## Ww2:Yy2:wi  -2.26237  0.23196  -9.753  < 2e-16 ***
## Ww3:Yy2:wi  -2.65609  0.27727  -9.579  < 2e-16 ***
## Ww1:Yy3:wi  -1.40657  0.18071  -7.784 7.11e-15 ***
## Ww2:Yy3:wi  -1.75094  0.20186  -8.674  < 2e-16 ***
## Ww3:Yy3:wi  -2.15624  0.23187  -9.299  < 2e-16 ***
## Ww1:Yy4:wi  -1.77728  0.17390 -10.220  < 2e-16 ***
## Ww2:Yy4:wi  -2.10603  0.19721 -10.679  < 2e-16 ***
## Ww3:Yy4:wi  -2.47437  0.22939 -10.787  < 2e-16 ***
## Ww1:Yy1:yj  -0.07345  0.12974  -0.566 0.571289    
## Ww2:Yy1:yj  -0.04198  0.12537  -0.335 0.737710    
## Ww3:Yy1:yj  -0.07756  0.12461  -0.622 0.533668    
## Ww1:Yy2:yj  -0.98088  0.14513  -6.759 1.39e-11 ***
## Ww2:Yy2:yj  -0.96360  0.13981  -6.892 5.49e-12 ***
## Ww3:Yy2:yj  -0.94798  0.13645  -6.947 3.72e-12 ***
## Ww1:Yy3:yj  -0.62780  0.13610  -4.613 3.97e-06 ***
## Ww2:Yy3:yj  -0.68056  0.13375  -5.088 3.61e-07 ***
## Ww3:Yy3:yj  -0.72599  0.13239  -5.484 4.16e-08 ***
## Ww1:Yy4:yj  -2.98716  0.29995  -9.959  < 2e-16 ***
## Ww2:Yy4:yj  -2.99510  0.29381 -10.194  < 2e-16 ***
## Ww3:Yy4:yj  -2.96408  0.27975 -10.595  < 2e-16 ***
## Yy2:wi:yj   -0.45643  0.62272  -0.733 0.463577    
## Yy3:wi:yj   -3.31978  0.89027  -3.729 0.000192 ***
## Yy4:wi:yj   -1.14761  0.86694  -1.324 0.185586    
## wi:yj:W3:Y1  1.42154  0.65375   2.174 0.029672 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##         Null deviance: 25401.0663    Residual deviance:     1.8567
##         Number of Fisher Scoring iterations: 4

 comp.final1 <- anova(object = mod.fit.final, model.HA = "saturated", type = "all")
 comp.final1

## 
## Model comparison statistics for 
## H0 = count ~ -1 + W:Y + wi %in% W:Y + yj %in% W:Y + wi:yj + wi:yj %in% Y + wi:yj %in% W3:Y1 
## HA = saturated 
##  
## Pearson chi-square statistic = 1.81 
## LRT statistic = 1.86 
## 
## Second-Order Rao-Scott Adjusted Results: 
## Rao-Scott Pearson chi-square statistic = 4.29, df = 5.07, p = 0.5178 
## Rao-Scott LRT statistic = 4.4, df = 5.07, p = 0.503 
## 
## Bootstrap Results: 
## Final results based on 2000 resamples 
## Pearson chi-square p-value = 0.404 
## LRT p-value = 0.388

 options(width = 55)  # Helps with book formatting
 resid.mod.final <- residuals(object = mod.fit.final)
 resid.mod.final$std.pearson.res.asymp.var

		y1		y2		y3		y4
W		1	0	1	0	1	0	1	0
w1	1	-1.08	1.08	1.04	-1.04	0.28	-0.28	0.83	-0.83
	0	1.08	-1.08	-1.04	1.04	-0.28	0.28	-0.83	0.83
w2	1	1.08	-1.08	0.92	-0.92	-0.94	0.94	-0.29	0.29
	0	-1.08	1.08	-0.92	0.92	0.94	-0.94	0.29	-0.29
w3	1	0.00	0.00	-1.70	1.70	0.32	-0.32	-0.63	0.63
	0	0.00	0.00	1.70	-1.70	-0.32	0.32	0.63	-0.63

 resid.mod.final$std.pearson.res.boot.var

		y1		y2		y3		y4
W		1	0	1	0	1	0	1	0
w1	1	-1.07	1.07	0.98	-0.98	0.30	-0.30	1.11	-1.11
	0	1.07	-1.07	-0.98	0.98	-0.30	0.30	-1.11	1.11
w2	1	1.07	-1.07	0.93	-0.93	-0.65	0.65	-0.41	0.41
	0	-1.07	1.07	-0.93	0.93	0.65	-0.65	0.41	-0.41
w3	1	0.00	0.00	-1.66	1.66	0.23	-0.23	-0.81	0.81
	0	0.00	0.00	1.66	-1.66	-0.23	0.23	0.81	-0.81

 OR.mod.final <- predict(mod.fit.final, alpha = 0.05, print.status = FALSE)
 OR.mod.final

## Observed odds ratios with 95% asymptotic confidence intervals 
##    y1                  y2               
## w1 2.2 (1.08, 4.47)    1.82 (0.91, 3.65)
## w2 2.91 (1.25, 6.78)   1.77 (0.81, 3.88)
## w3 10.27 (2.34, 44.98) 0.99 (0.37, 2.66)
##    y3                y4               
## w1 0.1 (0.02, 0.42)  1.09 (0.23, 5.12)
## w2 0.07 (0.01, 0.51) 0.68 (0.09, 5.43)
## w3 0.1 (0.01, 0.78)  0.45 (0.03, 7.83)
## 
## Model-predicted odds ratios with 95% asymptotic confidence intervals 
##    y1                  y2               
## w1 2.48 (1.2, 5.1)     1.57 (0.78, 3.18)
## w2 2.48 (1.2, 5.1)     1.57 (0.78, 3.18)
## w3 10.27 (2.34, 44.98) 1.57 (0.78, 3.18)
##    y3                y4               
## w1 0.09 (0.02, 0.44) 0.79 (0.21, 2.98)
## w2 0.09 (0.02, 0.44) 0.79 (0.21, 2.98)
## w3 0.09 (0.02, 0.44) 0.79 (0.21, 2.98)
## 
## Bootstrap Results: 
## Final results based on 2000 resamples 
## Model-predicted odds ratios with 95% bootstrap BCa confidence intervals 
##    y1                 y2               
## w1 2.48 (1.17, 5.42)  1.57 (0.73, 3.09)
## w2 2.48 (1.17, 5.42)  1.57 (0.73, 3.09)
## w3 10.27 (1.9, 41.02) 1.57 (0.73, 3.09)
##    y3                y4               
## w1 0.09 (0.04, 0.39) 0.79 (0.27, 3.61)
## w2 0.09 (0.04, 0.39) 0.79 (0.27, 3.61)
## w3 0.09 (0.04, 0.39) 0.79 (0.27, 3.61)

 # Example of a saturated model specification - notice the tested format allows
 #  for a different interaction within each 2x2 table.
 mod.fit.sat <- genloglin(data = farmer2, I = 3, J = 4,
  model = count ~ -1 + W:Y + wi%in%W:Y + yj%in%W:Y + wi:yj%in%W:Y, boot = FALSE, B = 2000)
 summary(mod.fit.sat)

## 
## Call:
## "glm(formula = count ~ -1 + W:Y + wi %in% W:Y + yj %in% W:Y + wi:yj %in% W:Y , family = poisson(link = log), data = model.data)"
## 
## Deviance Residuals: 
##  [1]  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
## [18]  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0  0
## [35]  0  0  0  0  0  0  0  0  0  0  0  0  0  0
## 
## Coefficients:
##               Estimate    RS SE z value Pr(>|z|)    
## Ww1:Yy1        4.81218  0.06742  71.373  < 2e-16 ***
## Ww2:Yy1        4.85203  0.06502  74.618  < 2e-16 ***
## Ww3:Yy1        4.89784  0.06228  78.646  < 2e-16 ***
## Ww1:Yy2        5.16479  0.04615 111.907  < 2e-16 ***
## Ww2:Yy2        5.19850  0.04405 118.007  < 2e-16 ***
## Ww3:Yy2        5.21494  0.04302 121.227  < 2e-16 ***
## Ww1:Yy3        5.04986  0.05316  94.993  < 2e-16 ***
## Ww2:Yy3        5.10595  0.04976 102.605  < 2e-16 ***
## Ww3:Yy3        5.15906  0.04651 110.931  < 2e-16 ***
## Ww1:Yy4        5.42935  0.02831 191.748  < 2e-16 ***
## Ww2:Yy4        5.46806  0.02520 216.963  < 2e-16 ***
## Ww3:Yy4        5.50126  0.02230 246.665  < 2e-16 ***
## Ww1:Yy1:wi    -2.24723  0.29164  -7.706 1.31e-14 ***
## Ww2:Yy1:wi    -2.77259  0.36443  -7.608 2.78e-14 ***
## Ww3:Yy1:wi    -4.20469  0.71236  -5.902 3.58e-09 ***
## Ww1:Yy2:wi    -1.98673  0.21767  -9.127  < 2e-16 ***
## Ww2:Yy2:wi    -2.30812  0.24715  -9.339  < 2e-16 ***
## Ww3:Yy2:wi    -2.50689  0.26852  -9.336  < 2e-16 ***
## Ww1:Yy3:wi    -1.41227  0.18090  -7.807 5.77e-15 ***
## Ww2:Yy3:wi    -1.73865  0.20135  -8.635  < 2e-16 ***
## Ww3:Yy3:wi    -2.16332  0.23611  -9.162  < 2e-16 ***
## Ww1:Yy4:wi    -1.79176  0.17522 -10.226  < 2e-16 ***
## Ww2:Yy4:wi    -2.10076  0.19673 -10.678  < 2e-16 ***
## Ww3:Yy4:wi    -2.45674  0.22738 -10.805  < 2e-16 ***
## Ww1:Yy1:yj    -0.05859  0.12943  -0.453  0.65074    
## Ww2:Yy1:yj    -0.05624  0.12679  -0.444  0.65737    
## Ww3:Yy1:yj    -0.07756  0.12461  -0.622  0.53367    
## Ww1:Yy2:yj    -1.00590  0.14608  -6.886 5.74e-12 ***
## Ww2:Yy2:yj    -0.97899  0.14224  -6.883 5.86e-12 ***
## Ww3:Yy2:yj    -0.91087  0.13765  -6.617 3.66e-11 ***
## Ww1:Yy3:yj    -0.63101  0.13586  -4.645 3.41e-06 ***
## Ww2:Yy3:yj    -0.67513  0.13403  -5.037 4.73e-07 ***
## Ww3:Yy3:yj    -0.72824  0.13286  -5.481 4.22e-08 ***
## Ww1:Yy4:yj    -3.03145  0.30870  -9.820  < 2e-16 ***
## Ww2:Yy4:yj    -2.98315  0.29589 -10.082  < 2e-16 ***
## Ww3:Yy4:yj    -2.93631  0.28461 -10.317  < 2e-16 ***
## Ww1:Yy1:wi:yj  0.78948  0.36154   2.184  0.02899 *  
## Ww2:Yy1:wi:yj  1.06784  0.43189   2.472  0.01342 *  
## Ww3:Yy1:wi:yj  2.32885  0.75376   3.090  0.00200 ** 
## Ww1:Yy2:wi:yj  0.60044  0.35427   1.695  0.09010 .  
## Ww2:Yy2:wi:yj  0.57352  0.39890   1.438  0.15050    
## Ww3:Yy2:wi:yj -0.00542  0.50228  -0.011  0.99139    
## Ww1:Yy3:wi:yj -2.31342  0.73809  -3.134  0.00172 ** 
## Ww2:Yy3:wi:yj -2.69217  1.02589  -2.624  0.00868 ** 
## Ww3:Yy3:wi:yj -2.26749  1.03327  -2.194  0.02820 *  
## Ww1:Yy4:wi:yj  0.08701  0.78842   0.110  0.91212    
## Ww2:Yy4:wi:yj -0.38414  1.05926  -0.363  0.71687    
## Ww3:Yy4:wi:yj -0.80136  0.35361  -2.266  0.02344 *  
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##         Null deviance: 2.5401e+04    Residual deviance: 1.4899e-13
##         Number of Fisher Scoring iterations: 4

#####################################################################
# This shows what happens when variable names are different from w1, w2, w3, y1, y2, y3, y4
#  Everything still works, but "W" and "Y" are still used as the MRCV names

 farmer2.temp <- farmer2
 names(farmer2.temp) <- c("a1", "a2", "a3", "b1", "b2", "b3", "b4")
 head(farmer2.temp)

##   a1 a2 a3 b1 b2 b3 b4
## 1  0  0  0  0  0  0  0
## 2  0  0  0  0  0  0  1
## 3  0  0  0  0  0  0  1
## 4  0  0  0  0  0  0  1
## 5  0  0  0  0  0  0  1
## 6  0  0  0  0  0  0  1

 set1 <- item.response.table(data = farmer2.temp, I = 3, J = 4, create.dataframe = TRUE)
 head(set1)

##    W  Y wi yj count
## 1 a1 b1  0  0   123
## 2 a1 b1  0  1   116
## 3 a1 b1  1  0    13
## 4 a1 b1  1  1    27
## 5 a1 b2  0  0   175
## 6 a1 b2  0  1    64

 tail(set1)

##     W  Y wi yj count
## 43 a3 b3  1  0    20
## 44 a3 b3  1  1     1
## 45 a3 b4  0  0   245
## 46 a3 b4  0  1    13
## 47 a3 b4  1  0    21
## 48 a3 b4  1  1     0

 mod.fit.temp <- genloglin(data = farmer2.temp, I = 3, J = 4, model = "y.main", boot = FALSE)
 summary(mod.fit.temp)

## 
## Call:
## glm(formula = count ~ -1 + W:Y + wi %in% W:Y + yj %in% W:Y + 
##     wi:yj + wi:yj %in% Y, family = poisson(link = log), data = model.data)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.58007  -0.13272   0.00043   0.10282   0.79587  
## 
## Coefficients:
##            Estimate    RS SE z value Pr(>|z|)    
## Wa1:Yb1     4.83360  0.06535  73.969  < 2e-16 ***
## Wa2:Yb1     4.85571  0.06387  76.023  < 2e-16 ***
## Wa3:Yb1     4.87418  0.06314  77.199  < 2e-16 ***
## Wa1:Yb2     5.15802  0.04696 109.838  < 2e-16 ***
## Wa2:Yb2     5.19427  0.04411 117.750  < 2e-16 ***
## Wa3:Yb2     5.22544  0.04130 126.535  < 2e-16 ***
## Wa1:Yb3     5.04874  0.05335  94.641  < 2e-16 ***
## Wa2:Yb3     5.10777  0.04944 103.316  < 2e-16 ***
## Wa3:Yb3     5.15832  0.04644 111.083  < 2e-16 ***
## Wa1:Yb4     5.42726  0.02879 188.505  < 2e-16 ***
## Wa2:Yb4     5.46863  0.02517 217.282  < 2e-16 ***
## Wa3:Yb4     5.50264  0.02174 253.070  < 2e-16 ***
## wi:yj       1.15732  0.36998   3.128  0.00176 ** 
## Wa1:Yb1:wi -2.49781  0.31878  -7.835 4.66e-15 ***
## Wa2:Yb1:wi -2.83697  0.32435  -8.747  < 2e-16 ***
## Wa3:Yb1:wi -3.23836  0.29518 -10.971  < 2e-16 ***
## Wa1:Yb2:wi -1.93200  0.21221  -9.104  < 2e-16 ***
## Wa2:Yb2:wi -2.26237  0.23196  -9.753  < 2e-16 ***
## Wa3:Yb2:wi -2.65609  0.27727  -9.579  < 2e-16 ***
## Wa1:Yb3:wi -1.40657  0.18071  -7.784 7.11e-15 ***
## Wa2:Yb3:wi -1.75094  0.20186  -8.674  < 2e-16 ***
## Wa3:Yb3:wi -2.15624  0.23187  -9.299  < 2e-16 ***
## Wa1:Yb4:wi -1.77728  0.17390 -10.220  < 2e-16 ***
## Wa2:Yb4:wi -2.10603  0.19721 -10.679  < 2e-16 ***
## Wa3:Yb4:wi -2.47437  0.22939 -10.787  < 2e-16 ***
## Wa1:Yb1:yj -0.10323  0.13018  -0.793  0.42780    
## Wa2:Yb1:yj -0.06382  0.12579  -0.507  0.61193    
## Wa3:Yb1:yj -0.02894  0.12225  -0.237  0.81288    
## Wa1:Yb2:yj -0.98088  0.14513  -6.759 1.39e-11 ***
## Wa2:Yb2:yj -0.96360  0.13981  -6.892 5.49e-12 ***
## Wa3:Yb2:yj -0.94798  0.13645  -6.947 3.72e-12 ***
## Wa1:Yb3:yj -0.62780  0.13610  -4.613 3.97e-06 ***
## Wa2:Yb3:yj -0.68056  0.13375  -5.088 3.61e-07 ***
## Wa3:Yb3:yj -0.72599  0.13239  -5.484 4.16e-08 ***
## Wa1:Yb4:yj -2.98716  0.29995  -9.959  < 2e-16 ***
## Wa2:Yb4:yj -2.99510  0.29381 -10.194  < 2e-16 ***
## Wa3:Yb4:yj -2.96408  0.27975 -10.595  < 2e-16 ***
## Yb2:wi:yj  -0.70644  0.63025  -1.121  0.26233    
## Yb3:wi:yj  -3.56978  0.88623  -4.028 5.62e-05 ***
## Yb4:wi:yj  -1.39762  0.85852  -1.628  0.10354    
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##         Null deviance: 25401.0663    Residual deviance:     5.8825
##         Number of Fisher Scoring iterations: 4

Este novo modelo apresenta um ajuste consideravelmente melhor do que o modelo de efeitos principais de \(Y\). Ao comparar o novo modelo com o modelo saturado, obtém-se \(X_M^2 = 1.81\), com um \(p\)-valor bootstrap de 0.404. Além disso, todos os resíduos padronizados são relativamente pequenos em valor absoluto. Portanto, este novo modelo parece explicar razoavelmente as associações entre os contaminantes e os métodos de armazenamento de resíduos.

As razões de chances estimadas pelo modelo são 2.48 para \((W_1, Y_1)\) e \((W_2, Y_1)\), com um intervalo bootstrap \(\mbox{BC}_a\) de 95% de (1.16; 5.24). Naturalmente, a razão de chances estimada pelo modelo para \((W_3, Y_1)\) e o intervalo de confiança correspondente são essencialmente os mesmos que os obtidos para os valores observados, conforme calculado anteriormente.

Todas as outras razões de chances estimadas pelo modelo e os resíduos padronizados são essencialmente iguais aos do modelo de efeitos principais de \(Y\). Em suma, existe uma associação positiva de moderada a forte entre o armazenamento de resíduos em lagoas e a realização de testes para cada contaminante. Além disso, tende a não haver testes de contaminantes quando se utiliza drenagem natural. Para fossas e tanques de armazenamento, não há uma associação clara com a realização de testes de contaminantes.

Também são possíveis modelos para três ou mais variáveis categóricas de resposta múltipla (MRCVs). Por exemplo, considere o caso de três MRCVs em que a terceira variável é representada por respostas binárias \(Z_k\) para \(k = 1,\cdots, K\). Em vez das \(IJ\) tabelas \(2\times 2\) que vimos anteriormente, agora temos \(IJK\) tabelas \(2\times 2\times 2\).

O modelo sob independência completa é \[ \tag{6.15} \log\big(\mu_{abc(ijk)} \big)=\beta_{0(ijk)}+\beta_{a(ijk)}^W+\beta_{b(ijk)}^Y+\beta_{c(ijk)}^Z, \] para \(a=1,2\), \(b=1,2\), \(c=1,2\), \(i=1,\cdots,I\), \(j=1,\cdots,J\) e \(k=1,\cdots,K\).

Este é o modelo usual de regressão de Poisson para independência completa entre três variáveis categóricas binárias, com subscritos adicionais \((i, j, k)\) adicionados para denotar a combinação específica \(W\), \(Y\), \(Z\) em uma tabela \(2\times 2\times 2\).

Modelos mais complexos podem ser formados nos quais os efeitos principais e as interações são adicionados entre os níveis de \(X\), \(Y\) e \(Z\). Por exemplo, considere um modelo que contenha os termos incluídos na Equação (6.15) e \[ \lambda_{ab}+\lambda_{ab(i)}^W+\lambda_{ab(j)}^Y+\lambda_{ab(ij)}^{WY}+\delta_{bc}+\delta_{bc(j)}^Y+\omega_{ac}\cdot \]

Os parâmetros \(λ\) permitem que as razões de chances entre \(W\) e \(Y\) sejam diferentes para cada combinação de \(W\) \(Y\), mas permaneçam constantes entre os níveis de \(Z\); os parâmetros \(\delta\) permitem que as razões de chances entre \(Y\) e \(Z\) sejam diferentes para cada nível de \(Y\), mas iguais para todos os níveis de \(X\) e \(Z\); e o parâmetro \(\omega\) permite que a razão de chances entre \(W\) e \(Z\) seja diferente de 1, mas igual para todos os níveis de \(X\), \(W\) e \(Z\).

O ajuste do modelo, o teste de hipóteses e a estimação das razões de chances são realizados da mesma maneira descrita para o caso de duas MRCVs. No entanto, à medida que o número de MRCVs aumenta, encontrar um modelo adequado e interpretar seus parâmetros pode se tornar mais difícil.

6.5 Modelos mistos para dados correlacionados

Todos os modelos apresentados nos Capítulos 2 a 4 baseiam-se na premissa fundamental de que os dados aos quais são ajustados consistem em observações independentes. Em aplicações reais, contudo, os dados se apresentam frequentemente coletados em agrupamentos (clusters), ou múltiplas medições podem ser realizadas no mesmo indivíduo.

Nesses casos, é comum que as medições provenientes de um mesmo agrupamento ou unidade sejam mais semelhantes entre si do que em relação a observações feitas em agrupamentos ou unidades diferentes. Em outras palavras, os dados contidos nesses agrupamentos apresentam correlação.

Não se recomenda realizar uma análise estatística em dados correlacionados como se fossem independentes. Em particular, quando os dados apresentam correlação positiva — isto é, quando observações de um mesmo grupo são mais semelhantes entre si do que em relação a observações de grupos diferentes —, uma análise estatística que pressupõe independência tende a ser excessivamente liberal.

Para compreender a razão disso, considere uma situação extrema na qual temos uma amostra composta por \(g\) grupos, cada um com \(m\) observações que fornecem resultados idênticos, enquanto as observações de grupos diferentes podem variar. Nesse caso, as múltiplas medições dentro de cada grupo são redundantes, bastando uma única medição por grupo.

Isso significa que, em vez de uma amostra de \(n = gm\) observações, temos, na prática, uma amostra de apenas \(g = n/m\) observações significativas; os demais dados não trazem informações novas. A análise estatística deveria ser realizada apenas com esses \(g\) valores, o que implica que a amostra é, efetivamente, muito menor do que aparenta. Se a análise for realizada utilizando todas as \(n\) observações sob a premissa de independência, as variâncias das estatísticas serão muito inferiores aos valores adequados.

Consequentemente, os intervalos de confiança resultantes serão mais estreitos do que o necessário para garantir o nível de confiança declarado, e os \(p\)-valores serão menores do que deveriam, levando a taxas excessivas de erro do Tipo I. Essa é uma questão importante que não deve ser ignorada em uma análise. Existem duas abordagens básicas para lidar com os efeitos da análise de dados correlacionados.

A primeira consiste em modificar o modelo estatístico para que ele reflita corretamente a estrutura de agrupamento dos dados. Há várias maneiras de fazer isso, mas, nesta seção, concentramo-nos em um dos modelos corretivos mais utilizados para contagens e proporções: o modelo linear misto generalizado. Na Seção 6.5.5, discutimos brevemente a abordagem alternativa — as equações de estimativa generalizadas —, na qual os modelos são ajustados aos dados assumindo-se independência, mas as inferências resultantes do modelo são ajustadas para levar em conta a correlação.

6.5.1 Efeitos aleatórios

Populações de medições frequentemente se organizam naturalmente em grupos. Por exemplo, vários hospitais diferentes podem participar de um estudo médico, cada um com seu próprio conjunto de pacientes. Em um estudo de garantia da qualidade, podemos amostrar produtos provenientes de diversas séries de produção (ou “lotes”). No exemplo de chutes de campo (placekicks) apresentado no Capítulo 2, as tentativas de chute são realizadas por diferentes chutadores e em diferentes jogos.

Dados amostrados em grupos desse tipo são denominados dados agrupados (clustered data). Em cada um desses exemplos, a variável de agrupamento — hospital, lote, chutador ou jogo — pode ser uma parte inevitável do estudo. A amostragem em grupos ou lotes pode ser necessária para garantir a coleta de uma amostra suficientemente grande dentro de um prazo ou orçamento razoáveis.

A amostragem a partir de múltiplos grupos ajuda a assegurar que os resultados do estudo sejam aplicáveis a unidades de uma população maior desses grupos, e não apenas àquelas pertencentes a um grupo específico.

De qualquer modo, essas variáveis de agrupamento não constituem o foco principal do estudo. No entanto, elas podem influenciar a média ou a probabilidade de uma resposta mensurada, uma vez que diferentes níveis das variáveis podem apresentar, naturalmente, um potencial de resposta mais alto ou mais baixo, por exemplo, diferentes chutadores podem ter probabilidades de sucesso maiores ou menores do que outros em todas as tentativas de field goal.

Essa variabilidade introduz uma correlação entre as medições, pois todas as medições provenientes de um mesmo grupo estão sujeitas ao potencial de resposta específico daquele grupo; consequentemente, elas tenderão a ser mais semelhantes entre si do que em relação a medições de grupos distintos que possuam potenciais de resposta diferentes.

Outra forma de agrupar medições ocorre quando as unidades são independentes, mas múltiplas observações são realizadas em cada uma delas. Essas observações são denominadas medidas repetidas, e as unidades nas quais elas são realizadas são genericamente referidas como “sujeitos”. Medidas repetidas são bastante comuns em estudos médicos, nos quais registros de parâmetros como sinais vitais, estágio da doença e efeitos colaterais podem ser feitos nos sujeitos em momentos específicos.

Medidas repetidas também são utilizadas em áreas como o estudo do crescimento de plantas ou animais ao longo do tempo, ou na medição de nutrientes e contaminantes do solo em diferentes profundidades predeterminadas. Note que medidas repetidas geram dados correlacionados: se a medição de um sujeito estiver acima da média em um determinado momento ou intervalo de profundidade, é provável que ela permaneça acima da média em momentos ou profundidades adjacentes.

Assim como ocorre com dados agrupados, a correlação entre medidas repetidas realizadas no mesmo sujeito pode ser expressa, alternativamente, como um potencial de resposta geral distinto para cada sujeito, resultando em respostas acima ou abaixo da média para todas as medições referentes a esse mesmo sujeito.

Assim, dados agrupados e medidas repetidas são duas versões diferentes do mesmo fenômeno de medições agrupadas. No entanto, existem características que distinguem as duas estruturas. Primeiramente, as medidas repetidas são geralmente realizadas em uma ordem específica (no tempo ou no espaço) que pode ser comum a todos os sujeitos.

Por exemplo, medições de crescimento podem ser feitas em momentos específicos para todos os sujeitos. A medida temporal ou espacial é, tipicamente, a única variável explicativa que varia entre as medidas repetidas de um mesmo sujeito, embora possam existir exceções. Todas as outras variáveis explicativas são geralmente observadas em relação ao sujeito como um todo, fazendo com que seus valores sejam iguais para todas as medições daquele sujeito.

Por outro lado, no caso de dados agrupados, as medições dentro de um grupo (ou cluster) frequentemente não seguem nenhuma ordem específica. Diz-se que elas são permutáveis, no sentido de que seria possível reorganizar aleatoriamente os rótulos de identificação das medições sem perda de informação. Contudo, respostas diferentes dentro de um mesmo grupo podem apresentar valores distintos para algumas ou todas as variáveis explicativas.

Considere, a seguir, a população de todos os níveis possíveis de uma determinada variável de agrupamento, por exemplo, todos os hospitais possíveis em um estudo médico ou todas as árvores possíveis em um estudo de crescimento. Podemos imaginar que a cada nível está associado um valor constante que é somado à média ou probabilidade geral, aumentando-a ou diminuindo-a em uma magnitude específica.

Esse valor constante é chamado de efeito aleatório do nível. Como variáveis de agrupamento — como hospitais ou identificadores de árvores — são sempre categóricas, elas são frequentemente denominadas fatores de efeitos aleatórios. Assume-se que os níveis de um fator de efeitos aleatórios utilizados em um estudo específico foram amostrados a partir de uma população de níveis possíveis.

Todas as variáveis explicativas categóricas estudadas antes desta seção são fatores de efeitos fixos. Seus níveis são escolhidos deliberadamente ou observados em uma amostra, e o interesse reside na comparação de médias ou probabilidades entre esses níveis específicos. Em particular, não se pressupõe a existência de uma população mais ampla de níveis da qual os níveis observados tenham sido selecionados.

Para fins de modelagem, geralmente assumimos que os efeitos aleatórios seguem alguma distribuição conhecida com parâmetros desconhecidos. O mais comum é assumir que eles seguem uma distribuição normal com média zero e variância desconhecida. A média zero garante que o hospital ou a árvore “média” acrescente zero às medições realizadas nas unidades a eles associadas, enquanto a variância desconhecida cria um novo parâmetro no modelo, representando a magnitude da diferença entre as medições provenientes de diferentes hospitais ou árvores. A variância associada a um determinado fator de efeitos aleatórios é denominada componente de variância.

Compreender o componente de variância de um fator de efeitos aleatórios pode, por vezes, ser o foco de um estudo. Por exemplo, existem muitos laboratórios capazes de analisar amostras de sangue, todos supostamente utilizando técnicas que seguem os mesmos protocolos e contando com equipes de técnicos que receberam o mesmo treinamento. Um órgão regulador pode ter interesse em avaliar se esses protocolos e treinamentos são adequados.

Caso não sejam, espera-se observar uma variabilidade significativa entre os laboratórios nos resultados obtidos a partir das mesmas amostras, bem como verificar se alguns laboratórios utilizam métodos ou técnicos que geram respostas consistentemente mais altas ou mais baixas do que outros. Nesse cenário, o objetivo é avaliar a variabilidade entre todos os laboratórios da população, em vez de comparar um laboratório específico com outro. Em outras palavras, busca-se determinar se o componente de variância referente ao fator de efeito aleatório “laboratório” é igual a zero.

Um determinado estudo pode apresentar mais de um fator de efeitos aleatórios, e esses fatores podem estar aninhados ou cruzados. Por exemplo, pode haver diversos laboratórios capazes de processar e analisar amostras de sangue, bem como vários técnicos trabalhando em cada um deles.

Poderíamos coletar múltiplas amostras de um grande número de doadores e enviar três amostras de cada doador para um conjunto de laboratórios selecionados aleatoriamente, para serem analisadas por três técnicos diferentes em cada laboratório. Nesse caso, teríamos fatores de efeitos aleatórios representando os laboratórios, os técnicos aninhados nos laboratórios e os doadores cruzados tanto com os laboratórios quanto com os técnicos.

6.5.2 Modelos de efeitos mistos

Os modelos podem conter apenas efeitos fixos, apenas efeitos aleatórios ou uma combinação de efeitos fixos e aleatórios. Estes últimos são denominados modelos de efeitos mistos ou, abreviadamente, “modelos mistos”.

Recorde-se, das Seções 2.3 e 4.2.1, que os modelos de regressão logística, de Poisson e muitos outros modelos de regressão para contagens ou proporções são tipos diferentes de modelos lineares generalizados (GLMs). Quando um modelo misto é aplicado a dados cujos efeitos fixos seriam normalmente modelados utilizando um modelo linear generalizado, cria-se um modelo linear generalizado de efeitos mistos (GLMM).

Considere, primeiramente, um problema simples no qual a única variável explicativa é um fator de efeitos aleatórios com níveis amostrados. Por exemplo, suponha que tenhamos medido o número de besouros-do-pinheiro em árvores situadas em diferentes locais aleatórios de uma região. É possível que as árvores em áreas distintas apresentem contagens médias mais altas ou mais baixas devido a diversos fatores que não estamos tentando mensurar.

Se utilizarmos um GLM de Poisson para esse problema, a variabilidade das médias entre os locais provavelmente causaria superdispersão (veja a Seção 5.3). Em vez disso, podemos ajustar um modelo de Poisson que permita à média variar aleatoriamente entre os diferentes locais.

Utilizando uma função de ligação logarítmica, \[ g(\mu_{ik}) = \log(\mu_{ik}), \] em que \(\mu_{ik}\) é a contagem média de besouros na árvore \(k\), no local \(i\), podemos escrever o preditor linear como \[ \tag{16} g(\mu_{ik})=\beta_0+b_{0i}, \] onde \(b_{0i}\), \(i = 1, \cdots, a\), é o efeito aleatório da localidade \(i\); assume-se que \(b_{01}, \cdots, b_{0a}\) constituem uma amostra aleatória de \(N(0, \sigma_{b0}^2)\), e \(\beta_0\) é o valor do preditor linear (o logaritmo da média) na localidade média. O objetivo do estudo pode ser, então, estimar \(\sigma_{b0}^2\), o que nos daria uma ideia da variabilidade das contagens de besouros em toda a região.

Observe que a Equação (16) é um modelo de efeitos aleatórios, pois o único fator no modelo é a localidade, que é aleatória. Note também que poderíamos escrever o modelo de forma ligeiramente diferente, combinando o logaritmo da média geral com o efeito aleatório de cada localidade em um único símbolo — digamos, \(\tau_i = \beta_0 + b_{0i}\) —, tornando evidente que o modelo representa um intercepto aleatório para cada localidade. De modo geral, os efeitos aleatórios combinam-se com seus respectivos parâmetros fixos de “média” para gerar valores de parâmetros aleatórios para cada sujeito ou agrupamento (cluster).

Podemos estender essa abordagem para um modelo linear misto generalizado caso disponhamos de medições adicionais. Por exemplo, árvores em certos locais podem ser maiores do que as de outros locais — devido a atividades recentes de extração de madeira, incêndios ou outros impactos — e árvores maiores podem abrigar mais besouros simplesmente em razão do maior volume disponível para que esses insetos habitem.

Suponha que meçamos a circunferência de cada árvore no estudo, denotada por \(x_{ik}\) (com \(i = 1, \cdots, a\) e \(k = 1, \cdots, t\)), e que acreditemos que o logaritmo da média da contagem de besouros varie linearmente em função da circunferência. Um modelo linear generalizado de efeitos fixos que desconsidere os locais utilizaria a equação \[ g(\mu_{ik}) = \beta_0 + \beta_1 x_{ik}, \] na qual \(\beta_0\) é o intercepto, tecnicamente, o logaritmo da média da contagem de besouros em uma árvore com circunferência zero e \(\beta_1\) é a inclinação associada ao logaritmo da média, representando a variação no logaritmo da média da contagem de besouros para cada aumento de uma unidade na circunferência.

Se quisermos levar em conta os efeitos das localidades neste modelo, existem várias maneiras de fazê-lo. Imagine ajustar um GLM de Poisson separado para a relação entre a contagem de besouros e o tamanho da árvore em cada localidade. Estimaríamos um intercepto e uma inclinação diferentes em cada caso, mas as estimativas podem ou não estar todas estimando a mesma grandeza populacional subjacente. Se acreditarmos que as inclinações subjacentes devem ser todas iguais, então os efeitos aleatórios de localidade atuam apenas sobre os interceptos, e os preditores lineares são paralelos.

O GLMM correspondente utiliza o preditor linear, \[ \tag{17} g(\mu_{ik})=\beta_0+\beta_1 x_{ik}+b_{0i}, \] onde \(b_{01},\cdots,b_{0a}\) são considerados uma amostra aleatória \(N(0,\sigma^2_{b_0})\).

Este modelo especifica que a razão entre as contagens médias de árvores de um determinado tamanho em duas localizações diferentes é a mesma para todos os tamanhos de árvore, ou equivalentemente, que a razão entre as médias de dois tamanhos específicos de árvore é a mesma em cada localização. Em um modelo de regressão logística, a suposição equivalente seria que as razões de chances entre quaisquer dois níveis do efeito aleatório são as mesmas para todos os valores de \(x\) ou vice-versa.

Observe que poderíamos reorganizar este modelo como \[ g(\mu_{ik}) = (\beta_0 + b_{0i}) + \beta_1 x_{ik}, \] tornando um pouco mais claro que este modelo representa interceptos aleatórios para cada localização com uma inclinação comum para todas as localizações. Alternativamente, se esperamos que as razões de médias verdadeiras (ou razões de chances) entre os níveis de \(x\) variem dependendo do nível do efeito aleatório, então o efeito aleatório também está alterando a inclinação.

Para o modelo de regressão de Poisson, isso resulta no preditor linear \[ \tag{18} g(\mu_{ik})=\beta_0+\beta_1 x_{ik}+b_{0i}+b_{1i} x_{ik}, \] onde os efeitos aleatórios adicionais \(b_{11},\cdots,b_{1a}\) constituem uma amostra aleatória \(N(0,\sigma^2_{b1})\).

O efeito aleatório \(b_{1i}\) mede o quanto a inclinação de \(x\) no preditor linear para a localidade \(i\) difere da inclinação média, \(\beta_1\). Note que agora existem dois componentes de variância, \(\sigma^2_{b0}\) e \(\sigma^2_{b1}\), que são estimados quando o modelo é ajustado aos dados. Reorganizar esse modelo, como fizemos com outros modelos, resulta em \[ g(\mu_{ik}) = (\beta_0 + b_{0i}) + (\beta_1 + b_{1i}) x_{ik}\cdot \] Assim, fica evidente que esse modelo inclui tanto interceptos aleatórios quanto inclinações aleatórias para cada localidade.

Outra característica do modelo que pode ser considerada é a relação entre \(b_{0i}\) e \(b_{1i}\), para \(i = 1, \cdots, a\). No modelo acima, especificamos uma distribuição normal separada para os efeitos aleatórios associados à inclinação e ao intercepto, o que implica tratá-los como variáveis aleatórias independentes.

No entanto, é possível que locais com interceptos muito baixos apresentem também inclinações muito baixas, indicando que a contagem média de besouros é baixa para árvores pequenas e não aumenta significativamente para árvores maiores. Em outras regiões, onde árvores pequenas apresentam contagens elevadas, as populações de besouros podem aumentar ainda mais rapidamente em árvores maiores. Assim, haveria uma correlação positiva entre os efeitos aleatórios de inclinação e intercepto. Isso pode ser especificado adicionando-se à Equação (18) a suposição de que \((b_{0i}, b_{1i})\), para \(i = 1, \cdots, a\), possuem correlação \(\rho_{01}\).

Modelos muito mais gerais podem ser desenvolvidos para problemas que envolvem múltiplos efeitos fixos e aleatórios. O ponto fundamental, em cada caso, é especificar cuidadosamente as maneiras pelas quais cada efeito aleatório pode influenciar as respostas. Existem diversos livros sobre modelos lineares mistos e modelos lineares generalizados mistos que abordam esse processo detalhadamente. Veja, por exemplo, Raudenbush and Bryk (2002), Littell et al. (2006), Molenberghs and Verbeke (2005) e Bates (2010).

Exemplo 6.16: Quedas com impacto na cabeça

As quedas representam um problema grave entre os idosos, resultando em lesões, despesas médicas e, por vezes, morte. Em particular, impactos na cabeça durante uma queda podem ter consequências severas. Schonnop et al. (2013) analisaram imagens de vídeo de 227 quedas ocorridas com 133 residentes de duas instituições de longa permanência na Colúmbia Britânica, Canadá. Eles registraram diversos atributos de cada queda, incluindo a direção da queda, a ocorrência de impacto em diferentes partes do corpo durante o evento, bem como a idade e o sexo do residente.

As imagens de algumas quedas apresentavam visibilidade obstruída; portanto, nem todas as quedas possuem registros de dados completos. Os dados foram gentilmente fornecidos pelo Dr. Steve Robinovich, do Departamento de Fisiologia Biomédica e Cinesiologia e da Escola de Engenharia da Simon Fraser University. Consideramos uma versão reduzida deste conjunto de dados, composta pelas 215 quedas com valores registrados para todas as seguintes variáveis:

1. resident: um código de identificação numérica do residente cuja queda foi registrada,

2. initial: uma variável categórica de 4 níveis: Para trás (Backward), Para baixo (Down), Para frente (Forward) e Para o lado (Sideways), e

3. head: uma variável binária que indica se a queda resultou no impacto da cabeça do residente contra o chão (1 = sim, 2 = não).

As primeiras linhas dos dados são apresentadas abaixo, juntamente com o código que mostra o número de quedas sofridas por cada participante do estudo. Essas contagens são ilustradas na Figura 6.5.

# Read the data from the subsetted file
fall.head <- read.csv("https://www.estatistica.c3sl.ufpr.br/~lucambio/ADC/FallHead.csv")
head(fall.head)

##   resident  initial head
## 1       56 Sideways    0
## 2        9 Backward    0
## 3       30  Forward    0
## 4        9     Down    0
## 5       70 Sideways    0
## 6       21 Sideways    1

# Summary table of falls by initial direction and head impact
head.dir <- xtabs(formula = ~ initial + head, data = fall.head)
head.dir

##           head
## initial     0  1
##   Backward 51 27
##   Down     18  3
##   Forward  24 33
##   Sideways 40 19

fallFreq <- table(fall.head$resident)

library(ggplot2)
library(dplyr) # Necessário para usar a função ntile() e agrupar facilmente

# 1. Cria a classificação em 2 grupos de maneira crescente pelo código do residente
fall.head <- fall.head %>%
  mutate(
    # ntile divide os residentes ordenados em 2 partes iguais
    grupo = ntile(resident, 2), 
    # Transforma em fator com nomes claros para as facetas do gráfico
    grupo_label = factor(grupo, labels = c("Grupo 1 (Primeiros)", "Grupo 2 (Últimos)"))
  )

# 2. Plota o gráfico dividindo em 2 painéis crescentes
ggplot(fall.head, aes(x = factor(resident))) +
  geom_bar(fill = "steelblue", width = 0.8) + # Ajustado a largura para melhorar visualização com menos barras por tela
  labs(
    title = "Frequência de quedas por residente (Dividido em 2 Grupos)",
    x = "Residente",
    y = "Frequência de quedas"
  ) +
  # O segredo está aqui: facet_wrap divide o gráfico em 4 com base na coluna 'grupo_label'
  # scales = "free_x" garante que cada gráfico só mostre os residentes daquele respectivo grupo
  facet_wrap(~grupo_label, ncol = 2, scales = "free_x") + 
  theme_minimal() +
  theme(
    panel.grid.minor = element_blank(),
    strip.text = element_text(face = "bold", size = 11) # Estiliza o título de cada grupo
  )

Figura 6.5: Número de quedas por residente. Observe que os dados referentes às quedas de dois residentes estavam incompletos e foram excluídos.

Neste exemplo, modelamos a probabilidade de impacto na cabeça em função da direção inicial da queda. A variável binária head (cabeça) é a nossa variável resposta.

A direção da queda (initial) é um efeito fixo porque

1. os quatro níveis — para frente, para trás, para os lados e diretamente para baixo — são os únicos quatro níveis possíveis, e

2. estamos interessados em comparar esses quatro níveis entre si quanto à possibilidade de efeitos diferentes na probabilidade de impacto na cabeça.

A partir da Figura 6.5, fica claro que a maioria dos residentes foi observada caindo apenas uma vez, mas que alguns caíram diversas vezes ao longo do estudo. É possível que exista um mecanismo subjacente comum por trás das múltiplas quedas sofridas por um determinado residente — por exemplo, uma tendência a tonturas ou fraqueza em uma perna específica — que faça com que o residente impacte o chão de maneira semelhante a cada vez.

Por esse motivo, consideramos resident como um fator de agrupamento em qualquer análise que realizarmos. Trata-se de um fator de efeitos aleatórios, pois os objetivos do estudo não são meramente compreender o comportamento de queda entre esses residentes específicos. Em vez disso, os residentes observados pretendem representar uma população mais ampla de residentes em instituições de longa permanência semelhantes.

O modelo resultante tem a seguinte forma: \[ \tag{6.19} logit(\pi_{ik})=\beta_0+\beta_{2} x_{2ik}+\beta_3 x_{3ik} +\beta_4 x_{4ik}+b_i, \] onde \(\pi_{ik}\) é a probabilidade de que a queda \(k\) do residente \(i\) envolva um impacto na cabeça; \(\beta_0\) é o logito da ocorrência de impacto na cabeça em uma queda para uma pessoa com initial = "Backward"; \(x_{2ik}\), \(x_{3ik}\) e \(x_{4ik}\) são variáveis indicadoras para os níveis "Down", "Forward" e "Sideways" da variável initial; \(\beta_j\) (\(j = 2, 3, 4\)) é a diferença nos logitos de impacto na cabeça entre o nível \(j\) e o nível 1 de initial; e \(b_i\) é o efeito aleatório do residente \(i\) sobre o logito de impacto na cabeça. Supomos que os \(b_i\) sejam independentes e sigam uma distribuição normal com média 0 e variância \(\sigma^2_{b0}\).

Embora os residentes não tenham sido selecionados de forma aleatória a partir da suposta população de residentes de instituições de longa permanência, assumimos que suas experiências de quedas são representativas de tais indivíduos.

Essa suposição não deve ser encarada de ânimo leve. Se houver alguma diferença nos residentes dessas instituições — por exemplo, dietas, hábitos de exercícios ou etnia distintos que de alguma forma se relacionem com a experiência de quedas —, a legitimidade de nossa suposição torna-se questionável, e os resultados do estudo podem não se aplicar à população mais ampla da maneira que esperamos.

Poderíamos verificar parcialmente a representatividade da amostra comparando características demográficas relevantes da amostra com as da população, na medida em que estas sejam conhecidas. Quaisquer diferenças evidentes serviriam de alerta de que as inferências derivadas da amostra podem não ser aplicáveis à população de interesse. Veja McLean et al. (1991) para uma discussão sobre as diferentes populações que podem estar implícitas no uso de distintas estruturas de efeitos aleatórios.

6.5.3 Ajuste do modelo

Um GLMM é ajustado aos dados utilizando a estimativa de máxima verossimilhança. A formulação de uma função de verossimilhança revela-se difícil para um GLMM, pois o modelo contém variáveis aleatórias não observadas — os valores dos efeitos aleatórios — além da variável resposta observada, \(Y\).

Os detalhes matemáticos do processo são apresentados em diversos livros, incluindo Raudenbush and Bryk (2002), Molenberghs and Verbeke (2005), Littell et al. (2006) e Bates (2010). Aqui, apresentamos apenas uma visão geral do processo.

Condicionalmente aos efeitos aleatórios — isto é, para um agrupamento ou sujeito específico —, a função de distribuição de \(Y\) apresenta a forma habitual de um modelo linear generalizado, tipicamente Poisson ou binomial. A média da distribuição condicional de \(Y\) varia para cada observação, dependendo das variáveis explicativas e dos efeitos aleatórios associados a essa observação.

A estimação dos parâmetros de regressão a partir da distribuição condicional de cada agrupamento ou sujeito resulta em estimativas aplicáveis apenas aos agrupamentos ou sujeitos presentes nos dados. No entanto, deseja-se que as estimativas dos parâmetros sejam válidas para todas as populações de níveis de efeitos aleatórios, e não apenas para aquelas observadas. É necessário, portanto, eliminar de alguma forma essa dependência em relação aos efeitos aleatórios.

Existem várias maneiras de fazer isso, mas a mais comum é basear as estimativas de máxima verossimilhança na distribuição marginal de \(Y\); isto é, na distribuição média sobre todos os valores possíveis dos efeitos aleatórios. Para tanto, primeiramente construímos a distribuição conjunta da variável resposta e dos efeitos aleatórios.

Em seguida, obtemos a distribuição marginal de \(Y\) integrando a distribuição conjunta em relação aos efeitos aleatórios e formulamos a função de verossimilhança a partir dessa distribuição marginal. Os parâmetros nessa função de verossimilhança são os coeficientes de regressão e os componentes de variância dos efeitos aleatórios, bem como quaisquer correlações modeladas entre os efeitos aleatórios.

Por exemplo, o modelo descrito na Equação (6.19) especifica que a distribuição condicional da resposta binária de impacto na cabeça, dado o efeito aleatório do residente, segue uma distribuição binomial com 1 tentativa e com probabilidade de impacto na cabeça baseada na forma logit apresentada na equação.

Denotamos essa distribuição por \(f(y_i | b_i; \pmb{\beta})\) para o residente \(i\), onde \(\pmb{\beta}\) contém todos os parâmetros de regressão de efeito fixo. Essa distribuição aplica-se apenas ao valor específico do efeito aleatório do residente \(i\). A distribuição conjunta do efeito aleatório e da resposta para o residente \(i\) é \(f(y_i, b_i; \pmb{\beta}, \sigma_{b0}^2) = f(y_i | b_i; \pmb{\beta})g(b_i; \sigma_{b0}^2)\), onde \(g(b_i; \sigma_{b0}^2)\) representa a função de densidade normal com média 0 e variância \(\sigma_{b0}^2\). Como \(b_i\) é uma variável aleatória, obtemos a distribuição marginal da resposta, \(h(y_i; \pmb{\beta}, \sigma_{b0}^2)\), calculando a média sobre todos os valores possíveis de \(b_i\) por meio de uma integral: \[ \begin{array}{rcl} h(y_i; \pmb{\beta}, \sigma_{b0}^2) & = & \displaystyle \int_{-\infty}^\infty f(y_i | b_i; \pmb{\beta})g(b_i; \sigma_{b0}^2)\mbox{d}b_i\\[0.8em] & = & \displaystyle \int_{-\infty}^\infty \pi_{ik}^{y_{ik}}(1-\pi_{ik})^{1-y_{ik}}\dfrac{1}{\sqrt{2\pi\sigma^2_{b0}}}\exp\left(-\dfrac{b_i}{2\sigma^2_{b0}}\right)\mbox{d}b_i, \end{array} \] onde \(\pi_{ik}\) é obtido a partir da Equação (6.19) e é uma função de \(b_i\).

Finalmente, a função de verossimilhança para os parâmetros, dados todos os dados \(\pmb{y}\), é o produto \[ L(\pmb{\beta},\sigma^2_{b0}|\pmb{y})=\prod_{i=1}^a h(y_i;\pmb{\beta},\sigma^2_{b0})\cdot \]

Infelizmente, a integral nesta função de verossimilhança geralmente não pode ser calculada matematicamente. Em vez disso, devemos utilizar algum método alternativo para calcular a integral e, então, maximizar esse resultado para encontrar as estimativas dos parâmetros.

O problema também pode ser formulado como um problema de estimação bayesiana, tratando os efeitos aleatórios como parâmetros com uma distribuição a priori normal. Veja a Seção 6.6 para uma breve descrição dos métodos bayesianos e Littell et al. (2006) para uma descrição mais geral das abordagens bayesianas para modelos mistos.

Existem três abordagens gerais para realizar esse cálculo.

1. Quase-verossimilhança penalizada ou pseudoverossimilhança (“aproximar o modelo”): Utilizando uma aproximação por série de Taylor, encontram-se aproximações convenientes para a função de ligação inversa que permitem escrever o modelo na forma “média + erro”, tal como um modelo de regressão linear normal é tipicamente expresso. Tanto a parte da média quanto a do erro são avaliadas a partir de quantidades estimadas, resultando em “pseudodados” que seguem aproximadamente uma distribuição normal. O uso desses pseudodados no modelo aproximado resulta em uma integral que pode ser avaliada com relativa facilidade por meio de técnicas numéricas iterativas. Os pseudodados são atualizados a cada iteração.

2. Aproximação de Laplace (“aproximar o integrando”): Como assumimos distribuições normais para quaisquer efeitos aleatórios, o integrando apresenta uma forma que pode ser aproximada por uma função mais simples e de integração matemática mais fácil. A função resultante é maximizada utilizando técnicas numéricas iterativas.

3. Quadratura gaussiana (adaptativa) (“aproximar a integral”): Uma integral unidimensional representa a área sob uma curva. Essa área pode ser aproximada por uma sequência de retângulos, de forma muito semelhante à aproximação de uma função de densidade por um histograma. A quadratura gaussiana é um método para realizar esse tipo de cálculo em qualquer número de dimensões. Os retângulos são denominados “pontos de quadratura”. O uso de um grande número de pontos de quadratura representa melhor a forma do integrando do que o uso de poucos retângulos largos, embora exija maior esforço computacional. Além disso, utilizar a forma da função para auxiliar na escolha das posições dos pontos de quadratura — procedimento conhecido como quadratura adaptativa — pode resultar em uma aproximação melhor do que utilizar uma grade de pontos pré-selecionada, a qual pode estar distante de eventuais picos da função.

A abordagem de quase-verossimilhança penalizada (PQL) é aplicável a problemas bastante gerais, incluindo medidas repetidas. No entanto, por basear-se em uma versão alterada dos dados, existem limitações quanto às inferências que podem ser derivadas do modelo e de suas estimativas. Por exemplo, a inferência baseada na razão de verossimilhanças e os critérios de informação não são válidos para comparar modelos com diferentes conjuntos de efeitos fixos, uma vez que esses modelos produzem pseudo-dados distintos.

Além disso, a PQL gera estimativas viesadas, e esse viés pode ser extremo em modelos binomiais com um número reduzido de tentativas (Breslow and Lin 1995). De modo geral, o método apresenta melhor desempenho quando os modelos são razoavelmente aproximados por distribuições normais, o que desaconselha seu uso para dados binomiais que envolvam poucas tentativas ou muitas probabilidades extremas, bem como para dados de Poisson com médias muito baixas.

A quadratura gaussiana adaptativa (AGQ) com muitos pontos de quadratura fornece a aproximação mais precisa da verossimilhança, mas é também a mais custosa computacionalmente. Para problemas com mais de um ou dois fatores de efeitos aleatórios, o tempo de processamento da AGQ pode tornar-se proibitivo quando se utilizam múltiplos pontos de quadratura. Acontece que a AGQ com apenas um ponto de quadratura é matematicamente equivalente ao uso da aproximação de Laplace.

Portanto, o método de Laplace pode ser utilizado em problemas com estruturas de efeitos aleatórios mais complexas do que aquelas que a AGQ consegue manejar. No entanto, Laplace nem sempre fornece estimativas muito precisas das estimativas de máxima verossimilhança (MLEs). De modo geral, recomendamos o uso da AGQ sempre que viável e, caso contrário, do método de Laplace. Se não for possível utilizar Laplace, pode-se recorrer ao PQL, mas as inferências devem ser consideradas como sendo apenas aproximações grosseiras.

Independentemente do método de ajuste utilizado, as quantidades obtidas são essencialmente as mesmas. Primeiramente, têm-se as estimativas dos parâmetros para os coeficientes de regressão e os componentes de variância, juntamente com seus erros-padrão, bem como a deviance correspondente à função de log-verossimilhança avaliada nas estimativas dos parâmetros. Em segundo lugar, podem ser gerados os valores estimados dos efeitos aleatórios para cada agrupamento ou sujeito; estes são, por vezes, denominados modas condicionais.

Ajuste de GLMMs no R

Existem inúmeras funções no R capazes de estimar os parâmetros de um GLMM com base em diversas implementações de um destes três métodos. A função glmer() do pacote lme4 pode realizar AGQ em modelos binomiais e de Poisson com um único efeito aleatório.

Também é possível utilizar aproximações de Laplace nas mesmas distribuições com estruturas de efeitos aleatórios mais complexas, incluindo efeitos aninhados e cruzados. A função glmmPQL() do pacote MASS aplica o método PQL a qualquer família de modelos disponível na função glm() e, além disso, permite lidar com diversas estruturas de correlação para medidas repetidas — algo que a função glmer() não faz.

Nesta seção introdutória sobre GLMMs, concentram-nos em modelos mais simples e, portanto, utilizamos a função glmer(). Recomendamos consultar fontes mais abrangentes antes de tentar ajustar modelos mais avançados. Estudos indicam que a falha em considerar adequadamente a estrutura de efeitos aleatórios de um modelo complexo pode levar a inferências muito precárias, como taxas de erro do Tipo I arbitrariamente elevadas; veja Loughin et al. (2007) e Fang and Loughin (2012) para exemplos.

Exemplo 6.17: Quedas com impacto na cabeça

O modelo para nossa análise, apresentado na Equação (6.19), contém apenas um efeito aleatório: resident. Portanto, utilizamos o método AGQ disponível na função glmer() do pacote lme4.

A parte referente aos efeitos fixos na especificação do argumento formula utiliza a mesma sintaxe da função glm() e de outras funções de modelagem de regressão. Os efeitos aleatórios são incorporados ao valor do argumento formula pela inclusão de termos da forma (a|b), em que b é substituído pelo nome do fator de efeitos aleatórios e a é substituído por um ou mais termos (em formato de formula) que indicam as variáveis cujos coeficientes devem ser tratados como aleatórios.

Por exemplo,

• (1|b): efeitos aleatórios são adicionados ao intercepto para cada nível de b, p. ex., Equação (6.17);

• (x|b): efeitos aleatórios são adicionados ao coeficiente de regressão para x;

• (1|b)+(x|b): tanto o intercepto quanto o coeficiente de regressão para x possuem efeitos aleatórios independentes, p. ex., Equação (6.18);

• (1+x1+x2|b): o intercepto e os coeficientes de regressão para x1 e x2 possuem efeitos aleatórios correlacionados.

Em nosso exemplo sobre quedas, a Equação (6.19) é representada pela sintaxe head ~ initial + (1|resident).

##############################################################
# Model fitting

library(package = lme4)
library(rlang)

# Estimate with varying numbers of quadrature points. 
# Variance components contained in summary()$varcor

mod.glmm.1 <- glmer(formula = head ~ initial + (1|resident), nAGQ = 1, 
                    data = fall.head, family = binomial(link = "logit"))
summary(mod.glmm.1)$varcor

##  Groups   Name        Std.Dev.
##  resident (Intercept) 0.25192

summary(mod.glmm.1)$varcor[[1]][1,1]

## [1] 0.06346605

mod.glmm.2 <- glmer(formula = head ~ initial + (1|resident), nAGQ = 2, 
                    data = fall.head, family = binomial(link = "logit"))
summary(mod.glmm.2)$varcor

##  Groups   Name        Std.Dev.
##  resident (Intercept) 0.26586

mod.glmm.3 <- glmer(formula = head ~ initial + (1|resident), nAGQ = 3, 
                    data = fall.head, family = binomial(link = "logit"))
summary(mod.glmm.3)$varcor

##  Groups   Name        Std.Dev.
##  resident (Intercept) 0.3034

mod.glmm.5 <- glmer(formula = head ~ initial + (1|resident), nAGQ = 5, 
                    data = fall.head, family = binomial(link = "logit"))
summary(mod.glmm.5)$varcor

##  Groups   Name        Std.Dev.
##  resident (Intercept) 0.30342

mod.glmm.10 <- glmer(formula = head ~ initial + (1|resident), nAGQ = 10, 
                     data = fall.head, family = binomial(link = "logit"))
summary(mod.glmm.10)$varcor

##  Groups   Name        Std.Dev.
##  resident (Intercept) 0.30342

Para demonstrar os efeitos do número de pontos de quadratura nas estimativas dos parâmetros, ajustamos o modelo para 1, 2, 3, 5 e 10 pontos utilizando o argumento nAGQ. A função glmer() gera objetos S4 da classe glmerMod. Diversas funções de método S3 familiares — como summary(), confint(), vcov() e predict() — podem ser aplicadas para acessar informações tipicamente necessárias em uma análise.

Exibimos as estimativas dos componentes de variância (\(\widehat{\sigma}^2_{b0}\)) para cada modelo acessando o elemento varcor do summary do modelo. Isso gera uma lista de matrizes contendo as variâncias e covariâncias associadas a cada efeito aleatório do modelo. A saída padrão apresenta os desvios-padrão correspondentes (raiz quadrada do componente de variância) e as correlações. Como temos apenas um efeito aleatório neste caso, é exibido apenas um valor: a raiz quadrada do componente de variância, \(\widehat{\sigma}_{b0}\).

Caso seja necessário obter mais informações sobre essas quantidades, é possível acessá-las utilizando summary(obj)$varcor[[q]][i,j] para obter o elemento (i, j) da matriz de covariância do q-ésimo termo de efeito aleatório especificado no argumento formula.

# Estimates are nearly identical starting with nAQG = 5, and barely different from nAGQ = 2.
#  Only nAGQ = 1 are different, and they are VERY different.
# Will use nAGQ = 5 going forward.

# Explore the object contents
slotNames(mod.glmm.5)

##  [1] "resp"    "Gp"      "call"    "frame"   "flist"  
##  [6] "cnms"    "lower"   "theta"   "beta"    "u"      
## [11] "devcomp" "pp"      "optinfo"

# Show summary output
summ <- summary(mod.glmm.5)
summ

## Generalized linear mixed model fit by maximum
##   likelihood (Adaptive Gauss-Hermite Quadrature,
##   nAGQ = 5) [glmerMod]
##  Family: binomial  ( logit )
## Formula: head ~ initial + (1 | resident)
##    Data: fall.head
## 
##       AIC       BIC    logLik -2*log(L)  df.resid 
##     279.5     296.4    -134.8     269.5       210 
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -1.2569 -0.7133 -0.6623  0.8608  2.4598 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  resident (Intercept) 0.09206  0.3034  
## Number of obs: 215, groups:  resident, 131
## 
## Fixed effects:
##                 Estimate Std. Error z value Pr(>|z|)
## (Intercept)      -0.6447     0.2469  -2.612  0.00901
## initialDown      -1.1705     0.6783  -1.726  0.08440
## initialForward    0.9581     0.3689   2.597  0.00940
## initialSideways  -0.1208     0.3768  -0.321  0.74855
##                   
## (Intercept)     **
## initialDown     . 
## initialForward  **
## initialSideways   
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) intlDw intlFr
## initialDown -0.340              
## initilFrwrd -0.660  0.230       
## initilSdwys -0.620  0.240  0.423

names(summ)

##  [1] "methTitle"    "objClass"     "devcomp"     
##  [4] "isLmer"       "useScale"     "logLik"      
##  [7] "family"       "link"         "ngrps"       
## [10] "coefficients" "sigma"        "vcov"        
## [13] "varcor"       "AICtab"       "call"        
## [16] "residuals"    "fitMsgs"      "optinfo"     
## [19] "corrSet"

methods(class = "merMod")

##  [1] anova            Anova            as.function     
##  [4] coef             confint          cooks.distance  
##  [7] deltaMethod      deviance         df.residual     
## [10] drop1            emm_basis        extractAIC      
## [13] family           fitted           fixef           
## [16] formula          fortify          getData         
## [19] getL             getLambda        getLower        
## [22] getME            getPar           getParLength    
## [25] getParNames      getProfLower     getProfPar      
## [28] getProfUpper     getTheta         getThetaLength  
## [31] getThetaNames    getUpper         getVCNames      
## [34] hatvalues        influence        isGLMM          
## [37] isLMM            isNLMM           isREML          
## [40] isSingular       linearHypothesis logLik          
## [43] matchCoefs       model.frame      model.matrix    
## [46] modelparm        na.action        ngrps           
## [49] nobs             plot             predict         
## [52] print            profile          ranef           
## [55] recover_data     refit            refitML         
## [58] rePCA            residuals        rstudent        
## [61] show             sigma            simulate        
## [64] summary          terms            update          
## [67] VarCorr          vcov             vif             
## [70] weights         
## see '?methods' for accessing help and source code

# Estimates of fixed-effect parameters
fixef(mod.glmm.5)

##     (Intercept)     initialDown  initialForward 
##      -0.6446629      -1.1704700       0.9581401 
## initialSideways 
##      -0.1207953

# Conditional Modes (b_0i) for random effects listed **BY resident ID**, not in data order.
head(ranef(mod.glmm.5)$resident)

##   (Intercept)
## 1  0.05913600
## 2 -0.03104568
## 3 -0.03104568
## 4 -0.01369700
## 5  0.05913600
## 6 -0.02865808

# Show that there is one element per resident
nrow(ranef(mod.glmm.5)$resident)

## [1] 131

# coef = Fixed + Random effects. Listed **BY resident ID**, not in data order.
head(coef(mod.glmm.5)$resident)

##   (Intercept) initialDown initialForward
## 1  -0.5855269    -1.17047      0.9581401
## 2  -0.6757086    -1.17047      0.9581401
## 3  -0.6757086    -1.17047      0.9581401
## 4  -0.6583599    -1.17047      0.9581401
## 5  -0.5855269    -1.17047      0.9581401
## 6  -0.6733210    -1.17047      0.9581401
##   initialSideways
## 1      -0.1207953
## 2      -0.1207953
## 3      -0.1207953
## 4      -0.1207953
## 5      -0.1207953
## 6      -0.1207953

mod.glmm.5@flist$resident[1:15]  # List of residents to help map random effects to observations

##  [1] 56 9  30 9  70 21 9  81 43 11 17 68 62 39 46
## 131 Levels: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ... 133

# The matrix of explanatory variables: Intercept and columns for levels 2,3,4
head(mod.glmm.5@frame)

##   head  initial resident
## 1    0 Sideways       56
## 2    0 Backward        9
## 3    0  Forward       30
## 4    0     Down        9
## 5    0 Sideways       70
## 6    1 Sideways       21

Observe que o uso de nAGQ = 1, equivalente à aproximação de Laplace, resulta em estimativas dos componentes de variância consideravelmente diferentes daquelas obtidas com AGQ utilizando três ou mais pontos.

Os três últimos métodos produzem estimativas muito semelhantes e o tempo computacional neste problema é desprezível; portanto, escolhemos o modelo com 5 pontos de quadratura para prosseguir com a análise.

# Predicted logit for each observation
logit.i <- round(predict(object = mod.glmm.5, newdata = fall.head, 
                         re.form = NULL, type = "link"), digits = 3)
# Estimated mean logit for each fall direction, by observation
logit.avg <- round(predict(object = mod.glmm.5, newdata = fall.head, 
                           re.form = NA, type = "link"), digits = 3)
# Predicted probability for each observation
pi.hat.i <- round(predict(object = mod.glmm.5, newdata = fall.head, 
                          re.form = NULL, type = "response"), digits = 3)
# Estimated average probability for each fall direction, by observation
pi.hat.avg <- round(predict(object = mod.glmm.5, newdata = fall.head, 
                            re.form = NA, type = "response"), digits = 3)
# Conditional modes listed in order of the original data (they are currently ordered by resident)
ranefs <- round(ranef(mod.glmm.5)$resident[fall.head$resident, ], digits = 3)
# Print of all predictions and mean estimates together
head(cbind(fall.head, ranefs, logit.i, logit.avg, pi.hat.i, pi.hat.avg))

##   resident  initial head grupo         grupo_label
## 1       56 Sideways    0     1 Grupo 1 (Primeiros)
## 2        9 Backward    0     1 Grupo 1 (Primeiros)
## 3       30  Forward    0     1 Grupo 1 (Primeiros)
## 4        9     Down    0     1 Grupo 1 (Primeiros)
## 5       70 Sideways    0     2   Grupo 2 (Últimos)
## 6       21 Sideways    1     1 Grupo 1 (Primeiros)
##   ranefs logit.i logit.avg pi.hat.i pi.hat.avg
## 1 -0.083  -0.849    -0.765    0.300      0.317
## 2 -0.073  -0.717    -0.645    0.328      0.344
## 3 -0.018   0.295     0.313    0.573      0.578
## 4 -0.073  -1.888    -1.815    0.132      0.140
## 5 -0.001  -0.766    -0.765    0.317      0.317
## 6  0.098  -0.668    -0.765    0.339      0.317

# Just a check: differences due to rounding error only
summary(plogis(logit.avg) - pi.hat.avg)

##       Min.    1st Qu.     Median       Mean    3rd Qu. 
## -3.826e-04 -3.826e-04  1.172e-04  9.861e-05  5.617e-04 
##       Max. 
##  5.617e-04

summary(plogis(logit.i) - pi.hat.i)

##       Min.    1st Qu.     Median       Mean    3rd Qu. 
## -5.273e-04 -1.423e-04  1.172e-04  5.332e-05  3.104e-04 
##       Max. 
##  5.130e-04

# Plot of what a set of probabilities from this model might look like
# Generate a set of random effects for each resident using model estimated variance component
reffs.norm <- rnorm(n = nrow(ranef(mod.glmm.5)$resident), mean = 0, 
                    sd = sqrt(summary(mod.glmm.5)$varcor[[1]][1,1]))
# Create logit and probabilities from estimated means and random effects applied to each resident's falls
logit <- logit.avg + reffs.norm[fall.head$resident]
probs <- plogis(logit)
# Plot Estimated probabilities of head impact from sample random effect values (first) 
#  and from a new set of random effect values generated from the estimated normal distribution (second). 
#  The difference in spread within each group is due to a phenomenon called "shrinkage" (****).
dev.new(height = 4, width = 6)
stripchart(x = probs ~ fall.head$initial, vertical = TRUE, method = "jitter", 
           pch = 1, cex = 0.5, col = "red", xlab = "Initial Fall Direction", 
           ylab = "Estimated P(Head Impact)")
stripchart(x = pi.hat.avg ~ fall.head$initial, vertical = TRUE, pch = 19, 
           add = TRUE, ylab = "Initial Fall Direction", xlab = "Estimated P(Head Impact)")
dev.new(height = 4, width = 6)
stripchart(x = pi.hat.i ~ fall.head$initial, vertical = TRUE, method = "jitter", 
           pch = 1, cex = 0.5, col = "red", xlab = "Initial Fall Direction", 
           ylab = "Estimated P(Head Impact)")
stripchart(x = pi.hat.avg ~ fall.head$initial, vertical = TRUE, pch = 19, 
           add = TRUE, ylab = "Initial Fall Direction", xlab = "Estimated P(Head Impact)")

A saída lista os critérios de informação e os resumos de ajuste do modelo, seguidos pelas estimativas dos componentes da variância, os coeficientes da porção de efeitos fixos da regressão e a correlação entre as estimativas dos parâmetros de efeitos fixos.

A probabilidade estimada de impacto na cabeça para a queda \(k\) do residente \(i\) é \[ logit\big(\widehat{\pi}_{ik} \big)=0.65-1.17x_{2ik}+0.96x_{3ik}-0.12x_{4ik}+b_i \] onde \(x_{2ik}\), \(x_{3ik}\) e \(x_{4ik}\) são variáveis indicadoras para os níveis 2, 3 e 4 de initial (quedas vertical, para frente e lateral, respectivamente), e \(b_i\) é uma variável aleatória proveniente de uma distribuição normal com média 0 e variância 0.092.

Observe que o valor médio de \(b_i\) é zero. Assim, para um residente típico com direção inicial de queda para trás, \[ logit(\widehat{\pi}) = −0.6447, \] o que resulta em \(\widehat{\pi} = 0.34\).

De modo semelhante, para um residente típico com direção inicial de queda para baixo, \[ logit(\pi) = −0.6447 − 1.1705 = −1.5152, \] o que corresponde a \(\widehat{\pi} = 0.14\).

O intercepto varia entre os diferentes residentes segundo uma distribuição normal com desvio padrão estimado \(\widehat{\sigma}_{b0} = 0.303\). Assim, podemos estimar que aproximadamente 95% dos residentes que caem inicialmente para trás apresentam log-odds de impacto na cabeça situados no intervalo \[ \widehat{\beta}_0 \pm 2\widehat{\sigma}_{b0} = −0.6447 \pm 0.606 = −1.24 \quad \mbox{a} \; −0.05\cdot \] Isso corresponde a probabilidades entre 0.22 e 0.49.

Da mesma forma, aproximadamente 95% dos residentes que sofrem quedas apresentam log-odds de impacto na cabeça situados entre −1.8152 \(\pm\) 0.606, o que corresponde a probabilidades entre 0.08 e 0.23. Note que esses intervalos não são intervalos de confiança de uma estatística, mas sim representam uma faixa de probabilidades estimadas de impacto na cabeça para diferentes residentes da população.

O método S3 summary() para objetos da classe glmerMod contém muitos componentes úteis. Sugerimos explorá-los utilizando names() e também explorar as funções de método disponíveis por meio de methods(class = "glmerMod").

#######################################################################
# Inference on fixed effects

# Because of grouping, this is the wrong thing to do. Showing it for comparison.
chisq.test(head.dir)

## 
##  Pearson's Chi-squared test
## 
## data:  head.dir
## X-squared = 15.785, df = 3, p-value = 0.001255

# LRT is available from drop1() function, which tests each term in the model.
#   Still not a very good test to use. 

lrt <- drop1(mod.glmm.5, test = "Chisq")
lrt

## Single term deletions
## 
## Model:
## head ~ initial + (1 | resident)
##         npar    AIC    LRT  Pr(Chi)   
## <none>       279.52                   
## initial    3 289.16 15.638 0.001345 **
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Wald test from Anova in car package. Worst test to use.
library(package = car)
Anova(mod.glmm.5)

## Analysis of Deviance Table (Type II Wald chisquare tests)
## 
## Response: head
##          Chisq Df Pr(>Chisq)   
## initial 13.879  3   0.003075 **
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Pairwise comparisons of individual levels (Wald)

library(package = emmeans)
emm1 <- emmeans(object = mod.glmm.5, specs = ~ initial)
confint(object = emm1, type = "response")

##  initial   prob     SE  df asymp.LCL asymp.UCL
##  Backward 0.344 0.0557 Inf    0.2444     0.460
##  Down     0.140 0.0768 Inf    0.0445     0.362
##  Forward  0.578 0.0676 Inf    0.4428     0.702
##  Sideways 0.317 0.0641 Inf    0.2066     0.454
## 
## Confidence level used: 0.95 
## Intervals are back-transformed from the logit scale

confint(object = contrast(object = emm1, method = "pairwise"), type = "response", adjust="tukey")

##  contrast            odds.ratio     SE  df asymp.LCL
##  Backward / Down          3.224 2.1900 Inf    0.5644
##  Backward / Forward       0.384 0.1420 Inf    0.1487
##  Backward / Sideways      1.128 0.4250 Inf    0.4286
##  Down / Forward           0.119 0.0825 Inf    0.0200
##  Down / Sideways          0.350 0.2420 Inf    0.0591
##  Forward / Sideways       2.942 1.1800 Inf    1.0512
##  asymp.UCL
##     18.411
##      0.990
##      2.971
##      0.707
##      2.072
##      8.232
## 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates 
## Intervals are back-transformed from the log odds ratio scale

confint(object = contrast(object = emm1, method = "revpairwise"), type = "response", adjust="tukey")

##  contrast            odds.ratio    SE  df asymp.LCL
##  Down / Backward          0.310 0.210 Inf    0.0543
##  Forward / Backward       2.607 0.962 Inf    1.0105
##  Forward / Down           8.403 5.830 Inf    1.4151
##  Sideways / Backward      0.886 0.334 Inf    0.3366
##  Sideways / Down          2.857 1.980 Inf    0.4826
##  Sideways / Forward       0.340 0.136 Inf    0.1215
##  asymp.UCL
##      1.772
##      6.725
##     49.901
##      2.333
##     16.910
##      0.951
## 
## Confidence level used: 0.95 
## Conf-level adjustment: tukey method for comparing a family of 4 estimates 
## Intervals are back-transformed from the log odds ratio scale

# Parametric bootstrap intervals
# Using "bootstrap t" approach to yield good intervals (Davison and Hinkley 1997)
# Basic idea is to replace Z in standard confidence interval formula,
#    estimate +/- Z(1-alpha/2) * Standard error,
#  with a simulated value Z*.
# So need to compute values of Z* = (estimate - parameter)/Standard error in each simulation.
# *** The trick is that the "parameter" in the simulation model 
#   is the value of the estimate from the original data.

# Showing different simulation approach, since only one model needs to be fit to different versions of the data
# "refit()" supposedly fits model faster than creating a new "glmer()" call

########### Warning: the simulate() method for mer-class objects is a bit limited! 
###########  You can only specify the family name, not also the link, and it must be in quotes.
###########mod.glmm.5a <- glmer(formula = head ~ initial + (1|resident), nAGQ = 5, data = fall.head, family = "binomial")

# Simulate one data set from model "mod.glmm.5" 
#  then refit model (m1) on each simulated data set.
#  (These can be the same model, as they will be here for confidence intervals,
#  but could also be different models, as for hypothesis test)
# Then compute covariance matrix for whole set of functions
# Finally compute Wald Z as "zz"

sims = 1000
simfull <- simulate(mod.glmm.5, nsim = sims, seed = 86824165)
# Create matrix to store Z-statistics for each resample
zz <- matrix(data = NA, nrow = sims, ncol = nrow(K))

# Fit Model and compute test statistic
for (i in c(1:sims)){
 m1 <- glmer(formula = simfull[,i] ~ initial + (1|resident), nAGQ = 5, 
             data = fall.head, family = binomial)
 var.pw <- diag(K %*% vcov(m1) %*% t(K))
 zz[i,] <- (K %*% (fixef(m1) - fixef(mod.glmm.5)))/sqrt(var.pw)
}
# Reduce results to only those cases that provided estimates
zz <- na.omit(zz)
nz <- nrow(zz)
summary(zz)

##        V1                 V2          
##  Min.   :-1.74576   Min.   :-3.42936  
##  1st Qu.:-0.65369   1st Qu.:-0.63006  
##  Median :-0.03029   Median : 0.11127  
##  Mean   : 0.03137   Mean   : 0.06217  
##  3rd Qu.: 0.55984   3rd Qu.: 0.72390  
##  Max.   : 3.36520   Max.   : 2.99582  
##        V3                   V4          
##  Min.   :-3.0216010   Min.   :-3.29080  
##  1st Qu.:-0.6968629   1st Qu.:-0.46602  
##  Median :-0.0291103   Median : 0.07949  
##  Mean   : 0.0007978   Mean   : 0.02087  
##  3rd Qu.: 0.7088648   3rd Qu.: 0.61293  
##  Max.   : 3.0396668   Max.   : 1.96542  
##        V5                 V6          
##  Min.   :-3.93007   Min.   :-2.89379  
##  1st Qu.:-0.58845   1st Qu.:-0.72937  
##  Median : 0.03071   Median :-0.08084  
##  Mean   :-0.02491   Mean   :-0.06340  
##  3rd Qu.: 0.60500   3rd Qu.: 0.61148  
##  Max.   : 1.93243   Max.   : 3.13987

# Compute critical values (quantiles) from each column of zz
crits <- apply(X = zz, MARGIN = 2, FUN = function(y){quantile(x = y, probs = c(0.025, 0.975))})
crits  # Compare to Normal 1.96

##            [,1]      [,2]      [,3]      [,4]
## 2.5%  -1.380109 -1.981470 -1.926753 -1.949981
## 97.5%  2.009867  1.933167  2.018389  1.468647
##            [,5]      [,6]
## 2.5%  -1.951421 -1.926904
## 97.5%  1.482721  1.936330

# Manually compute confidence intervals
estDiffs <- K %*% fixef(mod.glmm.5)
var.eD <- diag(K %*% vcov(mod.glmm.5) %*% t(K))

pw.CI <- cbind(estDiffs, lower = estDiffs - crits[2,]*sqrt(var.eD), 
               upper = estDiffs - crits[1,]*sqrt(var.eD))
# Exponentiating to present as odds ratios for comparisons between initial fall direction
round(exp(pw.CI), 2)

##     [,1] [,2]  [,3]
## D-B 0.31 0.08  0.79
## F-B 2.61 1.28  5.41
## S-B 0.89 0.41  1.83
## F-D 8.40 3.04 32.48
## S-D 2.86 1.02 11.03
## S-F 0.34 0.16  0.74

# Automatic confidence intervals for model parameters
# Not so useful here because parameters are differences between levels, 
# but could be helpful in regression settings.
confint(mod.glmm.5, method = "profile", level = 0.95)

##                      2.5 %      97.5 %
## .sig01           0.0000000  1.23939720
## (Intercept)     -1.1714262 -0.17368208
## initialDown     -2.7096108  0.03912798
## initialForward   0.2398951  1.73073766
## initialSideways -0.8886752  0.61179345

confint(mod.glmm.5, method = "Wald", level = 0.95)

##                      2.5 %     97.5 %
## .sig01                  NA         NA
## (Intercept)     -1.1284840 -0.1608418
## initialDown     -2.4998389  0.1588989
## initialForward   0.2350999  1.6811803
## initialSideways -0.8593821  0.6177916

# These produce errors due to nonconvergence that our simulations did not.
confint(mod.glmm.5, method = "boot", level = 0.95) 

##                       2.5 %      97.5 %
## .sig01            0.0000000  1.15256349
## (Intercept)      -1.2383784 -0.15415185
## initialDown     -32.9303751 -0.02863849
## initialForward    0.2576762  1.82247447
## initialSideways  -0.9574177  0.61478608

confint(mod.glmm.1, method = "boot", level = 0.95) 

##                      2.5 %      97.5 %
## .sig01           0.0000000  0.87056143
## (Intercept)     -1.2224671 -0.20526463
## initialDown     -2.8385099 -0.01640391
## initialForward   0.2668949  1.79103976
## initialSideways -0.8861819  0.67513560

#######################################################################
# Inferences on Random Effects

# Test significance of variance component by simulation

# Fit model without random effect (i.e. under H0: variance component = 0)
mod.glm <- glm(formula = head ~ initial, data = fall.head, family = binomial(link = "logit"))
summary(mod.glm)

## 
## Call:
## glm(formula = head ~ initial, family = binomial(link = "logit"), 
##     data = fall.head)
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)
## (Intercept)      -0.6360     0.2380  -2.672  0.00754
## initialDown      -1.1558     0.6675  -1.732  0.08336
## initialForward    0.9544     0.3586   2.661  0.00778
## initialSideways  -0.1085     0.3664  -0.296  0.76726
##                   
## (Intercept)     **
## initialDown     . 
## initialForward  **
## initialSideways   
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 285.84  on 214  degrees of freedom
## Residual deviance: 269.59  on 211  degrees of freedom
## AIC: 277.59
## 
## Number of Fisher Scoring iterations: 4

# Simulate many data sets from this model
# This runs for a few minutes using sims = 1000. Could use fewer and see if p-value is already clear in its message.
sims <- 1000
simmod.h0 <- simulate(mod.glm, nsim = sims, seed = 28662819)
# Fit mixed model to the data and estimate the variance component when it is known to be 0
orig.vc <- summary(mod.glmm.5)$varcor[[1]][1,1]
# Initialize LR0 and varcomps0 as matrix to preserve NA when estimation fails
varcomps0 <- matrix(data = NA, nrow = sims, ncol = 1)
LR0 <- matrix(data = NA, nrow = sims, ncol = 1)
for (i in c(1:sims)){
 mm <- glmer(formula = simmod.h0[,i] ~ initial + (1|resident), nAGQ = 5, 
             data = fall.head, family = binomial(link = "logit"))
 varcomps0[i,] <- summary(mm)$varcor[[1]][1,1]
 m0 <- glm(formula = simmod.h0[,i] ~ initial, data = fall.head, family = binomial(link = "logit"))
 LR0[i,] <- -2*logLik(m0) + 2*logLik(mm)
# print(i)
}

# Bootstrap p-value using variance component estimate
varcomps0 <- na.omit(varcomps0) 
nrow(varcomps0) 

## [1] 1000

summary(varcomps0)

##        V1        
##  Min.   :0.0000  
##  1st Qu.:0.0000  
##  Median :0.0000  
##  Mean   :0.1635  
##  3rd Qu.:0.1667  
##  Max.   :3.4896

pval.vc <- sum(varcomps0 >= orig.vc)/nrow(varcomps0)
pval.vc

## [1] 0.328

dev.new(width = 7, height = 5)
hist(x = varcomps0, breaks = 25, freq = FALSE, xlab = "Variance component value", main = NULL)
abline(v = orig.vc, col = "red", lwd = 2)

# Bootstrap p-value using LRT statistic
# Original data LR test stat
orig.LR <- -2*logLik(mod.glm) + 2*logLik(mod.glmm.5)
# Boot p
LR0 <- na.omit(LR0)
nrow(LR0)

## [1] 1000

summary(LR0)

##        V1        
##  Min.   :0.0000  
##  1st Qu.:0.0000  
##  Median :0.0000  
##  Mean   :0.4158  
##  3rd Qu.:0.2181  
##  Max.   :9.9321

pval.lr <- sum(LR0 >= orig.LR)/nrow(LR0)
pval.lr

## [1] 0.318

# Large sample p-value 
as.numeric(1 - pchisq(orig.LR, df = 1))/2

## [1] 0.3933802

# Histogram of bootstrap estimate sampling distribution of LRT stat.
#   Ignoring the 50% expected zeroes, looking at the rest.
dev.new(width = 7, height = 5)
hist(x = LR0[order(LR0)[-c(1:(sims/2))]], breaks = 100, freq = FALSE,
  xlab = expression(-2*log(Lambda)), main = NULL, col = NULL)
abline(v = orig.LR, col = "black", lwd = 2)
curve(expr = 2*dchisq(x,1), from = 0.05, to = 10, add = TRUE, lty = "dashed")

# Confidence interval for variance component by parametric bootstrap
# Note that LR confidence interval was produced earlier by confint(, method = "profile)
# Simulate data from model that we are using for fit.
# Note: this could be integrated into the precious parametric bootstrap for fixed effects. 
# Both use simulations from the same model (contained above in the object "simfull")
# We recreate the object here
 
sims <- 1000
varcomps1 <- matrix(data = NA, nrow = sims, ncol = 1)
simfull <- simulate(mod.glmm.5, nsim = sims, seed = 86824165)
for(i in c(1:sims)){
 m1 <- glmer(formula = simfull[,i] ~ initial + (1|resident), nAGQ = 5, 
             data = fall.head, family = binomial)
 varcomps1[i,] <- summary(m1)$varcor[[1]][1,1]
}

summary(varcomps1)

##        V1          
##  Min.   :0.000000  
##  1st Qu.:0.000000  
##  Median :0.003607  
##  Mean   :0.243164  
##  3rd Qu.:0.315559  
##  Max.   :4.108321

# Percentile confidence interval is just the 1 - alpha/2 quantiles
quantile(x = varcomps1, probs = c(0.025,0.975), na.rm = TRUE)

##     2.5%    97.5% 
## 0.000000 1.540611

# BCa interval requires two extra quantities, ahat and z0:
z0 <- qnorm(p = mean(varcomps1 <= orig.vc))
ahat <- sum((varcomps1 - mean(varcomps1))^3) / (6*(sum((varcomps1 - mean(varcomps1))^2))^(3/2)) 
zsums <- z0 + qnorm(p = c(0.025, 0.975))
p1 <- pnorm(zsums/(1 - ahat*zsums) + z0) 

quantile(x = varcomps1, probs = p1, na.rm = TRUE)

## 6.712998% 99.29138% 
##  0.000000  2.136736

# Alternative LR Confidence interval. 
# Note: Variance components are listed as "sig" parameters 
confint(object = mod.glmm.5, level = 0.95, method = "profile")

##                      2.5 %      97.5 %
## .sig01           0.0000000  1.23939720
## (Intercept)     -1.1714262 -0.17368208
## initialDown     -2.7096108  0.03912798
## initialForward   0.2398951  1.73073766
## initialSideways -0.8886752  0.61179345

# Estimates of fixed - effect parameters
fixef ( mod.glmm.5)

##     (Intercept)     initialDown  initialForward 
##      -0.6446629      -1.1704700       0.9581401 
## initialSideways 
##      -0.1207953

# Conditional Modes ( b_i ) for random effects listed ** BY resident ID ** , not in data order .
head ( ranef( mod.glmm.5)$resident )

##   (Intercept)
## 1  0.21740783
## 2 -0.11413648
## 3 -0.11413648
## 4 -0.05035573
## 5  0.21740783
## 6 -0.10535869

# Show that there is one element per resident
nrow ( ranef( mod.glmm.5)$resident )

## [1] 131

# coef = Fixed + Random effects . Listed ** BY resident ID ** , not in data order .
head ( coef( mod.glmm.5)$resident )

##   (Intercept) initialDown initialForward
## 1  -0.4272551    -1.17047      0.9581401
## 2  -0.7587994    -1.17047      0.9581401
## 3  -0.7587994    -1.17047      0.9581401
## 4  -0.6950186    -1.17047      0.9581401
## 5  -0.4272551    -1.17047      0.9581401
## 6  -0.7500216    -1.17047      0.9581401
##   initialSideways
## 1      -0.1207953
## 2      -0.1207953
## 3      -0.1207953
## 4      -0.1207953
## 5      -0.1207953
## 6      -0.1207953

As estimativas dos parâmetros de efeito fixo são obtidas utilizando fixef(), enquanto os valores de efeito aleatório \(b_i\), \(i = 1,\cdots,a\), são obtidos com ranef(). As estimativas combinadas de parâmetros fixos e aleatórios para cada residente são obtidas por meio de coef(). Note que o intercepto, que é \(\widehat{\beta}_0 + b_i\), varia para cada residente, mas as estimativas dos outros três parâmetros não estão associadas a efeitos aleatórios e permanecem constantes para todos os residentes.

A seguir, utilizamos diversas chamadas de predict() para apresentar o logit previsto, \(g(\widehat{\pi}_{ik})\), para cada residente, o logit médio estimado assumindo \(b_i = 0\), bem como as respectivas probabilidades previstas de impacto na cabeça (\(\widehat{\pi}_{ik}\)) e as estimativas para um residente médio.

# Predicted logit for each observation
logit.i <- round ( predict ( object = mod.glmm.5 , newdata = fall.head , 
                             re.form = NULL , type = "link") , digits = 3)

# Estimated mean logit for each fall direction , by observation
logit.avg <- round ( predict ( object = mod.glmm.5 , newdata = fall.head , 
                               re.form = NA , type = "link") , digits = 3)

# Predicted probability for each observation
pi.hat.i <- round ( predict ( object = mod.glmm.5 , newdata = fall.head , 
                              re.form = NULL , type = "response") , digits = 3)

# Estimated average probability for each fall direction , by observation
pi.hat.avg <- round ( predict ( object = mod.glmm.5 , newdata = fall.head , 
                                re.form = NA , type = "response") , digits = 3)

# Conditional Modes listed in order of the original data ( they are currently ordered by resident )
ranefs <- round ( ranef ( mod.glmm.5)$resident[ fall.head$resident ,] , digits = 3)

# All predictions and mean estimates
head ( cbind ( fall.head , ranefs , logit.i , logit.avg , pi.hat.i , pi.hat.avg ) )

##   resident  initial head grupo         grupo_label
## 1       56 Sideways    0     1 Grupo 1 (Primeiros)
## 2        9 Backward    0     1 Grupo 1 (Primeiros)
## 3       30  Forward    0     1 Grupo 1 (Primeiros)
## 4        9     Down    0     1 Grupo 1 (Primeiros)
## 5       70 Sideways    0     2   Grupo 2 (Últimos)
## 6       21 Sideways    1     1 Grupo 1 (Primeiros)
##   ranefs logit.i logit.avg pi.hat.i pi.hat.avg
## 1 -0.305  -1.071    -0.765    0.255      0.317
## 2 -0.267  -0.911    -0.645    0.287      0.344
## 3 -0.068   0.246     0.313    0.561      0.578
## 4 -0.267  -2.082    -1.815    0.111      0.140
## 5 -0.002  -0.767    -0.765    0.317      0.317
## 6  0.359  -0.407    -0.765    0.400      0.317

Observe que logit.i difere de logit.avg exatamente pelo valor de ranefs, evidenciando o impacto dos valores de efeitos aleatórios (modas condicionais) nos logits — e, consequentemente, nas probabilidades em pi.hat.i em relação a pi.hat.avg.

Assim, as quantidades “médias” são constantes para cada queda com a mesma direção inicial, ao passo que as previsões variam ligeiramente para cada residente. Com base nisso, podemos determinar que, em média, a probabilidade de impacto na cabeça é maior para quedas com direção inicial para a frente (0.58) e menor para quedas na vertical (0.14).

6.5.4 Inferência

O modelo ajustado contém estimativas para os efeitos fixos e componentes de variância, bem como as modas condicionais. Todos esses elementos podem ser alvos de interesse para testes e/ou intervalos de confiança. No entanto, a inferência em GLMMs deve ser realizada com cautela.

Como utilizamos a estimação por máxima verossimilhança (ML), espera-se que todas as estimativas dos parâmetros apresentem distribuições aproximadamente normais em amostras grandes, com variâncias que não são difíceis de calcular. Contudo, na prática, o que constitui uma “amostra grande” pode depender, em parte, do número de agrupamentos ou sujeitos, do número de observações dentro desses agrupamentos ou sujeitos e do formato da distribuição das variáveis de resposta que estão sendo modeladas.

Testes e intervalos de confiança para parâmetros de efeitos fixos

A parte referente aos efeitos fixos de um GLMM consiste em um modelo semelhante àqueles apresentados nos Capítulos 2 e 4. Portanto, os tipos de análise provavelmente necessários são os mesmos apresentados nesses capítulos.

Testes de hipóteses para parâmetros individuais ou para comparações entre parâmetros são comuns, e frequentemente deseja-se obter intervalos de confiança para essas mesmas quantidades, bem como para certas médias ou probabilidades. Nesses modelos de efeitos fixos, métodos de razão de verossimilhança (LR) eram geralmente recomendados para grandes amostras, sendo que os critérios para definir o que constitui uma amostra “grande” não eram excessivamente rigorosos.

Alternativamente, poderiam ser utilizados métodos de Wald baseados na normalidade assintótica (para grandes amostras) do estimador de máxima verossimilhança (MLE); contudo, os resultados frequentemente não eram tão precisos quanto os obtidos pelos métodos de LR para tamanhos de amostra comparáveis.

Em modelos lineares generalizados mistos (GLMMs), métodos baseados na razão de verossimilhança (LR) podem ser mais difíceis de aplicar do que em modelos de efeitos fixos, pois a função de verossimilhança pode ser muito mais complexa de avaliar, especialmente no caso de modelos complexos ou grandes conjuntos de dados.

Intervalos de confiança baseados na verossimilhança perfilada não são frequentemente utilizados, embora o aumento da capacidade computacional e o aprimoramento dos algoritmos de ajuste estejam tornando essa abordagem mais atraente. Historicamente, as inferências de Wald têm sido o padrão, apesar de tenderem a ser ainda menos precisas em GLMMs do que em modelos lineares generalizados (GLMs) convencionais.

Como alternativa a esses métodos, nossa abordagem preferida é utilizar o bootstrap paramétrico. Os métodos de bootstrap são discutidos nas Seções 3.2.3 e 6.4.2 e abordados de forma mais completa em Davison and Hinkley (1997). Para um teste de hipóteses utilizando bootstrap paramétrico, conjuntos de dados (chamados de “reamostras”) são simulados de maneira semelhante à utilizada na Seção 2.2.8, empregando-se uma versão do GLMM cujos parâmetros são estimados sob a suposição de que a hipótese nula é verdadeira.

Por exemplo, podemos remover um termo do modelo e simular dados a partir do novo modelo ajustado para testar a significância do termo removido. O GLMM completo é reajustado para cada reamostra, e uma estatística de teste — comumente a estatística de Wald ou outra grandeza de fácil cálculo — é calculada a partir de cada reajuste.

Um \(p\)-valor é calculado como a proporção desses valores simulados da estatística de teste que são pelo menos tão extremos, isto é, que favorecem a hipótese alternativa pelo menos tanto quanto aquele calculado a partir dos dados originais.

Para obter um intervalo de confiança via bootstrap paramétrico para um parâmetro, o modelo de simulação utilizado é o modelo original ajustado, com todos os efeitos preservados. O parâmetro é estimado para cada reamostra, e o conjunto de estimativas simuladas do parâmetro é convertido em limites de intervalo utilizando alguma técnica apropriada; várias dessas técnicas são descritas em Davison and Hinkley (1997).

Note que o parâmetro em questão pode ser um parâmetro de um modelo de regressão ou alguma outra grandeza calculada a partir deles, como uma razão de chances (odds ratio), uma média específica ou uma probabilidade.

Exemplo 6.18: Quedas com impacto na cabeça

#####
# Parametric Bootstrap for Fixed Effects

# Prepare for Parametric bootstrap. Calculate the LR statistic for test.
names(lrt)

## [1] "npar"    "AIC"     "LRT"     "Pr(Chi)"

orig.LRT <- lrt$LRT[2]  # Saves LR Test statistic

# Fit null model
mod.glmm0 <- glmer(formula = head ~ (1|resident), nAGQ = 5, data = fall.head, family = "binomial")

# Find distribution of LR Test Statistic by Parametric bootstrap simulation
# Generate data from reduced H0 model (No effect for initial fall direction)
# Fit full model with "initial"
# Compute test statistic (LRT Stat) for each "initial" simulation
# Compute p-value as % of simulations with larger LRT than original.
sims <- 1000
# simulate() generates new responses for the existing explanatory variables and grouping factors.
simfix.h0 <- simulate(mod.glmm0, nsim = sims, seed = 9245982)
# Fit model and compute test statistic
LRT0 <- numeric(length = sims)
for (i in 1:sims){
 m1 <- glmer(formula = simfix.h0[,i] ~ initial + (1|resident), nAGQ = 5, data = fall.head, 
             family = "binomial")
 LRT0[i] <- drop1(m1, test = "Chisq")$LRT[2]
}
summary(LRT0)

##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  0.04826  1.26985  2.32598  3.04838  4.28339 17.16812

pval <- mean(LRT0 >= orig.LRT)
pval

## [1] 0.003

# Plot results
dev.new(width = 7, height = 5)
hist(x = LRT0, breaks = 25, freq = FALSE, xlab = "-2 log(Lambda)", main = NULL, 
     xlim = c(0, 2+round(max(LRT0, orig.LRT))), col = NA)
abline(v = orig.LRT, col = "red", lwd = 2)
curve(expr = dchisq(x = x, df = 3), add = TRUE, from = 0, to = 18, col = "blue", lwd = 2)

library(multcomp)

K <- rbind("D-B" = c(0, 1, 0, 0), 
           "F-B" = c(0, 0, 1, 0),
           "S-B" = c(0, 0, 0, 1),
           "F-D" = c(0, -1, 1, 0),
           "S-D" = c(0, -1, 0, 1),
           "S-F" = c(0, 0, -1, 1))

pw.comps <- glht(mod.glmm.5, linfct = K)

# Wald Test of global hypothesis (all contrasts = 0) 
summary(pw.comps, test = Chisqtest())

## 
##   General Linear Hypotheses
## 
## Linear Hypotheses:
##          Estimate
## D-B == 0  -1.1705
## F-B == 0   0.9581
## S-B == 0  -0.1208
## F-D == 0   2.1286
## S-D == 0   1.0497
## S-F == 0  -1.0789
## 
## Global Test:
##   Chisq DF Pr(>Chisq)
## 1 13.88  3   0.003075

# Tests using Individual error rates = 0.95
summary(pw.comps, test = adjusted("none"))

## 
##   Simultaneous Tests for General Linear Hypotheses
## 
## Fit: glmer(formula = head ~ initial + (1 | resident), data = fall.head, 
##     family = binomial(link = "logit"), nAGQ = 5)
## 
## Linear Hypotheses:
##          Estimate Std. Error z value Pr(>|z|)   
## D-B == 0  -1.1705     0.6783  -1.726  0.08440 . 
## F-B == 0   0.9581     0.3689   2.597  0.00940 **
## S-B == 0  -0.1208     0.3768  -0.321  0.74855   
## F-D == 0   2.1286     0.6934   3.070  0.00214 **
## S-D == 0   1.0497     0.6922   1.516  0.12940   
## S-F == 0  -1.0789     0.4006  -2.694  0.00707 **
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- none method)

# Tests using Familywise error rates = 0.95
summary(pw.comps)

## 
##   Simultaneous Tests for General Linear Hypotheses
## 
## Fit: glmer(formula = head ~ initial + (1 | resident), data = fall.head, 
##     family = binomial(link = "logit"), nAGQ = 5)
## 
## Linear Hypotheses:
##          Estimate Std. Error z value Pr(>|z|)  
## D-B == 0  -1.1705     0.6783  -1.726   0.2973  
## F-B == 0   0.9581     0.3689   2.597   0.0431 *
## S-B == 0  -0.1208     0.3768  -0.321   0.9880  
## F-D == 0   2.1286     0.6934   3.070   0.0106 *
## S-D == 0   1.0497     0.6922   1.516   0.4136  
## S-F == 0  -1.0789     0.4006  -2.694   0.0326 *
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- single-step method)

# Confidence intervals using Individual error rates = 0.95
ci.logit.I <- confint(pw.comps, calpha = qnorm(0.975))
round(exp(ci.logit.I$confint),2)

##     Estimate  lwr   upr
## D-B     0.31 0.08  1.17
## F-B     2.61 1.27  5.37
## S-B     0.89 0.42  1.85
## F-D     8.40 2.16 32.71
## S-D     2.86 0.74 11.09
## S-F     0.34 0.16  0.75
## attr(,"conf.level")
## [1] 0.95
## attr(,"calpha")
## [1] 1.959964

# Confidence intervals using Familywise error rates = 0.95
ci.logit.F <- confint(pw.comps, level = 0.95)
round(exp(ci.logit.F$confint), 2)

##     Estimate  lwr   upr
## D-B     0.31 0.06  1.74
## F-B     2.61 1.02  6.65
## S-B     0.89 0.34  2.31
## F-D     8.40 1.44 48.92
## S-D     2.86 0.49 16.58
## S-F     0.34 0.12  0.94
## attr(,"conf.level")
## [1] 0.95
## attr(,"calpha")
## [1] 2.540291

As comparações aos pares são identificadas de acordo com os dois níveis que estão sendo comparados. Por exemplo, a estimativa de 0.31 para “D-B” indica que a chance estimada de impacto na cabeça em uma queda para baixo é 0.31 vezes a chance em uma queda para trás ou, de forma equivalente, que a chance estimada de impacto na cabeça em uma queda para trás é 1/0.31 = 3.2 vezes a chance em uma queda para baixo.

Os três intervalos de confiança relacionados a quedas para a frente excluem o valor 1. Com base na direção das diferenças, podemos concluir que a ocorrência de impacto na cabeça é significativamente mais provável quando a direção inicial da queda é para a frente do que em qualquer outra direção.

Todos os intervalos de confiança referentes aos três níveis restantes incluem o valor 1; portanto, não há diferenças significativas nas probabilidades de impacto na cabeça entre essas direções. Esses intervalos de confiança são bastante amplos, o que indica a persistência de uma incerteza considerável na estimativa dessas razões de chances (odds ratios).

Por fim, o uso de um nível de confiança para a família de estimativas (familywise confidence level) significa que temos 95% de confiança de que todos os seis intervalos de confiança abrangerão as suas respectivas razões de chances verdadeiras.

Alternativamente, podemos utilizar o bootstrap paramétrico para realizar testes e calcular intervalos de confiança. Westfall and Young (1993) apresentam algoritmos adicionais que podem ser utilizados para controlar os níveis de confiança para a família de estimativas em intervalos de confiança baseados em reamostragem.

6.5.5 Modelagem marginal utilizando equações de estimação generalizadas

Conforme descrito na Seção 6.5.3, a estimação de parâmetros em modelos lineares generalizados mistos (GLMMs) pode ser um processo computacionalmente complexo e difícil. Os resultados de um GLMM incluem previsões para cada cluster ou sujeito observado; para facilitar a discussão, no restante desta seção utilizamos o termo “sujeito” para nos referirmos tanto a um sujeito quanto a um cluster.

Eles também incluem estimativas de vários parâmetros de regressão para um “sujeito médio” — aquele que apresenta todos os efeitos aleatórios iguais a zero. Um GLMM é denominado modelo específico do sujeito, pois a inclusão de efeitos aleatórios permite que cada sujeito tenha seus próprios valores de parâmetros, conforme descrito na Seção 6.5.2.

Uma abordagem alternativa consiste em modelar diretamente a relação entre uma variável explicativa e a resposta média populacional, em vez de sua relação com os indivíduos da população. Um modelo direto para a média populacional é chamado de modelo marginal, uma vez que a média populacional é derivada da distribuição marginal do desfecho.

O modelo marginal é fundamentalmente diferente do GLMM, como se pode observar na Figura 6.8. O gráfico apresenta a probabilidade de sucesso simulada, \(P(Y = 1)\), para uma amostra de 50 indivíduos cuja probabilidade segue a relação \[ logit(\pi_i ) = −20 + b_i + 0.2x_i, \] \(i = 1, . . . , 50\), em que os \(b_i\) são variáveis aleatórias independentes com distribuição \(N (0, 1.5^2)\). A curva contínua mais espessa representa a curva de probabilidade para o “indivíduo médio”, isto é, para \(b_i = 0\). Essa é a grandeza estimada por um GLMM.

# PURPOSE: Simulate random effects for logistic regression and compare # 
#          curve with average random effect to average curve           #
########################################################################
set.seed(3789022)

beta1 <- 0.2
beta0 <- -100*beta1
b <- rnorm(n = 50, mean = 0, sd = 1.5)
x <- seq(from = 70, to = 130, by = .5)
probs <- matrix(data = 0, ncol = 50, nrow = length(x))

par(mar=c(1,1,1,1))
curve(expr = plogis(beta0 + beta1*x), from = 70, to = 130, col = "red", lwd = 2, ylab = "P(Y = 1)")

for(i in c(1:50)){
 curve(expr = plogis((beta0 + b[i]) + beta1*x), from = 70, to = 130, 
    col = "black", lwd = 1, lty = "dotted", add = TRUE)
 probs[,i] <- plogis((beta0 + b[i]) + beta1*x)
 
}
curve(expr = plogis(beta0 + beta1*x), from = 70, to = 130, col = "red", lwd = 3, add = TRUE)

marg <- apply(X = probs, MARGIN = 1, FUN = mean)
lines(x = x, y = marg, lty = "dashed", lwd = 3, col = "blue")
legend(x = 110, y = 0.3, legend = c("Subject-specific", "Marginal", "Individual"), bty = "n",
    lty = c("solid", "dashed", "dotted"), lwd = c(3,3,1), col = c("red", "blue", "black"))

grid()

Figura 6.8: Modelo específico para o sujeito e modelo marginal para uma amostra simulada de 50 sujeitos provenientes de uma população cuja probabilidade de sucesso segue uma curva logística com inclinação comum, porém interceptos diferentes.

A curva tracejada representa a probabilidade média para cada valor de \(x\), sendo essa a grandeza estimada por um modelo marginal. A diferença entre elas ocorre porque o modelo específico para o indivíduo realiza a média horizontalmente, enquanto o modelo marginal realiza a média verticalmente. Em modelos de regressão linear, essa distinção não é relevante, mas torna-se importante quando a curva de resposta é não linear.

Em algumas aplicações, um modelo marginal é mais relevante do que um modelo específico para o indivíduo. Por exemplo, em estudos governamentais sobre a associação entre a frequência de vacinação e a prevalência de uma doença, compreender os efeitos sobre a média populacional é mais útil para embasar políticas nacionais de saúde do que compreender os efeitos sobre os indivíduos.

Boas sínteses sobre os detalhes e as interpretações dos modelos marginais podem ser encontradas em Agresti (2002) e em Molenberghs and Verbeke (2005).

Criação e estimação de modelos marginais

Suponha que tenhamos um conjunto de \(a\) sujeitos e, por conveniência, que existam \(t\) medidas de resposta por sujeito; em alguns contextos, o número de respostas por sujeito pode variar. Modelar uma distribuição marginal envolve, primeiramente, especificar uma distribuição conjunta completa de todas as \(t\) respostas correlacionadas de um mesmo sujeito.

Isso exige a formulação de modelos para a média, para associações de ordem 2 entre pares de respostas, para associações de ordem 3 e assim por diante, até associações de ordem \(t\). Podemos ter pouca noção de como essas associações de ordem superior devem ser modeladas e, na verdade, estar interessados apenas em modelar a resposta média. Assim, consideramos tratar as associações como um aspecto de “incômodo” (nuisance).

Como um modelo aproximado, suponhamos que todas as associações entre as respostas sejam nulas; isto é, as respostas de um mesmo indivíduo são independentes. Isso significa que as \(n = at\) respostas são tratadas como independentes, em vez de serem consideradas como provenientes de agrupamentos de respostas.

É muito provável que essa suposição de independência esteja incorreta em muitas aplicações, mas ela nos permite criar um “modelo de trabalho” (“working model”) que pod ser especificado e ajustado aos dados, de forma semelhante à abordagem de pseudoverossimilhança utilizada nas Seções 6.3.6 e 6.4.3.

Zeger and Liang (1986) ajustam esse modelo utilizando uma técnica muito semelhante à estimação por máxima verossimilhança (MLE), porém não baseada em uma função de verossimilhança totalmente especificada. Eles propõem a resolução de um conjunto de equações de estimação generalizadas (GEEs) para obter as estimativas dos parâmetros.

“Equações de estimação generalizadas” (GEES) são funções de parâmetros igualadas a zero para encontrar estimativas de parâmetros, como a função score para obter estimadores de máxima verossimilhança (MLEs).

Os estimadores correspondentes possuem muitas das propriedades dos estimadores de máxima verossimilhança (MLEs). Em particular, eles apresentam distribuição aproximadamente normal em amostras grandes e são consistentes (ver Apêndice), desde que o modelo para as médias esteja correto, mesmo quando o modelo de trabalho para as associações estiver incorreto.

No entanto, as variâncias das estimativas dos parâmetros dependem da estrutura de associação que estamos ignorando no modelo. Especificamente, as estimativas de variância obtidas pelo ajuste de um GLM padrão tendem a ser subestimadas quando as respostas dentro dos sujeitos estão positivamente correlacionadas. Zeger and Liang (1986) desenvolveram um método para corrigir essas variâncias.

Os estimadores de variância resultantes são conhecidos como estimadores “sanduíche” devido à sua forma matemática como produto de três matrizes, em que a mesma matriz é utilizada em ambas as extremidades. Eles também são denominados variâncias “robustas” ou “empiricamente corrigidas”. Detalhes adicionais sobre o seu cálculo são apresentados em Zeger and Liang (1986), Agresti (2002) e Molenberghs and Verbeke (2005).

A abordagem GEE pode ser aplicada utilizando outras estruturas de associação assumidas para as respostas, em vez da independência. De fato, a eficiência (precisão) das estimativas dos parâmetros GEE melhora quando se utiliza uma estrutura de correlação que mais se aproxima da verdadeira distribuição conjunta das respostas.

No entanto, a eficiência também pode ser prejudicada se for escolhido um modelo de correlação que exija a estimação de mais parâmetros do que o necessário. Por isso, geralmente dá-se preferência a modelos de associação mais simples, que requerem menos parâmetros.

Uma escolha comum é assumir que todo par de respostas possui a mesma correlação diferente de zero. Essa é chamada de estrutura de correlação permutável (exchangeable). Ou, se as medições forem realizadas ao longo do tempo, pode-se assumir que a correlação entre um par de respostas depende do intervalo de tempo entre as medições. Em particular, se a correlação decresce exponencialmente com a distância, trata-se de uma estrutura de correlação autorregressiva (AR). Essas duas estruturas são populares porque ambas podem ser estimadas com um único parâmetro, distinto dos parâmetros de regressão.

Alternativamente, pode-se optar por uma estrutura de correlação totalmente não especificada, na qual um parâmetro de correlação é estimado para cada combinação de pares de respostas. Essa estrutura é frequentemente denominada “não estruturada” (unstructured). Note que isso resulta em um total de \(t(t − 1)/2\) parâmetros de correlação; portanto, seu uso é mais adequado apenas quando há dúvidas significativas sobre a suficiência de uma estrutura mais simples.

Outras estruturas de correlação também podem ser consideradas; no entanto, geralmente é difícil distinguir com precisão entre diferentes estruturas de correlação, especialmente quando o número de sujeitos não é muito grande.

As inferências a partir de GEEs são realizadas utilizando métodos de Wald; portanto, em todos os casos, é necessário um tamanho de amostra “grande”. O que se considera “grande” depende do número de sujeitos, das medidas por sujeito, das variáveis explicativas e das magnitudes das médias ou probabilidades que estão sendo estimadas.

Ao contrário de outros problemas, nos quais poderíamos verificar a qualidade das inferências por meio de uma simulação baseada no modelo estimado, as GEEs fundamentam-se em um modelo incompleto para as respostas; assim, não está totalmente claro qual modelo deveria ser utilizado para as simulações.

Quando há preocupação quanto à adequação das inferências de Wald e/ou das estimativas de variância, pode-se utilizar, em alternativa, uma abordagem de bootstrap não paramétrico (Davison and Hinkley 1997).

A reamostragem deve ser aplicada aos sujeitos, incluindo-se todas as \(t\) respostas sempre que um determinado sujeito for reamostrado, e não às respostas individuais, de modo que a estrutura de correlação intra-sujeito seja preservada ao se aplicar a GEE às reamostras.

A abordagem GEE é popular devido à sua relativa simplicidade. Os cálculos são diretos e a correção da variância funciona razoavelmente bem em grandes amostras, embora apresente tendência a subestimar a variância real das estimativas dos parâmetros, resultando em inferências liberais.

No entanto, essa abordagem limita-se principalmente a problemas com medidas repetidas ou agrupamento simples. Ela não é facilmente aplicável a problemas que envolvem efeitos aleatórios aninhados ou cruzados.

Exemplo 6.19: Quedas com impacto na cabeça

# PURPOSE: Analysis of head impact for falls using GEE              #
#####################################################################

# Model fitting

library(geepack)
# Need to sort data in order of the clusters first. 
fall.head.o <- fall.head[order(fall.head$resident),]

# Need to specify scale.fix = TRUE, or else quasi-binomial will be fit.
mod.gee.i <- geeglm(formula = head ~ initial, id = resident, data = fall.head.o, 
                    scale.fix = TRUE, family = binomial(link = "logit"), corstr = "independence")
summ <- summary(mod.gee.i)
summ

## 
## Call:
## geeglm(formula = head ~ initial, family = binomial(link = "logit"), 
##     data = fall.head.o, id = resident, corstr = "independence", 
##     scale.fix = TRUE)
## 
##  Coefficients:
##                 Estimate Std.err  Wald Pr(>|W|)   
## (Intercept)      -0.6360  0.2475 6.601  0.01019 * 
## initialDown      -1.1558  0.6510 3.152  0.07583 . 
## initialForward    0.9544  0.3401 7.875  0.00501 **
## initialSideways  -0.1085  0.3435 0.100  0.75222   
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation structure = independence 
## Scale is fixed.
## 
## Number of clusters:   131  Maximum cluster size: 13

names(summ)

##  [1] "call"           "terms"          "family"        
##  [4] "contrasts"      "deviance.resid" "coefficients"  
##  [7] "aliased"        "dispersion"     "df"            
## [10] "cov.unscaled"   "cov.scaled"     "corr"          
## [13] "corstr"         "scale.fix"      "cor.link"      
## [16] "clusz"          "error"          "geese"

summ$cov.scaled

##          [,1]     [,2]     [,3]     [,4]
## [1,]  0.06128 -0.06660 -0.05763 -0.05683
## [2,] -0.06660  0.42378  0.09347  0.04674
## [3,] -0.05763  0.09347  0.11568  0.05336
## [4,] -0.05683  0.04674  0.05336  0.11800

# anova() method performs Wald chi-square test.  
anova(mod.gee.i)

## Analysis of 'Wald statistic' Table
## Model: binomial, link: logit
## Response: head
## Terms added sequentially (first to last)
## 
##         Df   X2 P(>|Chi|)    
## initial  3 21.5   8.2e-05 ***
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Recreate anova Wald statistic
(ll <- cbind(c(0,0,0), diag(c(1,1,1))))

##      [,1] [,2] [,3] [,4]
## [1,]    0    1    0    0
## [2,]    0    0    1    0
## [3,]    0    0    0    1

(bhat <- summ$coefficients[,1])

## [1] -0.6360 -1.1558  0.9544 -0.1085

(W <- t(ll %*% bhat) %*% solve( ll %*% summ$cov.scaled %*% t(ll), diag(c(1,1,1))) %*% (ll %*% bhat))

##       [,1]
## [1,] 21.53

###################################################################
# Wald Pairwise comparisons as in FallsGLMM.R

# Defining a vcov() mmethod for use in multcomp. Currently doesn't exist.
vcov(mod.gee.i)  # Fails

##                 (Intercept) initialDown initialForward
## (Intercept)         0.06128    -0.06660       -0.05763
## initialDown        -0.06660     0.42378        0.09347
## initialForward     -0.05763     0.09347        0.11568
## initialSideways    -0.05683     0.04674        0.05336
##                 initialSideways
## (Intercept)            -0.05683
## initialDown             0.04674
## initialForward          0.05336
## initialSideways         0.11800

summ$cov.scaled  # This is what we want

##          [,1]     [,2]     [,3]     [,4]
## [1,]  0.06128 -0.06660 -0.05763 -0.05683
## [2,] -0.06660  0.42378  0.09347  0.04674
## [3,] -0.05763  0.09347  0.11568  0.05336
## [4,] -0.05683  0.04674  0.05336  0.11800

vcov.geeglm <- function(obj){summary(obj)$cov.scaled}
vcov(mod.gee.i)  # Now we get it!

##          [,1]     [,2]     [,3]     [,4]
## [1,]  0.06128 -0.06660 -0.05763 -0.05683
## [2,] -0.06660  0.42378  0.09347  0.04674
## [3,] -0.05763  0.09347  0.11568  0.05336
## [4,] -0.05683  0.04674  0.05336  0.11800

library(multcomp)

K <- rbind("B-F" = c(0, 1, 0, 0),
           "S-F" = c(0, 0, 1, 0),
           "D-F" = c(0, 0, 0, 1),
           "S-B" = c(0, -1, 1, 0),
           "D-B" = c(0, -1, 0, 1),
           "D-S" = c(0, 0, -1, 1))

pw.comps <- glht(mod.gee.i, linfct = K)
# Tests using Individual error rates = 0.95
summary(pw.comps, test = adjusted("none"))

## 
##   Simultaneous Tests for General Linear Hypotheses
## 
## Fit: geeglm(formula = head ~ initial, family = binomial(link = "logit"), 
##     data = fall.head.o, id = resident, corstr = "independence", 
##     scale.fix = TRUE)
## 
## Linear Hypotheses:
##          Estimate Std. Error z value Pr(>|z|)    
## B-F == 0   -1.156      0.651   -1.78  0.07583 .  
## S-F == 0    0.954      0.340    2.81  0.00501 ** 
## D-F == 0   -0.108      0.344   -0.32  0.75222    
## S-B == 0    2.110      0.594    3.55  0.00038 ***
## D-B == 0    1.047      0.670    1.56  0.11777    
## D-S == 0   -1.063      0.356   -2.98  0.00285 ** 
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- none method)

# Tests using Familywise error tates = 0.95
summary(pw.comps)

## 
##   Simultaneous Tests for General Linear Hypotheses
## 
## Fit: geeglm(formula = head ~ initial, family = binomial(link = "logit"), 
##     data = fall.head.o, id = resident, corstr = "independence", 
##     scale.fix = TRUE)
## 
## Linear Hypotheses:
##          Estimate Std. Error z value Pr(>|z|)   
## B-F == 0   -1.156      0.651   -1.78   0.2695   
## S-F == 0    0.954      0.340    2.81   0.0232 * 
## D-F == 0   -0.108      0.344   -0.32   0.9883   
## S-B == 0    2.110      0.594    3.55   0.0019 **
## D-B == 0    1.047      0.670    1.56   0.3818   
## D-S == 0   -1.063      0.356   -2.98   0.0138 * 
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## (Adjusted p values reported -- single-step method)

# Confidence intervals using Individual error rates = 0.95
ci.logit.I <- confint(pw.comps, calpha = qnorm(0.975))
round(exp(ci.logit.I$confint),2)

##     Estimate  lwr   upr
## B-F     0.31 0.09  1.13
## S-F     2.60 1.33  5.06
## D-F     0.90 0.46  1.76
## S-B     8.25 2.58 26.41
## D-B     2.85 0.77 10.59
## D-S     0.35 0.17  0.69
## attr(,"conf.level")
## [1] 0.95
## attr(,"calpha")
## [1] 1.96

# Confidence intervals using Familywise error rates = 0.95
ci.logit.F <- confint(pw.comps)
round(exp(ci.logit.F$confint),2)

##     Estimate  lwr   upr
## B-F     0.31 0.06  1.64
## S-F     2.60 1.10  6.16
## D-F     0.90 0.38  2.14
## S-B     8.25 1.83 37.21
## D-B     2.85 0.52 15.58
## D-S     0.35 0.14  0.85
## attr(,"conf.level")
## [1] 0.95
## attr(,"calpha")
## [1] 2.537

####################################################################
# Confidence intervals for probabilities of head impact
K.fit <- rbind("Forwards"  = c(1, 0, 0, 0),
      "Backwards" = c(1, 1, 0, 0),
      "Sideways"  = c(1, 0, 1, 0),
      "Down"    = c(1, 0, 0, 1))

fits <- glht(mod.gee.i, linfct = K.fit)
# Confidence intervals using Individual error rates = 0.95
ci.eta.I <- confint(fits, calpha = qnorm(0.975))
round(plogis(ci.eta.I$confint),3)

##           Estimate   lwr   upr
## Forwards     0.346 0.246 0.462
## Backwards    0.143 0.050 0.348
## Sideways     0.579 0.458 0.691
## Down         0.322 0.223 0.440
## attr(,"conf.level")
## [1] 0.95
## attr(,"calpha")
## [1] 1.96

# Confidence intervals using Familywise error rates = 0.95
ci.eta.F <- confint(fits)
round(plogis(ci.eta.F$confint),3)

##           Estimate   lwr   upr
## Forwards     0.346 0.222 0.495
## Backwards    0.143 0.037 0.422
## Sideways     0.579 0.426 0.718
## Down         0.322 0.201 0.473
## attr(,"conf.level")
## [1] 0.95
## attr(,"calpha")
## [1] 2.489

###################################################################
# Refit using exchangeable correlation structure 
# (equal correlation for all falls within a subject)
mod.gee.e <- geeglm(formula = head ~ initial, id = resident, data = fall.head.o, 
                    scale.fix = TRUE, family = binomial(link = "logit"), corstr = "exchangeable")
summ <- summary(mod.gee.e)
names( summ )

##  [1] "call"           "terms"          "family"        
##  [4] "contrasts"      "deviance.resid" "coefficients"  
##  [7] "aliased"        "dispersion"     "df"            
## [10] "cov.unscaled"   "cov.scaled"     "corr"          
## [13] "corstr"         "scale.fix"      "cor.link"      
## [16] "clusz"          "error"          "geese"

summ$cov.scaled

##          [,1]     [,2]     [,3]     [,4]
## [1,]  0.06108 -0.06649 -0.05751 -0.05653
## [2,] -0.06649  0.41638  0.09217  0.04611
## [3,] -0.05751  0.09217  0.11469  0.05318
## [4,] -0.05653  0.04611  0.05318  0.11820

# anova () method performs Wald chi - square test .
anova ( mod.gee.i )

## Analysis of 'Wald statistic' Table
## Model: binomial, link: logit
## Response: head
## Terms added sequentially (first to last)
## 
##         Df   X2 P(>|Chi|)    
## initial  3 21.5   8.2e-05 ***
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

O resumo do ajuste do modelo assemelha-se bastante a outros resumos de regressão. Os erros-padrão são calculados a partir das estimativas robustas do tipo “sanduíche” da variância de cada estimativa de parâmetro. Esses valores também podem ser obtidos a partir das raízes quadradas dos elementos da diagonal de cov.scaled no objeto resultante da função summary(), o qual contém as variâncias e covariâncias estimadas das estimativas dos parâmetros de regressão.

O teste de Wald para a igualdade de probabilidade de impacto na cabeça em cada direção é claramente significativo, apresentando uma estatística de teste W = 21.5 e um \(p\)-valor muito baixo.

Em seguida, realizamos comparações aos pares entre os níveis de initial. Elas são conduzidas da mesma forma que na análise GLMM e levam às mesmas interpretações, embora com valores ligeiramente diferentes.

É necessária uma etapa adicional para criar uma função de método vcov() que extraia cov.scaled do objeto resultante do ajuste do modelo.

6.6 Métodos bayesianos para dados categóricos

As análises realizadas nos Capítulos 1 a 5 utilizam métodos frequentistas para estimar um parâmetro fixo e desconhecido, como uma prevalência populacional \(\pi\), uma razão de chances (\(OR\)) ou um parâmetro de regressão \(\beta_r\). Isso envolveu a obtenção de uma amostra aleatória de uma população e a suposição de uma distribuição de probabilidade conjunta para as variáveis aleatórias correspondentes.

Com base nessas informações, determinou-se uma estimativa de máxima verossimilhança (MLE) para o parâmetro de interesse. Também foram construídos intervalos de confiança, geralmente utilizando propriedades baseadas na verossimilhança discutidas no Apêndice.

O nível de confiança associado a esses intervalos foi atribuído ao processo hipotético de repetir sucessivamente a mesma amostragem e os mesmos cálculos (origem do termo “frequentista”), de modo que \((1-\alpha)100\%\) dos intervalos contenham o parâmetro.

Note que esse nível de confiança não significa que um intervalo específico tenha uma probabilidade \((1-\alpha)\) de conter o parâmetro. Uma vez construído o intervalo, ele contém ou não o parâmetro; portanto, a probabilidade — que desconhecemos — é igual a 1 ou a 0. Atualmente, os métodos frequentistas constituem a abordagem predominante para a inferência estatística.

Os métodos bayesianos apresentam um paradigma alternativo para a inferência estatística. A popularidade desses métodos cresceu imensamente nos últimos 20 anos devido à disponibilidade de novos algoritmos computacionais e computadores mais rápidos.

Uma vantagem do uso de métodos bayesianos é que o conhecimento prévio sobre um problema subjacente pode ser incorporado à análise. Isso é feito tratando um parâmetro como uma variável aleatória com uma distribuição de probabilidade conhecida, a qual especificamos completamente. Essa é chamada de distribuição a priori (ou simplesmente “prior”), pois representa o que acreditamos sobre o parâmetro antes de considerar os dados.

Por exemplo, se o objetivo é estimar a prevalência de HIV em uma população, espera-se que essa prevalência seja baixa mesmo antes da coleta de dados; assim, a distribuição escolhida para a probabilidade de HIV em uma pessoa selecionada aleatoriamente concentrar-se-ia principalmente em valores próximos de zero. Após a coleta dos dados, essa distribuição a priori é atualizada para formar uma nova distribuição, conhecida como distribuição a posteriori (ou simplesmente “posterior”), para refletir as informações obtidas a partir dos dados.

O valor específico do parâmetro na população é tratado como uma realização aleatória dessa distribuição a posteriori. Dessa forma, as estimativas do parâmetro são resumos da distribuição a posteriori — como a média ou a moda — destinados a refletir valores prováveis. Também podemos construir um intervalo de valores prováveis para o parâmetro utilizando a distribuição a posteriori. Esse intervalo tem uma probabilidade de \(1-\alpha\) de conter o parâmetro, diferentemente do que representa um intervalo de confiança.

O objetivo desta seção é discutir a aplicação de métodos bayesianos em diversos cenários envolvendo dados categóricos. Começamos com uma introdução ao paradigma bayesiano no contexto dos tópicos discutidos na Seção 1.1.1. Em seguida, estendemos essas ideias a situações computacionalmente mais complexas que envolvem os modelos de regressão discutidos nos Capítulos 2 a 4. Por fim, apresentamos recursos adicionais para a aplicação de métodos bayesianos utilizando o R.

6.6.1 Estimação da probabilidade de sucesso

Os métodos bayesianos baseiam-se na aplicação da regra de Bayes, que é abordada na maioria dos cursos introdutórios de estatística. Essa regra estabelece que, para dois eventos \(A\) e \(B\), a probabilidade condicional de \(B\) dado \(A\) é \[ \tag{6.20} P(B|A)=\dfrac{P(A\cap B)}{P(A)}=\dfrac{P(A|B)P(B)}{P(A\cap B)+P(A\cap B^c)}, \] onde \(B^c\) denota o complemento (ou o oposto) de \(B\).

Em nosso contexto, pode-se pensar, de modo geral, em \(B\) como a representação do parâmetro e em \(A\) como a representação dos dados. Assim, \(P(B)\) representa o conhecimento prévio que se tem sobre o parâmetro, e atualizamos esse conhecimento com informações obtidas a partir dos dados para calcular a probabilidade a posteriori \(P(B|A)\).

Obtenção da distribuição posterior

A inferência Bayesiana baseia-se numa forma mais geral da Equação (6.20), expressa como \[ \tag{6.21} p(\theta|y)=\dfrac{f(y|\theta)p(\theta)}{f(y)}, \] onde \(\theta\) é o parâmetro de interesse, \(y\) representa os dados observáveis, e \(p(\cdot)\) e \(f(\cdot)\) representam distribuições de probabilidade específicas para \(\theta\) e \(Y\), respectivamente.

A Equação (6.21) é a distribuição a posteriori de \(\theta\) dada a informação observada sobre \(Y\). Para maior clareza, note que não apenas \(Y\) é uma variável aleatória, mas \(\theta\) também o é; dispensamos a formalidade de usar uma versão em letra maiúscula de \(\theta\) para facilitar a exposição.

A seguir, discutiremos detalhadamente suas distribuições de probabilidade no contexto da estimação de um parâmetro de probabilidade de sucesso \(\pi\) em um modelo binomial para o número de sucessos \(W\) em um número fixo de \(n\) tentativas.

Nosso objetivo é obter a distribuição posterior de \(\pi\) a partir das informações observadas sobre \(W\). Ao longo dos Capítulos 1 e 2, utilizamos uma distribuição binomial que foi inicialmente apresentada na Equação 1.1. Agora, reexpressamos essa distribuição como: \[ f(\omega|\pi)=\binom{n}{\omega}\pi^\omega (1-\pi)^{n-\omega}, \] onde utilizamos \(f(\cdot)\) para representar a função de densidade de probabilidade (PMF) de \(W\) e acrescentamos “\(|\pi\)” para enfatizar que as probabilidades são condicionadas a um valor de \(\pi\). Essa PMF condicional, que também é a função de verossimilhança para \(\omega\), é utilizada no numerador da Equação (6.21).

O conhecimento sobre \(\pi\) antes da coleta de uma amostra pode ser incorporado por meio da distribuição a priori, \(p(\pi)\), que representa os valores prováveis para o parâmetro. Existem muitas distribuições a priori possíveis, mas a mais utilizada nessa situação é a distribuição beta, veja a Equação (1.5).

Essa distribuição permite valores no intervalo \(0 <\pi < 1\), apresenta grande flexibilidade de forma e conduz a um resultado matematicamente elegante, que será apresentado em breve. Por exemplo, se acreditarmos que \(\pi\) deve ser pequeno — como no caso da prevalência de HIV —, uma distribuição beta com \(\alpha = 1\) e \(\beta = 10\) pode ser adequada, pois ela apresenta assimetria à direita, concentrando grande parte de sua probabilidade próxima a 0, como pode ser visto na figura abaixo. A distribuição a priori para \(\pi\) também é utilizada no numerador da Equação (6.21).

library(ggplot2)

# Cria o gráfico usando funções estatísticas do ggplot2
ggplot(data.frame(x = c(0, 1)), aes(x = x)) +
  # Adiciona a área preenchida sob a curva
  stat_function(fun = dbeta, args = list(shape1 = 1, shape2 = 10),
                geom = "area", fill = "#3498db", alpha = 0.2) +
  # Adiciona a linha da curva
  stat_function(fun = dbeta, args = list(shape1 = 1, shape2 = 10),
                color = "#2980b9", size = 1.2) +
  # Define os títulos e rótulos
  labs(title = "Distribuição Beta (α = 1, β = 10)",
       subtitle = "Visualização da função de densidade de probabilidade",
       x = "X",
       y = "Densidade") +
  # Aplica um tema limpo e minimalista
  theme_minimal(base_size = 14) +
  theme(plot.title = element_text(face = "bold", hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5, color = "gray40"))

Função de densidade \(beta(1,10)\).

Determinar \(f(\omega)\), que corresponde ao denominador na Equação (6.21), é tipicamente a parte mais difícil de uma análise bayesiana. Primeiramente, precisamos encontrar a função de densidade de probabilidade conjunta de \(W\) e \(\pi\). Assumindo uma distribuição a priori beta com parâmetros \(\alpha > 0\) e \(\beta > 0\), obtemos \[ \begin{array}{crl} f(\omega,\pi) & = & f(\omega|\pi)p(\pi) \\[0.em] & = & \binom{n}{\omega} \pi^\omega (1-\pi)^{n-\omega} \dfrac{\Gamma(\alpha+\beta)}{\Gamma(\alpha)\Gamma(\beta)}\pi^{\alpha-1}(1-\pi)^{\beta-1} \\[0.8em] & = & \dfrac{\Gamma(n+1)}{\Gamma(\omega+1)\Gamma(n-\omega+1)}\dfrac{\Gamma(\alpha+\beta)}{\Gamma(\alpha)\Gamma(\beta)}\pi^{\omega+\alpha-1}(1-\pi)^{n+\beta-\omega-1}, \end{array} \] para \(\omega = 0,\cdots,n\) e \(0 <\pi < 1\). Observe que utilizamos a relação \(\Gamma(c+1) = c!\) para um inteiro \(c\).

Para obter \(f(\omega)\), integramos sobre todos os valores possíveis de \(\pi\): \[ \begin{array}{rcl} f(\omega) & = & \displaystyle \int_0^1 \dfrac{\Gamma(n+1)}{\Gamma(\omega+1)\Gamma(n-\omega+1)}\dfrac{\Gamma(\alpha+\beta)}{\Gamma(\alpha)\Gamma(\beta)} \pi^{\omega+\alpha-1}(1-\pi)^{n+\beta-\omega-1}\mbox{d}\pi \\[0.8em] & = & \dfrac{\Gamma(n+1)}{\Gamma(\omega+1)\Gamma(n-\omega+1)}\dfrac{\Gamma(\alpha+\beta)}{\Gamma(\alpha)\Gamma(\beta)}\dfrac{\Gamma(\omega+\alpha)\Gamma(n+\beta-\omega)}{\Gamma(n+\alpha+\beta)}\cdot \end{array} \]

Juntando todas as peças, obtemos a distribuição a posteriori de \(\pi\) dada a informação observada sobre \(W\): \[ \tag{6.22} \begin{array}{rcl} f(\pi| \omega) & = & \dfrac{f(\omega|\pi)p(\pi)}{f(\omega)} \\[0.8em] & = & \dfrac{\Gamma(\omega+\alpha)\Gamma(n-\omega+\beta)}{\Gamma(n+\alpha+\beta)}\pi^{\omega+\alpha-1}(1-\pi)^{n+\beta-\omega-1}, \end{array} \] para \(0<\pi<1\).

Curiosamente, a Equação (6.22) é uma distribuição beta, assim como a distribuição a priori, mas agora com os parâmetros \(\omega+\alpha\) e \(n+\beta-\omega\) controlando o formato da distribuição. Quando uma distribuição a posteriori pertence à mesma família de distribuições que a distribuição a priori, diz-se que essas distribuições pertencem a uma família conjugada. Portanto, a distribuição beta é conjugada à distribuição binomial.

Estimativa de Bayes

A distribuição a posteriori é utilizada para obter estimativas de \(\pi\). Uma estimativa razoável consiste em utilizar a média \(\mbox{E}(\pi|\omega)\), que, neste caso, pode ser demonstrada como sendo \((\omega+\alpha)/(n+\alpha+\beta)\) mediante o uso de propriedades das distribuições beta. Essa média é conhecida como estimativa de Bayes e é denotada por \(\widehat{\pi}_B\).

Como alternativa, podemos utilizar a mediana ou a moda da distribuição a posteriori como estimativa. Note que encontrar a moda da distribuição a posteriori é análogo a encontrar a estimativa de máxima verossimilhança (MLE) a partir da função de verossimilhança, e ela só será necessariamente igual à média quando a distribuição a posteriori for simétrica e unimodal.

Antes de observar os dados, uma estimativa razoável para \(\pi\) teria sido \(\mbox{E}(\pi) = \alpha/(\alpha+\beta)\), obtida a partir da distribuição a priori. Curiosamente, a estimativa de Bayes neste problema pode ser decomposta em dois componentes: um que utiliza \(\mbox{E}(\pi)\) e outro que utiliza a estimativa de máxima verossimilhança (MLE) \(\widehat{\pi} =\omega/n\): \[ \tag{6.23} \widehat{\pi}_B=\left(\dfrac{n}{n+\alpha+\beta} \right)\widehat{\pi}+\left(\dfrac{\alpha+\beta}{n+\alpha+\beta} \right)\mbox{E}(\pi)\cdot \]

Assim, a estimativa de Bayes é uma média ponderada do estimador de máxima verossimilhança (MLE) e da média da distribuição a priori. Um tamanho de amostra maior resulta em maior peso relativo para o MLE, enquanto um tamanho de amostra menor resulta em maior peso relativo para a média a priori.

Em modelos bayesianos para outros parâmetros, o mesmo princípio se aplica: à medida que o tamanho da amostra aumenta, a estimativa de Bayes depende progressivamente menos da distribuição a priori e mais dos dados. No entanto, demonstrar essa relação por meio de uma expressão matemática em forma fechada nem sempre é tão simples quanto neste caso.

Escolha de uma distribuição a priori

A escolha de uma distribuição a priori desempenha, obviamente, um papel importante em qualquer análise bayesiana. Experiências anteriores podem sugerir valores possíveis para um parâmetro, o que leva à utilização de uma distribuição a priori específica com seus próprios parâmetros, os parâmetros da distribuição a priori são denominados hiperparâmetros.

Por exemplo, nossas crenças sobre \(\pi\) sugerem que podemos utilizar uma distribuição beta com valores específicos para \(\alpha\) e \(\beta\). A seleção de uma distribuição a priori dessa maneira constitui, ao mesmo tempo, uma das vantagens e um dos pontos de crítica da análise bayesiana, uma vez que diferentes analistas podem escolher distribuições a priori distintas com base em crenças diferentes. É possível que essas escolhas subjetivas de variadas a priori afetem significativamente o resultado da análise.

Como alternativa à escolha subjetiva de uma distribuição a priori, utiliza-se frequentemente na prática uma distribuição a priori não informativa. Trata-se de uma distribuição que atribui probabilidade ou densidade igual a todos os valores do parâmetro.

Para o nosso modelo binomial, uma distribuição Beta com \(\alpha = \beta = 1\), equivalente a uma distribuição uniforme no intervalo (0, 1), constitui uma a priori não informativa para a estimação de \(\pi\). Naturalmente, isso ainda implica especificar uma crença sobre o parâmetro — especificamente, que ele tem igual probabilidade de assumir qualquer valor permitido —; portanto, não se equipara a um método frequentista, que não especifica tal crença.

Embora uma distribuição uniforme seja não informativa para estimar \(\pi\), ela deixa de sê-lo se o objetivo for estimar uma transformação monotônica de \(\pi\), como uma razão de chances (odds). Assim, um analista que deseje utilizar essa distribuição a priori pode precisar escolher uma diferente para cada forma distinta de expressar o parâmetro. Uma maneira de evitar esse problema é utilizar a distribuição a priori de Jeffreys, que é invariante a transformações monotônicas do parâmetro Tools for Statistical Inference (1996).

De modo geral, para um parâmetro \(\theta\) e dados \(y\), a distribuição a priori é escolhida de modo a ser proporcional a \[ \left(\mbox{E}\left(\dfrac{\partial^2}{\partial \theta^2}\log \big(f(y|\theta) \big) \right) \right)^{1/2}\cdot \]

A quantidade sob a raiz quadrada é frequentemente denominada informação de Fisher e está intimamente relacionada à variância de um estimador de máxima verossimilhança. A informação de Fisher é conceituada como a quantidade de informação sobre o parâmetro que está disponível a partir dos dados. Assim, basear a distribuição a priori na informação de Fisher permite atribuir maior peso a valores de \(\theta\) que apresentam maior informação de Fisher.

Isso conduz a uma forma diferente de conceber a noção de “não informativa”, uma vez que a distribuição a priori de Jeffreys se harmoniza melhor com os dados do que outras distribuições a priori poderiam (Robert 2001, 130). Existem outras maneiras de escolher uma distribuição a priori. Em particular, distribuições de probabilidade conhecidas como hiperpriors ou distribuições a priori de nível superior, podem ser especificadas para cada hiperparâmetro de uma distribuição a priori. A análise resultante é denominada Bayesiana hierárquica, devido às especificações aninhadas de distribuições a priori.

Outra forma de escolher uma distribuição a priori é estimá-la utilizando os dados observados por meio de métodos Bayesianos empíricos. Um problema dessa abordagem é que a distribuição a priori não pode ser totalmente especificada antes da coleta de dados, o que contraria, em certa medida, a filosofia Bayesiana de declarar integralmente as crenças a priori. No entanto, alguns analistas apreciam essa abordagem devido à sua objetividade.

Para mais informações sobre essas e outras formas de especificar distribuições a priori, consulte obras de referência sobre métodos Bayesianos, como Gelman et al. (2004) e Carlin and Louis (2008).

Intervalos de credibilidade

Em uma análise Bayesiana, as estimativas por intervalo são baseadas nos quantis da distribuição a posteriori de um parâmetro. Esses intervalos são chamados de intervalos de credibilidade. A interpretação de um intervalo de credibilidade é que ele tem probabilidade de \(1-\gamma\) de conter o parâmetro, pois é baseado na distribuição posterior do parâmetro.

O tipo mais comum de intervalo de credibilidade é o intervalo de caudas iguais, que encontra limites tais que a probabilidade à esquerda do limite inferior seja \(\gamma/2\) e a probabilidade à direita do limite superior seja \(\gamma/2\). Por exemplo, com base na distribuição posterior de \(\pi\) que derivamos anteriormente, obtemos um intervalo de credibilidade de caudas iguais de \((1-\gamma)100\%\) para \(\pi\) da forma \[ beta(\gamma/2;\omega+\alpha,n+\beta-\omega)<\pi<beta(1-\gamma/2;\omega+\alpha,n+\beta-\omega), \] onde \(beta (\gamma; \omega+\alpha, n+\beta-\omega)\) é o quantil de ordem \(\gamma\) da distribuição beta com parâmetros \(\omega+\alpha\) e \(n+\beta-\omega\). Intervalos de caudas iguais são relativamente mais fáceis de calcular do que outros intervalos e apresentam melhor desempenho quando a distribuição a posteriori é razoavelmente simétrica.

Quando a distribuição a posteriori não é simétrica, uma escolha melhor é utilizar um intervalo de credibilidade de maior densidade a posteriori (HPD). Esse intervalo é calculado determinando-se os limites inferior e superior de um intervalo que corresponda à região de maior densidade a posteriori — isto é, a região mais “provável”.

O intervalo resultante é, geralmente, o mais estreito possível que contém \((1-\gamma)100\%\) da densidade a posteriori. Como, em geral, não existem expressões de forma fechada para o cálculo de intervalos HPD, mostramos como encontrar esse tipo de intervalo no exemplo a seguir. É importante notar que um intervalo HPD não é invariante a transformações. Assim, simplesmente transformar seus limites para \(\pi\) não leva, necessariamente, a um intervalo HPD para a mesma transformação de \(\pi\).

Exemplo 6.20: Estimativa de Bayes e intervalos de credibilidade.

Vamos considerar que sejam observados \(\omega = 4\) sucessos em \(n = 10\) tentativas. Nesta situação, se uma distribuição beta não informativa com \(\alpha = \beta = 1\) for utilizada como distribuição a priori, obtém-se uma estimativa de Bayes de \[ \widehat{\pi}_B= \dfrac{4 + 1}{10 + 1 + 1} = 0.4167 \] e um intervalo de credibilidade de \(95\%\) com caudas iguais de \(0.1675 <\pi < 0.6921\).

Os cálculos no R são simples; basta utilizar

qbeta(p = c(0.05/2, 1-0.05/2), shape1 = 4 + 1, shape2 = 10 + 1 - 4)

para obter o intervalo. Se, em vez disso, for utilizada a distribuição a priori de Jeffreys, pode-se demonstrar inicialmente que essa priori é proporcional a \[ \pi^{-1/2} (1-\pi)^{-1/2}, \] o que leva ao uso de uma distribuição beta com \(\alpha = \beta = 1/2\).

A estimativa de Bayes é 0.4091 e o intervalo de credibilidade de caudas iguais é \(0.1531 <\pi < 0.6963\), resultando em um limite inferior ligeiramente diferente daquele obtido ao utilizar \(\alpha = \beta = 1\).

# PURPOSE: Estimates and C.I.s for pi using Bayes methods                #

# Basic computations
w <- 4  # Sum(y_i)
n <- 10
alpha <- 0.05

# Bayes estimate
a <- 1
b <- 1
# a <- 0.5 From Jeffreys' prior
# b <- 0.5
pi.hatb <- (w+a)/(n+a+b)
pi.hatb

## [1] 0.4167

# MLE
pi.hat <- w/n
pi.hat

## [1] 0.4

# Equal-tail interval
qbeta(p = c(alpha/2, 1-alpha/2), shape1 = w + a, shape2 = n + b - w)

## [1] 0.1675 0.6921

# Jeffreys' prior
qbeta(p = c(alpha/2, 1-alpha/2), shape1 = w + 0.5, shape2 = n + 0.5 - w)

## [1] 0.1531 0.6963

# HPD
library(TeachingDemos)
# The posterior.icdf argument means "posterior inverse CDF"
save.hpd <- hpd(posterior.icdf = qbeta, shape1 = w + a, shape2 = n + b - w, conf = 1-alpha)
save.hpd

## [1] 0.1586 0.6818

# Verify lower and upper limits are at the same p(pi|w) values
dbeta(x = save.hpd, shape1 = w + a, shape2 = n + b - w)

## [1] 0.5183 0.5183

# Verify area between limits is 1-alpha
pbeta(q = save.hpd[2], shape1 = w + a, shape2 = n + b - w) -
 pbeta(q = save.hpd[1], shape1 = w + a, shape2 = n + b - w)

## [1] 0.95

# binom package - gives incorrect value for HPD (version 1.0-5)
library(package = binom)
binom.confint(x = w, n = n, conf.level = 1-alpha, methods = "bayes",
  prior.shape1 = a, prior.shape2 = b)

##   method x  n   mean  lower  upper
## 1  bayes 4 10 0.4167 0.1586 0.6818

binom.bayes(x = w, n = n, conf.level = 0.95, type = "highest",
      prior.shape1 = a, prior.shape2 = b)  # Supposed to be HPD

##   method x  n shape1 shape2   mean  lower  upper  sig
## 1  bayes 4 10      5      7 0.4167 0.1586 0.6818 0.05

binom.bayes(x = w, n = n, conf.level = 0.95, type = "central",
      prior.shape1 = a, prior.shape2 = b)  # Equal tail

##   method x  n shape1 shape2   mean  lower  upper  sig
## 1  bayes 4 10      5      7 0.4167 0.1675 0.6921 0.05

################################################################################
# Calculation details for HPD

 # Find the pi that maximizes p(pi|w) - one HPD limit will be to the left and one will be to the right
 mode <- optimize(f = dbeta, interval = c(0,1), maximum = TRUE, shape1 = w + a, shape2 = n + b - w)
 mode$maximum  # $objective gives height too

## [1] 0.4

 height <- dbeta(x = mode$maximum, shape1 = w + a, shape2 = n + b - w)  # max f(pi|w) value
 height

## [1] 2.759

 # Finds a pi corresponding to a given p(pi|w)
 find.pi <- function(x, shape1, shape2, height) {
  dbeta(x = x, shape1 = shape1, shape2 = shape2) - height
 }

 # Finds the p(pi|w) where the HPD limits occur
 find.p <- function(height, shape1, shape2, mode, conf.level) {

  # Find pi on the x-axis
  lower <- uniroot(f = find.pi, interval = c(0, mode), shape1 = w + a, shape2 = n + b - w,
   height = height)
  upper <- uniroot(f = find.pi, interval = c(mode, 1), shape1 = w + a, shape2 = n + b - w,
   height = height)

  # Check if area is equal to the confidence level (the value here will be 0 if it is)
  pbeta(q = upper$root, shape1 = w + a, shape2 = n + b - w) -
  pbeta(q = lower$root, shape1 = w + a, shape2 = n + b - w) - conf.level
 }
 
 # Save the p(pi|w) where HPD limits occur
 save.res <- uniroot(f = find.p, interval = c(0, height), shape1 = w + a, shape2 = n + b - w,
  mode = mode$maximum, conf.level = 0.95)
 # Find the corresponding value of pi given p(pi|w)
 lower <- uniroot(f = find.pi, interval = c(0, mode$maximum), shape1 = w + a, shape2 = n + b - w,
  height = save.res$root)
 upper <- uniroot(f = find.pi, interval = c(mode$maximum, 1), shape1 = w + a, shape2 = n + b - w,
  height = save.res$root)
 data.frame(lower$root, upper$root)

##   lower.root upper.root
## 1     0.1586     0.6818

# Certifique-se de ter o ggplot2 instalado: install.packages("ggplot2")
library(ggplot2)

# (Valores calculados no seu script: w=4, n=10, a=1, b=1, lower$root, upper$root, save.res$root)

shape1_val <- w + a
shape2_val <- n + b - w
hpd_y <- save.res$root
hpd_lower <- lower$root
hpd_upper <- upper$root

# 1. Criar um data frame para a curva da densidade Posterior
pi_seq <- seq(0, 1, length.out = 1000)
y_seq <- dbeta(pi_seq, shape1 = shape1_val, shape2 = shape2_val)
df_posterior <- data.frame(pi = pi_seq, densidade = y_seq)

# 2. Criar um sub-dataset para pintar a área do intervalo HPD
df_hpd <- subset(df_posterior, pi >= hpd_lower & pi <= hpd_upper)

# 3. Construir o gráfico com ggplot2
ggplot(df_posterior, aes(x = pi, y = densidade)) +
  # Área sombreada do intervalo HPD
  geom_area(data = df_hpd, aes(fill = "Intervalo HPD (95%)"), alpha = 0.2) +
  # Linha da densidade posterior
  geom_line(color = "#2c3e50", size = 1.2) +
  # Linha horizontal que define a altura do HPD
  geom_segment(aes(x = hpd_lower, y = hpd_y, xend = hpd_upper, yend = hpd_y, 
                   color = "Altura HPD"), linetype = "dashed", size = 0.8) +
  # Linhas verticais limitando o HPD
  geom_segment(aes(x = hpd_lower, y = 0, xend = hpd_lower, yend = hpd_y), 
               linetype = "dotted", color = "#e74c3c", size = 0.8) +
  geom_segment(aes(x = hpd_upper, y = 0, xend = hpd_upper, yend = hpd_y), 
               linetype = "dotted", color = "#e74c3c", size = 0.8) +
  # Pontos nos limites do HPD
  annotate("point", x = c(hpd_lower, hpd_upper), y = c(hpd_y, hpd_y), 
           color = "#e74c3c", size = 3) +
  # Rótulos de texto para os limites no eixo X
  annotate("text", x = hpd_lower, y = 0.1, label = round(hpd_lower, 3), 
           vjust = 1.5, color = "#e74c3c", fontface = "bold") +
  annotate("text", x = hpd_upper, y = 0.1, label = round(hpd_upper, 3), 
           vjust = 1.5, color = "#e74c3c", fontface = "bold") +
  # Customização de Cores e Estética
  scale_fill_manual(name = "", values = c("Intervalo HPD (95%)" = "#3498db")) +
  scale_color_manual(name = "", values = c("Altura HPD" = "#e74c3c")) +
  scale_x_continuous(breaks = seq(0, 1, 0.2)) +
  # Títulos e eixos (usando expressões matemáticas)
  labs(
    title = "Distribuição Posterior e Intervalo HPD",
    subtitle = paste0("Parâmetros Beta: Alpha = ", shape1_val, ", Beta = ", shape2_val),
    x = expression(pi),
    y = expression(paste("p(", pi, "|w)"))
  ) +
  # Tema minimalista e limpo
  theme_minimal(base_size = 14) +
  theme(
    plot.title = element_text(face = "bold", size = 16, hjust = 0.5),
    plot.subtitle = element_text(color = "gray40", hjust = 0.5),
    legend.position = "top",
    panel.grid.minor = element_blank()
  )

Figura 6.9: Gráfico de densidade a posteriori com uma linha horizontal traçada em \(p(\pi|\omega) = 0.5184\) e linhas verticais indicando os limites do intervalo HPD de 95%.

Essas estimativas e esses intervalos são bastante semelhantes ao estimador de máxima verossimilhança (EMV) \(\widehat{\pi} = 0.4\) e ao intervalo de Wilson \(0.1682 < \pi < 0.6873\), obtidos em um exemplo da Seção 1.1.1.

Parte da razão para isso pode ser compreendida examinando-se a expressão para \[ \widetilde{\pi} = (\omega + Z_{1-\gamma/2}^2/2) / (n + Z_{1-\gamma/2}^2), \] o estimador de \(\pi\) utilizado na construção dos intervalos de confiança de Wilson e de Agresti-Coull. Se \(\alpha = \beta = 1.96/2 = 098\), então \(\widehat{\pi}_B\) e \(\widetilde{\pi}\) são idênticos.

Para encontrar o intervalo HPD, suponha que uma linha horizontal seja traçada sobre o gráfico da distribuição a posteriori \(p(\pi|\omega)\) e que os valores correspondentes de \(\pi\), onde a linha intercepta \(p(\pi|\omega)\), sejam denotados como \(\pi_{lower}\) e \(\pi_{upper}\).

Procedimentos numéricos iterativos são então utilizados para encontrar a linha horizontal tal que a área entre \(\pi_{lower}\) e \(\pi_{upper}\) seja \(1-\gamma\). A Figura 6.9 mostra a distribuição a posteriori com \(\alpha = \beta = 1\) e uma linha horizontal em \(p(\pi|\omega) = 0.5184\).

O intervalo HPD correspondente é \(0.1586 <\pi < 0.6818\), com uma probabilidade de 0.95 entre esses dois limites. Esse intervalo é bastante semelhante ao intervalo de credibilidade de caudas iguais, pois há apenas uma leve assimetria à direita na distribuição a posteriori.

O processo computacional para o intervalo HPD é realizado pela função hpd() do pacote TeachingDemos:

w <- 4
n <- 10
alpha <- 0.05
a <- 1
b <- 1
library ( TeachingDemos )
save.hpd <- hpd ( posterior.icdf = qbeta , shape1 = w + a , shape2 = n + b - w , conf = 1 - alpha )
save.hpd

## [1] 0.1586 0.6818

# Verify lower and upper limits are at the same p ( pi | w ) values
dbeta ( x = save.hpd , shape1 = w + a , shape2 = n + b - w )

## [1] 0.5183 0.5183

# Verify area between limits is 1 - alpha
pbeta ( q = save.hpd [2] , shape1 = w + a , shape2 = n + b - w ) - 
  pbeta ( q = save.hpd [1] , shape1 = w + a , shape2 = n + b - w )

## [1] 0.95

O pacote binom, utilizado no Capítulo 1 para calcular intervalos para \(\pi\), também pode ser empregado para calcular o intervalo de caudas iguais (equal-tail interval). Na mencionada libraria, tanto a função binom.bayes() quanto a função binom.confint() — utilizando os argumentos type = "central", prior.shape1 = a e prior.shape2 = b — realizarão o cálculo desse intervalo.

A documentação de ajuda dessas funções também indica que o intervalo HPD pode ser calculado especificando-se type = "highest"; no entanto, observamos que a função continua retornando o intervalo de caudas iguais mesmo após essa especificação (na versão 1.0-5 do pacote binom).

É claro que as estimativas Bayesianas e os intervalos de credibilidade são afetados pela escolha de \(\alpha\) e \(\beta\) na distribuição a priori. Por exemplo, podemos reescrever a estimativa Bayesiana como \[ \begin{array}{rcl} \widehat{\pi}_B & = & \left(\dfrac{n}{n+\alpha+\beta} \right)\left(\dfrac{\omega}{n} \right)+\left(\dfrac{\alpha+\beta}{n+\alpha+\beta} \right)\left(\dfrac{\alpha}{\alpha+\beta} \right)\\[0.8em] & = & \left(\dfrac{10}{12} \right)\times 0.4 + \left(\dfrac{2}{12} \right)\times 0.5, \end{array} \] utilizando a Equação (6.23) e \(\alpha = \beta = 1\).

Isso ajuda a mostrar que essa distribuição a priori leva a uma estimativa de \(\pi\) ligeiramente maior do que a estimativa de máxima verossimilhança (MLE). O Exercício 2 investiga mais a fundo como as estimativas de Bayes e os intervalos de credibilidade variam para diferentes valores de \(\alpha\) e \(\beta\).

6.6.2 Modelos de regressão

Para aplicar métodos bayesianos à modelagem de regressão, é necessário começar pela especificação de uma distribuição a priori para os parâmetros de regressão \(\beta_0,\cdots,\beta_p\). Tipicamente, isso envolve, primeiramente, assumir que os parâmetros são independentes, de modo que não seja necessária uma distribuição de probabilidade conjunta mais complexa.

Além disso, embora uma distribuição a priori subjetiva possa ser utilizada para cada parâmetro, opta-se mais frequentemente por uma distribuição a priori não informativa ou fracamente informativa, que distribui a probabilidade de forma relativamente uniforme ao longo de uma ampla faixa de valores. Por exemplo, uma distribuição a priori fracamente informativa poderia ser uma distribuição normal com variância muito elevada.

A distribuição dos dados, dados os parâmetros, é tipicamente escolhida como um modelo comum, tal como aqueles apresentados nos Capítulos 2 a 4. A distribuição a posteriori de \(\beta_0,\cdots,\beta_p\), dados os dados \(\pmb{y} = (y_1,\cdots,y_n)\), tem a forma \[ \tag{6.24} \begin{array}{rcl} p(\beta_0,\cdots,\beta_p|\pmb{y}) & = & \displaystyle \dfrac{f(\pmb{y}|\beta_0,\cdots,\beta_p)p(\beta_0,\cdots,\beta_p)}{f(\pmb{y})}\\[0.8em] & = & \dfrac{\displaystyle \left(\prod_{i=1}^n f(y_i|\beta_0,\cdots,\beta_p) \right)\left(\prod_{r=0}^p p(\beta_r) \right)}{\displaystyle \int \cdots \int \left(\prod_{i=1}^n f(y_i|\beta_0,\cdots,\beta_p) \right)\left(\prod_{r=0}^p p(\beta_r) \right)\mbox{d}\beta_0 \times \cdots \times \mbox{d}\beta_p}, \end{array} \] quando assumimos que \(\beta_0,\cdots,\beta_p\) são independentes.

Muitas vezes, essa expressão para a distribuição a posteriori não pode ser calculada em uma forma fechada simples, ao contrário daquelas apresentadas na seção anterior. Diversos métodos de simulação de uso geral podem ser empregados para avaliar a Equação (6.24) sem a necessidade de obter a expressão completa em forma fechada.

Esses métodos de simulação são utilizados para obter amostras da distribuição a posteriori, permitindo assim estimar a própria distribuição e as quantidades associadas a ela. Focaremos em um método específico, conhecido como algoritmo de Metropolis-Hastings. Esse algoritmo é um tipo de método de simulação de Monte Carlo via Cadeias de Markov (MCMC) implementado pelo popular pacote MCMCpack na linguagem R (Martin and Quinn 2006; Martin et al. 2011). Discutiremos alguns detalhes do algoritmo em breve.

Para uma discussão geral sobre o algoritmo de Metropolis-Hastings, consulte Chib and Greenberg (1995) e os capítulos 6 e 8 de Robert and Casella (2010).

Exemplo 6.21: Placekicking (Chute de bola parada)

Retomamos o exemplo de chutes (field goals) do Capítulo 2, no qual nosso objetivo é estimar o modelo \(logit(\pi) = \beta_0 + \beta_1\times \mbox{distance}\).

placekick <- read.csv(file = "https://www.estatistica.c3sl.ufpr.br/~lucambio/ADC/Placekick.csv")

# Frequentist approach

 mod.fit <- glm(formula = good ~ distance, family = binomial(link = logit), data = placekick)
 summary(object = mod.fit)

## 
## Call:
## glm(formula = good ~ distance, family = binomial(link = logit), 
##     data = placekick)
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  5.81208    0.32628    17.8   <2e-16 ***
## distance    -0.11503    0.00834   -13.8   <2e-16 ***
## ---
## Signif. codes:  
## 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1013.43  on 1424  degrees of freedom
## Residual deviance:  775.75  on 1423  degrees of freedom
## AIC: 779.7
## 
## Number of Fisher Scoring iterations: 6

 # Modified function for C.I.s from Chapter 2
 ci.pi <- function(newdata, mod.fit.obj, alpha){
  linear.pred <- predict(object = mod.fit.obj, newdata = newdata, type = "link", se = TRUE)
  CI.lin.pred.lower <- linear.pred$fit - qnorm(p = 1-alpha/2)*linear.pred$se
  CI.lin.pred.upper <- linear.pred$fit + qnorm(p = 1-alpha/2)*linear.pred$se
  CI.pi.lower <- exp(CI.lin.pred.lower) / (1 + exp(CI.lin.pred.lower))
  CI.pi.upper <- exp(CI.lin.pred.upper) / (1 + exp(CI.lin.pred.upper))
  list(pi.hat = plogis(linear.pred$fit), lower = CI.pi.lower, upper = CI.pi.upper)
 }

 # Test cases
 ci.pi(newdata = data.frame(distance = 20), mod.fit.obj = mod.fit, alpha = 0.05)

## $pi.hat
##     1 
## 0.971 
## 
## $lower
##      1 
## 0.9598 
## 
## $upper
##      1 
## 0.9792

 ci.pi(newdata = data.frame(distance = 50), mod.fit.obj = mod.fit, alpha = 0.05)

## $pi.hat
##      1 
## 0.5152 
## 
## $lower
##      1 
## 0.4466 
## 
## $upper
##      1 
## 0.5831

A função MCMClogit() do pacote MCMCpack ajusta o modelo de regressão logística utilizando uma versão de passeio aleatório (random walk) do algoritmo de Metropolis-Hastings (que será discutido mais adiante nesta seção).

library(ggplot2)

# Configuração dos dados
mu <- 0
sigma <- sqrt(1 / 0.001)

# Gráfico elegante com ggplot2
ggplot(data.frame(x = c(-100, 100)), aes(x = x)) +
  stat_function(fun = dnorm, args = list(mean = mu, sd = sigma),
                color = "#2b6cb0", size = 1.2) +
  stat_function(fun = dnorm, args = list(mean = mu, sd = sigma),
                geom = "area", fill = "#2b6cb0", alpha = 0.1) +
  labs(x = expression(beta),
       y = expression(f(beta)),
       title = "Distribuição a Priori de " ~ beta) +
  theme_minimal(base_size = 14) +
  theme(
    plot.title = element_text(face = "bold", hjust = 0.5, color = "#2d3748"),
    axis.title = element_text(color = "#4a5568"),
    panel.grid.minor = element_blank()
  )

Argumentos familiares na função MCMClogit() são formula e data, que especificam o modelo e o conjunto de dados, respectivamente, e o argumento seed, que fornece o valor da semente utilizado para iniciar a simulação. Novos argumentos incluem mcmc, que define o número de amostras a serem extraídas da distribuição a posteriori, e burnin, que especifica o número de amostras iniciais a serem descartadas.

Um período de burn-in é necessário porque as amostras obtidas no início do processo de simulação podem não representar adequadamente a distribuição a posteriori, essa é uma característica do algoritmo de Metropolis-Hastings. O argumento verbose especifica a frequência com que informações sobre o processo de amostragem são exibidas, o que pode ser útil para estimar quanto tempo mais o processo levará.

library(MCMCpack)
mod.fit.Bayes <- MCMClogit ( formula = good ~ distance, data = placekick, 
                             seed = 8712, b0 = 0, B0 = 0.001, burnin = 10000, 
                             verbose = 0, mcmc = 100000)
summary( mod.fit.Bayes)

## 
## Iterations = 10001:110000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 1e+05 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##               Mean      SD Naive SE Time-series SE
## (Intercept)  5.837 0.32739 1.04e-03       3.15e-03
## distance    -0.116 0.00835 2.64e-05       7.98e-05
## 
## 2. Quantiles for each variable:
## 
##               2.5%    25%    50%   75%   97.5%
## (Intercept)  5.209  5.613  5.832  6.05  6.4974
## distance    -0.132 -0.121 -0.115 -0.11 -0.0995

HPDinterval(obj = mod.fit.Bayes, prob = 0.95)

##               lower    upper
## (Intercept)  5.2051  6.49274
## distance    -0.1323 -0.09946
## attr(,"Probability")
## [1] 0.95

A primeira tabela na saída da função summary() apresenta as estimativas de Bayes para os parâmetros de regressão na coluna “Mean” e o desvio padrão dos parâmetros de regressão amostrados na coluna “SD”.

As estimativas de Bayes e os desvios padrão são muito semelhantes às respectivas estimativas de máxima verossimilhança (MLEs) e aos erros-padrão obtidos na Seção 2.2.1. De modo geral, essas semelhanças não surpreendem, dado o grande tamanho da amostra e as distribuições a priori fracamente informativas. Em geral, não é necessário que as estimativas e as variâncias sejam tão semelhantes.

A segunda tabela na saída de summary() apresenta os quantis estimados para as distribuições a posteriori. Por exemplo, a linha referente a distance fornece os quantis 0.025 e 0.975, com valores de -0.1323 e -0.0995, respectivamente.

Esses quantis correspondem aos limites do intervalo de caudas iguais de 95% para \(\beta_1\). Outros quantis podem ser solicitados por meio do argumento quantiles da função summary(). O intervalo HPD de 95% para \(\beta_1\) é fornecido pela função HPDinterval() como \(-0.1323 < \beta_1 < -0.0995\), resultado praticamente idêntico ao do intervalo de caudas iguais.

Esses intervalos são bastante semelhantes aos limites dos intervalos de 95% baseados na razão de verossimilhança perfilada e no teste de Wald, apresentados na Seção 2.2.3. O objeto retornado por MCMClogit() contém apenas as amostras a posteriori. Podemos obter resumos dessas amostras, de forma semelhante ao que é feito com summary(), da seguinte maneira:

# Show that the output in summary() can be reproduced here
head(mod.fit.Bayes)

## Markov Chain Monte Carlo (MCMC) output:
## Start = 10001 
## End = 10007 
## Thinning interval = 1 
##      (Intercept) distance
## [1,]       5.919  -0.1187
## [2,]       5.919  -0.1187
## [3,]       5.919  -0.1187
## [4,]       5.919  -0.1187
## [5,]       5.919  -0.1187
## [6,]       5.764  -0.1110
## [7,]       5.216  -0.0961

tail(mod.fit.Bayes)

## Markov Chain Monte Carlo (MCMC) output:
## Start = 109994 
## End = 110000 
## Thinning interval = 1 
##      (Intercept) distance
## [1,]       5.588  -0.1095
## [2,]       5.628  -0.1110
## [3,]       5.628  -0.1110
## [4,]       5.677  -0.1117
## [5,]       5.677  -0.1117
## [6,]       5.677  -0.1117
## [7,]       5.677  -0.1117

colMeans(mod.fit.Bayes)  # Same as Mean column in summary()

## (Intercept)    distance 
##      5.8375     -0.1156

apply(X = mod.fit.Bayes, MARGIN = 2, FUN = sd)  # Same as SD column in summary()

## (Intercept)    distance 
##    0.327389    0.008354

É importante notar que as funções de método correspondentes para summary() e HPDinterval() encontram-se no pacote coda, o qual é instalado e carregado juntamente com o MCMCpack. O pacote coda contém funções que resumem amostras de simulação MCMC produzidas pelo MCMCpack e por diversos outros pacotes. Discutiremos o pacote coda com mais detalhes em breve, quando o utilizarmos para examinar a qualidade das amostras obtidas.

Vimos no Capítulo 2 que o \(p\)-valor para um teste de Wald de \(H_0 : \beta_1 = 0\) versus \(H_a : \beta_1\neq 0\) era \(< 2\times 10^{-16}\). Utilizando métodos bayesianos, podemos avaliar a posição de \(\beta_1 = 0\) em relação à distribuição a posteriori de \(\beta_1\):

# Where is beta1 = 0 relative to the distribution - like a p-value
beta1 <- mod.fit.Bayes[,2]
min(beta1)

## [1] -0.1523

max(beta1)

## [1] -0.0829

mean(beta1 >= 0)  # 0/100000

## [1] 0

Assim, \(P(\beta_1\geq 0) < 1/100.000\), indicando que é muito provável que \(\beta_1\) seja negativo.

Funções dos parâmetros de regressão, como razões de chances e probabilidades de sucesso, podem ser avaliadas utilizando as amostras da distribuição a posteriori. Estimativas de Bayes e intervalos de credibilidade são, então, obtidos a partir dessas avaliações.

Abaixo, apresenta-se o código que demonstra como calcular a razão de chances para uma redução de 10 jardas na distância e a probabilidade de sucesso para um chute de 20 jardas:

OR10 <- exp ( -10*beta1 ) # OR for a 10 yard decrease in distance
mean ( OR10 ) # Bayes estimate

## [1] 3.188

quantile ( x = OR10 , probs = c (0.025 , 0.975) ) # 95% equal - tail

##  2.5% 97.5% 
## 2.704 3.756

HPDinterval ( obj = OR10 , prob = 0.95) # 95% HPD

##      lower upper
## var1 2.676 3.723
## attr(,"Probability")
## [1] 0.95

beta0 <- mod.fit.Bayes [ ,1]
pi20 <- plogis ( q = beta0 + beta1*20) # Estimate of pi at 20 - yards
mean ( pi20 ) # Bayes estimate

## [1] 0.971

quantile ( x = pi20 , probs = c (0.025 , 0.975) ) # 95% equal - tail 

##   2.5%  97.5% 
## 0.9606 0.9797

HPDinterval ( obj = pi20 , prob = 0.95) # 95% HPD

##       lower  upper
## var1 0.9612 0.9802
## attr(,"Probability")
## [1] 0.95

pi50 <- plogis(q = beta0 + beta1*50)
mean(pi50)

## [1] 0.5145

quantile(x = pi50, probs = c(0.025, 0.975))  # 95% equal-tail

##   2.5%  97.5% 
## 0.4449 0.5826

HPDinterval(obj = pi50, prob = 0.95)  # 95% HPD

##       lower  upper
## var1 0.4464 0.5838
## attr(,"Probability")
## [1] 0.95

Assim, a estimativa de Bayes para a razão de chances é 3.19 e para a probabilidade de sucesso é 0.9710. Ambos os valores são, novamente, muito semelhantes às estimativas de máxima verossimilhança (MLEs) encontradas nas Seções 2.2.3 e 2.2.4. Os intervalos de credibilidade correspondentes também são semelhantes aos intervalos de confiança. Se desejado, gráficos das distribuições estimadas para cada grandeza podem ser obtidos utilizando a função densplot() do pacote coda.

# 1. Configuração da Janela Gráfica Elegante
# mfrow = c(3, 2): 3 linhas e 2 colunas
# mar: ajusta as margens internas; oma: margem externa para o título geral
par(mfrow = c(3, 2), mar = c(4.5, 4, 3, 1), oma = c(0, 0, 3, 0))

# Definição de cores elegantes (paleta minimalista Muted Blue)
cor_hist <- "#5dade2"
cor_dens <- "#2e86c1"
cor_linha <- "#e74c3c"

# ==========================================
# LINHA 1: OR para diminuição de 10 jardas
# ==========================================
beta1 <- mod.fit.Bayes[,2]
OR10 <- exp(-10*beta1)

# Gráfico 1: Histograma OR10
hist(OR10, main = "Histograma: OR (Queda 10j)", xlab = "Odds Ratio", 
     col = cor_hist, border = "white", las = 1, cex.main = 1.1)
grid(nx = NA, ny = NULL, col = "gray90", lty = "solid") # Linhas de grade suaves

# Gráfico 2: Densidade OR10
plot(density(OR10), main = "Densidade: OR (Queda 10j)", xlab = "Odds Ratio", 
     ylab = "Densidade", col = cor_dens, lwd = 3, las = 1, cex.main = 1.1)
grid(col = "gray90", lty = "solid")
polygon(density(OR10), col = paste0(cor_dens, "33"), border = NA) # Preenchimento suave

# ==========================================
# LINHA 2: pi para Chute de 20 jardas
# ==========================================
beta0 <- mod.fit.Bayes[,1]
pi20  <- plogis(q = beta0 + beta1*20)

# Gráfico 3: Histograma pi20
hist(pi20, main = "Histograma: Probabilidade (20j)", xlab = "Probabilidade (pi)", 
     col = cor_hist, border = "white", las = 1, cex.main = 1.1)
grid(nx = NA, ny = NULL, col = "gray90", lty = "solid")

# Gráfico 4: Densidade pi20
plot(density(pi20), main = "Densidade: Probabilidade (20j)", xlab = "Probabilidade (pi)", 
     ylab = "Densidade", col = cor_dens, lwd = 3, las = 1, cex.main = 1.1)
grid(col = "gray90", lty = "solid")
polygon(density(pi20), col = paste0(cor_dens, "33"), border = NA)

# ==========================================
# LINHA 3: pi para Chute de 50 jardas
# ==========================================
pi50 <- plogis(q = beta0 + beta1*50)

# Gráfico 5: Histograma pi50
hist(pi50, main = "Histograma: Probabilidade (50j)", xlab = "Probabilidade (pi)", 
     col = cor_hist, border = "white", las = 1, cex.main = 1.1)
grid(nx = NA, ny = NULL, col = "gray90", lty = "solid")

# Gráfico 6: Densidade pi50
plot(density(pi50), main = "Densidade: Probabilidade (50j)", xlab = "Probabilidade (pi)", 
     ylab = "Densidade", col = cor_dens, lwd = 3, las = 1, cex.main = 1.1)
grid(col = "gray90", lty = "solid")
polygon(density(pi50), col = paste0(cor_dens, "33"), border = NA)

# Título Principal Elegante no topo de toda a janela
mtext("Análise Posterior via MCMC: Placekicks", outer = TRUE, cex = 1.4, font = 2, col = "#2c3e50")

# 2. Execução dos cálculos textuais (saem no console de forma limpa)
cat("\n--- ESTATÍSTICAS DOS PARÂMETROS ---\n")

## 
## --- ESTATÍSTICAS DOS PARÂMETROS ---

cat("\n[OR10] Média:", mean(OR10), "\n")

## 
## [OR10] Média: 3.188

cat("[OR10] 95% Equal-Tail:", quantile(OR10, probs = c(0.025, 0.975)), "\n")

## [OR10] 95% Equal-Tail: 2.704 3.756

cat("[OR10] 95% HPD:\n"); print(coda::HPDinterval(obj = as.mcmc(OR10), prob = 0.95))

## [OR10] 95% HPD:

##      lower upper
## var1 2.676 3.723
## attr(,"Probability")
## [1] 0.95

cat("\n[pi20] Média:", mean(pi20), "\n")

## 
## [pi20] Média: 0.971

cat("[pi20] 95% Equal-Tail:", quantile(pi20, probs = c(0.025, 0.975)), "\n")

## [pi20] 95% Equal-Tail: 0.9606 0.9797

cat("[pi20] 95% HPD:\n"); print(coda::HPDinterval(obj = as.mcmc(pi20), prob = 0.95))

## [pi20] 95% HPD:

##       lower  upper
## var1 0.9612 0.9802
## attr(,"Probability")
## [1] 0.95

cat("\n[pi50] Média:", mean(pi50), "\n")

## 
## [pi50] Média: 0.5145

cat("[pi50] 95% Equal-Tail:", quantile(pi50, probs = c(0.025, 0.975)), "\n")

## [pi50] 95% Equal-Tail: 0.4449 0.5826

cat("[pi50] 95% HPD:\n"); print(coda::HPDinterval(obj = as.mcmc(pi50), prob = 0.95))

## [pi50] 95% HPD:

##       lower  upper
## var1 0.4464 0.5838
## attr(,"Probability")
## [1] 0.95

# Diagnostics

# Class of object and method functions available
class(mod.fit.Bayes)

## [1] "mcmc"

methods(class = "mcmc")

##  [1] [             acfplot       as.data.frame
##  [4] as.matrix     as.ts         autocorr.diag
##  [7] batchSE       emm_basis     end          
## [10] frequency     head          HPDinterval  
## [13] plot          print         recover_data 
## [16] rejectionRate start         summary      
## [19] tail          thin          time         
## [22] window       
## see '?methods' for accessing help and source code

# Example of how to thin after running MCMClogit()
temp <- window(x = mod.fit.Bayes, start = 20000, thin = 10)  # stats package
head(temp)

## Markov Chain Monte Carlo (MCMC) output:
## Start = 20000 
## End = 20060 
## Thinning interval = 10 
##      (Intercept) distance
## [1,]       5.893  -0.1184
## [2,]       6.270  -0.1251
## [3,]       6.022  -0.1181
## [4,]       6.201  -0.1252
## [5,]       6.504  -0.1304
## [6,]       5.855  -0.1132
## [7,]       5.803  -0.1126

# Trace and density plots
plot(mod.fit.Bayes)  # Entire chain

mod.fit.Bayes.temp <- window(x = mod.fit.Bayes, start = 10001, end = 20000)  # Pull out first 10,000
head(mod.fit.Bayes.temp)

## Markov Chain Monte Carlo (MCMC) output:
## Start = 10001 
## End = 10007 
## Thinning interval = 1 
##      (Intercept) distance
## [1,]       5.919  -0.1187
## [2,]       5.919  -0.1187
## [3,]       5.919  -0.1187
## [4,]       5.919  -0.1187
## [5,]       5.919  -0.1187
## [6,]       5.764  -0.1110
## [7,]       5.216  -0.0961

tail(mod.fit.Bayes.temp)

## Markov Chain Monte Carlo (MCMC) output:
## Start = 19994 
## End = 20000 
## Thinning interval = 1 
##      (Intercept) distance
## [1,]       5.909  -0.1168
## [2,]       5.909  -0.1168
## [3,]       5.613  -0.1109
## [4,]       6.232  -0.1265
## [5,]       6.232  -0.1265
## [6,]       5.893  -0.1184
## [7,]       5.893  -0.1184

plot(mod.fit.Bayes.temp)

# Diagnostic tests
heidel.diag(x = mod.fit.Bayes)

##                                           
##             Stationarity start     p-value
##             test         iteration        
## (Intercept) passed       1         0.892  
## distance    passed       1         0.732  
##                                       
##             Halfwidth Mean   Halfwidth
##             test                      
## (Intercept) passed     5.837 0.006173 
## distance    passed    -0.116 0.000156

geweke.diag(x = mod.fit.Bayes)

## 
## Fraction in 1st window = 0.1
## Fraction in 2nd window = 0.5 
## 
## (Intercept)    distance 
##    -0.03532     0.05640

geweke.plot(x = mod.fit.Bayes, frac1 = 0.1, frac2 = 0.5, nbins = 20,
pvalue = 0.05, auto.layout = TRUE)  # Provides some help to determine when convergence does occur if the previous test indicated problems

# Effective sample size
effectiveSize(mod.fit.Bayes)

## (Intercept)    distance 
##       10807       10972

effectiveSize(mod.fit.Bayes.temp)

## (Intercept)    distance 
##        1081        1095

# acceptance rate
1 - rejectionRate(x = mod.fit.Bayes)

## (Intercept)    distance 
##      0.5177      0.5177

Algoritmo de Metropolis-Hastings

O algoritmo de Metropolis-Hastings é utilizado para gerar uma longa sequência de valores amostrados a partir de uma distribuição a posteriori, sem a necessidade de especificar completamente essa distribuição. Essa amostra permite, então, estimar a própria distribuição a posteriori.

Por razões matemáticas e computacionais, é mais conveniente gerar um valor amostrado com base no valor amostrado anteriormente, em vez de gerar um novo valor independente. Isso resulta em uma sequência de valores de parâmetros simulados que são serialmente correlacionados — ou seja, cada um depende do valor anterior. A estrutura sequencial correspondente é conhecida como cadeia de Markov.

A cadeia começa em um ponto escolhido, como a estimativa de máxima verossimilhança (MLE) para um parâmetro (ou vetor de parâmetros) de interesse. A partir desse valor inicial, simula-se uma nova “proposta”. Por exemplo, suponha que o valor inicial do parâmetro seja denotado por \(d_0\).

Um algoritmo de passeio aleatório de Metropolis-Hastings simula uma proposta como \(c_1 = d_0 + \epsilon_1\), em que \(\epsilon_1\) é uma perturbação aleatória aplicada a \(d_0\), simulada a partir de uma distribuição de probabilidade escolhida, por exemplo, uma distribuição normal com média 0 e variância especificada. A proposta \(c_1\) é aceita como o próximo valor da cadeia, \(d_1\), com uma determinada probabilidade (discutida em breve) que depende das distribuições a priori e dos dados. Se a proposta \(c_1\) não for aceita, então \(d_1\) é definido como \(d_0\) (o valor anterior) para a próxima etapa da cadeia.

Esse processo continua, utilizando \(c_b = d_{b-1} + \epsilon_b\) para \(b = 1, \cdots, B\) e um valor elevado de \(B\). Diz-se que o algoritmo MCMC convergiu para a distribuição a posteriori quando a distribuição empírica se torna “estável”, no sentido de que diferentes sequências da cadeia apresentam distribuições empíricas muito semelhantes entre si.

A probabilidade de aceitação descrita no parágrafo anterior para \(c_b\) é a razão entre duas distribuições a posteriori, avaliadas em \(c_b\) no numerador e em \(d_b\) no denominador. Quanto mais plausível for um valor proposto, maior será o valor da sua distribuição a posteriori. Assim, essa razão mede a plausibilidade de \(c_b\) em relação a \(d_{b-1}\). Se \(c_b\) estiver em uma região de densidade a posteriori mais elevada do que \(d_{b-1}\), a razão será maior que 1. Naturalmente, probabilidades não podem exceder 1; portanto, a probabilidade de aceitação é definida como 1, garantindo a aceitação da proposta como \(d_b\).

Se \(c_b\) estiver em uma região de densidade a posteriori menor do que \(d_{b-1}\), a razão será inferior a 1, o que significa que a aceitação não é garantida. Um aspecto importante dessa implementação é que ambas as distribuições a posteriori possuem os mesmos denominadores; assim, a razão pode ser expressa como a razão entre as duas funções de verossimilhança multiplicadas por suas respectivas distribuições a priori. Dessa forma, não é necessário calcular a integral — potencialmente multidimensional — presente nos denominadores das distribuições a posteriori.

Para as funções de ajuste de modelos do pacote MCMCpack, o algoritmo Metropolis-Hastings de passeio aleatório (random walk) utiliza \(c_b\) e \(d_{b-1}\) como vetores de dimensão \((p+1)\) contendo valores potenciais para \(\beta_0,\cdots,\beta_p\). O termo \(\epsilon_b\) é um valor amostrado de uma distribuição normal multivariada de dimensão \((p + 1)\). O valor inicial \(d_0\) da cadeia é a estimativa de máxima verossimilhança (MLE) para \(\beta_0,\cdots,\beta_p\), visto que a MLE provavelmente apresenta uma densidade a posteriori razoavelmente alta. Isso pode contribuir para uma convergência da cadeia mais rápida do que se fosse iniciada com valores distantes do centro da distribuição a posteriori. O vetor de médias para \(\epsilon_1\) contém apenas zeros, e sua matriz de covariância é definida como a matriz de covariância da MLE.

Diagnósticos de convergência

Um aspecto importante do uso do algoritmo de Metropolis-Hastings é saber se a convergência foi alcançada. As funções de ajuste de modelos do pacote MCMCpack geram resultados que podem ser utilizados com o pacote coda, cujo nome deriva de COnvergence Diagnosis and output Analysis — Diagnóstico de Convergência e Análise de Resultados, para avaliar essa convergência. Tanto Plummer et al. (2006) quanto Robert and Casella (2010) apresentam boas discussões introdutórias sobre o coda.

Discussões mais aprofundadas sobre as medidas de diagnóstico fornecidas pela biblioteca coda podem ser encontradas em Cowles and Carlin (1996) e Robert and Casella (2004). Esta subseção apresenta um resumo dessas referências, juntamente com nossas próprias considerações.

Um gráfico de trajetória (trace plot) é frequentemente a primeira ferramenta utilizada para avaliar a convergência. Esse gráfico simplesmente exibe os valores dos parâmetros simulados na cadeia, unidos por uma linha na ordem em que foram gerados. As funções traceplot() e plot() produzem esses gráficos no R, sendo que a função plot() também inclui gráficos de estimativas de densidade não paramétricas para os parâmetros.

Se o algoritmo tiver convergido, tanto a média quanto a variabilidade dos valores simulados devem permanecer razoavelmente constantes ao longo do gráfico de trajetória. Além disso, a cadeia deve apresentar uma boa “mistura” (mixing), o que significa que ela percorre todas as regiões da distribuição a posteriori com bastante frequência.

Essas condições são frequentemente caracterizadas em um gráfico de trajetória por:

1. uma faixa central espessa e escura no meio do gráfico, oscilando suavemente dentro de uma faixa de valores relativamente constante; e

2. picos de comprimentos variados que se projetam a partir dessa faixa.

Os gráficos de trajetória da Figura 6.10 são exemplos de uma cadeia que parece ter convergido.

Às vezes, a média e/ou a variância constantes não são observadas logo no início da cadeia, especialmente se o valor inicial da cadeia não estiver situado em uma região de alta probabilidade da distribuição a posteriori. Essas amostras podem ser descartadas especificando-se um período de burn-in suficientemente longo. Outro problema possível ocorre quando a cadeia tende a permanecer em uma mesma região por uma longa sequência de amostras, ou seja, não apresenta boa “mistura”.

Isso resulta em fortes correlações positivas entre valores simulados sucessivos. No gráfico de trajetória (trace plot), uma mistura deficiente manifesta-se por meio de faixas e picos visualmente distintos, com amplitudes muito inferiores à faixa total de valores do parâmetro.

Soluções para a mistura deficiente incluem aumentar o tamanho da amostra e/ou realizar a técnica de thinning (subamostragem), utilizando apenas um a cada \(k\) valores simulados como amostra da distribuição a posteriori, sendo \(k\) um número inteiro maior que 1. O thinning pode ser definido por meio do argumento thin nas funções de ajuste de modelos do pacote MCMCpack, cujo padrão é não realizar thinning (thin = 1). Alternativamente, o thinning pode ser aplicado utilizando o argumento thin na função window().

A taxa com a qual o algoritmo de Metropolis-Hastings aceita novas propostas na amostra também é uma ferramenta de diagnóstico importante para a convergência. Dependendo da situação, uma taxa de aceitação baixa ou alta pode ser adequada. No entanto, na maioria dos casos, uma taxa excessivamente alta ou baixa indica a possibilidade de que nem todas as regiões da distribuição a posteriori tenham sido visitadas durante o processo de simulação. Taxas de aceitação desejáveis situam-se, geralmente, entre 0.2 e 0.5.

O argumento tune nas funções de ajuste de modelos do pacote MCMCpack pode auxiliar a alcançar essas taxas desejadas. O valor numérico atribuído a esse argumento simplesmente escala a variância associada a \(\epsilon_b\). O valor padrão é 1.1, e alterações nesse valor afetam a taxa de aceitação da cadeia. Especificamente, valores menores resultam em menor variabilidade na proposta \(c_b\) e, geralmente, aumentam a taxa de aceitação, enquanto valores maiores produzem o efeito oposto.

Como a probabilidade de aceitação baseia-se na razão entre duas distribuições a posteriori, é mais provável que essa razão se aproxime de 1 quando há menor variabilidade na proposta \(c_b\). Em outras palavras, o valor de \(c_b\) tenderá a ficar mais próximo de \(d_{b-1}\), tornando mais semelhantes os valores das duas distribuições a posteriori avaliadas.

Para que o R exiba a taxa de aceitação, é necessário especificar um valor diferente de zero para o argumento verbose na chamada da função de ajuste do modelo. Alternativamente, a taxa de rejeição — definida como um menos a taxa de aceitação — pode ser obtida utilizando-se a função rejectionRate() do pacote coda.

Vários testes de hipóteses estão disponíveis para auxiliar na verificação da convergência. Em particular, a função geweke.diag() realiza um teste de hipótese para comparar as médias da primeira e da última metade da cadeia. Valores da estatística de teste que ultrapassam \(\pm Z_{1-\alpha/2}\) indicam ausência de convergência.

Caso se conclua pela não convergência, pode-se utilizar a função geweke.plot() para verificar se a convergência acaba ocorrendo, traçando a estatística de teste para segmentos sucessivamente mais avançados da cadeia. Com o auxílio desse gráfico, é possível definir um período de burn-in mais longo para descartar a parte inicial e instável da cadeia.

Devido à correlação serial positiva entre os elementos da cadeia, as estatísticas calculadas a partir dela apresentam maior variabilidade do que teriam se os elementos fossem independentes. Assim, o tamanho efetivo da amostra é definido, aproximadamente, como o tamanho de uma amostra aleatória que forneceria uma estimativa da média com a mesma precisão da estimativa da média da cadeia. O tamanho efetivo da amostra é menor do que o tamanho da amostra da cadeia.

Quanto mais forte for a correlação entre elementos consecutivos na cadeia, menor será o tamanho efetivo da amostra. Se o tamanho efetivo da amostra for muito pequeno, isso pode indicar falta de convergência, sendo necessário um número maior de amostras para obter uma representação precisa da distribuição a posteriori. O tamanho efetivo da amostra é obtido por meio da função effectiveSize().

Como observado anteriormente, se um procedimento de diagnóstico indicar falta de convergência, uma solução simples pode ser simplesmente obter uma amostra maior. A convergência geralmente ocorrerá com o algoritmo de Metropolis-Hastings, a menos que a distribuição a posteriori não seja uma distribuição de probabilidade propriamente dita — o que pode acontecer se for escolhida uma distribuição a priori imprópria.

Para obter um tamanho de amostra maior, basta executar novamente a função de ajuste do modelo utilizando um valor maior para o argumento mcmc. Alternativamente, cadeias adicionais podem ser iniciadas. Por exemplo, a função MCMClogit() pode ser executada novamente uma ou mais vezes para o exemplo de placekicking, utilizando-se valores iniciais diferentes para β0 e β1 a cada execução — alterando o valor do argumento beta.start (cujo padrão é a estimativa de máxima verossimilhança, ou MLE); pode-se escolher valores a uma distância razoável de desvios-padrão da MLE e utilizar uma semente diferente no argumento seed.

Múltiplas cadeias são combinadas utilizando a função mcmc.list() do pacote coda. Uma vantagem de executar múltiplas cadeias é obter informações adicionais sobre a convergência que, de outra forma, poderiam não ser percebidas com uma única cadeia. Como Robert e Casella (2010) expressaram de forma eloquente, ao utilizar uma única cadeia, “você só viu onde esteve”. Em outras palavras, pode haver regiões da distribuição a posteriori que não foram visitadas por uma cadeia isolada. As funções gelman.diag() e gelman.plot() do pacote coda podem ser utilizadas com múltiplas cadeias para verificar a falta de convergência da média. Essas funções

calculam variâncias utilizadas na análise de variância padrão: uma variância entre cadeias para a média e uma variância dentro das cadeias para a média. Valores superiores a 1 para a estatística de teste resultante indicam uma possível falta de convergência.

Exemplo 6.22: Placekicking (Chute de bola parada)

A saída gerada por head(mod.fit.Bayes), mostra os valores de \(b = 10001\) a 10007 para \(\beta_0\) e \(\beta_1\) na cadeia. Os valores propostos para \(\beta_0\) e \(\beta_1\) foram rejeitados em \(b = 10002\) a 10005.

Em \(b = 10006\), os valores propostos foram aceitos e incluídos na amostra. Das 100.000 amostras obtidas, a taxa de aceitação foi de 0.5172, valor próximo ao limite superior da faixa de aceitação desejada.

A execução de plot(mod.fit.Bayes) gera gráficos de trajetória (trace plots) e de densidade para toda a amostra. Como utilizamos um tamanho de amostra muito grande, examinamos esses gráficos em intervalos menores com o auxílio da função window(). Por exemplo, window(x = mod.fit.Bayes, start = 10001, end = 20000) extrai as primeiras 10.000 amostras de mod.fit.Bayes — as amostras do período de burn-in não estão incluídas no objeto — e a Figura 6.10 apresenta os gráficos de trajetória e de densidade correspondentes.

Os gráficos de trajetória aqui apresentados (assim como os de outros segmentos da cadeia) exibem uma faixa central espessa e escura, com uma amplitude de valores de parâmetro relativamente constante. Além disso, os valores no gráfico de trajetória variam rapidamente em curtos intervalos de amostras. Portanto, esses gráficos não indicam falta de convergência.

A função plot() também fornece gráficos de densidade para β0 e β1, conforme mostrado na Figura 6.10. Ambos os gráficos apresentam distribuições bastante simétricas; é por isso que os intervalos de credibilidade de caudas iguais e HPD resultaram em limites inferiores e superiores semelhantes para cada parâmetro de regressão.

geweke.diag( x = mod.fit.Bayes )

## 
## Fraction in 1st window = 0.1
## Fraction in 2nd window = 0.5 
## 
## (Intercept)    distance 
##    -0.03532     0.05640

# Additional plots
autocorr.plot(mod.fit.Bayes)  # Plot of autocorrelations

acf(mod.fit.Bayes)  # This is autocorrelation plot used in time series analysis.

crosscorr.plot(mod.fit.Bayes)  # Plot of crosscorrelations

# cumuplot(mod.fit.Bayes)  # This produces plots for the entire chain, which can take a while
cumuplot(mod.fit.Bayes.temp)  # First 10000

# Improper prior distribution example - once again, similar results
mod.fit.Bayes4 <- MCMClogit(formula = good ~ distance, data = placekick, seed = 2399, 
                            b0 = 0, B0 = 0, burnin = 10000, verbose = 0, mcmc = 100000)
summary(mod.fit.Bayes4)

## 
## Iterations = 10001:110000
## Thinning interval = 1 
## Number of chains = 1 
## Sample size per chain = 1e+05 
## 
## 1. Empirical mean and standard deviation for each variable,
##    plus standard error of the mean:
## 
##               Mean      SD Naive SE Time-series SE
## (Intercept)  5.833 0.32987 1.04e-03       3.19e-03
## distance    -0.115 0.00842 2.66e-05       8.14e-05
## 
## 2. Quantiles for each variable:
## 
##               2.5%    25%    50%   75%   97.5%
## (Intercept)  5.208  5.608  5.826  6.05  6.5007
## distance    -0.132 -0.121 -0.115 -0.11 -0.0994

plot(mod.fit.Bayes4)

Figura 6.10: Gráficos de trajetória e de densidade para as primeiras 10.000 amostras incluídas na cadeia.

O pacote MCMCpack fornece as funções necessárias para estimar uma ampla variedade de modelos utilizando métodos bayesianos. Essas funções compartilham a mesma sintaxe; portanto, é fácil realizar outras análises depois de compreender como utilizar uma função como MCMClogit(). Algumas dessas funções são exploradas nos exercícios.

6.7 Exercícios

1- Rogan and Gladen (1978) discutem um levantamento realizado com 1 milhão de indivíduos nos Estados Unidos para estimar a prevalência de hipertensão. Entre os indivíduos pesquisados, 11.6% apresentaram pressão arterial diastólica acima de 95 mmHg, sendo classificados como hipertensos. Por meio de um estudo adicional, estimou-se que a sensibilidade e a especificidade do procedimento eram \(S_e = 0.930\) e \(S_p = 0.911\). Determine a estimativa de máxima verossimilhança (MLE) para a prevalência real global de hipertensão (utilizando > 95 mmHg como ponto de corte) e o intervalo de confiança de Wald de 95% correspondente. Descreva o efeito que a consideração do erro de teste exerce sobre a compreensão da prevalência de hipertensão.

2- A Seção 1.1.3 examinou os níveis de confiança reais para intervalos de confiança construídos para uma probabilidade de sucesso \(\pi\), com \(n = 40\), \(\alpha = 0.05\) e \(\pi\) variando de 0.001 a 0.999 em incrementos de 0.0005. Construa os mesmos tipos de gráficos para um intervalo de confiança de Wald para \(\widehat{\pi}\), variando de 0.001 a 0.999 em incrementos de 0.0005. Descreva o que acontece com os níveis de confiança reais à medida que a magnitude do erro de teste se altera e faça comparações com o caso de ausência de erro de teste. Recomendamos fixar inicialmente uma das medidas, \(S_e\) ou \(S_p\), em 1, enquanto se varia a outra medida de acurácia.

3- Obtenha \(\widehat{\widetilde{\pi}}\) e sua variância estimada utilizando o seguinte processo:

1. Encontre o logaritmo da função de verossimilhança dada na Equação (6.2).

2. Calcule a derivada da função de log-verossimilhança em relação a \(\widehat{\pi}\).

3. Iguale a zero a derivada encontrada em (b) e resolva para \(\widetilde{\pi}\). O valor resultante é o estimador de máxima verossimilhança (MLE).

4. Calcule a segunda derivada da função de log-verossimilhança em relação a \(\widetilde{\pi}\).

5. Encontre o valor esperado do resultado obtido em (d).

6. Inverta o resultado de (e) e multiplique por \(-1\). Esse valor é \(\mbox{Var}(\widehat{\widetilde{\pi}})\). Substitua \(\pi\) por \(\widehat{\pi}\) para obter \(\widehat{\mbox{Var}}(\widehat{\widetilde{\pi}})\).

4- Considere novamente o exemplo sobre o rastreamento de doenças infecciosas no pré-natal, apresentado na Seção 6.1.2.

1. Estime o modelo de regressão logística que inclua todas as variáveis explicativas disponíveis no conjunto de dados como termos lineares. Certifique-se de incluir marital.status como uma variável categórica.

2. Realize testes de razão de verossimilhança (LRTs) apropriados para cada uma das variáveis explicativas, assumindo que as demais variáveis estejam presentes no modelo.

3. Determine o modelo com o melhor ajuste aos dados. Interprete as variáveis explicativas utilizando razões de chances (odds ratios).

5- Os métodos descritos na Seção 6.1.2 oferecem uma maneira conveniente de obter um intervalo de confiança baseado na razão de verossimilhança (LR) para \(\widetilde{\pi}\) quando não há variáveis explicativas. Realize os passos a seguir para obter um intervalo para o exemplo da prevalência de hepatite C entre doadores de sangue apresentado na Seção 6.1.1.

1. Construa um data frame de uma única linha com as variáveis denominadas positive e blood.donors para representar os 42 doadores de sangue (de um total de 1875) que testaram positivo para hepatite C.

2. Estime o modelo \(logit(\widetilde{\pi}) = \beta_0\) utilizando a função glm() com a função de ligação my.link() fornecida. Certifique-se de incluir o argumento weights = blood.donors na chamada da função glm(), devido à natureza binomial dos dados.

3. Calcule o intervalo de confiança de 95% (baseado na LR) para \(\beta_0\) utilizando a função confint().

4. Determine o intervalo de confiança de 95% (baseado na LR) para \(\widetilde{\pi}\) utilizando a relação entre \(\widetilde{\pi}\) e \(\beta_0\). Compare esse intervalo com o intervalo de Wald calculado na Seção 6.1.1.

5. Discuta por que o cálculo de um intervalo de confiança baseado na LR para \(\widetilde{\pi}\) resulta em limites situados entre 0 e 1.

6- O objetivo deste problema é examinar o que acontece com \(\widehat{\mbox{Var}}\big(\widehat{\beta}_1\big)\) à medida que a quantidade de erro de teste aumenta. Para este problema, realize todos os seus cálculos usando os dados de triagem pré-natal de doenças infecciosas da Seção 6.1.2, onde a idade (age) é usada como variável explicativa para estimar a probabilidade de infecção pelo HIV (hiv) em um modelo de regressão logística.

1. 1. Estime o modelo usando \(S_e = S_p = 1\) com optim() ou glm() e a função my.link(). Confirme se você obtém o mesmo resultado que ao usar glm() com family = binomial(link = logit).

2. Mantendo \(S_p\) fixo em 1, examine o que acontece com \(\widehat{\mbox{Var}}\big(\widehat{\beta}_1\big)\) quando \(S_e\) varia de 0.94 para 1 em incrementos de 0.01.

3. Mantendo \(S_e\) fixo em 1, examine o que acontece com \(\widehat{\mbox{Var}}\big(\widehat{\beta}_1\big)\) quando \(S_p\) varia de 0.94 para 1 em incrementos de 0.01.

4. Compare seus resultados de (b) e (c) e sugira razões pelas quais a variância mudou ou não substancialmente. Discuta quaisquer problemas de convergência e/ou cálculo que surgiram.

7- Utilizando os dados de triagem de doenças infecciosas no pré-natal da Seção 6.1.2, com a idade (age) como variável explicativa e o HIV (hiv) como variável resposta, estime o modelo de regressão logística utilizando o método MCSIMEX, da seguinte forma:

1. Crie uma nova variável de resposta em set1 que transforme hiv em uma variável da classe factor. Nomeie essa nova variável como hiv.factor. Essa alteração de classe é necessária para utilizar a função mcsimex() do pacote simex.

2. Estime um modelo de regressão logística utilizando glm(), mas não considere o erro de teste. Armazene os resultados do ajuste do modelo em um objeto chamado mod.fit.naive. Inclua o argumento x = TRUE na função glm() para que a matriz \(\pmb{X}\), conforme descrita na Seção 2.2.1, esteja presente no objeto resultante; isso será necessário para a função mcsimex() na parte (d).

3. Construa uma tabela de contingência que contenha \(S_p\), \(1-S_p\), \(1-S_e\) e \(S_e\):

test.err <- array ( data = c (0.98 , 1 - 0.98 , 1 - 0.98 , 0.98), 
    dim = c (2 ,2) , dimnames = list ( obs.levels = levels ( set1$hiv.factor ), 
    true.levels = levels ( set1$hiv.factor ) ) )

4. Estime o modelo de regressão logística utilizando o método MCSIMEX com a função mcsimex():

library ( simex )
mod.fit.mcsimex <- mcsimex ( model = mod.fit.naive , mc.matrix = test.err , 
    SIMEXvariable = "hiv.factor")
summary ( mod.fit.mcsimex )

Esta implementação da função mcsimex() utiliza a simulação de Monte Carlo para aproximar os efeitos do erro de medição nos estimadores dos parâmetros de regressão. São geradas estimativas de erros-padrão tanto assintóticas quanto baseadas no método jackknife. Compare essas estimativas e erros-padrão com aqueles obtidos na Seção 6.1.2.

O jackknife é um procedimento semelhante ao bootstrap no sentido de que utiliza a reamostragem para extrair amostras da amostra original. A diferença entre ambos é que o jackknife emprega uma abordagem de reamostragem do tipo “deixar um de fora” (leave-one-out), gerando \(n\) reamostras distintas, cada uma contendo \(n - 1\) observações.

8- A distribuição hipergeométrica para uma tabela \(2\times 2\) (veja a Tabela 6.2) pode ser obtida partindo-se de duas distribuições binomiais independentes e aplicando-se os seguintes passos:

6.8 Referências

Agresti, Alan. 2002. Categorical Data Analysis. 2nd ed. John Wiley & Sons. https://doi.org/10.1002/0471249688.

Agresti, A., and I. Liu. 1999. “Modeling a Categorical Variable Allowing Arbitrarily Many Category Choices.” Biometrics, no. 55: 936–43.

Bates, D. 2010. Lme4: Mixed-Effects Modeling with r. Self-published, http://lme4.r-forge.r-project.org/.

Beller, Emily. 2009. “Bringing Intergenerational Social Mobility Research into the Twenty-First Century: Why Mothers Matter.” American Sociological Review 74 (4): 507–28. https://doi.org/10.1177/000312240907400401.

Berry, K., and P. Mielke. 2003. “Permutation Analysis of Data with Multiple Binary Category Choices.” Psychological Reports, no. 92: 91–98.

Bilder, C., and T. Loughin. 2002. “Testing for Conditional Multiple Marginal Independence.” Biometrics, no. 58: 200–208.

Bilder, C., and T. Loughin. 2004. “Testing for Marginal Independence Between Two Categorical Variables with Multiple Responses.” Biometrics, no. 60: 241–48.

Bilder, C., and T. Loughin. 2007. “Modeling Association Between Two or More Categorical Variables That Allow for Multiple Category Choices.” Communications in Statistics: Theory and Methods, no. 36: 433–51.

Bilder, C., T. Loughin, and D. Nettleton. 2000. “Multiple Marginal Independence Testing for Pick Any/c Variables.” Communications in Statistics: Simulation and Computation, no. 29: 1285–316.

Binder, David A. 1983. “On the Variances of Asymptotically Normal Estimators from Complex Surveys.” International Statistical Review 51 (3): 279–92. https://doi.org/10.2307/1402588.

Binder, D., and G. Roberts. 2003. “Statistical Inference for Survey Data Analysis.” ASA Proceedings of the Joint Statistical Meetings, 568–72.

Binder, D., and G. Roberts. 2009. “Design- and Model-Based Inference for Model Parameters.” In Handbook of Statistics 29B: Sample Surveys: Inference and Analysis, edited by D. Pfeffermann and C. Rao. Elsevier.

Breslow, Norman E., and Xihong Lin. 1995. “Bias Correction in Generalised Linear Mixed Models with a Single Component of Dispersion.” Biometrika 82 (1): 81–91.

Buonaccorsi, J. 2010. Measurement Error: Models, Methods, and Applications. Chapman & Hall/CRC.

Carlin, B., and T. Louis. 2008. Bayesian Methods for Data Analysis. Chapman & Hall/CRC.

Carroll, R., D. Ruppert, L. Stefanski, and C. Crainiceanu. 2010. Measurement Error in Nonlinear Models: A Modern Perspective. Chapman & Hall/CRC.

Casella, G., and R. Berger. 2002. Statistical Inference. Duxbury Press.

Chib, Siddhartha, and Edward Greenberg. 1995. “Understanding the Metropolis-Hastings Algorithm.” The American Statistician 49 (4): 327–35. https://doi.org/10.1080/00031305.1995.10476177.

Clogg, Clifford C., and Scott R. Eliason. 1987. “Some Common Problems in Log-Linear Analysis.” Sociological Methods & Research 16 (1): 8–44. https://doi.org/10.1177/0049124187016001002.

Coombs, C. 1964. A Theory of Data. John Wiley & Sons.

Cowles, Mary Kathryn, and Bradley P. Carlin. 1996. “Markov Chain Monte Carlo Convergence Diagnostics: A Comparative Review.” Journal of the American Statistical Association 91 (434): 883–904.

Davison, A., and D. Hinkley. 1997. Bootstrap Methods and Their Application. Cambridge University Press.

Fang, Liang, and Thomas M. Loughin. 2012. “Analyzing Binomial Data in a Split-Plot Design: Classical Approach or Modern Techniques?” Communications in Statistics—Simulation and Computation 42 (4): 727–40.

Firth, David. 1993. “Bias Reduction of Maximum Likelihood Estimates.” Biometrika 80 (1): 27–38. https://doi.org/10.1093/biomet/80.1.27.

Gange, Stephen J. 1995. “Generating Multivariate Categorical Variates Using the Iterative Proportional Fitting Algorithm.” The American Statistician 49 (2): 134–38. https://doi.org/10.1080/00031305.1995.10476130.

Gelman, A., J. Carlin, H. Stern, and D. Rubin. 2004. Bayesian Data Analysis.

Gustafson, P. 2004. Measurement Error and Misclassificaion in Statistics and Epidemiology: Impacts and Bayesian Adjustments. Chapman & Hall/CRC.

Heeringa, Steven G., Brady T. West, and Patricia A. Berglund. 2010. Applied Survey Data Analysis. Statistics in the Social and Behavioral Sciences. Chapman & Hall/CRC. https://doi.org/10.1201/9781420080674.

Heinze, Georg. 2006. “A Comparative Investigation of Methods for Logistic Regression with Separated or Nearly Separated Data.” Statistics in Medicine 25 (24): 4216–26. https://doi.org/10.1002/sim.2687.

Hirji, Karim F., Cyrus R. Mehta, and Nitin R. Patel. 1987. “Computing Distributions for Exact Logistic Regression.” Journal of the American Statistical Association 82 (400): 1110–17. https://doi.org/10.1080/01621459.1987.10478547.

Imrey, Peter B., Gary G. Koch, Maura E. Stokes, John N. Darroch, Daniel H. Freeman Jr., and H. Dennis Tolley. 1982. “Categorical Data Analysis: Some Reflections on the Log-Linear Model and Logistic Regression. Part II: Data Analysis.” International Statistical Review / Revue Internationale de Statistique 50 (1): 35–63. https://doi.org/10.2307/1402458.

Korn, Edward L., and Barry I. Graubard. 1999. Analysis of Health Surveys. John Wiley & Sons.

Korn, E., and B. Graubard. 1999. Analysis of Health Surveys. John Wiley & Sons.

Kott, Phillip S., and D. Andrew Carr. 1997. “Developing an Estimation Strategy for a Pesticide Data Program.” Journal of Official Statistics 13 (4): 367–83. https://www.scb.se/contentassets/ca21efb41fee47d293bbee5bf7be7fb3/developing-an-estimation-strategy-for-a-pesticide-data-program.pdf.

Küchenhoff, H., S. Mwalili, and E. Lesaffre. 2006. “A General Method for Dealing with Misclassification in Regression: The Misclassification SIMEX.” Biometrics, no. 62: 85–96.

Kuonen, Diego. 1999. “Saddlepoint Approximations for Distributions of Quadratic Forms in Normal Variables.” Biometrika 86 (4): 929–35.

Lederer, W., and H. Küchenhoff. 2006. A Short Introduction to the SIMEX and MCSIMEX. no. 6: 26–31.

Lee, Kang In, and John J. Koval. 1997. “Determination of the Best Significance Level in Forward Logistic Regression.” Communications in Statistics – Simulation and Computation 26 (2): 559–75. https://doi.org/10.1080/03610919708813397.

Littell, R., G. Milliken, W. Stroup, R. Wolfinger, and O. Schabenberger. 2006. SAS for Mixed Models. SAS Institute.

Liu, P., Z. Shi, Y. Zhang, Z. Xu, H. Shu, and X. Zhang. 1997. “A Prospective Study of a Serum-Pooling Strategy in Screening Blood Donors for Antibody to Hepatitis c Virus.” Transfusion, no. 37: 732–36.

Lohr, S. 2010. Sampling: Design and Analysis. Cengage Learning, 2nd edition.

Lohr, Sharon L. 2010. Sampling: Design and Analysis. 2nd ed. Brooks/Cole Cengage Learning.

Loughin, Thomas M., and Christopher R. Bilder. 2010. “On the Use of a Log-Rate Model for Survey-Weighted Categorical Data.” Communications in Statistics: Theory and Methods 40 (15): 2661–69. https://doi.org/10.1080/036109262010489178.

Loughin, Thomas M., Melissa G. Roediger, George A. Milliken, and John P. Schmidt. 2007. “On the Analysis of Long-Term Experiments.” Journal of the Royal Statistical Society: Series A (Statistics in Society) 170 (1): 29–42.

Loughin, T., and P. Scherer. 1998. “Testing for Association in Contingency Tables with Multiple Column Responses.” Biometrics, no. 54: 630–37.

Lumley, Thomas. 2010. Complex Surveys: A Guide to Analysis Using r. Wiley Series in Survey Methodology. John Wiley & Sons.

Martin, Andrew D., and Kevin M. Quinn. 2006. “Applied Bayesian Inference in R Using MCMCpack.” R News 6 (1): 2–7.

Martin, Andrew D., Kevin M. Quinn, and Jong Hee Park. 2011. “MCMCpack: Markov Chain Monte Carlo in R.” Journal of Statistical Software 42 (9): 1–21. https://doi.org/10.18637/jss.v042.i09.

McLean, Robert A., William L. Sanders, and Walter W. Stroup. 1991. “A Unified Approach to Mixed Linear Models.” The American Statistician 45 (1): 54–64.

Mehta, Cyrus R., and Nitin R. Patel. 1995. “Exact Logistic Regression: Theory and Examples.” Statistics in Medicine 14 (19): 2143–60. https://doi.org/10.1002/sim.4780141908.

Mehta, Cyrus R., Nitin R. Patel, and Pralay Senchaudhuri. 2000. “Efficient Monte Carlo Methods for Conditional Logistic Regression.” Journal of the American Statistical Association 95 (449): 99–108. https://doi.org/10.1080/01621459.2000.10473906.

Molenberghs, G., and G. Verbeke. 2005. Models for Discrete Longitudinal Data. Springer.

Plummer, Martyn, Nicky Best, Kate Cowles, and Karen Vines. 2006. “CODA: Convergence Diagnosis and Output Analysis for MCMC.” R News 6 (1): 7–11. https://journal.r-project.org/articles/RN-2006-002/.

Rao, J. N. K., and A. J. Scott. 1981. “The Analysis of Categorical Data from Complex Sample Surveys: Chi-Squared Tests for Goodness of Fit and Independence in Two-Way Tables.” Journal of the American Statistical Association 76 (374): 221–30. https://doi.org/10.1080/01621459.1981.10477633.

Rao, J. N. K., and A. J. Scott. 1984. “On Chi-Squared Tests for Multiway Contingency Tables with Cell Proportions Estimated from Survey Data.” The Annals of Statistics 12 (1): 46–60. https://doi.org/10.1214/aos/1176346391.

Rao, J. N. K., and Alastair J. Scott. 1984. “On Chi-Squared Tests for Multiway Contingency Tables with Cell Proportions Estimated from Survey Data.” The Annals of Statistics 12 (1): 46–60. https://doi.org/10.1214/aos/1176346391.

Rao, J. N. K., and D. Roland Thomas. 2003. “Analysis of Categorical Response Data from Complex Surveys: An Appraisal and Update.” In Analysis of Survey Data, edited by Ray Chambers and Chris Skinner. Wiley.

Raudenbush, S., and A. Bryk. 2002. Hierarchical Linear Models: Applications and Data Analysis Methods. Sage Publications.

Richert, B., M. Tokach, R. Goodband, and J. Nelssen. 1995. “Assessing Producer Awareness of the Impact of Swine Production on the Environment.” Journal of Extension, no. 33: 1–4.

Robert, C. 2001. The Bayesian Choice: From Decision-Theoretic Foundations to Computational Implementation. Springer.

Robert, Christian P., and George Casella. 2004. Monte Carlo Statistical Methods. 2nd ed. Springer.

Robert, Christian, and George Casella. 2010. Introducing Monte Carlo Methods with r. Springer.

Rogan, Walter J., and Beth Gladen. 1978. “Estimating Prevalence from the Results of a Screening Test.” American Journal of Epidemiology 107 (1): 71–76. https://doi.org/10.1093/oxfordjournals.aje.a112510.

Rust, Keith F., and J. N. K. Rao. 1996. “Variance Estimation for Complex Surveys Using Replication Techniques.” Statistical Methods in Medical Research 5 (3): 283–310. https://doi.org/10.1177/096228029600500305.

Salsburg, D. 2001. The Lady Tasting Tea: How Statistics Revolutionized Science in the Twentieth Century. Henry Holt; Company, LLC.

Satterthwaite, Franklin E. 1946. “An Approximate Distribution of Estimates of Variance Components.” Biometrics Bulletin 2 (6): 110–14. https://doi.org/10.2307/3001968.

Schonnop, R., Y. Yang, F. Feldman, E. Robinson, M. Loughin, and S. Robinovitch. 2013. “Prevalence of and Factors Associated with Head Impact During Falls in Older Adults in Long-Term Care.” Canadian Medical Association Journal, no. 185: E803–10.

Schwartz, Christine R., and Robert D. Mare. 2005. “Trends in Educational Assortative Marriage from 1940 to 2003.” Demography 42 (4): 621–46. https://doi.org/10.1353/dem.2005.0036.

Scott, Alastair. 2007. “Rao-Scott Corrections and Their Impact.” Proceedings of the Section on Survey Research Methods, 3514–18.

Scott, Alastair J., and J. N. K. Rao. 1981. “Chi-Squared Tests for Contingency Tables with Proportions Estimated from Survey Data.” In Current Topics in Survey Sampling, edited by J. Krewski, R. Platek, and J. N. K. Rao. Academic Press.

Shtatland, Ernest S., Ken Kleinman, and Emily M. Cain. 2003. “Stepwise Methods Using SAS Proc Logistic and SAS Enterprise Miner for Prediction.” Proceedings of the Twenty-Eighth Annual SAS Users Group International Conference (Cary, NC) 28: Paper 258–28. https://sas.com.

Skinner, Chris, and Louis-André Vallet. 2010. “Fitting Log-Linear Models to Contingency Tables from Surveys with Complex Sampling Designs: An Investigation of the Clogg-Eliason Approach.” Sociological Methods & Research 39 (1): 83–108. https://doi.org/10.1177/0049124110378097.

Thomas, D. Roland, and J. N. K. Rao. 1987. “Small-Sample Comparisons of Level and Power for Simple Goodness-of-Fit Statistics Under Cluster Sampling.” Journal of the American Statistical Association 82 (398): 630–36. https://doi.org/10.1080/01621459.1987.10478475.

Thomas, D. Roland, A. C. Singh, and Graham Richard Roberts. 1996. “Tests of Independence on Two-Way Tables Under Cluster Sampling: An Evaluation.” International Statistical Review 64 (3): 295–311. https://doi.org/10.2307/1403781.

Thomas, D., and Y. Decady. 2004. “Testing for Association Using Multiple Response Survey Data: Approximate Procedures Based on the Rao-Scott Approach.” International Journal of Testing, no. 4: 43–59.

Thompson, S. 2002. Sampling. John Wiley & Sons.

Tools for Statistical Inference: Methods for the Exploration of Posterior Distributions and Likelihood Functions. 1996. Springer, 3rd edition.

Vansteelandt, S., E. Goetghebeur, and T. Verstraeten. 2000. “Regression Models for Disease Prevalence with Diagnostic Tests on Pools of Serum Samples.” Biometrics, no. 56: 1126–33.

Vermunt, Jeroen K., and Jay Magidson. 2007. “Latent Class Analysis with Sampling Weights: A Maximum-Likelihood Approach.” Sociological Methods & Research 36 (1): 87–111. https://doi.org/10.1177/0049124107301965.

Verstraeten, T., B. Farah, L. Duchateau, and R. Matu. 1998. “Pooling Sera to Reduce the Cost of HIV Surveillance: A Feasibility Study in a Rural Kenyan District.” Tropical Medicine and International Health, no. 3: 747–50.

Westfall, P., and S. Young. 1993. Resampling-Based Multiple Testing: Examples and Methods for p-Value Adjustment. John Wiley & Sons.

Wilkins, T., J. Malcolm, D. Raina, and R. Schade. 2010. “Hepatitis c: Diagnosis and Treatment.” American Family Physician, no. 81: 1351–57.

Zamar, David, Brad McNeney, and Jinko Graham. 2007. “Elrm: Software Implementing Exact-Like Inference for Logistic Regression Models.” Journal of Statistical Software 21 (3): 1–18. https://doi.org/10.18637/jss.v021.i03.

Zeger, Scott L., and Kung-Yee Liang. 1986. “Longitudinal Data Analysis for Discrete and Continuous Outcomes.” Biometrics 42 (1): 121–30. https://doi.org/10.2307/2531248.