Análise de Dados Categóricos
Capítulo 5- Seleção e validação do modelo
2023-11-14
- 5.1 Seleção de variáveis
- 5.1.1 Visão geral da seleção de variáveis
- 5.1.2 Critérios de comparação de modelos
- 5.1.3 Regressão de todos os subconjuntos
- 5.1.4 Seleção de variável passo a passo (stepwise)
- 5.1.5 Métodos modernos de seleção de variáveis
- 5.1.6 Média do modelo
- 5.2 Ferramentas para avaliar o ajuste do modelo
- 5.2.1 Resíduos
- 5.2.2 Adequação do ajuste
- 5.2.3 Influência
- 5.2.4 Diagnósticos para modelos de resposta multicategoria
- 5.3 Superdispersão
- 5.3.1 Causas e implicações
- 5.3.2 Detecção
- 5.3.3 Soluções
- 5.3.3.1 Modelos de quase verossimilhança
- 5.3.3.2 Modelos binomial negativo e beta-binomial
- 5.4 Exemplos
- 5.4.1 Conjunto de dados de regressão logística - placekicking
- 5.4.2 Regressão Poisson - conjunto de dados de consumo de álcool
- 5.5 Exercícios
Nos Capítulos 1-4 desenvolvemos uma variedade de modelos de probabilidade para analisar diferentes tipos de dados categóricos. Em cada caso partimos de um conjunto fixo de variáveis explicativas e exploramos técnicas de ajuste e inferência de modelos assumindo que o modelo e as variáveis escolhidas estavam corretos. No entanto, cada um desses modelos de probabilidade é uma suposição que pode ou não ser satisfeita pelos dados de um determinado problema. Além disso, na prática, muitas vezes há incerteza sobre quais variáveis explicativas são necessárias em um modelo. De fato, o objetivo de muitas análises de regressão categórica é identificar quais variáveis de um grande número de candidatos estão associadas a uma resposta ou entre si e quais não estão.
A “seleção do modelo” consiste em
identificar um modelo de probabilidade apropriado para um problema e
identificar um conjunto apropriado de variáveis explicativas a serem usadas nesse modelo.
Neste capítulo, apresentamos pela primeira vez técnicas que podem ser usadas para selecionar um conjunto apropriado de variáveis explicativas dentre um conjunto maior de variáveis candidatas. Mostramos técnicas clássicas e desenvolvimentos mais recentes que têm vantagens distintas sobre suas contrapartes mais antigas.
Depois que o processo de seleção de variáveis é abordado, exploramos métodos para avaliar se as suposições que cercam nosso modelo de probabilidade são satisfeitas. Apresentamos resíduos e mostramos como eles podem ser usados em gráficos e testes para identificar suposições do modelo que podem ser violadas. Em particular, identificamos uma violação de modelo muito comum – a superdispersão – e discutimos suas causas, seus impactos nas inferências e os ajustes que podem ser feitos em um modelo para reduzir seus efeitos adversos. Concluímos o capítulo com dois exemplos resolvidos.
5.1 Seleção de variáveis
A seleção de variáveis refere-se ao processo de redução do tamanho do modelo de um número potencialmente grande de variáveis para um conjunto mais gerenciável e interpretável. Existem muitas abordagens para selecionar um subconjunto de variáveis de um pool (conjunto) maior. Todos têm pontos fortes e fracos, e novas abordagens estão sendo desenvolvidas a cada ano. Apresentaremos primeiro os métodos que são historicamente os mais usados e, de fato, ainda são de uso comum hoje.
No entanto, esses métodos não são mais recomendados por especialistas em seleção de variáveis. Apresentaremos críticas a esses métodos e ofereceremos alternativas geralmente mais confiáveis.
5.1.1 Visão geral da seleção de variáveis
Por que fazer seleção de variáveis? Por que não simplesmente usar o modelo com todas as variáveis disponíveis nele? Há duas respostas para essas perguntas. Primeiro, em muitas aplicações modernas, o número de variáveis disponíveis pode ser muito grande para formar um modelo interpretável. Parte do objetivo da análise pode ser tentar entender quais variáveis estão realmente relacionadas à resposta. Além disso, em áreas como genética e medicina, o número de variáveis disponíveis pode ser maior que o número de observações, problema conhecido como “p \(\gg\) n”. Nessas aplicações, o modelo completo não pode ser ajustado, o que significa que algum tipo de seleção de variável é necessária.
A segunda resposta tem a ver com algo chamado tradeoff viés-variância. Os erros cometidos pelas previsões de um modelo são resultado de duas fontes: viés e variância. O viés na especificação de um modelo inclui a incapacidade de adivinhar a relação correta entre a resposta e as variáveis do modelo, bem como erros na escolha das variáveis usadas no modelo. O uso de todas as variáveis disponíveis parece ser uma solução para o segundo desses dois problemas e, de fato, minimiza o viés devido à seleção de variáveis.
No entanto, o processo de estimar parâmetros adiciona variabilidade a quaisquer valores previstos, porque a estimativa geralmente não corresponde exatamente ao valor real do parâmetro. Para ver isso, considere ajustar um modelo para, digamos, 10 variáveis quando apenas uma é realmente importante. Embora os verdadeiros valores dos parâmetros devam ser 0 para as outras nove variáveis, eles provavelmente serão estimados por algum valor aleatório diferente de zero. Mesmo se tivéssemos que adivinhar exatamente o parâmetro da variável importante, os valores previstos variariam aleatoriamente de suas verdadeiras médias devido ao ruído adicionado pelas estimativas do parâmetro.
Quanto mais variáveis sem importância adicionarmos a um modelo, mais ruído aleatório será adicionado às previsões. Pode até acontecer que o verdadeiro efeito de uma variável na resposta não seja zero, mas tão pequeno que o aumento do viés causado por deixá-la fora de um modelo seja menor do que a variabilidade adicionada por ter que estimar seu parâmetro. Quando o objetivo principal de uma análise é prever novas observações, pode valer a pena usar um modelo que tenha poucas variáveis em vez de um que tenha todas as corretas. Isso é conhecido como esparsidade ou parcimônia na literatura de seleção de variáveis. Por outro lado, em problemas onde entender as relações entre a resposta e as variáveis explicativas é o objetivo principal, não queremos deixar de lado pequenas contribuições. Ambos os objetivos valem a pena em diferentes contextos. O Exercício 1 explora a compensação viés-variância no contexto da regressão logística.
A seleção de variáveis é, portanto, uma parte comum e importante de muitas análises estatísticas. Todas as técnicas de seleção de variáveis que discutimos se aplicam a qualquer um dos modelos de probabilidade dos capítulos anteriores. Portanto, começamos assumindo que selecionamos um modelo de probabilidade que acreditamos ser apropriado para o nosso problema; por exemplo, Poisson, binomial ou multinomial e que existe um “conjunto” de \(P\) variáveis explicativas, \(x_1,\cdots, x_P\) , que são candidatos a inclusão em um modelo de regressão. De acordo com a notação do modelo linear generalizado, assumimos que os parâmetros do modelo; por exemplo, a média \(\mu\) para um modelo de Poisson ou a probabilidade \(\pi\) para um binomial estão ligados aos parâmetros de regressão \(\beta_0,\beta_1,\cdots,\beta_P\) por meio de uma função de ligação apropriada \(g(\cdot)\), por exemplo, \(\log\) ou \(logit\); consulte a Seção 2.3. Portanto, expressamos todos os nossos modelos em termos do preditor linear \(g(\cdot) =\beta_0 +\beta_1 x_1 +\cdots + \beta_P x_P\).
Obviamente, queremos que o modelo final contenha todas as variáveis importantes e nenhuma das não importantes. Se o conhecimento ou alguma teoria sobre o problema nos diz que certas variáveis são definitivamente importantes, elas devem ser incluídas no modelo no início e não são mais consideradas para seleção. Da mesma forma, se alguma variável for conhecida por não estar relacionada à resposta, ela poderá ser imediatamente excluída do modelo.
As \(P\) variáveis restantes formam o pool sobre o qual o processo de seleção deve se concentrar. Este pool de variáveis pode incluir transformações de outras variáveis no pool ou interações entre variáveis. Precisamos de alguma forma criar modelos a partir dessas variáveis, compará-los usando algum critério e selecionar variáveis ou modelos que forneçam os melhores resultados. Primeiro discutimos critérios populares para comparar modelos. Em seguida, descrevemos algoritmos para criar modelos que podem ser comparados usando esses critérios. Finalmente explicamos como os modelos selecionados devem e não devem ser usados.
5.1.2 Critérios de comparação de modelos
A comparação de dois modelos pode ser feita usando um teste de hipótese, desde que um dos modelos esteja aninhado no outro. Ou seja, o modelo maior deve conter todas as mesmas variáveis do modelo menor, mais pelo menos uma variável adicional. Por exemplo, os modelos \(g(\cdot) =\beta_0 +\beta_1 x_1\) e \(g(\cdot) =\beta_0 +\beta_1 x_1 +\beta_2 x_2\) podem ser comparados usando um teste de hipótese, enquanto os modelos \(g(\cdot) =\beta_0 + \beta_1 x_1\) e \(g(\cdot) =\beta_0 + \beta_2 x_2\) não pode. Isso limita severamente o uso de testes de hipóteses para seleção de variáveis. Em vez disso, é necessário um critério que possa avaliar o quão bem qualquer modelo explica os dados.
Quando os modelos são ajustados usando a estimativa de máxima verossimilhança, o desvio residual fornece uma medida agregada de quão longe as previsões do modelo estão dos dados observados, com valores menores indicando um ajuste mais próximo. Pode parecer que o deviance poderia ser usado como um critério de seleção de variáveis no sentido de que um modelo com deviance menor seria preferido a outro com deviance maior. No entanto, como a soma dos erros quadrados na regressão linear, o desvio residual não pode aumentar quando uma nova variável é adicionada a um modelo. O modelo com todas as variáveis disponíveis sempre tem o menor deviance ou equivalentemente, o maior valor para sua função de verossimilhança avaliada.
O desvio residual ou valor de log-verossimilhança precisa ser ajustado de alguma forma para que a adição de uma variável não melhore automaticamente a medida. Os critérios de informação são medidas baseadas no log-verossimilhança que incluem uma “penalidade” para cada parâmetro estimado pelo modelo, ver, por exemplo, Burnham and Anderson, 2002. Se a penalidade for suficientemente grande, adicionar variáveis a um modelo melhora a verossimilhança, mas também aumenta a penalidade e a combinação pode resultar em um valor melhor ou pior do critério.
Numerosas versões de critérios de informação foram propostas que usam penalidades diferentes para o tamanho do modelo. Seja \(n\) o tamanho da amostra, \(r\) seja o número de parâmetros no modelo, incluindo parâmetros de regressão, interceptos e quaisquer outros parâmetros no modelo, como a variância na regressão linear normal e seja \[ \log\Big(L\big(\widehat{\beta} \, | \, y_1,\cdots.y_n\big)\Big) \] a expressão da função de log-verossimilhança de um modelo estimado, avaliado nos MLEs para os parâmetros.
A forma geral da maioria dos critérios de informação é \[ IC(k) = -2 \log\Big(L\big(\widehat{\beta} \, | \, y_1,\cdots.y_n\big)\Big) + kr, \] onde \(k\) é um coeficiente de penalidade escolhido antecipadamente e usado para todos os modelos.
Para um determinado \(k\), valores menores de \(IC(k)\) indicam modelos que possuem uma grande verossimilhança em relação à sua penalidade e, portanto, são melhores modelos de acordo com o critério.
Os três critérios de informação mais comuns são:
Critério de informação de Akaike: \[ AIC = IC(2) = −2\log\Big(L\big(\widehat{\beta} \, | \, y_1,\cdots.y_n\big)\Big)) + 2r \]
AIC corrigido: \[ AIC_c = IC(2n/(n − r − 1)) = −2\log\Big(L\big(\widehat{\beta} \, | \, y_1,\cdots.y_n\big)\Big)) + \dfrac{2n}{n-r-1}r = AIC + \dfrac{2r(r+1)}{n-r-1} \]
Critério de Informação Bayesiana \[ BIC = IC(\log(n)) = −2\log\Big(L\big(\widehat{\beta} \, | \, y_1,\cdots.y_n\big)\Big) + \log(n)r \]
O coeficiente de penalidade \(k\) para o \(AIC_c\) é sempre maior do que para \(AIC\). Aumenta à medida que o tamanho do modelo aumenta, mas torna-se mais semelhante à penalidade do \(AIC\) quando o tamanho da amostra é grande em relação ao tamanho do modelo. A penalidade BIC torna-se mais severa quando \(n\) é grande. É maior que a penalidade do \(AIC\) para todo \(n\geq 8\) e maior que a penalidade do \(AIC_c\) sempre que \(n − 1 − (2n/\log(n)) > r\), que é o caso em muitos problemas. Os critérios de informação são usados para a seleção de variáveis como segue.
Suponha que temos um grupo de modelos que diferem nas variáveis de regressão que usam. Selecionamos a \(k\) e calculamos \(IC(k)\) em todos os modelos. O modelo com o menor valor de \(IC(k)\) é o preferido por aquele critério de informação. Observe que isso não requer o aninhamento de modelos, o que dá aos critérios de informação uma vantagem distinta sobre os testes de hipóteses para seleção de variáveis.
É possível que muitos modelos tenham valores de \(IC(k)\) próximos do melhor modelo. Grosso modo, os modelos cujos valores de \(IC(k)\) estão dentro de cerca de 2 unidades do melhor são considerados como tendo um ajuste semelhante ao melhor modelo, Burnham and Anderson, 2002. Quanto mais modelos estiverem próximos do melhor, menos definitiva será a seleção do melhor modelo e maior a chance de que uma pequena alteração nos dados resulte na seleção de um modelo diferente. Por esse motivo, a média do modelo está se tornando mais popular na seleção de variáveis. Discutimos esse tópico na Seção 5.1.6.
Observe que usar valores maiores de \(k\) resulta em um critério que favorece modelos menores. Assim, o \(AIC\) tende a escolher modelos maiores que o \(BIC\) e o \(AIC_c\), enquanto o \(BIC\) geralmente escolhe modelos menores que o \(AIC_c\). As opiniões variam sobre qual deles é o melhor, pois existem resultados teóricos que apóiam o uso de cada um deles. O \(BIC\) tem uma propriedade chamada consistência, o que significa que, à medida que \(n\) aumenta, ele escolhe o modelo “certo”, ou seja, aquele com as mesmas variáveis explicativas do modelo do qual os dados surgem com probabilidade próxima de 1, assumindo que o modelo verdadeiro está entre os que estão sendo examinados.
O \(AIC\) possui uma propriedade chamada eficiência, o que significa que, assintoticamente, ele seleciona modelos que minimizam o erro quadrático médio da previsão, que leva em conta tanto o erro na estimativa dos coeficientes quanto a variabilidade dos dados. \(AIC_c\) foi desenvolvido para modelos lineares para estender a propriedade de eficiência para amostras menores. É usado em modelos lineares generalizados para atingir aproximadamente o mesmo objetivo, embora não exista nenhuma teoria para mostrar que a correção consegue esse propósito.
Dado que modelos parcimoniosos são geralmente preferíveis a modelos com muitas variáveis, geralmente preferimos usar \(AIC_c\) ou \(BIC\) para seleção de variáveis. Tanto o \(AIC\) quanto o \(BIC\) são geralmente calculados facilmente em R usando a função genérica AIC(), que pode ser aplicada a qualquer objeto de ajuste de modelo que produza uma log-verossimilhança que pode ser acessada por meio da função genérica logLik(). Definir o valor do argumento k = 2 em AIC() fornece o AIC, enquanto k = \(\log\)(n) fornece \(BIC\), onde \(n\) é um objeto contendo o tamanho da amostra do conjunto de dados. Não há uma maneira automática de calcular o \(AIC_c\), mas geralmente não é difícil obtê-lo de um cálculo de \(AIC\) usando a segunda equação do ponto 2 acima.
5.1.3 Regressão de todos os subconjuntos
Dado um critério para comparar e selecionar modelos, o próximo passo é decidir quais modelos comparar. Talvez a coisa mais óbvia a considerar seja fazer todas as combinações possíveis de variáveis e selecionar aquela que “se encaixa melhor”. De fato, essa abordagem – chamada de regressão de todos os subconjuntos – é popular onde pode ser usada e a descrevemos com mais detalhes abaixo.
Quando há \(P\) variáveis explanatórias candidatas, incluindo quaisquer transformações e interações que possam ser de interesse, então existem \(2^P\) modelos diferentes que devem ser formados. Referimo-nos a este conjunto de todos os modelos possíveis como o espaço do modelo. A regressão de todos os subconjuntos para modelos lineares generalizados é limitada a problemas nos quais \(P\) não é muito grande, porque cada modelo deve ser ajustado usando técnicas numéricas iterativas.
Embora os computadores modernos possam ser muito rápidos, o escopo do problema pode ser esmagador. Por exemplo, se \(P = 10\), há pouco mais de 1.000 modelos a serem ajustados e isso pode ser feito rapidamente na maioria dos casos. Se \(P = 20\); o número de modelos é superior a 1 milhão, enquanto se \(P = 30\); o número é superior a 1 bilhão e os requisitos de tempo ou memória podem inviabilizar a busca exaustiva em todo o espaço do modelo.
Assumindo que a tarefa é possível, então para um \(k\) escolhido um critério de informação \(IC(k)\) é computado para cada um dos \(2^P\) modelos. O modelo com o menor \(IC(k)\) é considerado “melhor”, embora seja bastante comum que existam inúmeros modelos com valores de \(IC(k)\) semelhantes. Isso é especialmente provável quando \(P\) é grande, de modo que há muitas variáveis possíveis cuja importância é limítrofe.
Quando uma busca exaustiva não é possível, um algoritmo de busca alternativo pode ser usado para explorar o espaço do modelo sem avaliar todos os modelos. Esses algoritmos podem ser determinísticos; para um determinado conjunto de dados, eles exploram um conjunto específico de modelos ou podem ser estocásticos; eles pode explorar diferentes conjuntos de modelos toda vez que eles são executados.
Vários algoritmos determinísticos são descritos nas Seções 5.1.4 e 5.1.5. Um exemplo de algoritmo de busca estocástica é o algoritmo genético (Michalewicz, 1996). Esse algoritmo cria uma primeira “geração” de modelos a partir de combinações de variáveis selecionadas aleatoriamente e, em seguida, cria uma nova geração de modelos unindo partes dos modelos da geração anterior com melhor desempenho. Essa etapa é repetida várias vezes com adições e exclusões aleatórias ocasionais de variáveis, chamadas de mutações.
A estrutura de combinação permite que o algoritmo se concentre em combinações de variáveis que funcionam bem juntas, enquanto as mutações permitem explorar o espaço do modelo de forma mais ampla. O algoritmo eventualmente converge para um “melhor” modelo de acordo com \(IC(k)\). Não é garantido que esse modelo seja o de menor \(IC(k)\) entre todos os modelos possíveis, mas em muitos problemas ele encontra o melhor modelo ou muito próximo dele. Por ser um processo de busca aleatório e a seleção ótima não ser garantida, recomendamos rodar o algoritmo algumas vezes para ver se melhores modelos podem ser encontrados.
Exemplo 5.1: Placekicking.
Usamos a função glmulti() da classe S4 do pacote glmulti para executar a regressão de todos os subconjuntos nos dados de placekicking. O pacote glmulti depende do pacote rJava, que é instalado e carregado junto com o glmulti. Encontramos inúmeras dificuldades com a instalação e carregamento do rJava em nossos computadores baseados no Windows.
Em particular, rJava requer uma instalação de software Java para a mesma arquitetura na qual R está em execução, ou seja, 32 ou 64 bits; consulte http://java.com/en/download/manual.jsp. Além disso, pelo menos em máquinas Windows, o rJava pode ter dificuldade em encontrar a instalação do Java. Vários recursos na Internet, podem ajudar a resolver outros problemas que possam surgir.
placekick <- read.csv(file = "http://leg.ufpr.br/~lucambio/CE073/20222S/Placekick.csv")
head ( placekick )## week distance change elap30 PAT type field wind good
## 1 1 21 1 24.7167 0 1 1 0 1
## 2 1 21 0 15.8500 0 1 1 0 1
## 3 1 20 0 0.4500 1 1 1 0 1
## 4 1 28 0 13.5500 0 1 1 0 1
## 5 1 20 0 21.8667 1 0 0 0 1
## 6 1 25 0 17.6833 0 0 0 0 1tail(placekick)## week distance change elap30 PAT type field wind good
## 1420 17 44 1 15.8500 0 0 0 0 0
## 1421 17 20 0 1.9000 1 0 0 0 1
## 1422 17 55 0 0.0000 0 0 0 0 0
## 1423 17 20 1 17.9833 1 0 0 0 1
## 1424 17 35 1 10.3667 0 0 0 0 0
## 1425 17 50 1 2.3833 0 0 0 0 0# Alternative specification to perform the search using a previous glm() fit:
#
### full.mod.1 <- glm(formula = good ~., family = binomial(link = logit), data = placekick)
### search.1.aicc <- glmulti(y = full.mod.1, level = 1, method = "h", crit = "aicc",
### family = binomial(link = "logit"))
#
library(glmulti)
# Using AICc as criterion. Could use crit = "bic" or "aic" instead.
# Using "good ~ ." to include all variables from data (other than "good")
search.1.aicc <- glmulti(y = good ~ ., data = placekick, fitfunction = "glm", plotty = FALSE,
level = 1, method = "h", crit = "aicc", family = binomial(link = "logit"))## Initialization...
## TASK: Exhaustive screening of candidate set.
## Fitting...
##
## After 50 models:
## Best model: good~1+week+distance+change+PAT
## Crit= 767.299644897567
## Mean crit= 861.376317807727
##
## After 100 models:
## Best model: good~1+week+distance+change+PAT
## Crit= 767.299644897567
## Mean crit= 849.706367688597
##
## After 150 models:
## Best model: good~1+week+distance+change+PAT
## Crit= 767.299644897567
## Mean crit= 793.693748713112
##
## After 200 models:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 777.754038353278
##
## After 250 models:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 774.167191225549
## Completed.print(search.1.aicc)## glmulti.analysis
## Method: h / Fitting: glm / IC used: aicc
## Level: 1 / Marginality: FALSE
## From 100 models:
## Best IC: 766.728784139471
## Best model:
## [1] "good ~ 1 + distance + change + PAT + wind"
## Evidence weight: 0.066955150166587
## Worst IC: 780.47950528365
## 12 models within 2 IC units.
## 51 models to reach 95% of evidence weight.aa <- weightable(search.1.aicc)
cbind(model = aa[1:5,1], round(aa[1:5,2:3], digits = 3))## model aicc weights
## 1 good ~ 1 + distance + change + PAT + wind 766.729 0.067
## 2 good ~ 1 + week + distance + change + PAT + wind 767.133 0.055
## 3 good ~ 1 + week + distance + change + PAT 767.300 0.050
## 4 good ~ 1 + distance + change + PAT 767.361 0.049
## 5 good ~ 1 + distance + PAT + wind 767.690 0.041plot(search.1.aicc, type = "p")
grid()
# The following search looks for all pairwise interactions as well.
# WARNING: It would have taken about 13 years to complete on an Intel Core I7 2600 with 8G RAM.
### search.2marg.aicc <- glmulti(y = full.mod.1, level = 2, marginality = TRUE,
### method = "h", crit = "aicc")
#
# Instead, glmulti() can use a "genetic algorithm" search procedure to find groups of models
# that might be good and find the best of those models.
#
# We repeat the first search using the genetic algorithm to show that it can get to the same
# results as the better exhaustive search in a small problem.
set.seed(267188299)
search.g.aicc <- glmulti(y = good ~ ., data = placekick, fitfunction = "glm", plotty = FALSE,
level = 1, method = "g", crit = "aicc", family = binomial(link = "logit"))## Initialization...
## TASK: Genetic algorithm in the candidate set.
## Initialization...
## Algorithm started...
##
## After 10 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 846.943969305254
## Change in best IC: -9233.27121586053 / Change in mean IC: -9153.05603069475
##
## After 20 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 839.932169412085
## Change in best IC: 0 / Change in mean IC: -7.0117998931687
##
## After 30 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 820.112593770616
## Change in best IC: 0 / Change in mean IC: -19.8195756414696
##
## After 40 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 796.831869034246
## Change in best IC: 0 / Change in mean IC: -23.2807247363696
##
## After 50 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 790.722324246703
## Change in best IC: 0 / Change in mean IC: -6.10954478754331
##
## After 60 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 788.099302550731
## Change in best IC: 0 / Change in mean IC: -2.62302169597183
##
## After 70 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 783.572110660389
## Change in best IC: 0 / Change in mean IC: -4.5271918903419
##
## After 80 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 779.226210793398
## Change in best IC: 0 / Change in mean IC: -4.34589986699166
##
## After 90 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 778.064778384685
## Change in best IC: 0 / Change in mean IC: -1.16143240871236
##
## After 100 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 774.736500640285
## Change in best IC: 0 / Change in mean IC: -3.32827774440011
##
## After 110 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 774.576612676932
## Change in best IC: 0 / Change in mean IC: -0.159887963353185
##
## After 120 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 774.09995502158
## Change in best IC: 0 / Change in mean IC: -0.47665765535146
##
## After 130 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.992308355491
## Change in best IC: 0 / Change in mean IC: -0.107646666089295
##
## After 140 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.868142844266
## Change in best IC: 0 / Change in mean IC: -0.124165511224646
##
## After 150 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.742112893819
## Change in best IC: 0 / Change in mean IC: -0.126029950447787
##
## After 160 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.609238197486
## Change in best IC: 0 / Change in mean IC: -0.132874696332351
##
## After 170 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.609238197486
## Change in best IC: 0 / Change in mean IC: 0
##
## After 180 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.609238197486
## Change in best IC: 0 / Change in mean IC: 0
##
## After 190 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.582684632986
## Change in best IC: 0 / Change in mean IC: -0.0265535645006594
##
## After 200 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.477966887709
## Change in best IC: 0 / Change in mean IC: -0.104717745276957
##
## After 210 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.477966887709
## Change in best IC: 0 / Change in mean IC: 0
##
## After 220 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.375826103558
## Change in best IC: 0 / Change in mean IC: -0.102140784150833
##
## After 230 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.375826103558
## Change in best IC: 0 / Change in mean IC: 0
##
## After 240 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.375826103558
## Change in best IC: 0 / Change in mean IC: 0
##
## After 250 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.375826103558
## Change in best IC: 0 / Change in mean IC: 0
##
## After 260 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.375826103558
## Change in best IC: 0 / Change in mean IC: 0
##
## After 270 generations:
## Best model: good~1+distance+change+PAT+wind
## Crit= 766.728784139471
## Mean crit= 773.375826103558
## Improvements in best and average IC have bebingo en below the specified goals.
## Algorithm is declared to have converged.
## Completed.# Now try genetic algorithm on bigger problem with pairwise interactions. See glmulti manual
# for details on tuning parameters for the genetic algorithm.
# NOTE: This took about 7 minutes to run on an Intel Core I7 2600 with 8G RAM.
search.gmarg.aicc <- glmulti(y = good ~ ., data = placekick, fitfunction = "glm", level = 2,
plotty = FALSE, marginality = TRUE, method = "g", crit = "aicc", family = binomial(link = "logit"))## Initialization...
## TASK: Genetic algorithm in the candidate set.
## Initialization...
## Algorithm started...
##
## After 10 generations:
## Best model: good~1+week+distance+elap30+PAT+type+field+wind+elap30:week+PAT:distance+type:week+type:PAT+field:type+wind:week+wind:distance+wind:field
## Crit= 772.314011144953
## Mean crit= 784.992202641056
## Change in best IC: -9227.68598885505 / Change in mean IC: -9215.00779735895
##
## After 20 generations:
## Best model: good~1+week+distance+change+elap30+PAT+type+field+wind+PAT:distance+type:week+field:type+wind:week+wind:distance+wind:PAT+wind:type+wind:field
## Crit= 770.292248767071
## Mean crit= 782.031093621379
## Change in best IC: -2.02176237788126 / Change in mean IC: -2.96110901967677
##
## After 30 generations:
## Best model: good~1+week+distance+change+elap30+PAT+field+wind+elap30:week+PAT:distance+wind:week+wind:distance+wind:PAT+wind:field
## Crit= 767.471123232879
## Mean crit= 780.365665316445
## Change in best IC: -2.82112553419256 / Change in mean IC: -1.66542830493415
##
## After 40 generations:
## Best model: good~1+week+distance+change+elap30+PAT+field+wind+elap30:week+PAT:distance+wind:week+wind:distance+wind:PAT+wind:field
## Crit= 767.471123232879
## Mean crit= 779.931023353702
## Change in best IC: 0 / Change in mean IC: -0.434641962742376
##
## After 50 generations:
## Best model: good~1+week+distance+change+PAT+type+field+wind+PAT:distance+wind:week+wind:distance+wind:PAT+wind:field
## Crit= 766.660424611005
## Mean crit= 778.614829455933
## Change in best IC: -0.810698621873712 / Change in mean IC: -1.31619389776915
##
## After 60 generations:
## Best model: good~1+week+distance+change+PAT+type+field+wind+PAT:distance+wind:distance+wind:PAT+wind:field
## Crit= 766.418576774737
## Mean crit= 777.083723091174
## Change in best IC: -0.24184783626788 / Change in mean IC: -1.53110636475947
##
## After 70 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:PAT+wind:field
## Crit= 765.02809642114
## Mean crit= 776.653901204991
## Change in best IC: -1.39048035359713 / Change in mean IC: -0.429821886183277
##
## After 80 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:PAT+wind:field
## Crit= 765.02809642114
## Mean crit= 776.249907163603
## Change in best IC: 0 / Change in mean IC: -0.403994041387818
##
## After 90 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 775.3044766232
## Change in best IC: -1.05427677345722 / Change in mean IC: -0.945430540402981
##
## After 100 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 775.089656760515
## Change in best IC: 0 / Change in mean IC: -0.214819862684521
##
## After 110 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 774.795601902731
## Change in best IC: 0 / Change in mean IC: -0.294054857784431
##
## After 120 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 774.533076579684
## Change in best IC: 0 / Change in mean IC: -0.262525323047157
##
## After 130 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 774.261899475561
## Change in best IC: 0 / Change in mean IC: -0.271177104123126
##
## After 140 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 774.112219926545
## Change in best IC: 0 / Change in mean IC: -0.149679549016014
##
## After 150 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.985041931535
## Change in best IC: 0 / Change in mean IC: -0.127177995009333
##
## After 160 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.794311165904
## Change in best IC: 0 / Change in mean IC: -0.190730765631656
##
## After 170 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.701629746398
## Change in best IC: 0 / Change in mean IC: -0.0926814195053112
##
## After 180 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.595045181369
## Change in best IC: 0 / Change in mean IC: -0.106584565029721
##
## After 190 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.452027836187
## Change in best IC: 0 / Change in mean IC: -0.143017345181306
##
## After 200 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.243227621897
## Change in best IC: 0 / Change in mean IC: -0.208800214290363
##
## After 210 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.23759748766
## Change in best IC: 0 / Change in mean IC: -0.00563013423732173
##
## After 220 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 773.100998743252
## Change in best IC: 0 / Change in mean IC: -0.13659874440782
##
## After 230 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.950179143918
## Change in best IC: 0 / Change in mean IC: -0.150819599333204
##
## After 240 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.81091470411
## Change in best IC: 0 / Change in mean IC: -0.139264439808926
##
## After 250 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.795906156328
## Change in best IC: 0 / Change in mean IC: -0.0150085477814628
##
## After 260 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.51983496437
## Change in best IC: 0 / Change in mean IC: -0.276071191957726
##
## After 270 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.456173926567
## Change in best IC: 0 / Change in mean IC: -0.063661037803854
##
## After 280 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.447880539707
## Change in best IC: 0 / Change in mean IC: -0.00829338685957737
##
## After 290 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.271110391921
## Change in best IC: 0 / Change in mean IC: -0.176770147785874
##
## After 300 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.12098455209
## Change in best IC: 0 / Change in mean IC: -0.150125839830707
##
## After 310 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 772.110086317745
## Change in best IC: 0 / Change in mean IC: -0.0108982343451771
##
## After 320 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.954609371749
## Change in best IC: 0 / Change in mean IC: -0.155476945995815
##
## After 330 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.797470563605
## Change in best IC: 0 / Change in mean IC: -0.157138808144509
##
## After 340 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.669156693958
## Change in best IC: 0 / Change in mean IC: -0.128313869646604
##
## After 350 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.422223547401
## Change in best IC: 0 / Change in mean IC: -0.246933146557353
##
## After 360 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.416629013062
## Change in best IC: 0 / Change in mean IC: -0.00559453433845647
##
## After 370 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.416629013062
## Change in best IC: 0 / Change in mean IC: 0
##
## After 380 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.387546362035
## Change in best IC: 0 / Change in mean IC: -0.0290826510271245
##
## After 390 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.331565982158
## Change in best IC: 0 / Change in mean IC: -0.0559803798774965
##
## After 400 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.284553247849
## Change in best IC: 0 / Change in mean IC: -0.0470127343086233
##
## After 410 generations:
## Best model: good~1+week+distance+change+PAT+field+wind+PAT:distance+wind:distance+wind:field
## Crit= 763.973819647683
## Mean crit= 771.135597327132
## Change in best IC: 0 / Change in mean IC: -0.14895592071673
##
## After 420 generations:
## Best model: good~1+week+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.587450340585
## Mean crit= 770.975820974071
## Change in best IC: -0.38636930709788 / Change in mean IC: -0.159776353061829
##
## After 430 generations:
## Best model: good~1+week+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.587450340585
## Mean crit= 770.975820974071
## Change in best IC: 0 / Change in mean IC: 0
##
## After 440 generations:
## Best model: good~1+week+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.587450340585
## Mean crit= 770.828865875592
## Change in best IC: 0 / Change in mean IC: -0.146955098478202
##
## After 450 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 770.174041234476
## Change in best IC: -0.257013033592671 / Change in mean IC: -0.654824641116761
##
## After 460 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 770.043854656104
## Change in best IC: 0 / Change in mean IC: -0.130186578371763
##
## After 470 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.907566617252
## Change in best IC: 0 / Change in mean IC: -0.136288038852058
##
## After 480 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.775484967732
## Change in best IC: 0 / Change in mean IC: -0.132081649520273
##
## After 490 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.713938893268
## Change in best IC: 0 / Change in mean IC: -0.0615460744635357
##
## After 500 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.63435090451
## Change in best IC: 0 / Change in mean IC: -0.079587988758135
##
## After 510 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.405241808252
## Change in best IC: 0 / Change in mean IC: -0.229109096258185
##
## After 520 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.405241808252
## Change in best IC: 0 / Change in mean IC: 0
##
## After 530 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.340245532318
## Change in best IC: 0 / Change in mean IC: -0.0649962759338223
##
## After 540 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 769.225853704649
## Change in best IC: 0 / Change in mean IC: -0.114391827669238
##
## After 550 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.979437505911
## Change in best IC: 0 / Change in mean IC: -0.246416198737734
##
## After 560 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.972448938513
## Change in best IC: 0 / Change in mean IC: -0.00698856739757048
##
## After 570 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.972448938513
## Change in best IC: 0 / Change in mean IC: 0
##
## After 580 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.972448938513
## Change in best IC: 0 / Change in mean IC: 0
##
## After 590 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.861135855476
## Change in best IC: 0 / Change in mean IC: -0.111313083037771
##
## After 600 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.743880402411
## Change in best IC: 0 / Change in mean IC: -0.117255453065013
##
## After 610 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.743880402411
## Change in best IC: 0 / Change in mean IC: 0
##
## After 620 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.607205484844
## Change in best IC: 0 / Change in mean IC: -0.136674917566893
##
## After 630 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.490751424865
## Change in best IC: 0 / Change in mean IC: -0.116454059978992
##
## After 640 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.490751424865
## Change in best IC: 0 / Change in mean IC: 0
##
## After 650 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.412390364452
## Change in best IC: 0 / Change in mean IC: -0.0783610604125897
##
## After 660 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.412390364452
## Change in best IC: 0 / Change in mean IC: 0
##
## After 670 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.412390364452
## Change in best IC: 0 / Change in mean IC: 0
##
## After 680 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.412390364452
## Change in best IC: 0 / Change in mean IC: 0
##
## After 690 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.402660086245
## Change in best IC: 0 / Change in mean IC: -0.00973027820737116
##
## After 700 generations:
## Best model: good~1+distance+change+PAT+wind+PAT:distance+wind:distance
## Crit= 763.330437306992
## Mean crit= 768.402660086245
## Improvements in best and average IC have bebingo en below the specified goals.
## Algorithm is declared to have converged.
## Completed.print(search.gmarg.aicc)## glmulti.analysis
## Method: g / Fitting: glm / IC used: aicc
## Level: 2 / Marginality: TRUE
## From 100 models:
## Best IC: 763.330437306992
## Best model:
## [1] "good ~ 1 + distance + change + PAT + wind + PAT:distance + wind:distance"
## [1] "good ~ 1 + distance + change + PAT + wind + wind:distance"
## Evidence weight: 0.042311783185219
## Worst IC: 775.793434125604
## 25 models within 2 IC units.
## 55 models to reach 95% of evidence weight.
## Convergence after 700 generations.
## Time elapsed: 10.4566334883372 minutes.head(weightable(search.gmarg.aicc))## model
## 1 good ~ 1 + distance + change + PAT + wind + PAT:distance + wind:distance
## 2 good ~ 1 + distance + change + PAT + wind + wind:distance
## 3 good ~ 1 + week + distance + change + PAT + wind + PAT:distance + wind:distance
## 4 good ~ 1 + week + distance + change + PAT + wind + wind:distance
## 5 good ~ 1 + week + distance + change + PAT + field + wind + PAT:distance + wind:distance + wind:field
## 6 good ~ 1 + week + distance + change + PAT + field + wind + wind:distance + wind:field
## aicc weights
## 1 763.3304 0.04231178
## 2 763.3304 0.04231178
## 3 763.5875 0.03720931
## 4 763.5875 0.03720931
## 5 763.9738 0.03067274
## 6 763.9738 0.03067274plot(search.gmarg.aicc, type = "p")
# All subsets using BMA package function bic.glm()
library(BMA)
search.bma <- bic.glm(f = good ~ ., glm.family = "binomial", data = placekick, occam.window = FALSE)
# Be aware that BMA has no function to do AICc, and that it calculates the IC(k) values slightly
# differently. The ordering of models is the same, and the differences between two models'
# IC(k) values is the same as in glmulti, but the numerical values are different.
summary(search.bma)##
## Call:
## bic.glm.formula(f = good ~ ., data = placekick, glm.family = "binomial", occam.window = FALSE)
##
##
## 21 models were selected
## Best 5 models (cumulative posterior probability = 0.894 ):
##
## p!=0 EV SD model 1 model 2 model 3
## Intercept 100 4.619e+00 0.543428 4.516e+00 4.676e+00 4.599e+00
## week.x 5.6 -1.462e-03 0.007531 . . .
## distance.x 100.0 -8.746e-02 0.012594 -8.587e-02 -8.646e-02 -8.676e-02
## change.x 11.7 -4.110e-02 0.131478 . -3.402e-01 .
## elap30.x 2.3 7.991e-05 0.001667 . . .
## PAT.x 94.9 1.258e+00 0.472916 1.338e+00 1.245e+00 1.319e+00
## type.x 2.4 2.134e-03 0.034412 . . .
## field.x 2.2 -2.393e-04 0.027724 . . .
## wind.x 9.3 -4.994e-02 0.182665 . . -5.326e-01
##
## nVar 2 3 3
## BIC -9.564e+03 -9.560e+03 -9.560e+03
## post prob 0.666 0.082 0.070
## model 4 model 5
## Intercept 4.767e+00 5.812e+00
## week.x -2.597e-02 .
## distance.x -8.592e-02 -1.150e-01
## change.x . .
## elap30.x . .
## PAT.x 1.339e+00 .
## type.x . .
## field.x . .
## wind.x . .
##
## nVar 3 1
## BIC -9.559e+03 -9.558e+03
## post prob 0.044 0.032
##
## 1 observations deleted due to missingness.# All subsets using BMA package function bic.glm()
library(bestglm)
search.bestglm <- bestglm(Xy = placekick, family = binomial, IC = "BIC")
# Show glm() fit of best model
search.bestglm$BestModel##
## Call: glm(formula = y ~ ., family = family, data = Xi, weights = weights)
##
## Coefficients:
## (Intercept) distance PAT
## 4.51557 -0.08587 1.33827
##
## Degrees of Freedom: 1424 Total (i.e. Null); 1422 Residual
## Null Deviance: 1013
## Residual Deviance: 762.4 AIC: 768.4# List top 5 models. Can get more models listed using TopModels = parameter.
search.bestglm$BestModels## week distance change elap30 PAT type field wind Criterion
## 1 FALSE TRUE FALSE FALSE TRUE FALSE FALSE FALSE 776.9337
## 2 FALSE TRUE TRUE FALSE TRUE FALSE FALSE FALSE 781.1183
## 3 FALSE TRUE FALSE FALSE TRUE FALSE FALSE TRUE 781.4475
## 4 TRUE TRUE FALSE FALSE TRUE FALSE FALSE FALSE 782.3567
## 5 FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE 783.0070# List best model of each size
search.bestglm$Subsets ## Intercept week distance change elap30 PAT type field wind logLikelihood
## 0 TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE -506.7131
## 1 TRUE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE -387.8725
## 2* TRUE FALSE TRUE FALSE FALSE TRUE FALSE FALSE FALSE -381.2049
## 3 TRUE FALSE TRUE TRUE FALSE TRUE FALSE FALSE FALSE -379.6662
## 4 TRUE FALSE TRUE TRUE FALSE TRUE FALSE FALSE TRUE -378.3433
## 5 TRUE TRUE TRUE TRUE FALSE TRUE FALSE FALSE TRUE -377.5369
## 6 TRUE TRUE TRUE TRUE FALSE TRUE TRUE FALSE TRUE -377.2456
## 7 TRUE TRUE TRUE TRUE FALSE TRUE TRUE TRUE TRUE -376.8620
## 8 TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE -376.7586
## BIC
## 0 1013.4262
## 1 783.0070
## 2* 776.9337
## 3 781.1183
## 4 785.7342
## 5 791.3833
## 6 798.0627
## 7 804.5575
## 8 811.6127Este pacote é descrita com mais detalhes por Calcagno and de Mazancourt (2010). Este pacote possui vários recursos atraentes que a maioria dos outros pacotes semelhantes não possui:
pode acomodar uma ampla variedade de famílias de modelos, incluindo todas aquelas dos Capítulos 2–4;
pode ser configurado para incluir automaticamente interações de duas variáveis sem ter que especificá-las individualmente;
quando uma interação envolvendo uma variável explicativa categórica é incluída no pool, ela inclui ou exclui todo o conjunto de variáveis de interação que são criadas a partir dos produtos envolvendo as variáveis indicadoras da variável categórica; e
para problemas de busca muito grandes, ele pode usar o algoritmo de busca genética para tentar encontrar o melhor modelo.
Lembre-se de que as variáveis categóricas são codificadas como grupos de variáveis indicadoras para regressão. Alguns pacotes alternativos tratam as variáveis de indicadores individuais e os produtos de interação subseqüentes como variáveis separadas que são selecionadas individualmente. Isso pode aumentar drasticamente o número de variáveis em um pool e, portanto, resultar em maior dificuldade na seleção de um modelo apropriado.
O argumento \(y\) em glmulti() pode conter uma fórmula, conforme mostrado ou um objeto como um ajuste glm() anterior do modelo completo. O argumento fitfunction leva o nome de qualquer função R que pode avaliar a log-verossimilhança de um objeto de classe formula, incluindo “glm”, “lm” ou funções semelhantes definidas pelo usuário. Outros argumentos importantes incluem level, 1 apenas para efeitos principais, 2 para incluir interações bidirecionais e methos, “h” para pesquisa exaustiva, “g” para algoritmo genético. Quando o level = 2 é escolhido, adicionar marginality = TRUE limita as interações apenas àquelas baseadas em variáveis cujos efeitos principais também estão no modelo.
A função genérica print() é usada em vez de summary() para fornecer um resumo dos resultados, enquanto weightable() lista os modelos na ordem de seus valores \(IC(k)\). Por padrão, um relatório de status é fornecido a cada 50 modelos.
As atualizações de status mostram o melhor modelo encontrado até agora, seu valor de \(IC(k)\) e a média de \(IC(k)\) entre os 100 melhores modelos ajustados até o momento. Os resultados de print() indicam que o melhor modelo contém as variáveis distance, change, PAT e wing, com \(AIC_c=766.7\). É interessante observar que 12 modelos possuem \(AIC_c\) a 2 unidades do melhor modelo, o que é um indicativo de que a declaração desse modelo como “melhor” não é muito definitiva. O pior dos 100 melhores modelos teve \(AIC_c=780.5\).
Os cinco principais modelos são mostrados, juntamente com seus valores de \(AIC_c\). É significativo notar que todos esses modelos principais incluem distance e PAT, enquanto change aparece em quatro desses modelos, wing em três e week em dois. Isso dá uma indicação informal de quais variáveis são as mais importantes para explicar a probabilidade de um placekick feito. Na Seção 5.1.6, descreveremos uma abordagem mais formal para essa avaliação e discutiremos as notas sobre Evidence weight e weights da saída.
Adicionar interações aos pares ao conjunto de variáveis pode ser útil. No entanto, isso aumenta enormemente o número de modelos possíveis - de \(2^8 = 256\) para \(2^{36} = 68.7\) bilhões - e torna a pesquisa exaustiva inviável; estimamos que levaria cerca de 13 anos para ser concluída em um de nossos computadores. É aqui que o algoritmo de busca genética é útil. O programa que acompanha este exemplo inclui código para completar esta pesquisa, consulte o Exercício 6. Demorou cerca de sete minutos para ser concluído, calculou a média de quatro execuções do algoritmo e encontrou o mesmo “melhor” modelo em três das quatro execuções.
Os pacotes bestglm e BMA também fazem regressão de todos os subconjuntos, mas são restritos a famílias de modelos disponíveis em glm(). Isso exclui, por exemplo, probabilidades proporcionais e modelos de Poisson inflados de zero (Seções 3.4 e 4.4, respectivamente). O procedimento de busca usado no pacote glmulti é consideravelmente mais lento do que aqueles usados nos pacotes bestglm ou BMA. Para problemas maiores que podem ser modelados usando uma família disponível em glm(), esses outros pacotes podem ser escolhas melhores.
Burnham and Anderson (2002) recomendam cautela no uso de rotinas automatizadas de seleção de variáveis porque, na presença de tantos modelos candidatos, encontrar o verdadeiro “melhor” modelo torna-se um problema de agulha no palheiro. Muitos modelos podem ter valores de \(IC(k)\) semelhantes simplesmente por sorte. Por exemplo, imagine que um jogador de dardos campeão mundial jogue um dardo em um alvo de dardos e, em seguida, espalhe aleatoriamente outros 64 bilhões de dardos pelo tabuleiro. As chances são extremamente boas de que alguns dos dardos aleatórios caiam mais perto do alvo do que o do campeão, não importa quão bom seja o campeão.
A lista de variáveis explicativas candidatas deve, portanto, ser a menor possível usando o conhecimento do assunto antes de iniciar a regressão de todos os subconjuntos. De fato, a sabedoria de adicionar rotineiramente interações e transformações aos pares a uma pesquisa variável é questionável sob essa luz. Em vez disso, geralmente faz mais sentido incluir apenas certas interações que são de interesse específico e usar o conhecimento do assunto e as ferramentas de diagnóstico da Seção 5.2.
5.1.4 Seleção de variável passo a passo (stepwise)
Conforme observado na seção anterior, a menos que o número de variáveis, \(P\), seja bastante pequeno, não é viável concluir uma busca exaustiva em todo o espaço do modelo para localizar o “melhor” modelo. Nesses casos, devemos usar algum tipo de algoritmo para explorar modelos que possam ser rapidamente identificados como “promissores”. Algoritmos de busca passo a passo (stepwise) são métodos simples e rápidos para selecionar um número relativamente pequeno de modelos potencialmente bons do espaço do modelo. Esses algoritmos têm deficiências que não são amplamente conhecidas entre os profissionais e, portanto, embora os descrevamos abaixo, geralmente não os recomendamos, a menos que nenhuma abordagem melhor esteja disponível.
A seleção de variáveis passo a passo (stepwise) usa um algoritmo estruturado para examinar modelos em apenas uma pequena parte do espaço do modelo. A chave do algoritmo é avaliar os modelos em uma sequência específica, onde cada modelo difere do modelo anterior por apenas uma única variável. Uma vez escolhida uma sequência de modelos, um critério de informação é usado para compará-los e selecionar um “melhor” modelo. Existem várias versões diferentes do algoritmo, conforme descrito abaixo. Em cada versão, seja \(x_j\), \(j = 1,\cdots,P\) a representação de uma única variável ou um conjunto de variáveis que devem ser incluídas ou excluídas juntas; por exemplo, uma variável explicativa categórica que é representada por um grupo de variáveis indicadoras incluídas no modelo ou excluídas dele como um grupo.
Seleção de encaminhamento (forward selection)
A seleção de encaminhamento ou seleção direta (forward selection) começa a partir de um modelo sem variáveis e, em seguida, adiciona uma variável por vez até que todas as variáveis estejam no modelo ou, opcionalmente, alguma regra de parada tenha sido alcançada.
Especificamente:
Selecione a \(k\) para o critério de informação.
Comece com um modelo vazio, \(g(\cdot) = \beta_0\) e calcule o \(IC(k)\) neste modelo. Todas as variáveis estão no “pool de seleção”.
Adicione variáveis ao modelo, uma de cada vez, da seguinte forma:
Calcule o \(IC(k)\) para cada modelo que pode ser formado pela adição de uma única variável do pool de seleção ao modelo atual. Em outras palavras, consideramos modelos que contêm todas as variáveis do modelo atual mais uma variável adicional.
Escolha a variável cujo \(IC(k)\) é menor e adicione-a ao modelo.
(Opcional) Se o modelo com a variável adicionada tiver um \(IC(k)\) maior que o modelo anterior, pare. Relate o modelo com o menor valor de \(IC(k)\) como o modelo final.
Repita a etapa 3 até que a regra de terminação na parte (c) seja usada ou até que todas as variáveis tenham sido adicionadas ao modelo.
Se nenhuma regra de parada for usada, então uma sequência de \(P+1\) modelos é criada, cada uma com um número diferente de variáveis. Relate o modelo com o menor \(IC(k)\) como o modelo final.
Observe que o tamanho do modelo em cada etapa aumenta em no máximo uma variável. A lógica aqui é que, a cada passo, a variável adicionada é a que mais melhora o modelo. Portanto, incluí-lo no modelo resulta no melhor modelo de seu tamanho, dado o modelo anterior. O próximo exemplo ilustra esse algoritmo.
Exemplo 5.2: Placekicking.
Os métodos de seleção de variáveis passo a passo (stepwise) são implementados em várias funções do R. Usamos a função step() porque ela faz parte do pacote stats e é flexível e bastante fácil de usar.
Para começar, os modelos menores e maiores a serem considerados são primeiro ajustados usando glm() e salvos como objetos. Um deles se torna o valor para o argumento object em step() e o outro é especificado no argumento scope, dependendo da forma de algoritmo passo a passo que está sendo usado. Se as interações devem ser consideradas, elas devem ser incluídas no modelo maior, listando-as explicitamente ou usando um “^2” ao redor do modelo de efeito principal. A função anova() resume o processo de seleção.
Aqui mostramos a seleção para frente indicando direction = “forward” para um modelo de regressão logística usando os dados de placekicking. Partimos de um modelo sem variáveis empty.mod e adicionamos uma variável de cada vez até que não seja possível adicionar nenhuma variável que melhore o critério ou o modelo com todas as variáveis full.mod seja alcançado.
Infelizmente, step() requer um coeficiente de penalidade constante para todos os modelos, então o \(AIC_c\) não está disponível. Em vez disso, baseamos a seleção em \(BIC\), \(IC(\log(n))\), especificando o valor do argumento k = log(nrow(placekick)).
empty.mod = glm( formula = good ~ 1, family = binomial ( link = logit ), data = placekick )
full.mod = glm( formula = good ~ ., family = binomial ( link = logit ), data = placekick )
forw.sel = step ( object = empty.mod , scope = list ( upper = full.mod),
direction = "forward", k = log( nrow ( placekick )), trace = TRUE )## Start: AIC=1020.69
## good ~ 1
##
## Df Deviance AIC
## + distance 1 775.75 790.27
## + PAT 1 834.41 848.93
## + change 1 989.15 1003.67
## <none> 1013.43 1020.69
## + elap30 1 1007.71 1022.23
## + wind 1 1010.59 1025.11
## + week 1 1011.24 1025.76
## + type 1 1011.39 1025.92
## + field 1 1012.98 1027.50
##
## Step: AIC=790.27
## good ~ distance
##
## Df Deviance AIC
## + PAT 1 762.41 784.20
## <none> 775.75 790.27
## + change 1 770.50 792.29
## + wind 1 772.53 794.32
## + week 1 773.86 795.64
## + type 1 775.67 797.45
## + elap30 1 775.68 797.47
## + field 1 775.74 797.53
##
## Step: AIC=784.2
## good ~ distance + PAT
##
## Df Deviance AIC
## <none> 762.41 784.20
## + change 1 759.33 788.38
## + wind 1 759.66 788.71
## + week 1 760.57 789.62
## + type 1 762.25 791.30
## + elap30 1 762.31 791.36
## + field 1 762.41 791.46anova ( forw.sel )## Analysis of Deviance Table
##
## Model: binomial, link: logit
##
## Response: good
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev
## NULL 1424 1013.43
## distance 1 237.681 1423 775.75
## PAT 1 13.335 1422 762.41O valor do argumento trace = TRUE permite ver o
processo de seleção de encaminhamento completo em cada etapa. Na
primeira etapa, o algoritmo começa apenas com um intercepto e fornece os
valores de \(IC(k)\), listados como
\(AIC\), independentemente do valor
especificado para \(k\), para cada
modelo que surge com base na adição de uma das oito variáveis
explicativas. Os modelos com cada variável adicionada e o modelo sem
variáveis adicionadas “
Vemos que distance tem o menor \(BIC\) e, portanto, é a primeira variável inserida. A próxima etapa começa com distance no modelo e descobre que adicionar PAT resulta em um \(BIC\) menor; observe que \(BIC\) é diferente agora do que era para PAT na primeira etapa porque distance agora está no modelo. Assim, adiciona-se PAT ao modelo e inicia-se a próxima etapa. Como nenhuma variável adicionada melhora o \(BIC\), o algoritmo termina e declara que nosso modelo final usa as variáveis distance e PAT. Se tivéssemos usado \(AIC\) em vez de \(BIC\) especificando k = 2, o modelo escolhido também incluiria chance e wind.
Eliminação para trás (backward elimination)
Às vezes, um algoritmo passo a passo diferente é usado para abordar o problema na direção oposta. A eliminação regressiva (backward) começa a partir de um modelo que contém todas as variáveis disponíveis, assumindo que esse modelo pode ser ajustado e, em seguida, remove uma variável por vez, desde que isso melhore o \(IC(k)\) do modelo.
Especificamente,
Selecione a \(k\) para o critério de informação.
Comece com um modelo completo, \(g(\cdot ) =\beta_0 +\beta_1 x_1 + \cdots + \beta_P x_P\) e calcule o \(IC(k)\) neste modelo.
Remova as variáveis do modelo, uma de cada vez, da seguinte maneira:
Calcule o \(IC(k)\) para cada modelo que pode ser formado pela exclusão de uma única variável do modelo atual. Em outras palavras, consideramos modelos que contêm todas menos uma das variáveis no modelo atual.
Escolha a variável cuja exclusão resulta no menor \(IC(k)\) e remova-a do modelo.
(Opcional) Se o novo modelo com a variável excluída tiver um \(IC(k)\) maior que o modelo anterior, pare. Relate o modelo com o menor valor de \(IC(k)\) como o modelo final.
Repita o passo 3 até que a regra de terminação na parte (c) seja usada ou até que todas as variáveis tenham sido removidas do modelo.
Se nenhuma regra de parada for usada, então uma sequência de \(P+1\) modelos é criada, cada uma com um número diferente de variáveis. Relate o modelo com o menor \(IC(k)\) como o modelo final.
Observe que a cada passo o modelo atual é comparado com todos os modelos que são exatamente uma variável menor. Assim, o tamanho do modelo diminui em no máximo uma variável. A lógica aqui é que, a cada passo, é retirada a variável que menos está contribuindo para o modelo atual.
Exemplo 5.3: Placekicking.
Apenas pequenas modificações no programa do exemplo anterior são necessárias para executar a eliminação reversa (backward elimination). O objeto inicial agora é o modelo completo, o objeto final está listado em scope e definimos direction = “backward”. A saída para este exemplo é longa:
back.sel = step ( object = full.mod , scope = list ( lower = empty.mod ),
direction = "backward", k = log( nrow ( placekick )), trace = TRUE )## Start: AIC=818.87
## good ~ week + distance + change + elap30 + PAT + type + field +
## wind
##
## Df Deviance AIC
## - elap30 1 753.72 811.82
## - field 1 754.25 812.35
## - type 1 754.76 812.86
## - week 1 755.13 813.23
## - change 1 756.69 814.79
## - wind 1 756.74 814.84
## <none> 753.52 818.87
## - PAT 1 764.63 822.73
## - distance 1 822.64 880.73
##
## Step: AIC=811.82
## good ~ week + distance + change + PAT + type + field + wind
##
## Df Deviance AIC
## - field 1 754.49 805.32
## - type 1 755.04 805.87
## - week 1 755.32 806.16
## - change 1 756.78 807.61
## - wind 1 756.96 807.79
## <none> 753.72 811.82
## - PAT 1 764.81 815.64
## - distance 1 824.69 875.53
##
## Step: AIC=805.32
## good ~ week + distance + change + PAT + type + wind
##
## Df Deviance AIC
## - type 1 755.07 798.65
## - week 1 756.06 799.63
## - wind 1 757.06 800.63
## - change 1 757.77 801.34
## <none> 754.49 805.32
## - PAT 1 765.38 808.95
## - distance 1 825.52 869.09
##
## Step: AIC=798.65
## good ~ week + distance + change + PAT + wind
##
## Df Deviance AIC
## - week 1 756.69 793.00
## - wind 1 757.26 793.57
## - change 1 758.27 794.58
## <none> 755.07 798.65
## - PAT 1 765.85 802.16
## - distance 1 827.69 864.00
##
## Step: AIC=793
## good ~ distance + change + PAT + wind
##
## Df Deviance AIC
## - wind 1 759.33 788.38
## - change 1 759.66 788.71
## <none> 756.69 793.00
## - PAT 1 767.54 796.59
## - distance 1 829.87 858.92
##
## Step: AIC=788.38
## good ~ distance + change + PAT
##
## Df Deviance AIC
## - change 1 762.41 784.20
## <none> 759.33 788.38
## - PAT 1 770.50 792.29
## - distance 1 831.75 853.53
##
## Step: AIC=784.2
## good ~ distance + PAT
##
## Df Deviance AIC
## <none> 762.41 784.20
## - PAT 1 775.75 790.27
## - distance 1 834.41 848.93Partindo de um modelo com todas as oito variáveis nele, a remoção de elap30 resulta na maior melhoria no \(BIC\). Na próxima etapa, field é removido. As etapas continuam a remover variáveis até que apenas PAT e distance permaneçam. Nenhuma delas pode ser removida do modelo sem aumentar o \(BIC\), então este é o modelo final.
Seleção passo a passo alternada
Uma das críticas aos dois algoritmos anteriores é que uma vez que uma variável é adicionada ou removida ao modelo, essa decisão nunca pode ser revertida. Mas em todas as formas de regressão, as relações entre as variáveis explicativas podem fazer com que a importância percebida de uma variável mude, dependendo de quais outras variáveis são consideradas no mesmo modelo.
Por exemplo, a ingestão média diária de calorias de uma pessoa pode parecer muito importante por si só em um modelo para a probabilidade de pressão alta, mas essa relação pode desaparecer quando também consideramos seu peso e nível de exercício. Portanto, pode ser útil em alguns casos ter um algoritmo que permita que decisões passadas sejam reconsideradas à medida que a estrutura do modelo muda. O padrão desse algoritmo é baseado na seleção direta (forward selection), mas com a alteração de que cada vez que uma variável é adicionada, uma rodada de eliminação reversa é realizada para que as variáveis que foram tornadas sem importância pela nova adição possam ser removidas do modelo.
Exemplo 5.4: Placekicking.
Como esse algoritmo é o padrão em step(), o algoritmo de seleção direta (forward selection) pode ser modificado para executar a seleção gradual simplesmente excluindo o argumento direction, “both” é seu valor padrão.
back.sel = step ( object = full.mod , scope = list ( lower = empty.mod ),
direction = "both", k = log( nrow ( placekick )), trace = TRUE )## Start: AIC=818.87
## good ~ week + distance + change + elap30 + PAT + type + field +
## wind
##
## Df Deviance AIC
## - elap30 1 753.72 811.82
## - field 1 754.25 812.35
## - type 1 754.76 812.86
## - week 1 755.13 813.23
## - change 1 756.69 814.79
## - wind 1 756.74 814.84
## <none> 753.52 818.87
## - PAT 1 764.63 822.73
## - distance 1 822.64 880.73
##
## Step: AIC=811.82
## good ~ week + distance + change + PAT + type + field + wind
##
## Df Deviance AIC
## - field 1 754.49 805.32
## - type 1 755.04 805.87
## - week 1 755.32 806.16
## - change 1 756.78 807.61
## - wind 1 756.96 807.79
## <none> 753.72 811.82
## - PAT 1 764.81 815.64
## - distance 1 824.69 875.53
##
## Step: AIC=805.32
## good ~ week + distance + change + PAT + type + wind
##
## Df Deviance AIC
## - type 1 755.07 798.65
## - week 1 756.06 799.63
## - wind 1 757.06 800.63
## - change 1 757.77 801.34
## <none> 754.49 805.32
## - PAT 1 765.38 808.95
## - distance 1 825.52 869.09
##
## Step: AIC=798.65
## good ~ week + distance + change + PAT + wind
##
## Df Deviance AIC
## - week 1 756.69 793.00
## - wind 1 757.26 793.57
## - change 1 758.27 794.58
## <none> 755.07 798.65
## - PAT 1 765.85 802.16
## - distance 1 827.69 864.00
##
## Step: AIC=793
## good ~ distance + change + PAT + wind
##
## Df Deviance AIC
## - wind 1 759.33 788.38
## - change 1 759.66 788.71
## <none> 756.69 793.00
## - PAT 1 767.54 796.59
## - distance 1 829.87 858.92
##
## Step: AIC=788.38
## good ~ distance + change + PAT
##
## Df Deviance AIC
## - change 1 762.41 784.20
## <none> 759.33 788.38
## - PAT 1 770.50 792.29
## - distance 1 831.75 853.53
##
## Step: AIC=784.2
## good ~ distance + PAT
##
## Df Deviance AIC
## <none> 762.41 784.20
## - PAT 1 775.75 790.27
## - distance 1 834.41 848.93Neste caso, os resultados são idênticos à seleção direta, pois não há etapas nas quais quaisquer variáveis adicionadas anteriormente se tornem não significativas e possam ser removidas.
Procedimentos stepwise têm sido historicamente aplicados usando testes de hipóteses para determinar a sequência de modelos a serem considerados. No entanto, esses testes não são realmente testes de hipóteses válidos (Miller, 1984) e, portanto, está se tornando mais comum aplicar métodos passo a passo usando um critério de informação como mostramos acima. O programa correspondente ao exemplo desta seção fornece o código que mostra como manipular a função step() para usar testes de hipótese para adição e exclusão de variáveis.
É importante observar que tanto os testes de hipótese quanto os critérios de informação ordenam as variáveis da mesma forma em cada etapa e, portanto, produzem exatamente a mesma sequência de modelos se for permitido executar até que todas as variáveis sejam adicionadas ou removidas. A única diferença possível entre usar um teste e um critério de informação é a seleção de um modelo final da sequência.
Pelas mesmas razões que acabamos de observar, testes de significância para variáveis em um modelo selecionado por um critério de informação não são testes válidos. Portanto, não é apropriado seguir um procedimento passo a passo com mais testes de significância para ver se o modelo selecionado pode ser mais simplificado. Fazer isso normalmente faria com que o valor de \(IC(k)\) aumentasse, resultando em um modelo pior de acordo com o critério escolhido.
Embora os procedimentos para frente, para trás e passo a passo apontassem para o mesmo “melhor” modelo no exemplo do placekicking, isso geralmente não tem que acontecer. É bem possível que os três procedimentos selecionem três modelos diferentes. De fato, Miller (1984) discute um exemplo real com onze variáveis explicativas em que a primeira variável inserida no modelo por seleção direta é também a primeira removida por eliminação retrógrada. Ver Miller (1984), Grechanovsky (1987), Shtatland et al. (2003) e Kutner et al. (2004) para mais detalhes e críticas de procedimentos passo a passo.
5.1.5 Métodos modernos de seleção de variáveis
Nas últimas duas décadas, muitos novos algoritmos foram propostos para pesquisar um espaço de modelos. O mais popular deles é o operador de seleção e encolhimento absoluto mínimo (LASSO) proposto por Tibshirani (1996). O LASSO foi refinado, aprimorado e redesenvolvido de várias maneiras diferentes. Em seguida, descrevemos o LASSO original e mencionamos várias melhorias nele.
O LASSO
Um procedimento de seleção de variável tem maior probabilidade de selecionar uma variável específica quando o acaso nos dados faz com que a variável pareça mais importante do que realmente é, em comparação com os momentos em que o acaso faz com que pareça menos importante do que realmente é. Como resultado, as estimativas de parâmetros para as variáveis selecionadas tendem a ser enviesadas: elas são frequentemente estimadas mais longe de zero do que deveriam. Esta é a principal motivação para o LASSO, que tenta simultaneamente selecionar variáveis e encolher suas estimativas de volta a zero para neutralizar esse viés.
O LASSO estima parâmetros usando um procedimento que adiciona uma penalidade ao logaritmo da verossimilhança para evitar que as estimativas de parâmetros sejam muito grandes. Especificamente, para um modelo com \(p\) variáveis explicativas, os parâmetros LASSO estimados são \(\widehat{\beta}_{0,LASSO}\), \(\widehat{\beta}_{1,LASSO}\), \(\cdots\), \(\widehat{\beta}_{p,LASSO}\) obtidos da maximização da função \[ \log\big( \beta_0,\beta_1,\cdots,\beta_p \, | \, y_1,\cdots,y_n \big) - \lambda \sum_{j=1}^n | \beta_j |, \] onde \(\lambda\) é um parâmetro de ajuste que precisa ser determinado.
Para um dado valor de \(\lambda\), o termo de penalidade \(\sum_{j=1}^n | \beta_j |\) no critério de verossimilhança tem dois efeitos. Faz com que algumas das estimativas dos parâmetros da regressão permaneçam em zero, de forma que suas variáveis correspondentes sejam consideradas excluídas do modelo. Além disso, desencoraja que outras estimativas de parâmetros se tornem muito grandes, a menos que o aumento de suas magnitudes forneça um aumento suficiente na verossimilhança de superar a penalidade adicional. Assim, o procedimento simultaneamente seleciona variáveis e reduz suas estimativas para zero, o que pode ajudar a superar o viés observado acima.
À medida que o parâmetro de penalidade \(\lambda\) cresce, mais encolhimento ocorre e modelos menores são escolhidos. Esse parâmetro geralmente é escolhido por validação cruzada (CV), que divide aleatoriamente os dados em vários grupos e prevê as respostas dentro de cada grupo com base em modelos ajustados ao restante dos dados. A comparação das respostas previstas e reais de alguma forma fornece uma estimativa do erro de previsão do modelo. O erro de predição é calculado para uma sequência de valores diferentes para \(\lambda\), e aquele que tiver o menor erro de predição estimado é uma possível escolha para a penalidade.
Observe que o CV é um procedimento aleatório. É provável que erros de previsão ligeiramente diferentes resultem de execuções repetidas do algoritmo CV, levando a diferentes valores escolhidos e resultando em diferentes modelos e estimativas de parâmetros. Além disso, muitas vezes existem muitos valores \(\lambda\) que levam a valores semelhantes de erro de previsão. Na prática, é comum usar o menor modelo cujo erro de previsão esteja dentro de 1 erro padrão do menor erro de CV, onde o erro padrão se refere à variabilidade das estimativas de erro de previsão de CV e pode ser calculado de várias maneiras. Ver Hastie et al. (2009) para detalhes.
Embora as estimativas LASSO geralmente resultem em melhores previsões do que os MLEs comuns, os procedimentos de inferência subsequentes ainda não foram totalmente desenvolvidos. Por exemplo, ainda não existem intervalos de confiança para parâmetros de regressão ou valores previstos. Portanto, o LASSO é usado principalmente como uma ferramenta de seleção de variáveis ou para fazer previsões onde as estimativas de intervalo não são necessárias.
Exemplo 5.5: Placekicking.
O pacote glmnet inclui funções que podem calcular estimativas de parâmetros LASSO e valores previstos para modelos de regressão binomial (ligação logito), Poisson (ligação log) e multinomial (resposta nominal). A função glmnet() calcula estimativas LASSO para uma sequência de até 100 valores de \(\lambda\). A função cv.glmnet() usa validação cruzada para escolher um valor de \(\lambda\). Ambos glmnet() e cv.glmnet() requerem que as observações para as variáveis explanatórias e resposta sejam separadas em objetos classe matrix, inseridos como valores de argumento para \(x\) e \(y\), respectivamente.
Embora ambas as funções tenham vários parâmetros de controle adicionais, os níveis padrão servem razoavelmente bem para uma análise relativamente fácil. Os objetos criados por essas funções podem ser acessados usando as funções genéricas coef(), predict() e plot(). Por padrão, coef() e predict() produzem saída para cada valor de \(\lambda\) para objetos de glmnet(); alternativamente, os valores de \(\lambda\) podem ser especificados usando o argumento s.
Aplicamos essas funções aos dados de placekicking abaixo. Depois de criar as matrizes necessárias, armazenadas como objetos yy e xx, executamos o algoritmo LASSO e examinamos os resultados.
yy <- as.matrix ( placekick [ ,9])
xx <- as.matrix ( placekick [ ,1:8])
library(glmnet)
lasso.fit <- glmnet (y = yy , x = xx , family = "binomial")
# List out coefficients for each lambda
round(coef(lasso.fit), digits = 3)## 9 x 63 sparse Matrix of class "dgCMatrix"
##
## (Intercept) 2.047 2.359 2.632 2.875 3.095 3.297 3.482 3.653 3.812
## week . . . . . . . . .
## distance . -0.011 -0.021 -0.029 -0.036 -0.042 -0.048 -0.054 -0.058
## change . . . . . . . . .
## elap30 . . . . . . . . .
## PAT . . . . . . . . .
## type . . . . . . . . .
## field . . . . . . . . .
## wind . . . . . . . . .
##
## (Intercept) 3.960 4.097 4.225 4.344 4.456 4.559 4.656 4.671 4.654
## week . . . . . . . . .
## distance -0.063 -0.067 -0.071 -0.074 -0.077 -0.080 -0.083 -0.084 -0.084
## change . . . . . . . . .
## elap30 . . . . . . . . .
## PAT . . . . . . . 0.060 0.142
## type . . . . . . . . .
## field . . . . . . . . .
## wind . . . . . . . . .
##
## (Intercept) 4.640 4.628 4.616 4.608 4.611 4.614 4.618 4.622 4.630
## week . . . . . . . . .
## distance -0.084 -0.084 -0.085 -0.085 -0.085 -0.085 -0.085 -0.085 -0.085
## change . . . -0.004 -0.034 -0.062 -0.086 -0.109 -0.129
## elap30 . . . . . . . . .
## PAT 0.218 0.291 0.360 0.424 0.478 0.530 0.578 0.624 0.667
## type . . . . . . . . .
## field . . . . . . . . .
## wind . . . . . . . . -0.041
##
## (Intercept) 4.638 4.647 4.671 4.696 4.720 4.742 4.762 4.782 4.799
## week . . -0.002 -0.004 -0.005 -0.007 -0.009 -0.010 -0.011
## distance -0.085 -0.085 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086
## change -0.147 -0.164 -0.180 -0.195 -0.208 -0.220 -0.231 -0.242 -0.251
## elap30 . . . . . . . . .
## PAT 0.707 0.744 0.779 0.812 0.843 0.872 0.900 0.925 0.948
## type . . . . . . . . .
## field . . . . . . . . .
## wind -0.086 -0.127 -0.160 -0.189 -0.215 -0.239 -0.261 -0.280 -0.298
##
## (Intercept) 4.812 4.814 4.817 4.816 4.812 4.809 4.807 4.804 4.802
## week -0.012 -0.013 -0.014 -0.015 -0.016 -0.017 -0.017 -0.018 -0.019
## distance -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086
## change -0.260 -0.268 -0.275 -0.283 -0.289 -0.296 -0.301 -0.306 -0.310
## elap30 . . . 0.000 0.001 0.001 0.002 0.002 0.002
## PAT 0.971 0.992 1.011 1.029 1.046 1.061 1.076 1.089 1.102
## type 0.004 0.018 0.030 0.041 0.051 0.060 0.068 0.079 0.099
## field . . . . . . . -0.005 -0.023
## wind -0.315 -0.334 -0.352 -0.367 -0.382 -0.395 -0.407 -0.420 -0.438
##
## (Intercept) 4.800 4.798 4.796 4.795 4.794 4.793 4.792 4.791 4.791
## week -0.019 -0.020 -0.020 -0.021 -0.021 -0.021 -0.022 -0.022 -0.022
## distance -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086
## change -0.314 -0.317 -0.320 -0.322 -0.325 -0.327 -0.329 -0.331 -0.333
## elap30 0.002 0.003 0.003 0.003 0.003 0.003 0.003 0.004 0.004
## PAT 1.114 1.125 1.135 1.144 1.153 1.160 1.168 1.174 1.180
## type 0.117 0.134 0.149 0.163 0.175 0.187 0.198 0.207 0.216
## field -0.039 -0.054 -0.068 -0.081 -0.093 -0.103 -0.113 -0.122 -0.130
## wind -0.455 -0.470 -0.484 -0.497 -0.508 -0.519 -0.529 -0.538 -0.546
##
## (Intercept) 4.790 4.789 4.789 4.788 4.788 4.787 4.786 4.786 4.785
## week -0.022 -0.023 -0.023 -0.023 -0.023 -0.023 -0.023 -0.023 -0.024
## distance -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086 -0.086
## change -0.334 -0.336 -0.337 -0.338 -0.339 -0.340 -0.341 -0.342 -0.342
## elap30 0.004 0.004 0.004 0.004 0.004 0.004 0.004 0.004 0.004
## PAT 1.186 1.191 1.195 1.199 1.203 1.207 1.210 1.214 1.216
## type 0.224 0.232 0.238 0.245 0.250 0.256 0.260 0.265 0.269
## field -0.138 -0.145 -0.151 -0.156 -0.162 -0.166 -0.171 -0.175 -0.178
## wind -0.553 -0.560 -0.566 -0.572 -0.577 -0.581 -0.586 -0.590 -0.593# Adding lambda values to output
las.lambda <- lasso.fit$lambda
length(las.lambda)## [1] 63# Matrix(x,sparse = TRUE) converts zeroes on matrix x into dots for nicer print
las.coefs <- Matrix(rbind(as.matrix(coef(lasso.fit)), las.lambda), sparse = TRUE)
#splitting up range of columns for better printing)
round(las.coefs[,c(1:5)], digits = 4)## 10 x 5 sparse Matrix of class "dgCMatrix"
## s0 s1 s2 s3 s4
## (Intercept) 2.0467 2.3588 2.6316 2.8750 3.0954
## week . . . . .
## distance . -0.0111 -0.0206 -0.0287 -0.0359
## change . . . . .
## elap30 . . . . .
## PAT . . . . .
## type . . . . .
## field . . . . .
## wind . . . . .
## las.lambda 0.1403 0.1278 0.1165 0.1061 0.0967round(las.coefs[,c(21:25)], digits = 4)## 10 x 5 sparse Matrix of class "dgCMatrix"
## s20 s21 s22 s23 s24
## (Intercept) 4.6161 4.6077 4.6109 4.6145 4.6181
## week . . . . .
## distance -0.0845 -0.0846 -0.0847 -0.0849 -0.0850
## change . -0.0040 -0.0342 -0.0616 -0.0864
## elap30 . . . . .
## PAT 0.3597 0.4241 0.4783 0.5296 0.5783
## type . . . . .
## field . . . . .
## wind . . . . .
## las.lambda 0.0218 0.0199 0.0181 0.0165 0.0150round(las.coefs[,c(60:63)], digits = 4)## 10 x 4 sparse Matrix of class "dgCMatrix"
## s59 s60 s61 s62
## (Intercept) 4.7870 4.7864 4.7859 4.7855
## week -0.0232 -0.0234 -0.0235 -0.0236
## distance -0.0860 -0.0860 -0.0860 -0.0860
## change -0.3400 -0.3409 -0.3416 -0.3424
## elap30 0.0041 0.0042 0.0042 0.0043
## PAT 1.2071 1.2104 1.2135 1.2164
## type 0.2556 0.2604 0.2648 0.2687
## field -0.1665 -0.1709 -0.1749 -0.1785
## wind -0.5814 -0.5857 -0.5897 -0.5933
## las.lambda 0.0006 0.0005 0.0005 0.0004O algoritmo produziu estimativas de parâmetros que maximizam a log-verossimilhança penalizada acima em 63 valores de \(\lambda\), dos quais exibimos apenas o primeiro e o último. As estimativas são listadas em ordem decrescente, para que os modelos progridam de apenas intercepto para um ajuste quase não penalizado. No programa correspondente a este exemplo, fornecemos codificação adicional para obter os valores impressos de \(\lambda\) em cada coluna junto com as estimativas.
Em seguida, usamos cv.glmnet() para selecionar um valor para \(\lambda\) usando o valor padrão de 10 subconjuntos de CV e, em seguida, mostrar e imprimir os resultados. Definimos uma semente para que o procedimento de CV sempre dê os mesmos resultados.
# cv.glmnet() uses crossvalidation to estimate optimal lambda
# Fix seed for crossvalidation, so the book's results can be duplicated
set.seed (27498272)
cv.lasso.fit <- cv.glmnet (y = yy , x = xx , family = "binomial")
# Default plot method for cv. lambda () produces CV errors +/- 1 SE at each lambda .
plot (cv.lasso.fit)
grid()
Figura 5.1: Estimativas de validação cruzada do erro de
predição (desvio residual binomial) \(\pm\) 1 erro padrão para cada valor de
\(\lambda\). Os números no topo do
gráfico são o número de variáveis no correspondente \(\lambda\). A primeira linha vertical
pontilhada é onde ocorre o menor erro de CV; o segundo é o menor modelo
onde o erro CV está dentro de 1 erro padrão do menor.
A figura acima mostra as estimativas de validação cruzada com o erro de predição, desvio residual binomial sendo \(\pm\) 1 erro padrão para cada valor de \(\lambda\). Os números no topo do gráfico são o número de variáveis no correspondente \(\lambda\). A primeira linha vertical pontilhada é onde ocorre o menor erro CV; o segundo é o menor modelo em que o erro CV está dentro de 1 erro padrão do menor.
# Print out coefficients at optimal lambda
coef (cv.lasso.fit)## 9 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) 4.09748542
## week .
## distance -0.06697266
## change .
## elap30 .
## PAT .
## type .
## field .
## wind .# Another way to do this
coef(lasso.fit, s = cv.lasso.fit$lambda.1se) ## 9 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) 4.09748542
## week .
## distance -0.06697266
## change .
## elap30 .
## PAT .
## type .
## field .
## wind .# Predicted response values
predict.las <- predict (cv.lasso.fit , newx = xx , type = "response")
head ( cbind ( placekick$distance , round ( predict.las , digits = 3)))## lambda.1se
## [1,] 21 0.936
## [2,] 21 0.936
## [3,] 20 0.940
## [4,] 28 0.902
## [5,] 20 0.940
## [6,] 25 0.919As estimativas CV de erro em cada um são mostradas na figura acima; observe que o deviance residual binomial é a função avaliada para comparar os dados preditos e observados em cada subconjunto CV. A estimativa do CV mínimo do deviance ocorre com um modelo de 6 variáveis, mas existem muitos modelos com praticamente o mesmo deviance. O menor modelo cujo desvio está dentro de 1 erro padrão do mínimo tem apenas uma variável.
A impressão dos coeficientes para este modelo mostra que a variável é distance, com uma estimativa de parâmetro de -0.077. Comparando isso com o MLE, -0.115, vemos que ocorreu algum encolhimento. As probabilidades previstas de uma cesta de campo bem-sucedida são impressas para as primeiras observações no conjunto de dados.
O LASSO foi aprimorado de várias maneiras desde sua introdução. A formulação original para o LASSO não lida com variáveis explanatórias categóricas, então uma versão revisada, chamada de LASSO agrupado, foi desenvolvida para corrigir isso (Yuan and Lin, 2006).
O LASSO agrupado está disponível para regressão logística no pacote SGL e para regressão logística e de Poisson no pacote grplasso. Além disso, foi observado em vários lugares que o LASSO pode ter um desempenho ruim quando confrontado com um problema no qual existem muitas variáveis no pool, mas poucas são importantes (ver, por exemplo, Meinshausen, 2007). Tem a tendência de incluir muito mais variáveis do que o necessário, embora com estimativas de parâmetros muito pequenas. Melhorias como o LASSO relaxado (Meinshausen, 2007) e o LASSO adaptativo (Zou, 2006) corrigem essa tendência separando a tarefa de encolhimento da tarefa de seleção variável. Infelizmente, essas melhorias ainda não foram implementadas em pacotes R padrão para modelos lineares generalizados, até o momento. Eles podem estar disponíveis como funções ou pacotes oferecidos de forma privada, como nos sites dos autores.
Sugerimos que os leitores verifiquem periodicamente se há novos pacotes que oferecem essas técnicas.
5.1.6 Média do modelo
Conforme observado na seção anterior, muitas vezes há muitos modelos com valores de \(IC(k)\) muito próximos do menor valor. Esta é uma indicação de que há alguma incerteza sobre qual modelo é realmente melhor. Nesses casos, alterar ligeiramente os dados pode resultar na seleção de um modelo diferente como o melhor. No Exercício 2, ilustramos essa incerteza dividindo os dados de chutes a gol aproximadamente pela metade e mostrando que existem diferenças consideráveis nos 5 principais modelos selecionados pelas duas metades.
Essa incerteza é difícil de medir se a seleção de variáveis for aplicada usando a abordagem tradicional de selecionar um único modelo e usá-lo para todas as inferências posteriores. Em particular, se um modelo for selecionado e então ajustado aos dados, qualquer variável que não esteja nesse modelo implicitamente terá seus parâmetros de regressão estimados como zero, com um erro padrão de zero. Ou seja, agimos como se soubéssemos que essas variáveis não pertencem ao modelo, quando na verdade os dados não podem determinar isso com certeza.
Seria útil poder estimar melhor a incerteza em cada uma de nossas estimativas de parâmetros. Quando a seleção variável de todos os subconjuntos é viável, a média do modelo pode levar em conta a incerteza da seleção do modelo em inferências subsequentes consulte, por exemplo, Burnham and Anderson (2002). Em particular, a média do modelo bayesiano \(BMA\), Hoeting et al. (1999) usa a teoria bayesiana para calcular a probabilidade de que cada modelo possível seja o modelo correto, supondo que um deles seja, de fato, correto.
Acontece que essas probabilidades podem ser aproximadas por funções relativamente simples do valor \(BIC\) para cada modelo. Suponha que um total de \(M\) modelos sejam ajustados e denote o \(BIC\) para o modelo \(m\) por \(BIC_m\), \(m = 1,\cdots,M\). Denote o menor valor de \(BIC\) entre todos os modelos por \(BIC_0\) e defina \(\Delta_m = BIC_m-BIC_0\geq 0\).
Assumindo que todos os modelos foram considerados igualmente prováveis antes do início da análise de dados, então a probabilidade estimada de que o modelo \(m\) esteja correto, \(\tau_m\), é aproximadamente \[ \widehat{\tau}_m=\dfrac{\displaystyle \exp\Big( -\frac{1}{2}\Delta_m \Big)}{\displaystyle \sum_{a=1}^M \exp\Big( -\frac{1}{2}\Delta_a \Big)}\cdot \]
Para o modelo com o menor \(BIC\), \(\exp(-\Delta_m/2) = 1\); para todos os outros modelos, \(\exp(-\Delta_m/2) < 1\) e esse número diminui muito rapidamente à medida que \(m\) cresce. Observe que quando \(\Delta_m = 2\), \(\exp(-\Delta_m/2) = 0.37\), de modo que a probabilidade do modelo \(m\) é cerca de um terço maior que a do modelo de melhor ajuste.
Esta não é uma grande diferença, considerando que os procedimentos de seleção de variáveis que selecionam um único modelo declaram essencialmente que um modelo tem probabilidade 1 e o resto tem probabilidade zero. Este também é o significado por trás do relatório do número de modelos dentro de 2 unidades IC dos melhores em glmulti().
Agora, seja \(\theta\) qualquer quantidade que queremos estimar a partir dos modelos; como um parâmetro de regressão, uma razão de chances ou um valor previsto. Denote sua estimativa no modelo \(m\) por \(\widehat{\theta}_m\) com a variância correspondente estimada por \(\widehat{\mbox{Var}}(\widehat{\theta}_m)\). Em seguida, a estimativa média deste parâmetro na média do modelo é \[ \widehat{\theta}_{MA}=\sum_{m=1}^M \widehat{\tau}_m \widehat{\theta}_m, \] e a variância deste estimador é estimada por \[ \widehat{\mbox{Var}}(\widehat{\theta}_{MA})=\sum_{m=1}^M \widehat{\tau}_m \Big(\big( \widehat{\theta}_m-\widehat{\theta}_{MA}\big)^2 + \widehat{\mbox{Var}}(\widehat{\theta}_m)\Big)\cdot \]
Se um modelo é claramente melhor do que todos os outros, então é \(\widehat{\tau}_m\approx 1\). Nesse caso, a estimativa da média do modelo, \(\widehat{\theta}_{MA}\), não é muito diferente da estimativa desse modelo e a variância de \(\widehat{\theta}_{MA}\) é essencialmente apenas a variância estimada de \(\widehat{\theta}_m\) de seu modelo. Por outro lado, se muitos modelos têm probabilidades comparáveis, então a variância da estimativa \(\widehat{\theta}_{MA}\) depende tanto de quão variáveis são as estimativas dos parâmetros de modelo para modelo até \((\widehat{\theta}_m-\widehat{\theta}_{MA})^2\) e da variância das estimativas dos parâmetros de cada modelo.
Este processo pode ser aplicado a qualquer número de parâmetros associados ao modelo. Como exemplo, considere o caso de um único parâmetro de regressão, \(\theta=\beta_j\). Existe uma estimativa, \(\widehat{\beta}_{j,m}\), em cada modelo. A estimativa média do modelo de \(\beta_j\) é \[ \widehat{\beta}_{j,MA} = \sum_{m=1}^M \widehat{\tau}_m \widehat{\beta}_{j,m}\cdot \]
Observe aqui que metade dos modelos na seleção de todos os subconjuntos exclui \(X_j\) , então \(\widehat{\beta}_{j,m} = 0\) para esses modelos. Em modelos onde \(X_j\) aparece e que também possuem alta probabilidade a eles ligada, é provável que \(\beta_j\) tenha sua magnitude superestimada. Esses fatos têm várias implicações:
A média do modelo geralmente resulta em uma estimativa diferente de zero para todos os parâmetros de regressão.
Variáveis realmente sem importância provavelmente não aparecerão nos modelos com alta probabilidade. Assim, suas estimativas médias de modelo são próximas de zero, porque as probabilidades para os modelos em que aparecem são todas pequenas e há pouca variabilidade nessas estimativas. Na prática, eles podem ser considerados zero, porque seu impacto nas previsões médias do modelo é insignificante.
Por outro lado, as variáveis que aparecem em alguns, mas não em todos, dos modelos com maior probabilidade normalmente têm suas estimativas reduzidas ao serem calculadas com zeros nos modelos em que não aparecem. Isso reduz o viés pós-seleção observado na Seção 5.1.5.
Exemplo 5.6: Placekicking.
O principal pacote R que executa a média do modelo bayesiano BMA, concentra-se na seleção e avaliação de variáveis, ou seja, tomando \(\theta=\beta_j\), \(j = 1,\cdots,p\). Os cálculos para inferência da média do modelo em outros parâmetros, como valores previstos, devem ser programados manualmente usando os resultados deste pacote.
Por outro lado, o pacote glmulti tem funções que podem facilmente produzir valores preditos de médias de modelo e intervalos de confiança correspondentes. Portanto, demonstramos a média do modelo aqui usando glmulti() e incluímos um exemplo usando bic.glm() do pacote BMA neste exemplo.
A sintaxe glmulti() para a pesquisa de variáveis é essencialmente a mesma usada no exemplo da Seção 5.1.3, exceto que escolhemos crit = “bic” para que possamos realizar a média do modelo bayesiano.
search.1.bic <- glmulti (y = good ~ ., data = placekick , fitfunction = "glm", plotty = FALSE,
level = 1, method = "h", crit = "bic", family = binomial ( link = "logit"))## Initialization...
## TASK: Exhaustive screening of candidate set.
## Fitting...
##
## After 50 models:
## Best model: good~1+distance+PAT
## Crit= 784.195620372141
## Mean crit= 880.572816427467
##
## After 100 models:
## Best model: good~1+distance+PAT
## Crit= 784.195620372141
## Mean crit= 871.535524395134
##
## After 150 models:
## Best model: good~1+distance+PAT
## Crit= 784.195620372141
## Mean crit= 818.542604925582
##
## After 200 models:
## Best model: good~1+distance+PAT
## Crit= 784.195620372141
## Mean crit= 804.423604971349
##
## After 250 models:
## Best model: good~1+distance+PAT
## Crit= 784.195620372141
## Mean crit= 801.597872678926
## Completed.print ( search.1.bic)## glmulti.analysis
## Method: h / Fitting: glm / IC used: bic
## Level: 1 / Marginality: FALSE
## From 100 models:
## Best IC: 784.195620372141
## Best model:
## [1] "good ~ 1 + distance + PAT"
## Evidence weight: 0.656889992065595
## Worst IC: 810.039529019811
## 1 models within 2 IC units.
## 9 models to reach 95% of evidence weight.head ( weightable ( search.1.bic))## model bic weights
## 1 good ~ 1 + distance + PAT 784.1956 0.65688999
## 2 good ~ 1 + distance + change + PAT 788.3802 0.08106306
## 3 good ~ 1 + distance + PAT + wind 788.7094 0.06875864
## 4 good ~ 1 + week + distance + PAT 789.6186 0.04364175
## 5 good ~ 1 + distance 790.2689 0.03152804
## 6 good ~ 1 + distance + PAT + type 791.3004 0.01882426plot ( search.1.bic , type = "w")
grid()
Figura 5.2: Probabilidades estimadas do modelo a partir
da média do modelo bayesiano aplicada aos dados de placekicking. Os
modelos à esquerda da linha vertical representam 95% da probabilidade
acumulada.
Comparado com os resultados do \(AIC_c\), vemos que o \(BIC\) prefere modelos menores, como esperado. Os resultados de print() mostram que o melhor modelo usa as variáveis distance e PAT e que é o único modelo dentro de duas unidades de seu valor \(BIC\).
As notas sobre evidence weight referem-se às probabilidades do modelo: o modelo superior tem probabilidade 0.66 e os nove principais de \(2^8 = 256\) modelos respondem por 95% da probabilidade. A última coluna na saída de weightable() mostra as probabilidades do modelo, onde vemos que o modelo superior é bastante dominante. O segundo melhor modelo tem 0.08 de probabilidade. Um gráfico dessas probabilidades de modelo para os 100 principais modelos é produzido pela função plot para objetos glmulti e é mostrado na figura acima.
Instruções de programação adicionais criam estimativas de parâmetros de média de modelo e intervalos de confiança, mostrados abaixo. A função coef() produz as estimativas e variâncias do parâmetro BMA, juntamente com o número de modelos nos quais a variável foi incluída, a probabilidade total contabilizada por esses modelos e a largura média de um intervalo de confiança para o parâmetro.
As variáveis são impressas em ordem da menos provável para a mais provável, então invertemos essa ordem e calculamos os intervalos de confiança. Exponenciar as estimativas e os pontos finais do intervalo permite que eles sejam interpretados em termos de razões de chances por mudança de 1 unidade na variável explicativa correspondente.
parms <- coef ( search.1.bic)
# Renaming columns to fit in book output display
colnames ( parms ) <- c("Estimate", "Variance", "n.Models", "Probability", "95% CI +/ -")
round (parms , digits = 3)## Estimate Variance n.Models Probability 95% CI +/ -
## field 0.000 0.000 41 0.026 0.010
## elap30 0.000 0.000 40 0.027 0.001
## type 0.003 0.000 42 0.028 0.017
## week -0.002 0.000 43 0.062 0.007
## wind -0.051 0.010 46 0.095 0.197
## change -0.042 0.007 46 0.119 0.159
## PAT 1.252 0.191 56 0.944 0.857
## (Intercept) 4.626 0.269 100 1.000 1.017
## distance -0.088 0.000 100 1.000 0.024parms.ord <- parms [ order ( parms [,4], decreasing = TRUE ) ,]
ci.parms <- cbind ( lower = parms.ord [ ,1] - parms.ord [ ,5],
upper = parms.ord [ ,1] + parms.ord [ ,5])
round ( cbind ( parms.ord [ ,1], ci.parms ), digits = 3)## lower upper
## (Intercept) 4.626 3.609 5.644
## distance -0.088 -0.111 -0.064
## PAT 1.252 0.394 2.109
## change -0.042 -0.201 0.117
## wind -0.051 -0.248 0.147
## week -0.002 -0.008 0.005
## type 0.003 -0.015 0.020
## elap30 0.000 -0.001 0.001
## field 0.000 -0.011 0.010parms.ord <- parms [ order ( parms [,4], decreasing = TRUE ) ,]
ci.parms <- cbind ( lower = parms.ord [ ,1] - parms.ord [ ,5],
upper = parms.ord [ ,1] + parms.ord [ ,5])
round ( cbind ( parms.ord [ ,1], ci.parms ), digits = 3)## lower upper
## (Intercept) 4.626 3.609 5.644
## distance -0.088 -0.111 -0.064
## PAT 1.252 0.394 2.109
## change -0.042 -0.201 0.117
## wind -0.051 -0.248 0.147
## week -0.002 -0.008 0.005
## type 0.003 -0.015 0.020
## elap30 0.000 -0.001 0.001
## field 0.000 -0.011 0.010Como seria de esperar, distance é a variável mais importante, aparecendo em todos os 100 principais modelos. Em seguida foi PAT, aparecendo em modelos que representam 0.94 de probabilidade. Nenhuma outra variável foi considerada particularmente importante. Isso se reflete nos intervalos de confiança baseados na estatística \(t\) de 95% para os parâmetros e as razões de chances, em que a configuração padrão usa graus de liberdade calculados em média entre os modelos.
Os intervalos de parâmetros cobrem 0 e os intervalos OR correspondentes cobrem 1 para todas as variáveis, exceto para distance e PAT. O programa correspondente a este exemplo fornece os resultados ajustando apenas o melhor modelo, good ~ 1 + distance + PAT e ignorando todos os outros.
As estimativas de parâmetros dos dois métodos são bastante semelhantes - o que não é surpreendente, considerando que esse modelo foi bastante dominante entre todos os subconjuntos possíveis - mas os intervalos de confiança do ajuste de modelo único são ligeiramente mais estreitos e não obtemos intervalos de confiança para as outras variáveis.
# CI for OR for 10-unit decrease in distance
# (Multiplying by negative distance causes confidence interval labels to be backwards)
round(exp(-10*c(OR = parms.ord[2,1], ci.parms[2,])), digits = 2)## OR lower upper
## 2.40 3.04 1.89# Get out predicted values (linear predictor scale), and get standard errors
preds <- predict(search.1.bic, se.fit = TRUE)
preds.av <- t(preds$averages)
preds.var <- preds$variability
# Confidence intervals on linear predictor scale;
# second column of $variability contains needed calculations
preds.ci <- cbind(preds.av - preds.var[,2], preds.av + preds.var[,2])
#Transform to probability scale and print out a few rows.
pred.prob <- exp(preds.av)/(1 + exp(preds.av))
pred.prob.ci <- exp(preds.ci)/(1 + exp(preds.ci))
colnames(pred.prob.ci) <- c("lower", "upper")
round(head(cbind(pred.prob, pred.prob.ci)), digits = 3)## lower upper
## 1 0.940 0.901 0.964
## 2 0.942 0.904 0.966
## 3 0.984 0.971 0.991
## 4 0.898 0.854 0.930
## 5 0.984 0.971 0.991
## 6 0.920 0.878 0.948# Comparison to fitting best model only, good ~ 1 + distance + PAT
best.fit <- glm(formula = good ~ distance + PAT, data = placekick, family = binomial(link = "logit"))
linear.pred <- predict(object = best.fit, newdata = placekick, type = "link", se = TRUE)
pred.best <- exp(linear.pred$fit) / (1 + exp(linear.pred$fit))
alpha <- 0.05
linear.ci <- cbind(linear.pred$fit + qnorm(p = c(alpha/2))*linear.pred$se,
linear.pred$fit + qnorm(p = c(1 - alpha/2))*linear.pred$se)
pred.best.ci <- exp(linear.ci)/(1+exp(linear.ci))
round(head(cbind(pred.best, lower = pred.best.ci[,1], upper = pred.best.ci[,2])), digits = 3)## pred.best lower upper
## 1 0.938 0.905 0.960
## 2 0.938 0.905 0.960
## 3 0.984 0.973 0.991
## 4 0.892 0.856 0.920
## 5 0.984 0.973 0.991
## 6 0.914 0.879 0.940Nosso programa também mostra como calcular as probabilidades preditas com a média do modelo de um placekick bem-sucedido, juntamente com os intervalos de confiança para as verdadeiras probabilidades.
#####################################################################################
# Model averaging using BMA
# Note: Can do BIC only using bic.glm()
# bic.glm from the BMA package uses a more computationally efficient algorithm than glmulti().
# It has options that reduce number of models estimated and speed up computations:
# occam.window = TRUE (default) is a argument that can quickly identify some models that
# will have very low probability and eliminate them from the candidate set without
# fitting them.
# OR = 20 (default) is the probability ratio for excluding models using occam.window. If a
# model has probability less than 1/OR times the best model's probability, it is not
# considered. It is also used following model evaluations to select the set of models
# upon which the model probabilities will be based. The default of 20 can produce very
# small sets. Larger values let in models with smaller probabilities.
# See four examples below. Computational time is not much of an issue here with only 8 variables.
library(BMA)
# Using the window to select models with OR = 20 (defaults)
search.bma.OR <- bic.glm(f = good ~., glm.family = "binomial", data = placekick[,-10])
summary(search.bma.OR)##
## Call:
## bic.glm.formula(f = good ~ ., data = placekick[, -10], glm.family = "binomial")
##
##
## 4 models were selected
## Best 4 models (cumulative posterior probability = 1 ):
##
## p!=0 EV SD model 1 model 2 model 3
## Intercept 100 4.550496 0.463314 4.516e+00 4.676e+00 4.599e+00
## week.x 5.1 -0.001333 0.007195 . . .
## distance.x 100.0 -0.085999 0.011016 -8.587e-02 -8.646e-02 -8.676e-02
## change.x 9.5 -0.032430 0.116331 . -3.402e-01 .
## elap30.x 0.0 0.000000 0.000000 . . .
## PAT.x 100.0 1.327848 0.381042 1.338e+00 1.245e+00 1.319e+00
## type.x 0.0 0.000000 0.000000 . . .
## field.x 0.0 0.000000 0.000000 . . .
## wind.x 8.1 -0.043067 0.170216 . . -5.326e-01
##
## nVar 2 3 3
## BIC -9.564e+03 -9.560e+03 -9.560e+03
## post prob 0.772 0.095 0.081
## model 4
## Intercept 4.767e+00
## week.x -2.597e-02
## distance.x -8.592e-02
## change.x .
## elap30.x .
## PAT.x 1.339e+00
## type.x .
## field.x .
## wind.x .
##
## nVar 3
## BIC -9.559e+03
## post prob 0.051
##
## 1 observations deleted due to missingness.# NOT Using the window to select models with OR = 20
search.bma.NOR <- bic.glm(f = good ~., glm.family = "binomial", data = placekick[,-10],
occam.window = FALSE)
summary(search.bma.NOR)##
## Call:
## bic.glm.formula(f = good ~ ., data = placekick[, -10], glm.family = "binomial", occam.window = FALSE)
##
##
## 21 models were selected
## Best 5 models (cumulative posterior probability = 0.894 ):
##
## p!=0 EV SD model 1 model 2 model 3
## Intercept 100 4.619e+00 0.543428 4.516e+00 4.676e+00 4.599e+00
## week.x 5.6 -1.462e-03 0.007531 . . .
## distance.x 100.0 -8.746e-02 0.012594 -8.587e-02 -8.646e-02 -8.676e-02
## change.x 11.7 -4.110e-02 0.131478 . -3.402e-01 .
## elap30.x 2.3 7.991e-05 0.001667 . . .
## PAT.x 94.9 1.258e+00 0.472916 1.338e+00 1.245e+00 1.319e+00
## type.x 2.4 2.134e-03 0.034412 . . .
## field.x 2.2 -2.393e-04 0.027724 . . .
## wind.x 9.3 -4.994e-02 0.182665 . . -5.326e-01
##
## nVar 2 3 3
## BIC -9.564e+03 -9.560e+03 -9.560e+03
## post prob 0.666 0.082 0.070
## model 4 model 5
## Intercept 4.767e+00 5.812e+00
## week.x -2.597e-02 .
## distance.x -8.592e-02 -1.150e-01
## change.x . .
## elap30.x . .
## PAT.x 1.339e+00 .
## type.x . .
## field.x . .
## wind.x . .
##
## nVar 3 1
## BIC -9.559e+03 -9.558e+03
## post prob 0.044 0.032
##
## 1 observations deleted due to missingness.# Using the window to select models with OR = 50
search.bma.OR50 <- bic.glm(f = good ~., glm.family = "binomial", data = placekick[,-10], OR = 50)
summary(search.bma.OR50)##
## Call:
## bic.glm.formula(f = good ~ ., data = placekick[, -10], glm.family = "binomial", OR = 50)
##
##
## 8 models were selected
## Best 5 models (cumulative posterior probability = 0.9418 ):
##
## p!=0 EV SD model 1 model 2 model 3
## Intercept 100 4.589e+00 0.514159 4.516e+00 4.676e+00 4.599e+00
## week.x 4.7 -1.210e-03 0.006867 . . .
## distance.x 100.0 -8.695e-02 0.012128 -8.587e-02 -8.646e-02 -8.676e-02
## change.x 8.7 -2.945e-02 0.111252 . -3.402e-01 .
## elap30.x 2.0 6.392e-05 0.001528 . . .
## PAT.x 96.6 1.284e+00 0.444610 1.338e+00 1.245e+00 1.319e+00
## type.x 2.0 1.618e-03 0.030855 . . .
## field.x 1.9 -1.737e-04 0.025511 . . .
## wind.x 7.3 -3.911e-02 0.162683 . . -5.326e-01
##
## nVar 2 3 3
## BIC -9.564e+03 -9.560e+03 -9.560e+03
## post prob 0.701 0.087 0.073
## model 4 model 5
## Intercept 4.767e+00 5.812e+00
## week.x -2.597e-02 .
## distance.x -8.592e-02 -1.150e-01
## change.x . .
## elap30.x . .
## PAT.x 1.339e+00 .
## type.x . .
## field.x . .
## wind.x . .
##
## nVar 3 1
## BIC -9.559e+03 -9.558e+03
## post prob 0.047 0.034
##
## 1 observations deleted due to missingness.# NOT Using the window to select models with OR = 50
search.bma.NOR50 <- bic.glm(f = good ~., glm.family = "binomial", data = placekick[,-10], OR = 50,
occam.window = FALSE)
summary(search.bma.NOR50)##
## Call:
## bic.glm.formula(f = good ~ ., data = placekick[, -10], glm.family = "binomial", OR = 50, occam.window = FALSE)
##
##
## 37 models were selected
## Best 5 models (cumulative posterior probability = 0.8845 ):
##
## p!=0 EV SD model 1 model 2 model 3
## Intercept 100 4.6249143 0.549679 4.516e+00 4.676e+00 4.599e+00
## week.x 6.1 -0.0015838 0.007828 . . .
## distance.x 100.0 -0.0875788 0.012701 -8.587e-02 -8.646e-02 -8.676e-02
## change.x 11.8 -0.0417821 0.132696 . -3.402e-01 .
## elap30.x 2.6 0.0000903 0.001779 . . .
## PAT.x 94.5 1.2529041 0.479102 1.338e+00 1.245e+00 1.319e+00
## type.x 2.7 0.0024443 0.037066 . . .
## field.x 2.5 -0.0003114 0.029882 . . .
## wind.x 9.3 -0.0499304 0.182644 . . -5.326e-01
##
## nVar 2 3 3
## BIC -9.564e+03 -9.560e+03 -9.560e+03
## post prob 0.659 0.081 0.069
## model 4 model 5
## Intercept 4.767e+00 5.812e+00
## week.x -2.597e-02 .
## distance.x -8.592e-02 -1.150e-01
## change.x . .
## elap30.x . .
## PAT.x 1.339e+00 .
## type.x . .
## field.x . .
## wind.x . .
##
## nVar 3 1
## BIC -9.559e+03 -9.558e+03
## post prob 0.044 0.032
##
## 1 observations deleted due to missingness.# Note: In this problem we suggest a higher OR value, because the best model has probability of about 0.66
# in full enumeration. 1/20 of this is still 0.033, and if there are several models betweeo .01 and .03,
# these could account for a notable proportion of the probability.
aa <- bic.glm(f = good ~., glm.family = "binomial", data = placekick[,-10], OR = 80)
summary(aa)##
## Call:
## bic.glm.formula(f = good ~ ., data = placekick[, -10], glm.family = "binomial", OR = 80)
##
##
## 9 models were selected
## Best 5 models (cumulative posterior probability = 0.9303 ):
##
## p!=0 EV SD model 1 model 2 model 3
## Intercept 100 4.604e+00 0.531885 4.516e+00 4.676e+00 4.599e+00
## week.x 4.6 -1.196e-03 0.006827 . . .
## distance.x 100.0 -8.727e-02 0.012419 -8.587e-02 -8.646e-02 -8.676e-02
## change.x 9.8 -3.453e-02 0.121573 . -3.402e-01 .
## elap30.x 1.9 6.314e-05 0.001518 . . .
## PAT.x 95.5 1.268e+00 0.463724 1.338e+00 1.245e+00 1.319e+00
## type.x 2.0 1.599e-03 0.030668 . . .
## field.x 1.8 -1.716e-04 0.025356 . . .
## wind.x 7.3 -3.863e-02 0.161749 . . -5.326e-01
##
## nVar 2 3 3
## BIC -9.564e+03 -9.560e+03 -9.560e+03
## post prob 0.693 0.086 0.073
## model 4 model 5
## Intercept 4.767e+00 5.812e+00
## week.x -2.597e-02 .
## distance.x -8.592e-02 -1.150e-01
## change.x . .
## elap30.x . .
## PAT.x 1.339e+00 .
## type.x . .
## field.x . .
## wind.x . .
##
## nVar 3 1
## BIC -9.559e+03 -9.558e+03
## post prob 0.046 0.033
##
## 1 observations deleted due to missingness.# Confidence intervals for the parameters. Can be converted into confidence intervals for
# the corresponding odds ratios by exponentiating.
bhat.bma <- aa$postmean
aa$postsd## [1] 0.531885426 0.006826526 0.012419044 0.121573443 0.001518355 0.463723888
## [7] 0.030668003 0.025355762 0.161749227alpha <- 0.05
ci.param <- cbind(bhat.bma + qnorm(p = alpha/2) * aa$postsd,
bhat.bma + qnorm(p = 1 - alpha/2) * aa$postsd)
# Parameter estimates and confidence intervals
round(cbind(bhat.bma, ci.param), digits = 3)## bhat.bma
## (Intercept) 4.604 3.562 5.647
## week -0.001 -0.015 0.012
## distance -0.087 -0.112 -0.063
## change -0.035 -0.273 0.204
## elap30 0.000 -0.003 0.003
## PAT 1.268 0.359 2.177
## type 0.002 -0.059 0.062
## field 0.000 -0.050 0.050
## wind -0.039 -0.356 0.278# Odds ratios from each variable and confidence intervals
round(exp(cbind(bhat.bma, ci.param))[-1,], digits = 2)## bhat.bma
## week 1.00 0.99 1.01
## distance 0.92 0.89 0.94
## change 0.97 0.76 1.23
## elap30 1.00 1.00 1.00
## PAT 3.55 1.43 8.82
## type 1.00 0.94 1.06
## field 1.00 0.95 1.05
## wind 0.96 0.70 1.32Embora a teoria para BMA se aplique apenas ao BIC, os métodos desta seção também são frequentemente usados com outros \(IC(k)\). Burnham and Anderson (2002) referem-se ao modelo e às probabilidades variáveis calculadas nesta seção como pesos de evidência em vez de probabilidades posteriores quando \(IC(k)\) alternativo é usado.
Média de modelos como uma ferramenta de seleção de variáveis
Conforme observado na Seção 5.1.3 é comum em uma busca exaustiva que existam muitos modelos com valores de \(IC(k)\) muito semelhantes ao melhor modelo. Esses modelos podem conter muitas das mesmas variáveis explicativas, fornecendo assim evidências sobre quais variáveis são mais importantes. Podemos formalizar essa evidência usando a média do modelo.
Especificamente, usando o critério BIC, calculamos a probabilidade posterior de cada variável explicativa pertencer ao modelo somando as probabilidades de todos os modelos nos quais a variável aparece, poderíamos alternativamente trabalhar com pesos de evidência produzidos por um critério de informação diferente. Se uma variável é importante, os modelos com essa variável tendem a estar entre aqueles com as maiores probabilidades e os modelos sem essa variável têm probabilidades muito pequenas. Assim, os modelos que contêm a variável têm probabilidades que somam quase 1. Da mesma forma, uma variável sem importância tende a não estar entre os principais modelos, de modo que suas probabilidades somam algo relativamente pequeno.
Raftery (1995) sugere diretrizes para interpretar a probabilidade a posteriori de que uma variável pertence ao modelo. Primeiro, qualquer variável com probabilidade a posteriori abaixo de 0.5 tem mais probabilidade de não pertencer ao modelo do que de pertencer. A evidência de que uma variável pertence ao modelo é “fraca” quando sua probabilidade a posteriori está entre 0.50 e 0.75, “positiva” quando está entre 0.75 e 0.95, “forte” quando está entre 0.95 e 0.99 e “muito forte” quando sua probabilidade a posteriori é superior a 0.99. Claro, essas não são as únicas interpretações possíveis. Por exemplo, usar a função plot() com type = “s” em um objeto de glmulti() produz um gráfico de barras das probabilidades a posteriori para cada variável, com uma diretriz desenhada em 0.80.
Consulte a Seção 5.4.2 para obter um exemplo que usa a média do modelo para seleção de variáveis.
5.2 Ferramentas para avaliar o ajuste do modelo
Quando ajustamos um modelo linear generalizado (GLM), assumimos que as três coisas a seguir são verdadeiras:
a distribuição ou componente aleatório, é aquela que especificamos (por exemplo, binomial ou Poisson);
a média dessa distribuição está ligada às variáveis explicativas pela função \(g\) que especificamos, por exemplo, \(g(\pi ) =\beta_0 +\beta_1 x\), onde \(\pi\) é a média de uma variável de resposta binária \(Y\) e
a função de ligaçõa relaciona-se com as variáveis explicativas especificadas de forma linear.
Qualquer uma dessas suposições pode ser violada; na verdade, esperamos que um modelo seja apenas uma aproximação da verdade. Nesta seção apresentamos ferramentas que podem nos ajudar a identificar quando um modelo não é uma boa aproximação.
Os métodos que usamos são amplamente análogos aos usados na regressão linear normal, particularmente em sua dependência de resíduos. Para uma atualização sobre o uso de resíduos no diagnóstico de problemas com modelos lineares com erros normalmente distribuídos, consulte Kutner et al. (2004). Nesta seção, mostraremos como calcular e interpretar resíduos apropriados para diagnosticar problemas em distribuições em que a média e a variância estão relacionadas.
Também ofereceremos alguns métodos para testar o ajuste de um modelo. Essas técnicas sempre devem ser usadas como parte de um processo iterativo de construção de modelo. Um modelo é proposto, ajustado e verificado. Se estiver faltando, um novo modelo é proposto, ajustado e verificado e esse processo é repetido até que um modelo satisfatório seja encontrado.
Esta seção discute ferramentas que são usadas principalmente com modelos para uma única resposta de contagem por observação, como modelos binomiais e de Poisson. Historicamente, mais esforço tem sido gasto no desenvolvimento de ferramentas de diagnóstico para modelos de regressão binomial - particularmente, regressão logística - do que para outros modelos. Além disso, os modelos binomiais requerem consideração especial porque as contagens que são modeladas podem ser baseadas em diferentes números de tentativas para diferentes assuntos.
Portanto, concentramos nossa discussão em modelos binomiais e generalizamos para outros modelos para contagens conforme apropriado. Diagnósticos especializados para os modelos de regressão multinomial das Seções 3.3 e 3.4, que modelam respostas múltiplas simultaneamente, são menos desenvolvidos e não estão prontamente disponíveis em R. Discutiremos eles brevemente no final da seção.
5.2.1 Resíduos
Geralmente, um resíduo é uma comparação entre um valor observado e um valor previsto. Com dados de contagem em modelos de regressão, os dados observados são contagens e os valores previstos são contagens médias estimadas produzidas pelo modelo. Para o modelo de Poisson, isso é direto, porque a contagem média é modelada e prevista diretamente. No entanto, alguns outros casos, como binomial, multinomial e regressões de taxa de Poisson, os modelos são escritos em termos de parâmetros diferentes da média - a probabilidade de sucesso ou a taxa. Esses parâmetros precisam ser convertidos em contagens antes de calcular os resíduos. Para uma regressão de taxa de Poisson, isso significa simplesmente multiplicar a taxa pela exposição para cada observação.
Para regressão binomial, isso requer um pouco mais de cuidado. Considere um problema de regressão binomial no qual existem \(M\) combinações únicas da(s) variável(is) explicativa(s). Referimo-nos a essas combinações como padrões de variáveis explicativas (EVPs). Para EVP \(m = 1,\cdots,M\); seja \(n_m\) o número de tentativas observadas para a(s) variável(is) \(x_m\). Por exemplo, no contexto do exemplo de chute de posição (placekicks) com a distância como única variável explicativa, há 3 chutes de posição a uma distância de 18 jardas, 7 a 19 jardas, 789 a 20 jardas e assim por diante, levando a \(n_1 = 3\), \(n_2 = 7\), \(n_3 = 789\), \(\cdots\). Podemos escolher entre ajustar o modelo às respostas binárias individuais ou primeiro agregar as tentativas e ajustar o modelo às contagens resumidas de sucessos, \(w_m\), conforme mostrado na Seção 2.2.1.
Conforme observado naquela seção, as estimativas dos parâmetros são as mesmas de qualquer maneira e levam à mesma probabilidade estimada de sucesso, \(\widehat{\pi}_m\). Mas modelar as tentativas binárias individualmente produz \(n_m\) residuos para cada \(x\) único, dos quais \(w_m\) são de \(\widehat{\pi}_m\) e os restantes \(n_m-w_m\) são de \(1-\widehat{\pi}_m\), independentemente de \(\widehat{\pi}_m\) estar próximo da proporção observada de sucesso, \(w_m/n_m\). Por outro lado, a modelagem da contagem agregada resulta em um único resíduo que fornece um resumo melhor do ajuste do modelo. Portanto, antes de calcular os resíduos ou qualquer uma das quantidades que posteriormente derivamos deles é importante agregar todas as tentativas para cada EVP em uma única contagem. Referimo-nos a essa agregação como forma padrão de variável explicativa.
Doravante, assumimos que todos os dados binomiais foram agregados dessa maneira em contagens \(y_m\); \(m = 1,\cdots,M\). Usamos \(y\) em vez de \(w\) para consistência com outros modelos, onde a resposta de contagem é normalmente denotada por \(y\). Suponha que EVP \(m\) tenha \(n_m\) tentativas. Então a contagem predita correspondente é \(\widehat{y}_m = n_m\, \widehat{\pi}_m\); \(m = 1,\cdots,M\).
Usamos notação semelhante para contagens de outros modelos que não são baseados em agregações de tentativas: respostas observadas em \(M\) unidades são denotadas por \(y_m\), com contagens preditas correspondentes \(\widehat{y}_m\), \(m = 1,\cdots,M\). Freqüentemente, os ajustes de vários modelos possíveis devem ser comparados, por exemplo, por meio de testes de razão de verossimilhança ou alguma outra comparação de desvio residual. As verossimilhanças baseadas em diferentes estruturas EVP se comportam como se fossem calculadas em diferentes conjuntos de dados, o que significa que não são comparáveis. A agregação de contagens binomiais deve, portanto, ser feita no nível do modelo mais complexo que está sendo comparado antes de ajustar todos os modelos que estão sendo comparados.
Todas as contagens dos modelos distribucionais discutidos nos Capítulos 2–4 têm variâncias que dependem de suas respectivas médias. Portanto, o “resíduo bruto” que é comumente usado na regressão linear normal, \(y_m-\widehat{y}_m\), \(m = 1,\cdots,M\) é de uso limitado, porque uma diferença de um determinado tamanho pode ser insignificante ou extraordinária, dependendo do tamanho da média. Em vez disso, devemos usar quantidades que se ajustem à variabilidade da contagem. O resíduo básico usado com dados de contagem é o resíduo de Pearson, \[ \epsilon_m = \dfrac{y_m-\widehat{y}_m}{\sqrt{\widehat{\mbox{Var}}(Y_m)}}, \] onde \(\widehat{\mbox{Var}}(Y_m)\) é a variância estimada da contagem \(Y_m\) com base no modelo, por exemplo, \(\widehat{\mbox{Var}}(Y_m) = \widehat{y}_m\) para Poisson, \(\widehat{\mbox{Var}}(Y_m) = n_m \, \widehat{\pi}_m(1-\widehat{\pi}_m)\) para a binomial. Os resíduos de Pearson se comportam aproximadamente como uma amostra de uma distribuição normal, particularmente quando \(\widehat{y}_m\) e \(n_m-\widehat{y}_m\), no caso binomial, são grandes.
No entanto, o denominador superestima o desvio padrão de \(y_m-\widehat{y}_m\), de modo que a variância de \(\epsilon_m\) é menor que 1. Para corrigir isso, calculamos o resíduo padronizado de Pearson, \[ r_m=\dfrac{y_m-\widehat{y}_m}{\sqrt{\widehat{\mbox{Var}}(Y_m-\widehat{Y}_m)}}=\dfrac{y_m-\widehat{y}_m}{\sqrt{\widehat{\mbox{Var}}(Y_m)(1-h_m)}}, \] onde \(h_m\) é o \(m\)-ésimo elemento diagonal da matriz hat descrita nas Seções 2.2.7 e 5.2.3.
Às vezes, um tipo diferente de resíduo é usado com base no desvio residual do modelo. Conforme discutido pela primeira vez na Seção 2.2.2, o deviance residual é uma medida de quão longe o modelo está dos dados e pode ser escrito na forma \[ \sum_{m=1}^M d_m=1, \]
onde a natureza exata de \(d_m\) depende do modelo para a distribuição, por exemplo, \[ d_m = -2y_m \log\big(\widehat{y}_m/y_m\big) -2(n_m-y_m) \log\big( (n_m-\widehat{y}_m)/(n_m-y_m)\big), \] no caso binomial.
A quantidade \[ \epsilon^D_m = \mbox{sign}(y_m-\widehat{y}_m) \sqrt{d_m}, \] é chamado de desvio residual e uma versão padronizada dele, \[ r^D_m =\epsilon^D_m / \sqrt{1-h_m} \] tem aproximadamente uma distribuição normal padrão.
Entre os diferentes tipos de resíduos, preferimos usar os resíduos padronizados de Pearson quando disponíveis. Eles são geralmente fáceis de interpretar e também não são difíceis de calcular de muitos objetos de modelo ajustados comuns.
Resíduos padronizados podem ser interpretados aproximadamente como observações de uma distribuição normal padrão. Usamos limites convenientes com base na distribuição normal padrão como diretrizes aproximadas para identificar resíduos incomuns. Por exemplo, valores acima de \(\pm\) 2 devem ocorrer apenas para cerca de 5% da amostra quando o modelo está correto, valores acima de \(\pm\) 3 são extremamente raros e valores acima de \(\pm\) 4 não são esperados.
Para EVPs com \(n_m\) pequeno em modelos binomiais, a aproximação normal padrão é ruim e essas diretrizes devem ser vistas como provisórias. Por exemplo, respostas binárias \(n_m = 1\) podem produzir apenas dois valores residuais brutos possíveis, \(0-\widehat{\pi}\) e \(1-\widehat{\pi}\) e, portanto, também apenas dois valores possíveis de Pearson, deviance ou residual padronizado. Essa situação discreta não é bem aproximada por uma distribuição normal, que é referência para variáveis aleatórias contínuas.
De forma mais geral, existem \(n_m + 1\) valores residuais possíveis para um EVP com \(n_m\) tentativas, portanto, com \(n_m\) pequeno não há valores residuais possíveis diferentes o suficiente para permitir uma interpretação significativa. A aproximação normal também pode ser ruim quando \(\widehat{\pi}_m\) está próximo de 0 ou 1. Novamente, esses casos tendem a gerar apenas algumas respostas possíveis, a menos que o número de tentativas seja grande.
Um fenômeno semelhante pode acontecer com modelos de Poisson onde as médias estimadas são muito pequenas, por exemplo \(\widehat{y}_m < 0.5\). Então, a maioria dos \(y_m\) observados são 0 ou 1, com apenas valores maiores ocasionais, de modo que há muito poucos valores residuais possíveis. Surpreendentemente, no entanto, as diretrizes aproximadas ainda são razoavelmente úteis para identificar resíduos extremos, mesmo quando \(\widehat{y}_m\) é um pouco menor que 1. Veja o Exercício 17.
Nos casos em que a aproximação normal não é confiável, parte da interpretação de quaisquer resíduos aparentemente extremos é calcular a probabilidade de tal resíduo extremo, assumindo que a contagem estimada pelo modelo \(\widehat{y}_m\) é o valor esperado correto. Por exemplo, isso significa calcular a probabilidade de uma contagem pelo menos tão extrema quanto o \(y_m\) observado no modelo binomial com \(n_m\) tentativas e probabilidade \(\widehat{\pi}_m\). Um cálculo de probabilidade semelhante deve ser feito para resíduos de Poisson com \(\widehat{y}_m\) pequeno.
Calculando resíduos no R
Muitas funções de ajuste de modelos têm funções de método associadas a elas que podem calcular vários tipos de resíduos para os modelos mostrados nos Capítulos 2–4. Mais notavelmente, a função genérica residuals() tem funções de método que funcionam em objetos de ajuste de modelo produzidos por glm(), vglm(), zeroinfl() e hurdle().
Todas essas funções usam o argumento type para selecionar os tipos de resíduos computados. Pearson ou resíduos brutos são produzidos com os valores de argumento “pearson” ou “resposta”, respectivamente. O método residuals.glm() também possui um valor de argumento “deviance” para produzir resíduos de deviance. Para modelos ajustados com logistf(), atualmente não há funções disponíveis que produzam resíduos úteis automaticamente.
Para esses objetos, um cálculo manual relativamente simples pode criar resíduos de Pearson ou deviance. Resíduos padronizados de Pearson e deviance estão disponíveis para objetos da classe glm usando rstandard(). A padronização dos resíduos para ajustes de outros modelos envolve o cálculo manual da matriz chapéu (hat). A localização dos elementos diagonais da matriz chapéu é auxiliada pelo código para computação de \((X^\top VX)^{-1}\) mostrado em exemplos anteriores, embora nem todos os objetos de ajuste de modelo forneçam prontamente todos os elementos necessários para concluir esses cálculos com facilidade.
Avaliação gráfica de resíduos
A informação contida em um conjunto de resíduos é melhor compreendido em exibições gráficas. A maioria dessas exibições reflete os gráficos residuais usados na regressão linear consulte, por exemplo, Kutner et al. (2004). No entanto, sua interpretação em modelos lineares generalizados pode ser ligeiramente diferente. Em particular, enquanto os gráficos residuais na regressão linear diagnosticam principalmente problemas com o modelo médio e possíveis observações incomuns, nos modelos lineares generalizados os gráficos também podem diagnosticar quando outras suposições do modelo não se ajustam bem aos dados, incluindo a escolha da família da distribuição da resposta. Obviamente, a interpretação de qualquer gráfico residual para um modelo de contagem de dados está sujeita às ressalvas observadas na seção anterior sobre a interpretação de resíduos quando há um número limitado de respostas possíveis.
Um gráfico dos resíduos padronizados contra cada variável explicativa pode mostrar se a forma dessa variável explicativa é apropriada. O gráfico deve mostrar aproximadamente a mesma variância em todo o intervalo da variável explicativa de interesse \(x_j\) e não deve mostrar flutuações sérias no valor médio. A curvatura no gráfico sugere que uma transformação ou termos polinomiais adicionais são necessários para essa variável ou possivelmente que a função de ligação precisa ser alterada. Recomendamos adicionar uma curva suave ao gráfico, como uma suavização loess, representando o resíduo médio no intervalo do eixo \(x\).
Isso torna as mudanças nos resíduos médios mais proeminentes. A curva deve oscilar aleatoriamente em torno de zero quando o modelo é um ajuste razoável. Padrões claros de curvatura, como um “sorriso” ou uma “carranca”, são indicações de um problema. Em modelos binomiais, a curva de loess pode ser ponderada por \(n_m\), de modo que os EVPs baseados em um número maior de tentativas contribuem relativamente mais para a colocação da curva do que aqueles com relativamente poucos. Observe que as curvas de loess são altamente variáveis onde os dados são esparsos ou próximos dos valores extremos da variável no eixo \(x\). Deve-se tomar cuidado para não “interpretar demais” as mudanças aparentes na curva nas bordas do gráfico.
Da mesma forma, um gráfico de resíduos em relação aos valores ajustados \(\widehat{y}\), \(\widehat{\pi}\) em modelos binomiais, é útil para avaliar quando a função de ligação não está se ajustando bem. Os pontos devem novamente ter variância aproximadamente constante e não mostrar nenhuma curvatura clara. Como alternativa, um gráfico dos resíduos em relação ao preditor linear, \(g(\widehat{y})\), pode mostrar padrões de alteração nos resíduos médios com mais clareza e pode ajudar a diagnosticar como a função de ligação \(g(\cdot)\) deve ser alterada para melhor ajustar os dados.
Qualquer um desses gráficos pode ser lido para verificar se há resíduos extremos. Conforme observado acima, apenas cerca de 5% dos resíduos padronizados devem estar além de \(\pm\) 2 e normalmente nenhum deve estar além de \(\pm\) 3. A presença de um ou dois resíduos muito extremos pode indicar outliers, ou seja, observações incomuns que devem ser verificadas quanto a possíveis erros. No entanto, outliers são raros por definição. Se houver vários resíduos cujas magnitudes são maiores do que o esperado e esses valores forem aleatoriamente espalhados pela faixa do eixo \(x\) do gráfico, isso pode ser um sinal de superdispersão, o que significa que há mais variabilidade nas contagens do que o modelo assume que deveria haver. Esta é uma indicação de que pode haver importantes variáveis explicativas faltando no modelo ou que uma distribuição diferente pode ser necessária para modelar os dados. Consulte a Seção 5.3 para obter detalhes sobre a superdispersão.
Uma interpretação ligeiramente diferente se aplica a esses gráficos em modelos binomiais. Hosmer e Lemeshow (2000) mostram que a oportunidade de ocorrência de resíduos extremos é maior em regiões de alta ou baixa probabilidade estimada de sucesso, por exemplo, \(\widehat{\pi} < 0.1\) ou \(\widehat{\pi}> 0.9\). Há duas razões principais para isso. Primeiro, os valores chapéu \(h_m\) tendem a ser maiores para valores mais extremos das variáveis explicativas, para os quais as estimativas de probabilidade de sucesso também podem ser extremas. Em segundo lugar, o maior valor residual bruto possível é \(0-n_m \, \widehat{\pi}\) ou \(n_m - n_m \, \widehat{\pi}_m\) e estes são os maiores se \(\widehat{\pi}_m\) estiver próximo de 0 ou 1. Portanto, parte da interpretação de quaisquer resíduos aparentemente extremos em uma regressão binomial está calculando a probabilidade binomial de que tal valor extremo que \(y_m\) poderia ocorrer em \(n_m\) tentativas com probabilidade \(\widehat{\pi}_m\).
Além disso, quando as contagens de resposta assumem relativamente poucos valores únicos, os gráficos residuais geralmente mostram bandas de pontos de aparência estranha. Como o exemplo mais extremo, considere um gráfico de resíduos brutos contra \(\widehat{\pi}\) em uma regressão logística com respostas binárias. Conforme observado acima, para cada valor de \(\widehat{\pi}\) existem apenas dois resíduos possíveis. O gráfico, portanto, mostrará apenas duas bandas de pontos: uma em \(-\widehat{\pi}\) e a outra em \(1-\widehat{\pi}\). Essa falta de “aleatoriedade” no gráfico é uma indicação de que as contagens de resposta nas quais o modelo se baseia são bastante pequenas e limitadas em alcance. Nesse caso, a normalidade aproximada dos resíduos está em dúvida, enfraquecendo assim o potencial dos gráficos de resíduos para detectar violações das suposições do modelo.
Exemplo 5.7: Placekicking.
Demonstramos a interpretação dos gráficos de resíduos em uma regressão logística usando os dados de placekicking com um modelo contendo apenas a variável distance. A agregação desses dados no formulário EVP para esse modelo foi mostrada na Seção 2.2.1. O ajuste do modelo e as funções que chamam os resíduos são mostrados abaixo, juntamente com o código para criar o gráfico de resíduos de Pearson padronizados contra a variável explanatória.
#####################################################################
# Examine the binomial form of the data and re-fit the model
# Find the observed proportion of successes at each distance
w <- aggregate( good ~ distance, data = placekick, FUN = sum)
n <- aggregate( good ~ distance, data = placekick, FUN = length)
w.n <- data.frame(distance = w$distance, success = w$good, trials = n$good,
prop = round(w$good/n$good,4))
head(w.n)## distance success trials prop
## 1 18 2 3 0.6667
## 2 19 7 7 1.0000
## 3 20 776 789 0.9835
## 4 21 19 20 0.9500
## 5 22 12 14 0.8571
## 6 23 26 27 0.9630tail(w.n)## distance success trials prop
## 38 55 2 3 0.6667
## 39 56 1 1 1.0000
## 40 59 1 1 1.0000
## 41 62 0 1 0.0000
## 42 63 0 1 0.0000
## 43 66 0 1 0.0000mod.fit.bin <- glm(formula = success/trials ~ distance, weights = trials,
family = binomial(link = logit), data = w.n)
summary(mod.fit.bin)##
## Call:
## glm(formula = success/trials ~ distance, family = binomial(link = logit),
## data = w.n, weights = trials)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0373 -0.6449 -0.1424 0.5004 2.2758
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 5.812080 0.326277 17.81 <2e-16 ***
## distance -0.115027 0.008339 -13.79 <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: 282.181 on 42 degrees of freedom
## Residual deviance: 44.499 on 41 degrees of freedom
## AIC: 148.46
##
## Number of Fisher Scoring iterations: 5# Show how to find the hat matrix using matrix algebra
X <- model.matrix(mod.fit.bin)
V <- diag(mod.fit.bin$weights)
# mod.fit.bin$weights[1] # n*hat(pi)*(1-hat(pi))
# w.n$trials[1]*mod.fit.bin$fitted.values[1]*(1-mod.fit.bin$fitted.values[1])
H <- sqrt(V)%*%X%*%solve(t(X)%*%V%*%X)%*%t(X)%*%sqrt(V)
head(diag(H))## [1] 0.002387198 0.005747539 0.666705043 0.017346106 0.012429654 0.024474806head(hatvalues(mod.fit.bin)) # Matches## 1 2 3 4 5 6
## 0.002387198 0.005747539 0.666705043 0.017346106 0.012429654 0.024474806Observe o uso de loess() para criar um objeto cujos valores previstos adicionam a tendência suave para o resíduo médio. O valor do argumento weights = trials faz com que loess() use o número de tentativas no EVP - denotado no quadro de dados w.n como trials - para ponderar a tendência média. Assim, EVPs com muitas tentativas (trials) influenciam mais a curva de tendência do que aquelas com menos.
#####################################################################
# Create plot with fit overlaid onto confidence intervals for each distance
pi.hat <- predict(mod.fit.bin, type = "response")
p.res <- residuals(mod.fit.bin, type = "pearson")
s.res <- rstandard(mod.fit.bin, type = "pearson")
lin.pred <- mod.fit.bin$linear.predictors
w.n <- data.frame(w.n, pi.hat, p.res, s.res, lin.pred)
round(head(w.n), digits = 3)## distance success trials prop pi.hat p.res s.res lin.pred
## 1 18 2 3 0.667 0.977 -3.571 -3.575 3.742
## 2 19 7 7 1.000 0.974 0.432 0.433 3.627
## 3 20 776 789 0.984 0.971 2.094 3.628 3.512
## 4 21 19 20 0.950 0.968 -0.444 -0.448 3.397
## 5 22 12 14 0.857 0.964 -2.136 -2.149 3.281
## 6 23 26 27 0.963 0.960 0.090 0.091 3.166library(package = binom)
wilson <- matrix(NA, nrow = nrow(w.n), ncol = 2)
for(i in c(1:nrow(w.n))){
wil.i <- binom.confint(x = w.n$success[i], n = w.n$trials[i], conf.level = .95, methods = "wilson")[c(5,6)]
wilson[i,] <- as.matrix(wil.i, nrow = 1)
}
# Overlay estimated curve onto plot with points and 95% confidence limits.
col.miss <- ifelse((wilson[,1] < w.n$pi.hat) & (w.n$pi.hat < wilson[,2]), yes = "black", no = "red")
plot(x = w.n$distance, y = w.n$prop, xlab = "Distance", ylab = "Estimated probability of Success",
col = col.miss, main = "Plot of estimated fit and observed proportions with 95% Wilson CI")
# Put estimated logistic regression model on the plot
curve(expr = predict(object = mod.fit.bin, newdata = data.frame(distance = x), type = "response"),
col = "blue", add = TRUE, xlim = c(18, 66))
segments(x0 = w.n$distance, y0 = wilson[,1], y1 = wilson[,2], lty = "dotted", col = col.miss)
grid()
Observa-se nos gráficos da figura abaixo que como distance é a única variável no modelo e tem um coeficiente negativo, o gráfico dos resíduos em relação ao preditor linear é apenas uma imagem espelhada do gráfico em relação à distance. Todos os três gráficos mostram as mesmas características gerais.
Primeiro, observe a tendência geral de aumentar a variabilidade conforme \(\widehat{\pi}\) se aproxima de 1, o que é mais evidente no gráfico central. Isso é esperado até certo ponto, mesmo quando o modelo se ajusta bem. Em seguida, há dois resíduos muito extremos, magnitudes acima de 3 e ambos ocorrem para distâncias muito pequenas. Se esses EVPs contêm erros ou têm alguma outra explicação, não fica claro apenas no gráfico. Esses dois pontos precisam ser melhor investigados.
Além disso, existem 6 resíduos com magnitudes de 2 ou mais, o que é um pouco mais do que os 5% que esperaríamos ver em uma amostra de 43 observações de uma distribuição normal padrão. Estes ocorrem principalmente para pequenas distâncias e quatro desses cinco são negativos. Uma possível explicação poderia ser que o valor positivo extremo é um outlier de algum tipo ou seja, um caso especial, caso em que os resíduos remanescentes seguem um padrão crescente geral, que desapareceria ao reajustar os dados com o valor questionável removido ou fixo.
Finalmente, a forma da curva de loess é interessante. Sugere que os resíduos para distâncias longas, probabilidades mais baixas, tendem a ser positivos, enquanto os resíduos para distâncias mais curtas tendem a ser negativos, exceto por um ponto claro com um grande resíduo positivo. No entanto, não levamos essa curva muito a sério até determinarmos a causa dos dois resíduos extremos. Se nada sobre eles for considerado incomum, isso pode sugerir que a forma de distance no modelo ou a função de ligação pode estar errada.
####################################################################
# Residual plots
par(mfrow = c(1,3))
# Standardized Pearson residual vs X plot
plot(x = w.n$distance, y = w.n$s.res, xlab = "Distance", ylab = "Standardized Pearson residuals",
main = "Standardized residuals vs. \n X")
abline(h = c(3, 2, 0, -2, -3), lty = "dotted", col = "blue")
smooth.stand <- loess(formula = s.res ~ distance, data = w.n, weights = trials)
# Make sure that loess estimates are ordered by "X" for the plots, so that they are displayed properly
order.dist <- order(w.n$distance)
lines(x = w.n$distance[order.dist], y = predict(smooth.stand)[order.dist],
lty = "solid", col = "red", lwd = 1)
# Standardized Pearson residual vs pi plot
plot(x = w.n$pi.hat, y = w.n$s.res, xlab = "Estimated probability of success",
ylab = "Standardized Pearson residuals", main = "Standardized residuals vs. \n pi.hat")
abline(h = c(3, 2, 0, -2, -3), lty = "dotted", col = "blue")
smooth.stand <- loess(formula = s.res ~ pi.hat, data = w.n, weights = trials)
# Make sure that loess estimates are ordered by "X" for the plots, so that they are displayed properly
order.pi.hat <- order(w.n$pi.hat)
lines(x = w.n$pi.hat[order.pi.hat], y = predict(smooth.stand)[order.pi.hat],
lty = "solid", col = "red", lwd = 1)
# Standardized Pearson residual vs linear predictor plot
plot(x = w.n$lin.pred, y = w.n$s.res, xlab = "Linear predictor", ylab = "Standardized Pearson residuals",
main = "Standardized residuals vs. \n Linear predictor")
abline(h = c(3, 2, 0, -2, -3), lty = "dotted", col = "blue")
smooth.stand <- loess(formula = s.res ~ lin.pred, data = w.n, weights = trials)
# Make sure that loess estimates are ordered by "X" for the plots, so that they are displayed properly
order.lin.pred <- order(w.n$lin.pred)
lines(x = w.n$lin.pred[order.lin.pred], y = predict(smooth.stand)[order.lin.pred],
lty = "solid", col = "red", lwd = 1)
Figura 5.3: Gráficos de resíduos para modelagem da
probabilidade de sucesso versus distância.
Os dois residuais mais extremos são vistos nos EVP’s 1 e 3 na saída, nas distâncias de 18 e 20 jardas. O resíduo extremo em 18 jardas é causado pela observação de apenas 2 sucessos em 3 tentativas, quando a probabilidade de sucesso é estimada em 0.977. Os limites em 2 e 3 mostrados no gráfico não são muito precisos para tão poucas tentativas. Na verdade, podemos calcular facilmente que a probabilidade é de 0.067 de observar apenas dois sucessos em três tentativas, quando a verdadeira probabilidade de sucesso é de 0.977, conforme previsto pelo modelo. A probabilidade de 0.067 é calculada a partir de \[ \mbox{pbinom(q = 2, size = 3, prob = 0.977)}\cdot \]
Portanto, esse resíduo não é realmente tão extremo quanto parece com base em sua posição em relação aos limites. Por outro lado, o outro resíduo extremo ocorre nas 20 jardas, onde há 789 tentativas e mais acertos observados do que o esperado. Na maioria dos casos, um placekick de 20 jardas ocorre como um ponto após touchdown (PAT).
Ao contrário das cestas de campo comuns, esses chutes são colocados exatamente na frente do centro das traves, criando o maior ângulo possível para um chute bem-sucedido e valem apenas um ponto em vez de três. Pode ser possível que esses chutes tenham uma probabilidade maior de sucesso do que seria esperado para uma cesta de campo comum a uma distância comparável. Talvez o modelo possa ser melhorado adicionando uma variável que permita que os PATs tenham uma probabilidade de sucesso diferente de outros placekicks. Exploraremos essa possibilidade em outro exemplo na Seção 5.4.1
# Single R file that contains all three goodness-of fit tests
# Adapted from program published by Ken Kleinman as Exmaple 8.8 on the SAS and R blog,
# sas-and-r.blogspot.ca
# Assumes data are aggregated into Explanatory Variable Pattern form.
HLTest = function(obj, g) {
# first, check to see if we fed in the right kind of object
stopifnot(family(obj)$family == "binomial" && family(obj)$link == "logit")
y = obj$model[[1]]
trials = rep(1, times = nrow(obj$model))
if(any(colnames(obj$model) == "(weights)"))
trials <- obj$model[[ncol(obj$model)]]
# the double bracket (above) gets the index of items within an object
if (is.factor(y))
y = as.numeric(y) == 2 # Converts 1-2 factor levels to logical 0/1 values
yhat = obj$fitted.values
# Creates factor with levels 1,2,...,g
interval = cut(yhat, quantile(yhat, 0:g/g), include.lowest = TRUE)
Y1 <- trials*y
Y0 <- trials - Y1
Y1hat <- trials*yhat
Y0hat <- trials - Y1hat
obs = xtabs(formula = cbind(Y0, Y1) ~ interval)
expect = xtabs(formula = cbind(Y0hat, Y1hat) ~ interval)
if (any(expect < 5))
warning("Some expected counts are less than 5. Use smaller number of groups")
pear <- (obs - expect)/sqrt(expect)
chisq = sum(pear^2)
P = 1 - pchisq(chisq, g - 2)
# by returning an object of class "htest", the function will perform like the
# built-in hypothesis tests
return(structure(list(
method = c(paste("Hosmer and Lemeshow goodness-of-fit test with", g, "bins", sep = " ")),
data.name = deparse(substitute(obj)),
statistic = c(X2 = chisq),
parameter = c(df = g-2),
p.value = P,
pear.resid = pear,
expect = expect,
observed = obs
), class = 'htest'))
}
# Osius-Rojek test
# Based on description in Hosmer and Lemeshow (2000) p. 153.
# Assumes data are aggregated into Explanatory Variable Pattern form.
o.r.test = function(obj) {
# first, check to see if we fed in the right kind of object
stopifnot(family(obj)$family == "binomial" && family(obj)$link == "logit")
mf <- obj$model
trials = rep(1, times = nrow(mf))
if(any(colnames(mf) == "(weights)"))
trials <- mf[[ncol(mf)]]
prop = mf[[1]]
# the double bracket (above) gets the index of items within an object
if (is.factor(prop))
prop = as.numeric(prop) == 2 # Converts 1-2 factor levels to logical 0/1 values
pi.hat = obj$fitted.values
y <- trials*prop
yhat <- trials*pi.hat
nu <- yhat*(1-pi.hat)
pearson <- sum((y - yhat)^2/nu)
c = (1 - 2*pi.hat)/nu
exclude <- c(1,which(colnames(mf) == "(weights)"))
vars <- data.frame(c,mf[,-exclude])
wlr <- lm(formula = c ~ ., weights = nu, data = vars)
rss <- sum(nu*residuals(wlr)^2 )
J <- nrow(mf)
A <- 2*(J - sum(1/trials))
z <- (pearson - (J - ncol(vars) - 1))/sqrt(A + rss)
p.value <- 2*(1 - pnorm(abs(z)))
cat("z = ", z, "with p-value = ", p.value, "\n")
}
# Stukel Test
# Based on description in Hosmer and Lemeshow (2000) p. 155.
# Assumes data are aggregated into Explanatory Variable Pattern form.
stukel.test = function(obj) {
# first, check to see if we fed in the right kind of object
stopifnot(family(obj)$family == "binomial" && family(obj)$link == "logit")
high.prob <- (obj$fitted.values >= 0.5)
logit2 <- obj$linear.predictors^2
z1 = 0.5*logit2*high.prob
z2 = 0.5*logit2*(1-high.prob)
mf <- obj$model
trials = rep(1, times = nrow(mf))
if(any(colnames(mf) == "(weights)"))
trials <- mf[[ncol(mf)]]
prop = mf[[1]]
# the double bracket (above) gets the index of items within an object
if (is.factor(prop))
prop = (as.numeric(prop) == 2) # Converts 1-2 factor levels to logical 0/1 values
pi.hat = obj$fitted.values
y <- trials*prop
exclude <- which(colnames(mf) == "(weights)")
vars <- data.frame(z1, z2, y, mf[,-c(1,exclude)])
full <- glm(formula = y/trials ~ ., family = binomial(link = logit),
weights = trials, data = vars)
null <- glm(formula = y/trials ~ ., family = binomial(link = logit),
weights = trials, data = vars[,-c(1,2)])
LRT <- anova(null,full)
p.value <- 1 - pchisq(LRT$Deviance[[2]], LRT$Df[[2]])
cat("Stukel Test Stat = ", LRT$Deviance[[2]], "with p-value = ", p.value, "\n")
}##############################################################
# Goodness-of-Fit Tests
#
# First the Deviance/DF
rdev <- mod.fit.bin$deviance
dfr <- mod.fit.bin$df.residual
ddf <- rdev/dfr
thresh2 <- 1 + 2*sqrt(2/dfr)
thresh3 <- 1 + 3*sqrt(2/dfr)
c(rdev, dfr, ddf, thresh2, thresh3)## [1] 44.499448 41.000000 1.085352 1.441726 1.662589sum(p.res^2)## [1] 56.11361#
# Three goodness-of-fit tests are shown below: Hosmer and Lemeshow, Osius-Rojek, and Stukel.
# Each is contained in a separate function that assumes that a glm-class object
# has been created for the logistic regression. These functions are wrapped up into one
# function, AllGOFTests.R, that must be sourced. All expect the model fit from glm to
# be in EVP form (there is no internal aggregation in the functions). Also, the
# OsiusRojek and Stukel expect that all interactions are actually listed as named
# individual variables (i.e. that they are included in the model as cross-product
# variables, like "X1:X2", rather than implicit interactions of other variables in the model.
HL <- HLTest(obj = mod.fit.bin, g = 10)
# Print out observed and expected counts in bins
cbind(HL$observed, round(HL$expect, digits = 1))## Y0 Y1 Y0hat Y1hat
## [0.144,0.353] 3 2 3.8 1.2
## (0.353,0.469] 19 13 18.3 13.7
## (0.469,0.589] 25 39 30.1 33.9
## (0.589,0.699] 24 49 26.4 46.6
## (0.699,0.79] 32 74 26.6 79.4
## (0.79,0.859] 18 75 15.9 77.1
## (0.859,0.908] 12 69 9.2 71.8
## (0.908,0.941] 10 72 5.9 76.1
## (0.941,0.963] 3 53 2.6 53.4
## (0.963,0.977] 17 816 24.3 808.7HL##
## Hosmer and Lemeshow goodness-of-fit test with 10 bins
##
## data: mod.fit.bin
## X2 = 11.028, df = 8, p-value = 0.2001# Pearson residuals for each group
round(HL$pear, digits = 1) ##
## interval Y0 Y1
## [0.144,0.353] -0.4 0.8
## (0.353,0.469] 0.2 -0.2
## (0.469,0.589] -0.9 0.9
## (0.589,0.699] -0.5 0.4
## (0.699,0.79] 1.0 -0.6
## (0.79,0.859] 0.5 -0.2
## (0.859,0.908] 0.9 -0.3
## (0.908,0.941] 1.7 -0.5
## (0.941,0.963] 0.3 -0.1
## (0.963,0.977] -1.5 0.3o.r.test(obj = mod.fit.bin)## z = 1.563042 with p-value = 0.1180426stukel.test(obj = mod.fit.bin)## Stukel Test Stat = 6.977164 with p-value = 0.03054416glmInflDiag <- function(mod.fit, print.output = TRUE, which.plots = c(1,2)){
# Which set of plots to show
show <- rep(FALSE, 2) # Idea from plot.lm()
show[which.plots] <- TRUE
# Main quantities: Pearson and deviance residual, model Pearson and deviance stats
pear <- residuals(mod.fit, type = "pearson")
dres <- residuals(mod.fit, type = "deviance")
x2 <- sum(pear^2)
N <- length(pear)
P <- length(coef(mod.fit))
# Hat values (leverages)
hii <- hatvalues(mod.fit)
# Computed quantities: Standardized Pearson residual, Delta-beta, Delta-deviance
sres <- pear/sqrt(1-hii)
# D.beta <- (pear^2*hii/(1-hii)^2)
# cookD <- D.beta / (P * summary(mod.fit)$dispersion)
cookD <- pear^2 * hii / ((1-hii)^2 * (P) * summary(mod.fit)$dispersion)
D.dev2 <- dres^2 + hii*sres^2
D.X2 <- sres^2
yhat <- fitted(mod.fit)
# Plots against fitted values
if(show[1] == TRUE) {
# x11(height = 7,width = 15, pointsize = 15)
par(mfrow = c(1,4), lty = "dotted")
plot(x = yhat, y = hii, xlab = "Estimated Mean or Probability",
ylab = "Hat (leverage) value",
ylim = c(0, max(hii,3*P/N)))
abline(h = c(2*P/N,3*P/N))
plot(x = yhat, y = D.X2, xlab = "Estimated Mean or Probability",
ylab = "Approx change in Pearson stat",
ylim = c(0, max(D.X2,9)))
abline(h = c(4,9), lty = "dotted")
plot(x = yhat, y = D.dev2, xlab = "Estimated Mean or Probability",
ylab = "Approx change in deviance",
ylim = c(0, max(D.dev2,9)))
abline(h = c(4,9), lty = "dotted")
plot(x = yhat, y = cookD, xlab = "Estimated Mean or Probability",
ylab = "Approx Cook's Distance",
ylim = c(0, max(cookD, 1)))
abline(h = c(4/N,1), lty = "dotted")
}
# Plots against hat values
if(show[2] == TRUE) {
# x11(height = 6, width = 12, pointsize = 20)
par(mfrow = c(1,3))
plot(x = hii, y = D.X2, xlab = "Hat (leverage) value",
ylab = "Approx change in Pearson stat", ylim = c(0, max(D.X2, 9)),
xlim = c(0, max(hii,3*P/N)))
abline(h = c(4,9), lty = "dotted")
abline(v = c(2*P/N,3*P/N), lty = "dotted")
plot(x = hii, y = D.dev2, xlab = "Hat (leverage) value",
ylab = "Approx change in deviance", ylim = c(0, max(D.dev2,9)),
xlim = c(0, max(hii,3*P/N)))
abline(h = c(4,9), lty = "dotted")
abline(v = c(2*P/N,3*P/N), lty = "dotted")
plot(x = hii, y = cookD, xlab = "Hat (leverage) value",
ylab = "Approx Cook's Distance", ylim = c(0, max(cookD, 1)),
xlim = c(0, max(hii,3*P/N)))
abline(h = c(4/N,1), lty = "dotted")
abline(v = c(2*P/N,3*P/N), lty = "dotted")
}
# Listing of values to check
# Create flags to identify high values in listing
hflag <- ifelse(test = hii > 3*P/N, yes = "**", no =
ifelse(test = hii > 2*P/N, yes = "*", no = ""))
xflag <- ifelse(test = D.X2 > 9, yes = "**", no =
ifelse(test = D.X2 > 4, yes = "*", no = ""))
dflag <- ifelse(test = D.dev2 > 9, yes = "**", no =
ifelse(test = D.dev2 > 4, yes = "*", no = ""))
cflag <- ifelse(test = cookD > 1, yes = "**", no =
ifelse(test = cookD > 4/N, yes = "*", no = ""))
chk.hii2 <- which(hii > 3*P/N)
chk.DX22 <- which(D.X2 > 9 | (D.X2 > 4 & hii > 2*P/N))
chk.Ddev2 <- which(D.dev2 > 9 | (D.dev2 > 4 & hii > 2*P/N))
chk.cook2 <- which(cookD > 4/N)
all.meas <- data.frame(h = round(hii,2), hflag, Del.X2 = round(D.X2,2), xflag,
Del.dev = round(D.dev2,2), dflag, Cooks.D = round(cookD,3), cflag)
if(print.output == TRUE) {
cat("Potentially influential observations by any measures","\n")
print(all.meas[sort(unique(c(chk.hii2, chk.DX22, chk.Ddev2, chk.cook2))),])
cat("\n","Data for potentially influential observations","\n")
print(cbind(mod.fit$data, yhat = round(yhat, 3))[sort(unique(c(chk.hii2, chk.DX22, chk.Ddev2, chk.cook2))),])
}
data.frame(hat = hii, CD = cookD, delta.Xsq = D.X2, delta.D = D.dev2)
}
###################################################################
# Influence analysis
# Using our glmInflDiag(mod.fit) function contained in the glmDiagnostics.R program
# Assuming it resides in current working directory; otherwise add path
save.diag <- glmInflDiag(mod.fit = mod.fit.bin, print.output = TRUE, which.plots = c(1,2))
## Potentially influential observations by any measures
## h hflag Del.X2 xflag Del.dev dflag Cooks.D cflag
## 1 0.00 12.78 ** 3.84 0.015
## 3 0.67 ** 13.16 ** 13.95 ** 13.163 **
## 34 0.08 3.98 4.11 * 0.174 *
##
## Data for potentially influential observations
## distance success trials prop yhat
## 1 18 2 3 0.6667 0.977
## 3 20 776 789 0.9835 0.971
## 34 51 11 15 0.7333 0.486round(head(save.diag, n = 3), digits = 2)## hat CD delta.Xsq delta.D
## 1 0.00 0.02 12.78 3.84
## 2 0.01 0.00 0.19 0.37
## 3 0.67 13.16 13.16 13.95names(save.diag)## [1] "hat" "CD" "delta.Xsq" "delta.D"s.res[c(1:3, 34)] # Standardized residuals## 1 2 3 34
## -3.575463 0.432813 3.627780 1.9952155.2.2 Adequação do ajuste
Examinar os gráficos de resíduos é essencial para entender os problemas com o ajuste de qualquer modelo linear generalizado, mas a interpretação desses gráficos é um tanto subjetiva. Estatísticas de qualidade de ajuste (GOF) são frequentemente calculadas como medidas mais objetivas do ajuste geral de um modelo. Embora essas estatísticas sejam úteis, elas tendem a fornecer poucas informações sobre a causa de qualquer ajuste inadequado que possam detectar. Portanto, recomendamos enfaticamente que essas estatísticas sejam usadas como um complemento para a interpretação dos gráficos de resíduos, em vez de substituí-los.
A avaliação estatística do ajuste de um GLM geralmente começa com a observação do desvio ou deviance residual e das estatísticas de Pearson para o modelo. O deviance residual, que podemos denotar aqui por \(D\), é uma comparação das contagens estimadas pelo modelo com as contagens observadas e tem uma forma que varia dependendo da distribuição usada como modelo. A estatística de Pearson tem uma forma mais genérica, mas também pode ser calculada de várias maneiras diferentes, dependendo da distribuição que está sendo modelada. Para distribuições com uma resposta univariada, como Poisson ou binomial, a estatística de Pearson é calculada como \[ X^2=\sum_{m=1}^M \epsilon_m^2 = \sum_{m=1}^M \dfrac{(y_m -\widehat{y}_m)^2}{\widehat{\mbox{Var}}(y_m)}\cdot \]
Por exemplo, \(\widehat{\mbox{Var}}(y_m)=\widehat{y}_m\) para o modelo Poisson e \(\widehat{\mbox{Var}}(y_m)=n_m \, \widehat{\pi}_m(1-\widehat{\pi}_m)\) para o modelo binomial. Para modelos binomiais, às vezes é mais conveniente usar uma forma equivalente da estatística com base nas contagens de sucesso e falha, \[ X^2=\sum_{m=1}^M \dfrac{(y_m -\widehat{y}_m)^2}{\widehat{y}_m}+\sum_{m=1}^M \dfrac{\big((n_m-y_m)-(n_m-\widehat{y}_m)\big)^2}{n_m-\widehat{y}_m}\cdot \]
Tanto \(D\) quanto \(X^2\) são medidas resumidas da distância entre as estimativas baseadas em modelo e os dados observados. Como tal, eles são frequentemente usados em testes formais de adequação, o que significa testar a hipótese nula de que o modelo está correto contra a alternativa de que não está. Claro, o modelo nunca é realmente considerado “correto” porque nunca aceitamos formalmente a hipótese nula. Se o nulo não for rejeitado, simplesmente concluímos que o modelo é um ajuste “razoável” aos dados.
Ambas as estatísticas têm distribuições de \(\chi^2_{M-\widetilde{p}}\) para amostras grandes, onde \(\widetilde{p}\) é o número total de parâmetros de regressão estimados no modelo. No entanto, esse resultado é válido apenas sob a suposição de que o conjunto de EVPs nos dados é fixo e não mudaria com amostragem adicional. Isso é verdade se, por exemplo, todas as variáveis explicativas forem categóricas e todas as categorias possíveis já tiverem sido observadas ou se os valores numéricos forem fixados pelo projeto de um experimento.
No entanto, na maioria dos casos com variáveis explicativas contínuas, uma amostragem adicional certamente produziria novos EVPs e, portanto, as distribuições de \(D\) e \(X^2\) podem não ser bem aproximadas por uma distribuição de \(\chi^2_{M-\widetilde{p}}\) mesmo se o modelo estiver correto. Além disso, a aproximação de \(\chi^2_{M-\widetilde{p}}\) mantém-se razoavelmente bem apenas se todas as contagens previstas \(\widehat{y}\) e \(n_m-\widehat{y}_m\) em modelos binomiais forem grandes o suficiente, por exemplo, todas são pelo menos 1 e muitas são pelo menos 5.
Assim, os modelos nos quais essas estatísticas podem ser usadas em testes formais são limitados principalmente àqueles com apenas preditores categóricos e não muitos deles, de modo que todas as combinações tenham contagens estimadas razoavelmente altas.
Como uma alternativa informal ao teste de hipótese formal é comum calcular a razão entre a deviance residual e os graus de liberdade residuais, que denotamos no texto como “deviance/df” ou simbolicamente por \(D/(M-\widetilde{p})\). Como o valor esperado da variável aleatória \(\chi^2_{M-\widetilde{p}}\) é \(M-\widetilde{p}\), podemos esperar que essa razão não esteja muito longe de 1 quando o modelo estiver correto. Não há diretrizes claras sobre quão longe é “longe demais”, em parte devido à incerteza em torno de se a distribuição de \(\chi^2_{M-\widetilde{p}}\) é uma aproximação razoável da distribuição de \(D\). Quando é e quando \(M-\widetilde{p}\) não é pequeno, então os valores de \(D\) que são mais do que, digamos, dois ou três desvios padrão acima do valor esperado seriam incomuns quando o modelo está correto. À medida que \(\nu\) aumenta, \(\chi^2_{\nu}\) se comporta cada vez mais como uma distribuição normal com média \(\nu\) e variância \(2\nu\).
Como a variância de uma variável aleatória qui-quadrada é o dobro de seus graus de liberdade, isso sugere uma diretriz aproximada de \[ D/(M-\widetilde{p}) > 1+2\sqrt{2/(M-\widetilde{p})}, \] para indicar um problema potencial, e \[ D/(M-\widetilde{p}) > 1+3\sqrt{2/(M-\widetilde{p})} \] para indicar um ajuste ruim. Não pretendemos que esses limites sejam considerados regras rígidas, mas sim fornecer ao usuário uma maneira de reduzir a subjetividade na interpretação dessa estatística.
Testes de bondade de ajuste
Existem vários testes GOF, Goodness-of-fit tests ou testes de bondade de ajuste, alternativos que podem ser usados mesmo quando o número de EVPs pode aumentar com amostragem adicional. Estes são especialmente comuns na regressão logística, mas também podem ser usadas variantes deles em outros modelos de regressão. O Capítulo 5 de Hosmer and Lemeshow (2000) fornece uma discussão muito boa sobre esses testes para a regressão logística. Resumimos sua discussão e fornecemos nossa própria visão.
O teste GOF mais conhecido para EVPs com variáveis contínuas é o teste de Hosmer and Lemeshow para a regressão logística (Hosmer and Lemeshow, 1980). A ideia é agregar observações semelhantes em grupos que tenham amostras grandes o suficiente para que uma estatística de Pearson calculada nas contagens observadas e previstas dos grupos tenha aproximadamente uma distribuição qui-quadrada.
Como exemplo, considere uma única variável explicativa, como distância nos dados de placekicking. Podemos esperar que os placekicks de distâncias semelhantes tenham probabilidades de sucesso semelhantes o suficiente para que seus sucessos e falhas observados possam ser agrupados em um único par de contagens. Isso pode ser feito antes de ajustar um modelo, ou seja, “combinar” os dados em intervalos; mas isso às vezes pode criar um ajuste de aparência ruim de um bom modelo. Em vez disso, Hosmer and Lemeshow sugeriram ajustar o modelo aos dados primeiro e, em seguida, formar \(g\) grupos de EVPs “semelhantes” de acordo com suas probabilidades estimadas.
As contagens agregadas de sucessos e falhas dentro de cada grupo são então combinadas com as contagens agregadas estimadas pelo modelo dentro do mesmo grupo em uma estatística de Pearson conforme mostrado na equação \[ X^2=\sum_{m=1}^g \dfrac{(y_m -\widehat{y}_m)^2}{\widehat{y}_m}+\sum_{m=1}^M \dfrac{\big((n_m-y_m)-(n_m-\widehat{y}_m)\big)^2}{n_m-\widehat{y}_m}, \] somando os sucessos e falhas para os \(g\) grupos. A estatística de teste, \(X^2_{HL}\) é comparada a uma distribuição \(\chi^2_{g -2}\).
Deixar de rejeitar a hipótese nula de um bom ajuste não significa que o ajuste seja, de fato, bom. O poder do teste pode ser afetado pelo tamanho da amostra e o processo de agregação às vezes pode mascarar problemas potenciais. Por exemplo, um grande valor atípico positivo e um grande valor atípico negativo no mesmo grupo se “cancelarão”, resultando em um valor menor de \(X^2_{HL}\) do que algum outro agrupamento poderia ter criado. Isso aponta para outra dificuldade com o teste: existem inúmeras maneiras de formar o grupo de EVPs semelhantes e o resultado do teste pode depender do padrão de agrupamento escolhido.
Na implementação mais comum do teste, as probabilidades estimadas pelo modelo são divididas em \(g = 10\) grupos de tamanho aproximadamente igual com base nos 10° percentis dos valores de \(\widehat{\pi}\). No entanto, existem várias maneiras de fazer isso, por exemplo, tornando a contagem de EVPs em cada grupo aproximadamente constante ou tornando o número de tentativas em cada grupo aproximadamente constante e isso pode fornecer agrupamentos diferentes quando alguns EVPs têm várias tentativas. Os resultados dos testes podem variar de acordo com o agrupamento e nenhum algoritmo é claramente melhor do que outros. Portanto, é uma boa ideia tentar vários agrupamentos, por exemplo, definindo \(g\) como vários valores diferentes, se o tamanho da amostra permitir e garantir que os resultados do teste dos vários agrupamentos estejam em concordância substantiva antes de tirar conclusões desse teste.
Em geral, quanto mais grupos forem usados, menor a chance de EVPs muito diferentes serem agrupados, portanto, o teste pode ser mais sensível a ajustes ruins. No entanto, também é importante que as contagens esperadas, ou seja, sucessos e falhas previstos agregados do modelo sejam grandes o suficiente para justificar o uso da aproximação qui-quadrado em amostras grandes.
Hosmer et al. (1997) comparam vários testes GOF para regressão logística e recomendam dois outros testes que podem ser usados além do teste de Hosmer-Lemeshow. O primeiro deles é o teste Osius-Rojek, baseado na estatística Pearson GOF do modelo original. Osius and Rojek (1992) derivaram a média e a variância de uma grande amostra para \(X^2\) de tal forma que permite que o número de categorias amostradas cresça à medida que o tamanho da amostra cresce, permitindo que seja usado como uma estatística de teste mesmo quando há variáveis explicativas contínuas. Em seguida, uma versão padronizada de \(X^2\) é comparada com uma distribuição normal padrão, com valores extremos representando evidências de que o modelo ajustado não está correto.
Um segundo teste é o teste de Stukel (Stukel, 1988), que se baseia em um modelo de regressão logística expandida que permite que as metades superior e inferior das curvas logísticas difiram em forma. Duas variáveis explicativas adicionais são calculadas a partir dos logitos do ajuste do modelo original e são adicionadas ao modelo original. Um teste da hipótese nula de que seus coeficientes de regressão são zero indica se a forma do modelo original é adequada, o que está implícito na hipótese nula ou se pode ser necessária uma ligação diferente ou uma transformação de variáveis contínuas. Deixamos de lado os detalhes de cálculo aqui e orientamos os leitores interessados a consultarem Hosmer et al. (1997) e ao nosso código R descrito no exemplo abaixo.
Exemplo 5.8: Placekicking.
Nenhum dos testes Hosmer-Lemeshow, Osius-Rojek ou Stukel está incluído na distribuição padrão do R, então utilizaremos funções para realizá-los mostradas no Exemplo 5.7. Em todas as três funções, o argumento obj é um ajuste de objeto glm usando family = binomial.
HL = HLTest ( obj = mod.fit.bin , g = 10)
HL##
## Hosmer and Lemeshow goodness-of-fit test with 10 bins
##
## data: mod.fit.bin
## X2 = 11.028, df = 8, p-value = 0.2001A função HLTest() inclui um argumento adicional para \(g\), que é definido como \(g = 10\) por padrão. Para cada função, a estatística de teste e o \(p\)-valor são produzidos. Para o teste de Hosmer-Lemeshow, os resíduos de Pearson nos quais a estatística de Pearson do teste se baseia estão disponíveis para exame, assim como as contagens observadas e esperadas em cada grupo. Executamos este teste aqui usando \(g = 10\).
cbind ( HL$observed , round ( HL$expect , digits = 1))## Y0 Y1 Y0hat Y1hat
## [0.144,0.353] 3 2 3.8 1.2
## (0.353,0.469] 19 13 18.3 13.7
## (0.469,0.589] 25 39 30.1 33.9
## (0.589,0.699] 24 49 26.4 46.6
## (0.699,0.79] 32 74 26.6 79.4
## (0.79,0.859] 18 75 15.9 77.1
## (0.859,0.908] 12 69 9.2 71.8
## (0.908,0.941] 10 72 5.9 76.1
## (0.941,0.963] 3 53 2.6 53.4
## (0.963,0.977] 17 816 24.3 808.7round ( HL$pear , digits = 1) # Pearson residuals for each group##
## interval Y0 Y1
## [0.144,0.353] -0.4 0.8
## (0.353,0.469] 0.2 -0.2
## (0.469,0.589] -0.9 0.9
## (0.589,0.699] -0.5 0.4
## (0.699,0.79] 1.0 -0.6
## (0.79,0.859] 0.5 -0.2
## (0.859,0.908] 0.9 -0.3
## (0.908,0.941] 1.7 -0.5
## (0.941,0.963] 0.3 -0.1
## (0.963,0.977] -1.5 0.3o.r.test (obj = mod.fit.bin)## z = 1.563042 with p-value = 0.1180426stukel.test (obj = mod.fit.bin )## Stukel Test Stat = 6.977164 with p-value = 0.03054416A função de teste Hosmer-Lemeshow relata primeiro um aviso de que algumas contagens esperadas são menores que 5 para as células da tabela \(10\times 2\) de contagens esperadas para os grupos. Imprimimos os sucessos e falhas observados; rotulados Y1 e Y0, respectivamente e o número esperado estimado de sucessos e falhas, Y1hat e Y0hat, respectivamente em cada grupo.
Por exemplo, entre todos os \(\widehat{\pi}\) no intervalo [0.144, 0.353] existem apenas 5 observações, cujas contagens esperadas são divididas em 3.8 falhas e 1.2 sucessos de acordo com o modelo ajustado. Além disso, o intervalo (0.941,0.963] tem apenas 2.6 falhas esperadas estimadas. Essas contagens esperadas não são drasticamente baixas, por exemplo, abaixo de 1 e não há muitas delas, apenas 15% das células, portanto, a aproximação \(\chi_8^2\) pode não ser tão ruim aqui.
Colchetes, “[“ ou “]”, indicam que o ponto final do intervalo correspondente está incluído no intervalo, enquanto parênteses redondos, “(“ ou “)”, indicam que o ponto final do intervalo correspondente não está nesse intervalo. Por exemplo, o intervalo (0.353,0.469] inclui todos os valores de \(\widehat{\pi}\) tais que 0.353 <\(\widehat{\pi}\leq\) 0.469. Usando essa notação, não há ambiguidade em relação a qual intervalo contém os pontos finais.
A estatística do teste é \(X^2_{HL} = 11.0\) com um \(p\)-valor de 0.20, o que sugere que o ajuste não é ruim. No entanto, os resíduos de Pearson para as contagens agrupadas mostram um padrão potencial nos sinais. Em cada linha, deve haver um resíduo positivo e um negativo e estes devem, idealmente, ter a mesma probabilidade de ocorrer com qualquer uma das respostas.
Observe que cinco intervalos seguidos têm o mesmo padrão de resíduo positivo para a resposta \(Y = 0\). Embora nenhum desses valores seja grande, por exemplo, nenhum maior que 2 o padrão sugere potencial para um problema específico de superestimar a verdadeira probabilidade de sucesso quando a probabilidade é grande. Já vimos evidências disso nos gráficos de resíduos.
O teste de Osius-Rojek produz uma estatística de teste de z = 1.56 com um \(p\)-valor de 0.12, que não oferece nenhuma evidência séria de um ajuste ruim. No entanto, o teste de Stukel fornece um \(p\)-valor de 0.03, o que fornece algumas evidências de que o modelo não está se ajustando bem aos dados. Em particular, porque este teste visa desvios do modelo separadamente para grandes e pequenas probabilidades, pode ser mais sensível à possível falha do modelo sugerida anteriormente e os resíduos de Pearson do agrupamento de Hosmer-Lemeshow. Portanto, devemos investigar mais para determinar o que pode estar causando esse problema.
Para variáveis resposta com outras distribuições, não existe um teste formal de qualidade de ajuste que seja reconhecido como padrão quando variáveis explicativas contínuas estão envolvidas. Para modelos com uma resposta univariada, pode ser realizado um análogo ao teste de Hosmer-Lemeshow, em que agrupamentos são formados com base em valores ajustados do modelo, como contagens previstas de um modelo de Poisson ou taxas de um modelo de taxa Poisson. Esta ideia foi sugerida em Agresti (1996), mas não parece ser bem estudada.
Oferecemos uma função que pode realizar este teste em um conjunto de contagens e valores previstos:
#####################################################################
# NAME: Tom Loughin #
# DATE: 06-24-2013 #
# PURPOSE: Grouped-prediction goodness of fit test for count models #
# #
# NOTES: #
# Program operates on user-supplied numerical objects containing #
# observed counts for each observation and predicted counts in the #
# same order. User can supply number of groups; uses n/5 otherwise, #
# unless n>100, whereupn g defaults to 20. #
# #
# Source this program before calling the function. #
#####################################################################
PostFitGOFTest = function(obs, pred, g = 0) {
if(g == 0) g = round(min(length(obs)/5,20))
ord <- order(pred)
obs.o <- obs[ord]
pred.o <- pred[ord]
# Creates factor with levels 1,2,...,g
interval = cut(pred.o, quantile(pred.o, 0:g/g), include.lowest = TRUE)
counts = xtabs(formula = cbind(obs.o, pred.o) ~ interval)
centers <- aggregate(formula = pred.o ~ interval, FUN = "mean")
pear.res <- rep(NA,g)
for(gg in (1:g)) pear.res[gg] <- (counts[gg] - counts[g+gg])/sqrt(counts[g+gg])
pearson <- sum(pear.res^2)
if (any(counts[((g+1):(2*g))] < 5))
warning("Some expected counts are less than 5. Use smaller number of groups")
P = 1 - pchisq(pearson, g - 2)
cat("Post-Fit Goodness-of-Fit test with", g, "bins", "\n", "Pearson Stat = ",
pearson, "\n", "p = ", P, "\n")
return(list(pearson = pearson, pval = P, centers = centers$pred.o,
observed = counts[1:g], expected = counts[(g+1):(2*g)], pear.res = pear.res))
}No entanto, esse teste deve ser verificado quanto à precisão antes de ser usado de forma mais ampla, por exemplo, usando uma simulação para garantir que o teste mantenha seu tamanho para o conjunto de dados no qual é usado.
Observe que os \(p\)-valores de qualquer teste de qualidade de ajuste são válidos somente se o modelo sendo testado puder ter sido escolhido antes de iniciar a análise de dados. As razões são as mesmas discutidas na Seção 5.1.4. Em particular, usar os dados para selecionar as variáveis a serem incluídas em um modelo tem o efeito de fazer com que o modelo pareça melhor para esse conjunto de dados do que em outro conjunto de dados. A aplicação de um teste de qualidade de ajuste a tal modelo tende a resultar em \(p\)-valores maiores que seriam encontrados se o ajuste fosse avaliado de forma mais justa em um conjunto de dados independente.
Isso leva a dois pontos importantes. Em primeiro lugar, sempre que possível, os modelos devem ser testados em dados independentes antes de serem adotados como válidos para algum propósito mais amplo do que descrever os dados nos quais se baseiam. Em segundo lugar, o \(p\)-valor de um teste de qualidade de ajuste precisa ser interpretado com cuidado quando o teste é feito em um modelo que resulta de um processo de seleção de variáveis. Se o \(p\)-valor for “pequeno”, isso é, de fato, uma evidência de que o modelo não se ajusta bem. No entanto, não está claro qual interpretação pode ser aplicada quando o \(p\)-valor não é pequeno.
5.2.3 Influência
O ajuste de um modelo de regressão é influenciado por cada uma das observações na amostra. Remover ou alterar qualquer observação ou equivalentemente um EVP em uma regressão binomial, pode resultar em uma alteração nas estimativas de parâmetros, valores previstos e estatísticas de bondade de ajuste (GOF). Uma observação é considerada influente se os resultados da regressão mudarem muito quando ela for temporariamente removida do conjunto de dados. Obviamente, não queremos que nossas conclusões dependem muito fortemente de uma única observação, por isso é aconselhável verificar se há observações influentes.
A análise de influência consiste em calcular e interpretar quantidades que medem diferentes maneiras pelas quais um modelo muda quando cada observação é alterada ou removida. Remover observações e reajustar modelos para medir como eles mudam pode parecer complicado. Felizmente, as quantidades mais comumente calculadas para medir a influência em modelos de regressão linear têm fórmulas de “atalho” que permitem que sejam calculadas a partir de um único ajuste de modelo. As mesmas quantidades não são calculadas tão facilmente a partir de um ajuste de modelo GLM, mas podem ser aproximadas usando fórmulas análogas àquelas usadas na regressão linear. Apresentamos essas aproximações aqui e discutimos outra quantidade, alavancagem, que é útil para identificar observações potencialmente influentes. Para obter mais detalhes sobre análise de influência para modelos lineares, consulte Belsley et al. (1980) ou Kutner et al. (2004). Pregibon (1981) e Fox (2008) mostram como aplicar algumas dessas medidas aos GLMs.
Alavancagem
Na regressão linear, os valores de alavancagem geralmente são calculados como uma forma de medir o potencial de uma observação influenciar o modelo de regressão. Na Seção 2.2.7 definimos a matriz hat em uma regressão logística como \[ H = V^{1/2}X(X^\top VX)^{-1}X^\top V^{1/2}, \] onde \(X\) é a matriz de dimensão \(M\times (p+1)\) cujas linhas contêm as variáveis explicativas \(x^\top_m\); \(m = 1,\cdots,M\) e \(V\) é uma matriz diagonal cujo \(m\)-ésimo elemento diagonal é \[ v_m = \widehat{\mbox{Var}}(Y_m), \] a variância da variável de resposta calculada usando a estimativa de regressão da média ou probabilidade em \(x^\top_m\).
Essa definição surge por meio de uma estimativa de mínimos quadrados ponderada usada para modelos de regressão linear normal e se aplica a todos os GLMs (Pregibon, 1981). Os elementos diagonais de \(H\), \(h_m\), \(m = 1,\cdots,M\) são os valores de alavancagem para o GLM. Pregibon (1981) e Hosmer and Lemeshow (2000) mostram que \(h_m\) mede o potencial para que a observação \(m\) tenha grande influência no ajuste do modelo. Como o valor médio de \(h_m\) em qualquer modelo é \(p/M\), as observações com \(h_m > 2p/M\) são consideradas como tendo alavancagem moderadamente alta e aquelas com \(h_m > 3p/M\) como tendo alta alavancagem. Se a influência é realmente exercida ou não depende da ocorrência de uma resposta extrema e isso pode ser medido pelos resíduos e por outras medidas descritas abaixo. Assim, os valores de alavancagem são ferramentas importantes, mas não podem ficar sozinhos como medidas de influência. Discutimos ferramentas mais úteis para examinar a próxima influência.
Distância de Cook
A distância de Cook da regressão linear é um resumo padronizado da mudança em todas as estimativas de parâmetros simultaneamente quando a observação \(m\) é temporariamente excluída. Uma versão aproximada da distância de Cook para GLMs é encontrada como \[ CD_m = \dfrac{r^2_m h_m}{ (p+1)(1-h_m)^2}, \] \(m=1,\cdots,M\).
Em geral, pontos com valores de \(CD_m\) que se destacam acima dos demais são candidatos a uma investigação mais aprofundada. Alternativamente, observações com \(CD_m > 1\) podem ser consideradas como tendo alta influência nas estimativas dos parâmetros de regressão, enquanto aquelas com \(CD_m > 4/M\) têm influência moderadamente alta.
A mudança na estatística de qualidade de ajuste de Pearson \(X^2\) causada pela exclusão da observação \(m\) é medida aproximadamente por \[ \Delta X^2_m = r^2_m, \] enquanto a mudança na estatística de desvio residual é aproximadamente \[ \Delta D_m = \big(e^D_m\big)^2 + h_m r^2_m\cdot \]
A última aproximação é especialmente excelente, em muitos casos replicando a mudança real no desvio residual quase perfeitamente. Para ambas as estatísticas, usamos limites de 4 e 9 para sugerir observações que têm influência moderada ou forte em suas respectivas estatísticas de ajuste.
Esses números são derivados do quadrado dos limites sugeridos \(\pm 2\) e \(\pm 3\) que usamos para os resíduos padronizados nos quais eles se baseiam. As duas estatísticas podem sugerir possíveis observações que podem ter grande influência no ajuste geral do modelo.
Gráficos
Plotando as quatro medidas \(h_m\), \(CD_m\), \(\Delta X^2_m\) e \(\Delta D_m\) contra os valores ajustados é recomendado por Hosmer ande Lemeshow (2000) para ajudar a localizar observações influentes para modelos de regressão logística. Esses gráficos também podem ser usados para outros GLMs. Hosmer and Lemeshow (2000) também recomendam plotar as últimas três estatísticas em relação aos valores de alavancagem, como uma forma de julgar simultaneamente se uma observação com influência potencial está causando uma mudança real no ajuste do modelo. No entanto, todas essas três estatísticas são funções diretas de \(h_m\), portanto, uma grande alavancagem pode afetar seus valores.
Além disso, todos eles são funções de resíduos, portanto, podem ser grandes devido aos grandes resíduos associados a observações que não são particularmente influentes. Isto é especialmente verdadeiro para \(\Delta X^2_m\) e \(\Delta D_m\). Uma vez identificadas as observações potencialmente influentes, resta-nos decidir o que fazer com elas. Discutiremos isso após o próximo exemplo.
Exemplo 5.9: Placekicking.
Para objetos de modelo glm-class, as medidas de influência são todas fáceis de calcular: hatvalues() produz os \(h_m\); cooks.distance() produz \(CD_m\); residuais() produz \(e_m\) e \(e^D_m\) com um valor de argumento type = “pearson” ou type = “deviance”, respectivamente e rstandard() produz \(r_m\) e \(r^D_m\), novamente com um valor de argumento type = “pearson” ou type = “deviance”, respectivamente. As medidas de influência \(\Delta X^2_m\) e \(\Delta D_m\) podem ser subsequentemente calculadas usando \(r_m\), \(e^D_m\) e \(h_m\).
Por conveniência, criamos uma função, glmInflDiag(), para produzir os gráficos e formar uma lista de todas as observações identificadas como potencialmente influentes por pelo menos uma estatística. Esta função espera um objeto glm-class como seu primeiro argumento, mas também funcionará em qualquer outro objeto para o qual existam funções de método residuais() e hatvalues() e para o qual summary()$dispersion seja um elemento legítimo.
A saída desta função é dada abaixo. Incluímos os argumentos print.output e which.plots na função para controlar a saída a ser impressa e os conjuntos de gráficos a serem construídos; ambos são definidos aqui com seus valores padrão para maximizar as informações fornecidas. As observações impressas por glmInflDiag() correspondem àquelas onde \(h_m > 3p/M\), \(CD_m > 4/M\), \(\Delta X^2_m > 9\) ou \(\Delta D_m > 9\) e aqueles com \(\Delta X^2_m > 4\) e \(h_m > 2p/M\) ou \(\Delta D_m > 4\) e \(h_m > 2p/M\).
source("http://leg.ufpr.br/~lucambio/ADC/glmDiagnostics.R")
glmInflDiag (mod.fit = mod.fit.bin , print.output = TRUE , which.plots = 1)
## Potentially influential observations by any measures
## h hflag Del.X2 xflag Del.dev dflag Cooks.D cflag
## 1 0.00 12.78 ** 3.84 0.015
## 3 0.67 ** 13.16 ** 13.95 ** 13.163 **
## 34 0.08 3.98 4.11 * 0.174 *
##
## Data for potentially influential observations
## distance success trials prop yhat
## 1 18 2 3 0.6667 0.977
## 3 20 776 789 0.9835 0.971
## 34 51 11 15 0.7333 0.486## hat CD delta.Xsq delta.D
## 1 0.002387198 1.529541e-02 1.278394e+01 3.835268e+00
## 2 0.005747539 5.414469e-04 1.873271e-01 3.687081e-01
## 3 0.666705043 1.316306e+01 1.316079e+01 1.395377e+01
## 4 0.017346106 1.773826e-03 2.009738e-01 1.735582e-01
## 5 0.012429654 2.907219e-02 4.619731e+00 2.732875e+00
## 6 0.024474806 1.040400e-04 8.293727e-03 8.521223e-03
## 7 0.006462386 1.083600e-03 3.331887e-01 6.490459e-01
## 8 0.012194897 1.196016e-03 1.937583e-01 1.683647e-01
## 9 0.008561508 2.230549e-03 5.166034e-01 4.089629e-01
## 10 0.027932087 8.808571e-02 6.130963e+00 4.322021e+00
## 11 0.021434575 1.708427e-03 1.559917e-01 1.435265e-01
## 12 0.016752055 7.210552e-04 8.464347e-02 9.165053e-02
## 13 0.013965736 4.102598e-03 5.793181e-01 4.931563e-01
## 14 0.011132407 1.642524e-05 2.918037e-03 2.961978e-03
## 15 0.030915613 8.428651e-02 5.284109e+00 4.133756e+00
## 16 0.022155076 1.146048e-02 1.011648e+00 1.264609e+00
## 17 0.020669062 1.411210e-03 1.337305e-01 1.265344e-01
## 18 0.015844574 4.417373e-07 5.487534e-05 5.494741e-05
## 19 0.026174822 1.263182e-03 9.399247e-02 9.057037e-02
## 20 0.036689913 1.798093e-02 9.441950e-01 8.673136e-01
## 21 0.038120401 6.115314e-04 3.086114e-02 3.138557e-02
## 22 0.041499160 7.623301e-05 3.521488e-03 3.504084e-03
## 23 0.030981482 1.319088e-02 8.251511e-01 7.671093e-01
## 24 0.018100496 1.225450e-03 1.329542e-01 1.278231e-01
## 25 0.054622952 7.516763e-04 2.601901e-02 2.627947e-02
## 26 0.049974233 7.336194e-02 2.789267e+00 2.590962e+00
## 27 0.046015453 3.835108e-03 1.590176e-01 1.629508e-01
## 28 0.051792792 4.178441e-03 1.529953e-01 1.504494e-01
## 29 0.045259533 3.728674e-02 1.573112e+00 1.703223e+00
## 30 0.083252391 3.518082e-04 7.747990e-03 7.765421e-03
## 31 0.072600095 8.589663e-04 2.194502e-02 2.188257e-02
## 32 0.053613972 2.184514e-02 7.712144e-01 7.900162e-01
## 33 0.093401767 5.357882e-04 1.040119e-02 1.040623e-02
## 34 0.080538334 1.743486e-01 3.980884e+00 4.108580e+00
## 35 0.075645806 1.240861e-02 3.032541e-01 3.066567e-01
## 36 0.056301442 1.848175e-02 6.195651e-01 6.118490e-01
## 37 0.046693870 5.005100e-02 2.043691e+00 2.338330e+00
## 38 0.021164597 1.210634e-02 1.119805e+00 1.074180e+00
## 39 0.007401006 7.047965e-03 1.890501e+00 2.127146e+00
## 40 0.008153211 1.098061e-02 2.671606e+00 2.611140e+00
## 41 0.008419500 1.144240e-03 2.695186e-01 4.759666e-01
## 42 0.008401478 1.017689e-03 2.402290e-01 4.293530e-01
## 43 0.008070974 6.918782e-04 1.700648e-01 3.131432e-01Figura 5.4: Gráficos de medidas de influência versus probabilidades estimadas de sucesso para os dados de placekicking. As linhas pontilhadas representam limites para uma influência potencialmente elevada.
A função identifica três observações potencialmente influentes: #1, #3 e #34. A observação #1 tem grande \(\Delta X^2_1\) sem um grande valor de \(h_1\), indicando que o grande valor de medida de influência é devido ao tamanho de seu resíduo padronizado \(r_1\). Este caso foi abordado na Seção 5.2.1, onde vimos que o grande resíduo foi apenas resultado da observação de 1 falha em 3 tentativas quando a probabilidade estimada de sucesso é muito grande. Não há motivo para alarme com esta observação.
A observação #3 tem grandes valores de \(\Delta X^2_3\), \(\Delta D_3\) e \(CD_3\) junto com um grande \(h_3\). Essa observação também foi identificada como tendo um resíduo extremo na Seção 5.2.1. Sua alta alavancagem se deve, sem dúvida, ao fato de representar mais da metade do total de 1.425 tentativas no conjunto de dados. Assim, esperamos que essa observação seja influente, embora sua alta influência não seja necessariamente uma coisa ruim. No entanto, como também possui um \(CD_3\) extremo, sua influência está afetando claramente as estimativas dos parâmetros e o ajuste geral do modelo. Veremos na Seção 5.4.1 que simplesmente adicionar a variável explicativa PAT ao modelo elimina o resíduo padronizado extremo, mas ainda deixa uma observação influente correspondente a esse mesmo EVP.
glmInflDiag (mod.fit = mod.fit.bin , print.output = TRUE , which.plots = 2)
## Potentially influential observations by any measures
## h hflag Del.X2 xflag Del.dev dflag Cooks.D cflag
## 1 0.00 12.78 ** 3.84 0.015
## 3 0.67 ** 13.16 ** 13.95 ** 13.163 **
## 34 0.08 3.98 4.11 * 0.174 *
##
## Data for potentially influential observations
## distance success trials prop yhat
## 1 18 2 3 0.6667 0.977
## 3 20 776 789 0.9835 0.971
## 34 51 11 15 0.7333 0.486## hat CD delta.Xsq delta.D
## 1 0.002387198 1.529541e-02 1.278394e+01 3.835268e+00
## 2 0.005747539 5.414469e-04 1.873271e-01 3.687081e-01
## 3 0.666705043 1.316306e+01 1.316079e+01 1.395377e+01
## 4 0.017346106 1.773826e-03 2.009738e-01 1.735582e-01
## 5 0.012429654 2.907219e-02 4.619731e+00 2.732875e+00
## 6 0.024474806 1.040400e-04 8.293727e-03 8.521223e-03
## 7 0.006462386 1.083600e-03 3.331887e-01 6.490459e-01
## 8 0.012194897 1.196016e-03 1.937583e-01 1.683647e-01
## 9 0.008561508 2.230549e-03 5.166034e-01 4.089629e-01
## 10 0.027932087 8.808571e-02 6.130963e+00 4.322021e+00
## 11 0.021434575 1.708427e-03 1.559917e-01 1.435265e-01
## 12 0.016752055 7.210552e-04 8.464347e-02 9.165053e-02
## 13 0.013965736 4.102598e-03 5.793181e-01 4.931563e-01
## 14 0.011132407 1.642524e-05 2.918037e-03 2.961978e-03
## 15 0.030915613 8.428651e-02 5.284109e+00 4.133756e+00
## 16 0.022155076 1.146048e-02 1.011648e+00 1.264609e+00
## 17 0.020669062 1.411210e-03 1.337305e-01 1.265344e-01
## 18 0.015844574 4.417373e-07 5.487534e-05 5.494741e-05
## 19 0.026174822 1.263182e-03 9.399247e-02 9.057037e-02
## 20 0.036689913 1.798093e-02 9.441950e-01 8.673136e-01
## 21 0.038120401 6.115314e-04 3.086114e-02 3.138557e-02
## 22 0.041499160 7.623301e-05 3.521488e-03 3.504084e-03
## 23 0.030981482 1.319088e-02 8.251511e-01 7.671093e-01
## 24 0.018100496 1.225450e-03 1.329542e-01 1.278231e-01
## 25 0.054622952 7.516763e-04 2.601901e-02 2.627947e-02
## 26 0.049974233 7.336194e-02 2.789267e+00 2.590962e+00
## 27 0.046015453 3.835108e-03 1.590176e-01 1.629508e-01
## 28 0.051792792 4.178441e-03 1.529953e-01 1.504494e-01
## 29 0.045259533 3.728674e-02 1.573112e+00 1.703223e+00
## 30 0.083252391 3.518082e-04 7.747990e-03 7.765421e-03
## 31 0.072600095 8.589663e-04 2.194502e-02 2.188257e-02
## 32 0.053613972 2.184514e-02 7.712144e-01 7.900162e-01
## 33 0.093401767 5.357882e-04 1.040119e-02 1.040623e-02
## 34 0.080538334 1.743486e-01 3.980884e+00 4.108580e+00
## 35 0.075645806 1.240861e-02 3.032541e-01 3.066567e-01
## 36 0.056301442 1.848175e-02 6.195651e-01 6.118490e-01
## 37 0.046693870 5.005100e-02 2.043691e+00 2.338330e+00
## 38 0.021164597 1.210634e-02 1.119805e+00 1.074180e+00
## 39 0.007401006 7.047965e-03 1.890501e+00 2.127146e+00
## 40 0.008153211 1.098061e-02 2.671606e+00 2.611140e+00
## 41 0.008419500 1.144240e-03 2.695186e-01 4.759666e-01
## 42 0.008401478 1.017689e-03 2.402290e-01 4.293530e-01
## 43 0.008070974 6.918782e-04 1.700648e-01 3.131432e-01Figura 5.5: Gráficos de medidas de influência versus valores de alavancagem para os dados de placekicking. As linhas pontilhadas representam limites para uma influência potencialmente elevada.
A observação #34 também é potencialmente influente, mas a evidência é leve. Tanto o \(CD_{34}\) quanto o \(\Delta D_{34}\) estão apenas ligeiramente acima de seus respectivos limites. Tem uma probabilidade de sucesso estimada um pouco menor do que a proporção observada. Um cálculo rápido mostra que a probabilidade de 11 ou mais sucessos em 15 tentativas quando \(\widehat{\pi} = 0.486\) é 0.047, então essa observação não é extremamente atípica e, portanto, não é realmente uma grande preocupação.
Outra medida útil não abordada aqui é o resíduo estudentizado. É uma versão padronizada do resíduo de desvio usando um denominador que exclui sua própria contagem. Um valor grande indica que a observação está longe de onde o modelo sugere que deveria estar. A função influencePlot() no pacote car plota o resíduo estudentizado em relação ao valor de alavancagem, com bolhas proporcionais à distância de Cook. Esta é outra ferramenta útil para identificar pontos que possuem uma combinação de extremos relativos às variáveis explicativas e extremos relativos à resposta.
Ajustes de modelo para influência e outliers
A forma como lidamos com outliers e valores influentes depende da causa dos resultados extremos e dos objetivos da análise. Em geral, quaisquer observações sinalizadas devem ser investigadas quanto a outras características que possam causar seu status periférico e/ou influente. Se houver motivos para acreditar que foi cometido um erro na medição ou no registro de seus dados, isso obviamente deve ser corrigido, se possível, e a análise deve ser executada novamente. Se as observações forem fundamentalmente diferentes de alguma forma, como uma cabra em um estudo de ovelhas ou um atleta profissional em um estudo de pessoas comuns, então é razoável excluir a(s) observação(ões), desde que o motivo para fazê-lo é esclarecido e os resultados da análise são explicitamente aplicados a essa população mais restrita (por exemplo, pessoas que não são atletas profissionais).
No contexto de nossos dados de placekicking, existem diferenças entre PATs e outros gols de campo que podem fazer com que suas probabilidades de sucesso na mesma distância sejam diferentes. Poderíamos optar por excluir os PATs dos dados e refazer a análise, caso em que nossas inferências se aplicariam apenas a gols de campo e não a todos os chutes de passagem.
Quando não há razão clara para a influência ou extremismo de uma observação, removê-la do estudo não deve ser automática. Quando não há muitos valores sinalizados a serem considerados, é possível executar novamente a análise com e sem os valores extremos. Se as principais inferências da análise não mudarem de maneira substantiva, não há preocupação de que esses valores estejam interferindo na análise e não há problema em apresentar os resultados originais. Por outro lado, se as inferências mudarem significativamente, haverá incerteza sobre quais conclusões devem ser tiradas.
O relato dos resultados deve refletir essa incerteza, indicando claramente as diferenças e explicando que não está claro quais resultados estão mais próximos da verdade.
5.2.4 Diagnósticos para modelos de resposta multicategoria
Conforme observado na introdução desta seção, as ferramentas de diagnóstico para modelos de resposta multicategoria não estão prontamente disponíveis. Para começar a discussão sobre o que pode ser usado, assumimos que os dados foram agregados na forma de EVP como em um modelo de regressão binomial. Então, há \(M\) EVPs, onde \(m\) EVP consistem em \(n_m\) tentativas para \(m = 1,\cdots,M\). Se houver \(J\) categorias na variável de resposta, então a resposta é uma lista de \(J\) contagens em vez da contagem única de sucessos que os modelos binomiais usam, por exemplo, se \(n_m = 1\), uma das \(J\) contagens é 1 e o resto são 0. Represente as contagens como \(y_{mj}\), \(m = 1,\cdots,M\) e \(j = 1,\cdots,J\).
O ajuste do modelo fornece probabilidades estimadas \(\widehat{\pi}_{mj}\) para todas as \(J\) categorias para cada EVP e, portanto, contagens esperadas estimadas \(\widehat{y}_{mj} = n_m\widehat{\pi}_{mj}\). Depois, há \(J\) resíduos, \(y_{mj}-\widehat{y}_{mj}\), \(j = 1,\cdots,J\) por EVP, embora não sejam independentes, porque tanto as contagens observadas quanto as esperadas devem somar \(n_m\). Um conjunto de resíduos de Pearson pode ser definido para cada observação como \[ \epsilon_{mj}=\dfrac{y_{mj}-\widehat{y}_{mj}}{\sqrt{\widehat{y}_{mj}}}, \] \(j=1,\cdots,J\).
A contribuição de cada EVP para a estatística de Pearson no ajuste do modelo é a soma de seus resíduos quadrados de Pearson, \[ X^2_m = \sum_{j=1}^J \epsilon^2_{mj}\cdot \] Da mesma forma, a contribuição de cada EVP para o desvio residual pode ser computado.
A partir dos resíduos de Pearson, várias outras quantidades podem ser calculadas semelhantes às das Seções 5.2.1 e 5.2.3. A definição da matriz hat (chapéu) e, portanto, dos valores de alavancagem \(h_m\), requer alguns cuidados devido à natureza multivariada da resposta. Detalhes matemáticos são dados em Lesaffre and Albert (1989), que estendem as medidas de Pregibon (1981) para o caso multicategoria.
Escrevemos funções R que calculam estatísticas e criam gráficos que podem ajudar a identificar EVPs periféricos ou influentes. Estes estão contidos no programa R multinomDiagnostics.R para ajuste de modelos usando multinom(). As estatísticas calculadas em cada EVP incluem os resíduos de Pearson, as contribuições para as estatísticas de desvio de ajuste de Pearson e residual, alavancagem, distância de Cook e as duas estatísticas de exclusão de caso, \(\Delta D_m\) e \(\Delta X^2_m\).
Como alternativa à realização de diagnósticos especializados para modelos multinomiais, o problema pode ser dividido em uma série de regressões logísticas comuns e cada uma delas pode ser avaliada separadamente. Por exemplo, o modelo de regressão multinomial para um valor nominal deresposta, \[ \log(\pi_j/\pi_1) = \beta_{j0} + \beta_{j1} x_1 +\cdots + \beta_{jp} x_p, \] usa \(J-1\) logitos, cada um comparando a resposta \(j\) com a resposta 1, \(j = 2,\cdots,J\). Uma série de \(J-1\) regressões logísticas pode ser ajustada, cada uma considerando apenas os dados da categoria 1 e da categoria \(j\) e a adequação para cada um desses modelos pode ser avaliada usando ferramentas padrão descritas anteriormente nesta seção. O apelo dessa abordagem é que as ferramentas de diagnóstico são facilmente acessadas e bem compreendido. No entanto, cada modelo é apenas uma parte do modelo total.
5.3 Superdispersão
Na maioria dos problemas de regressão linear, assumimos que os erros são normalmente distribuídos com variância constante. Sob essa suposição, a variância dos dados não é afetada pelo modelo que propomos para a média; a média e a variância são controladas independentemente por parâmetros separados. Ou seja, suponha que escrevamos a resposta média em uma forma condicional como \(\mbox{E}(Y|x) =\mu(x)\) para enfatizar a relação entre a média e as variáveis explanatórias \(x\), com notação análoga para \(\mbox{Var}(Y|x)\). No modelo normal temos \(\mbox{Var}(Y|x) =\sigma^2\), uma constante que não depende de \(x\).
Na maioria das configurações do GLM, como regressões logísticas e de Poisson, a média e a variância estão relacionadas. Para a regressão de Poisson com \(\mbox{E}(Y|x) =\mu(x)\), temos \(\mbox{Var}(Y|x) =\mu(x)\). Em uma regressão logística, um EVP com \(n_m\) tentativas tem \(\mbox{E}(Y|x) =\mu(x) = n_m\pi(x)\), de modo que \(\mbox{Var}(Y|x) = n_m \pi(x)\big(1-\pi(x)\big)\). Assim, com a maioria dos GLMs, quando especificamos um modelo para a relação entre a média e \(x\), estamos implicitamente impondo um modelo para a relação entre a variância e \(x\).
Na regressão linear, é um tanto comum que a variância não siga seu modelo assumido; ou seja, a variância não é constante para todos os valores de \(x\). Essa situação é conhecida como heterocedasticidade ou simplesmente variância não constante e é frequentemente detectada por meio da análise dos resíduos ver, por exemplo, Kutner et al., 2004. Da mesma forma, em GLMs a variância pode não seguir a estrutura que lhe é imposta pelo modelo distributivo.
Em particular, é bastante comum ter contagens ou proporções que exibem mais variabilidade do que os modelos indicam que deveria haver. Isso indica um ajuste ruim do modelo, mesmo quando a média ou probabilidade estimada parece se ajustar bem aos dados. Esse fenômeno é chamado de superdispersão. Explicamos nas próximas seções o que causa a superdispersão, como detectá-la e como corrigir os modelos para considerá-la.
5.3.1 Causas e implicações
A superdispersão é uma falha do modelo, não uma falha dos dados. É um sintoma de outro problema e não um problema em si. Na regressão linear, quando uma variável importante é adicionada ao modelo, a variabilidade que ela explica é retirada da soma dos quadrados do erro e colocada na soma dos quadrados do modelo. Olhando de outra forma, quando uma variável importante é deixada de fora do modelo, a soma dos quadrados dos erros é muito maior do que deveria ser.
Como resultado, o erro quadrático médio torna-se inflado e superestima a verdadeira variância \(\sigma^2\). De certa forma, este é um exemplo de superdispersão, exceto que o modelo tem um parâmetro embutido \(\sigma^2\), que se adapta à falha do modelo. As inferências na regressão linear são todas baseadas no uso do erro médio quadrado para medir a variância, portanto as inferências são ajustadas automaticamente para a falha do modelo, tornando as estatísticas de teste menos extremas e os intervalos de confiança mais amplos.
Modelos como o de Poisson e o binomial não têm parâmetro de variância separado para permitir que se adaptem à ausência de variáveis importantes. Quando uma variável importante é deixada de fora do modelo, as observações que têm a mesma média de acordo com o modelo podem, na verdade, ter médias diferentes se tiverem valores diferentes da variável ausente.
Assim, as respostas dessa média estimada comum podem apresentar mais variabilidade do que o modelo espera. O próximo exemplo mostra que os dados são mais variáveis quando são gerados a partir de distribuições de Poisson com médias variáveis do que quando são gerados a partir de uma distribuição de Poisson com média constante. Assim, a média da resposta estimada por um modelo de regressão de Poisson subestima a quantidade de variabilidade nos dados em torno dessa média. Exatamente o mesmo fenômeno ocorre com outros modelos distribucionais que não possuem um parâmetro separado para variância, como o binomial.
Ao contrário do caso com uma distribuição normal, não há nenhum mecanismo dentro desses modelos para ajustar as inferências para torná-las menos certas em consideração a essa variabilidade extra. As inferências assumem que as estimativas de variância baseadas no modelo estão corretas, quando na verdade são muito pequenas. Assim, os intervalos de confiança são muito estreitos - ou seja, eles não atingem seus níveis de confiança declarados - e os \(p\)-valores são menores do que deveriam ser, o que significa que as taxas de erro tipo I são maiores do que as declaradas. O resultado final é que as inferências tendem a detectar efeitos que não existem realmente.
Exemplo 5.10: Simulação da superdispersão.
Neste exemplo, simulamos dados sob um modelo Poisson com e sem superdispersão. Primeiro, simulamos dados diretamente de uma distribuição de Poisson com média 100 e calculamos a média amostral e a variância dos dados, chamados mean0 e var0, respectivamente.
Em seguida, repetimos a simulação, exceto que a média pode variar simulando-a a partir de uma distribuição normal com média 100 e desvio padrão 20. A média e a variância amostrais são novamente calculadas, chamadas mean20 e var20, respectivamente. Ambas as simulações usam tamanhos de amostra de 50 e as simulações são repetidas 10 vezes para que os padrões sejam aparentes.
# First start with simple simulation using two cases: Po(100) and P(Z), where Z~N(100,20^2)
# Observe means and variances from 10 simulated data of size 50.
set.seed(389201892)
# Create Poisson random variates whose means vary according to N(100,SD) for various values of SD
# Break these into 100 data sets (columns of the matrix) of n = 20 obs each.
# poi**: the ** gives the SD.
poi0 <- matrix(rpois(n = 500, lambda = rep(x = 100, times = 500)), nrow = 50, ncol = 10)
poi20 <- matrix(rpois(n = 500, lambda = rnorm(n = 500, mean = 100, sd = 20)), nrow = 50, ncol = 10)
# Compute the mean and variance for each data set (columns of each poi** matrix)
mean0 <- apply(X = poi0, MARGIN = 2, FUN = mean)
var0 <- apply(X = poi0, MARGIN = 2, FUN = var)
mean20 <- apply(X = poi20, MARGIN = 2, FUN = mean)
var20 <- apply(X = poi20, MARGIN = 2, FUN = var)
all <- cbind(mean0, var0, mean20, var20)
round(all, digits = 1)## mean0 var0 mean20 var20
## [1,] 99.9 85.9 104.3 456.0
## [2,] 101.5 91.7 97.0 533.5
## [3,] 99.1 83.3 104.5 534.0
## [4,] 99.9 121.1 100.4 452.2
## [5,] 99.5 102.4 101.0 452.3
## [6,] 99.7 73.8 104.0 408.8
## [7,] 101.0 94.5 96.9 509.0
## [8,] 100.4 110.9 102.1 292.8
## [9,] 98.0 92.4 98.1 303.8
## [10,] 99.8 96.1 104.3 524.6round(apply(X = all, MARGIN = 2, FUN = mean), digits = 1)## mean0 var0 mean20 var20
## 99.9 95.2 101.3 446.7As médias amostrais para ambos os casos variam aleatoriamente em torno do valor verdadeiro de 100, embora haja mais variabilidade nas médias do caso em que as médias de Poisson são variáveis. As variâncias para a Poisson padrão também variam aleatoriamente em torno de 100, mas as do caso com médias variáveis são consideravelmente maiores, com média de 447.
Assim, fica claro que gerar dados a partir de uma situação em que as médias podem variar faz com que os dados resultantes exibam muito mais variabilidade do que o esperado em um modelo de Poisson. Pode-se mostrar que a verdadeira média e variância da resposta \(Y\) sob o segundo modelo são 100 e 500, respectivamente. Veja o Exercício 32.
#########################################################################
# Extend simulation to a larger example:
# Same case as above, except that all data are from Po(Z), Z~N(100, s^2),
# where s = 0:20. (s = 0 corresponds to a constant mean for all data)
# Here we also fit a GLM to the data to estimate the mean and get
# * deviance/dfmodel
# * model-based confidence intervals for the mean.
# Plotting various quantities, including estimated confidence level for CIs.
# Function to record CI, residual deviance, and df from model that assumes just an intercept
fit.mod <- function(response) {
mod.fit <- glm(formula = response ~ 1, family = poisson(link = "log"))
c(mod.fit$deviance, mod.fit$df.residual, confint(mod.fit))
}
# Function that simulates the needed data for a given SD.
# Also computes mean and variance of data and runs the fit.mod function on the data
# to get model statistics
all <- function(sd.value) {
poi <- matrix(data = rpois(n = 2000, lambda = rnorm(n = 2000, mean = 100, sd = sd.value)),
nrow = 20, ncol = 100)
mean.val <- apply(X = poi, MARGIN = 2, FUN = mean)
var.val <- apply(X = poi, MARGIN = 2, FUN = var)
save.dev <- apply(X = poi, MARGIN = 2, FUN = fit.mod)
cbind(mean.val, var.val, t(save.dev))
}
# Set the SD values to be used and initialize a matrix for the results
sd.set <- c(0:20)
mat.save <- matrix(data = NA, nrow = 100*length(sd.set), ncol = 7)
# Run the simulation and analysis functions for the chosen SD values
count <- 1
for(i in sd.set) {
mat.save[(100*(count-1)+1):(100*count),] <- cbind(i, all(sd.value = i))
count <- count+1
}
# Plot sample means from all sims vs. SD used in generating Poisson means
par(mfrow = c(1,2))
plot (x = mat.save[,1], y = mat.save[,2], xlab = "Std. Dev. of Poisson means",
ylab = "Sample mean", pch = 19)
abline(h = 100)
grid()
# Plot sample variances from all sims vs. SD used in generating Poisson means
plot (x = mat.save[,1], y = mat.save[,3], xlab = "Std. Dev. of Poisson means",
ylab = "Sample variance", pch = 19)
abline(h = 100)
grid()
curve(expr = 100+x^2, add = TRUE, lty = "dashed")
# Plot sample var/mean ratios from all sims vs. SD used in generating Poisson means
par(mfrow = c(1,2))
plot (x = mat.save[,1], y = mat.save[,4]/mat.save[,5], xlab = "Std. Dev. of Poisson means",
ylab = "Deviance/DF", pch = 19)
abline(h = 1, lty = "solid")
abline(h = 1+2*sqrt(2/mat.save[,5]), lty = "dotted")
abline(h = 1+3*sqrt(2/mat.save[,5]), lty = "dotted")
grid()
# Plot Confidence interval widths vs. SD used in generating Poisson means
plot(x = mat.save[,1], y = exp(mat.save[,7])-exp(mat.save[,6]), pch = 19,
xlab = "Std. Dev. of Poisson means", ylab = "Width of Poisson CI for mean")
grid()
# Confidence level of confidence interval
cover <- ifelse(exp(mat.save[,7]) < 100, yes = 0, no = ifelse(exp(mat.save)[,6] > 100,
yes = 0, no = 1))
conf <- by(data = cover, INDICES = mat.save[,1], FUN = mean)
plot(x = sd.set, y = conf, xlab = "Std. Dev. of Poisson means", pch = 19,
ylab = "Estimated confidence level")
grid()
abline(h = 0.95, lty = "solid")
Figura 5.6: Resultados do intervalo de confiança da
razão de verossimilhança de simulações usando dados de Poisson
superdispersos. As larguras dos intervalos de confiança (esquerda) e os
níveis de confiança estimados (direita) são plotados em relação ao
desvio padrão das médias usadas para gerar os dados de Poisson. A linha
horizontal no gráfico do nível de confiança mostra o nível de confiança
declarado de 95%.
Simulamos também conjuntos de dados do mesmo modelo usado acima, exceto que a quantidade de superdispersão é controlada com mais precisão definindo o desvio padrão nas médias aleatórias como 0, 1, …, 20. Para cada desvio padrão, geramos 100 conjuntos de dados de tamanho 20. Esses conjuntos de dados são então analisados por um modelo de regressão Poisson usando apenas o intercepto, resultando na estimativa de máxima verossimilhança da média constante para cada conjunto de dados.
Os intervalos de confiança LR baseados em modelo são calculados e as larguras médias do intervalo de confiança e os níveis de confiança verdadeiros estimados - a fração de conjuntos de dados cujo intervalo de confiança contém corretamente - são calculados. Essas larguras e níveis de confiança estimados são graficados em relação aos desvios padrão usados para gerar as médias de Poisson.
O gráfico das larguras do intervalo de confiança mostra que a largura média não é afetada pelos níveis aumentados de superdispersão. Parece haver um pouco mais de variabilidade nas larguras à medida que a superdispersão aumenta, o que reflete a observação feita na primeira simulação de que as médias do caso superdisperso são mais variáveis do que as do Poisson padrão. O maior problema que vemos está nos níveis de confiança estimados. Esses níveis diminuem à medida que a superdispersão aumenta e caem substancialmente abaixo do nível declarado de 95% para desvios padrão maiores. Esta é uma indicação de que as inferências não são confiáveis quando os modelos de regressão de Poisson comuns são ajustados para dados superdispersos, mesmo quando o modelo para a média está correto.
Outras causas para superdispersão foram dadas na literatura. Por exemplo, McCullagh and Nelder (1989), entre outros, destacam que os modelos binomial padrão e de Poisson assumem que cada tentativa ou observação é independente de todas as outras. No entanto, às vezes o processo de amostragem é tal que essa suposição não é satisfeita. Um exemplo comum é a amostragem de dados em clusters, o que significa que grupos de observações são amostrados juntos.
Normalmente, as observações dentro de um cluster respondem de maneira mais semelhante umas às outras do que as observações em clusters diferentes. Por exemplo, casais casados podem ter opiniões mais parecidas com as de seus cônjuges do que com as de outra pessoa aleatória. O gado no mesmo curral ou campo tende a ter problemas de saúde mais semelhantes do que o gado selecionado de locais diferentes.
Produtos fabricados em tempos semelhantes em uma determinada linha de montagem podem apresentar defeitos mais semelhantes do que produtos de linhas diferentes ou períodos de produção diferentes. Se a amostragem for feita em casais, currais de gado ou lotes de produtos consecutivos produzidos – ou seja, em conglomerados – então os indivíduos resultantes tenderão a ser positivamente correlacionados dentro de seus conglomerados. A correlação positiva dentro dos clusters faz com que as médias ou probabilidades sejam mais variáveis do que seus respectivos modelos esperam. Assim, tratar unidades que foram reunidas em clusters como se fossem independentes provavelmente levará à superdispersão. Esse fenômeno é discutido com mais detalhes na Seção 6.5.
5.3.2 Detecção
O principal sintoma da superdispersão é um ajuste inadequado do modelo sem nenhuma causa óbvia. Em particular, estatísticas de bondade de ajuste muito largas descritas na Seção 5.2.2, como a estatística deviance/df ou testes formais de qualidade de ajuste, indicam um problema com o modelo. No entanto, isso não é evidência de superdispersão por si só.
O exame de resíduos padronizadas é necessário para descartar outras questões. Os gráficos não devem mostrar um ajuste ruim do modelo médio, nem identificar um ou talvez dois outliers específicos que possam estar causando o desvio excessivamente grande e/ou a estatística de Pearson. Se esses outros problemas estiverem presentes, eles devem ser resolvidos antes de considerar se há superdispersão. Tipicamente, a superdispersão faz com que muitos resíduos de Pearson ou padronizados fiquem próximos ou além dos limites esperados para valores “extremos” – consideravelmente mais de 5% deles além de 2 e frequentemente vários além de 3. Esses resíduos extremos geralmente ocorrem de maneira bastante uniforme em todos os valores do preditor linear, na média ou probabilidade estimada ou em qualquer variável explicativa.
Exemplo 5.11: Contagem de pássaros equatorianos.
Neste exemplo, revisitamos os dados da contagem de pássaros equatorianos originalmente analisados na Seção 4.2.3. Reajustamos o modelo de Poisson usado para esses dados e examinamos os resultados em busca de sinais de superdispersão. Isso é feito usando a estatística deviance/df e um gráfico dos resíduos padronizados em relação às médias estimadas. Os resultados relevantes são dados abaixo:
#####################################################################
# Enter the data
alldata <- read.table(file = "http://leg.ufpr.br/~lucambio/ADC/BirdCounts.csv",
sep = ",", header = TRUE)
head(alldata)## Loc Birds
## 1 ForA 155
## 2 ForA 84
## 3 ForB 77
## 4 ForB 57
## 5 ForB 38
## 6 ForB 40#####################################################################
# Model using regular likelihood
# Fit Poisson Regression
Mpoi <- glm(formula = Birds ~ Loc, family = poisson(link = "log"), data = alldata)
summary(Mpoi)##
## Call:
## glm(formula = Birds ~ Loc, family = poisson(link = "log"), data = alldata)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.4322 -0.7594 -0.1302 0.8874 3.1038
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.87640 0.07198 53.853 <2e-16 ***
## LocForA 0.90692 0.09678 9.371 <2e-16 ***
## LocForB 0.13094 0.09062 1.445 0.1485
## LocFrag 0.11874 0.09082 1.307 0.1911
## LocPasA -0.20010 0.13356 -1.498 0.1341
## LocPasB -0.23881 0.10844 -2.202 0.0277 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 216.944 on 23 degrees of freedom
## Residual deviance: 67.224 on 18 degrees of freedom
## AIC: 217.87
##
## Number of Fisher Scoring iterations: 4# Residual plots vs. predicted
pred <- predict(Mpoi, type = "response")
# Standardized Pearson residuals
stand.resid <- rstandard(model = Mpoi, type = "pearson")
par(mfrow = c(1,2))
plot(x = pred, y = stand.resid, xlab = "Predicted count",
ylab = "Standardized Pearson residuals",
main = "Residuals from regular likelihood", ylim = c(-5,5))
grid()
abline(h = c(-3, -2, 0, 2, 3), lty = "dotted", col = "red")
#####################################################################
# Model using quasi-likelihood
# Fit Quasi-Poisson model
Mqp <- glm(formula = Birds ~ Loc, family = quasipoisson(link = "log"), data = alldata)
summary(Mqp)##
## Call:
## glm(formula = Birds ~ Loc, family = quasipoisson(link = "log"),
## data = alldata)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.4322 -0.7594 -0.1302 0.8874 3.1038
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.8764 0.1391 27.877 2.93e-16 ***
## LocForA 0.9069 0.1870 4.851 0.000128 ***
## LocForB 0.1309 0.1751 0.748 0.464139
## LocFrag 0.1187 0.1755 0.677 0.507153
## LocPasA -0.2001 0.2580 -0.775 0.448115
## LocPasB -0.2388 0.2095 -1.140 0.269257
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasipoisson family taken to be 3.731881)
##
## Null deviance: 216.944 on 23 degrees of freedom
## Residual deviance: 67.224 on 18 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 4# Demonstrate calculation of dispersion parameter
pearson <- residuals(Mpoi, type = "pearson")
sum(pearson^2)/Mpoi$df.residual## [1] 3.731881# Residual plots vs. predicted
pred <- predict(Mqp, type = "response")
stand.resid <- rstandard(model = Mqp, type = "pearson") # Standardized Pearson residuals
plot(x = pred, y = stand.resid, xlab = "Predicted count",
ylab = "Standardized Pearson residuals",
main = "Residuals from quasi-likelihood", ylim = c(-5,5))
grid()
abline(h = c(-3, -2, 0, 2, 3), lty = "dotted", col = "red")
Figura 5.7: Resíduos padronizados graficados contra a
média para os dados da contagem de pássaros do Equador. Esquerda:
Resíduos do ajuste do modelo original de Poisson. Direita: Resíduos do
ajuste de um modelo quasi-Poisson. Em ambos os casos, linhas pontilhadas
superiores e inferiores são dadas em \(\pm\) 2 e \(\pm\) 3 para ajudar na interpretação dos
gráficos
A razão residual deviance/df é 67.2/18 = 3.73, que é muito maior do que as diretrizes sugeridas na Seção 5.2.2: 1+3\(\sqrt{2/18}\) = 2.0. O gráfico residual à esquerda na Figura 5.7 mostra que 4 de 24 resíduos estão além de \(\pm\) 3, e 2 estão além de \(\pm\) 4.
#####################################################################
# Comparison of inferences
anova(Mpoi, test = "Chisq") ## Analysis of Deviance Table
##
## Model: poisson, link: log
##
## Response: Birds
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 23 216.944
## Loc 5 149.72 18 67.224 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(Mqp, test = "Chisq") ## Analysis of Deviance Table
##
## Model: quasipoisson, link: log
##
## Response: Birds
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 23 216.944
## Loc 5 149.72 18 67.224 1.413e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Predicted means and CIs
pred.data <- data.frame(Loc = c("ForA", "ForB", "Frag", "Edge", "PasA", "PasB"))
means.poi <- predict(object = Mpoi, newdata = pred.data, type = "link", se.fit = TRUE)
means.qp <- predict(object = Mqp, newdata = pred.data, type = "link", se.fit = TRUE)
# Wald CI for log means
alpha <- 0.05
lower.logmean.poi <- means.poi$fit + qnorm(alpha/2)*means.poi$se.fit
upper.logmean.poi <- means.poi$fit + qnorm(1-alpha/2)*means.poi$se.fit
lower.logmean.qp <- means.qp$fit + qnorm(alpha/2)*means.qp$se.fit
upper.logmean.qp <- means.qp$fit + qnorm(1-alpha/2)*means.qp$se.fit
# Combine means and confidence intervals in count scale
mean.wald.ci.poi <- data.frame(pred.data, round(cbind(exp(means.poi$fit),
exp(lower.logmean.poi), exp(upper.logmean.poi)), digits = 2))
colnames(mean.wald.ci.poi) <- c("Location", "Mean", "Lower", "Upper")
mean.wald.ci.poi## Location Mean Lower Upper
## 1 ForA 119.50 105.27 135.65
## 2 ForB 55.00 49.37 61.27
## 3 Frag 54.33 48.74 60.56
## 4 Edge 48.25 41.90 55.56
## 5 PasA 39.50 31.68 49.25
## 6 PasB 38.00 32.41 44.55mean.wald.ci.qp <- data.frame(pred.data, round(cbind(exp(means.qp$fit),
exp(lower.logmean.qp), exp(upper.logmean.qp)), digits = 2))
colnames(mean.wald.ci.qp) <- c("Location", "Mean", "Lower", "Upper")
mean.wald.ci.qp## Location Mean Lower Upper
## 1 ForA 119.50 93.54 152.66
## 2 ForB 55.00 44.65 67.75
## 3 Frag 54.33 44.05 67.01
## 4 Edge 48.25 36.74 63.37
## 5 PasA 39.50 25.80 60.48
## 6 PasB 38.00 27.95 51.66Como a variável explicativa é categórica, não há preocupação com a não linearidade neste gráfico. Além disso, não há outras variáveis a serem consideradas para adicionar a esse modelo e não há agrupamento no processo de amostragem. Portanto, concluímos que o mau ajuste do modelo é provavelmente causado por superdispersão. Examinamos soluções para o problema na próxima seção.
Observe que a superdispersão ocorre quando a variância aparente das contagens de resposta é maior do que o modelo sugere. Em regressões binomiais ou multinomiais, em que todos os EVPs têm \(n_m = 1\), a superdispersão não pode ser detectada, mesmo quando se espera que ocorra.
Por exemplo, se houver grupos de dados altamente correlacionados que estão sendo erroneamente tratados como observações independentes. Isso ocorre porque quando \(n_m = 1\), as respostas podem assumir apenas valores 0 ou 1 e não podem expressar variabilidade extra, enquanto quando \(n_m > 1\), as contagens podem ser distribuídas mais longe de \(n_m \widehat{\pi}_m\) do que o esperado.
5.3.3 Soluções
Como a superdispersão é resultado de uma inadequação no modelo, a maneira óbvia de resolver o problema da superdispersão é consertar o modelo. Como se faz isso depende da fonte da superdispersão.
O caso mais fácil de lidar é quando existem variáveis adicionais que foram medidas, mas não incluídas no modelo. Em seguida, adicionar um ou mais deles ao modelo criará previsões mais próximas das contagens observadas, especialmente se as variáveis adicionadas estiverem fortemente relacionadas à resposta. Os resíduos do novo modelo serão, portanto, geralmente menores do que os do modelo original e o deviance residual será reduzido. Se aumentar o modelo dessa maneira for bem-sucedido na remoção dos sintomas de superdispersão, as inferências poderão ser realizadas da maneira usual usando o modelo aumentado.
Exemplo 5.12: Placekick.
Vimos em exemplos anteriores que a distância na qual um placekick é tentado é o preditor mais importante da probabilidade de sucesso do chute. Este resultado faz sentido, dada a compreensão do chute de posição no futebol. Em muitos outros problemas, no entanto, não há intuição suficiente para levar a um bom palpite sobre quais variáveis explicativas serão importantes. Neste exemplo, demonstramos o que pode acontecer quando uma variável explicativa importante — representada pela distância nos dados de placekicking — é deixada de fora do modelo.
Ajustamos um modelo de regressão logística usando apenas o vento como preditor e avaliamos o ajuste desse modelo. Em seguida, adicionamos distância ao modelo, reajustamos e mostramos a avaliação revisada do ajuste. Antes do ajuste e avaliação do modelo, os dados são agregados no formulário EVP correspondente a amabas wind e distance. Isso nos permite comparar estatísticas de ajuste entre modelos com e sem a variável de distância.
placekick <- read.table(file = "http://leg.ufpr.br/~lucambio/ADC/Placekick.csv",
header = TRUE, sep = ",")
head(placekick)## week distance change elap30 PAT type field wind good
## 1 1 21 1 24.7167 0 1 1 0 1
## 2 1 21 0 15.8500 0 1 1 0 1
## 3 1 20 0 0.4500 1 1 1 0 1
## 4 1 28 0 13.5500 0 1 1 0 1
## 5 1 20 0 21.8667 1 0 0 0 1
## 6 1 25 0 17.6833 0 0 0 0 1tail(placekick)## week distance change elap30 PAT type field wind good
## 1420 17 44 1 15.8500 0 0 0 0 0
## 1421 17 20 0 1.9000 1 0 0 0 1
## 1422 17 55 0 0.0000 0 0 0 0 0
## 1423 17 20 1 17.9833 1 0 0 0 1
## 1424 17 35 1 10.3667 0 0 0 0 0
## 1425 17 50 1 2.3833 0 0 0 0 0# Putting data into explanatory variable pattern form for wind + distance
# so that deviance/DF statistics can be compared.
w <- aggregate( good ~ distance + wind , data = placekick, FUN = sum)
n <- aggregate( good ~ distance + wind , data = placekick, FUN = length)
w.n <- data.frame(success = w$good, trials = n$good, distance = w$distance, wind = w$wind)
# Fit logistic regression model with wind, but not distance.
mod.fit.nodist <- glm(formula = success/trials ~ wind, weights = trials,
family = binomial(link = logit), data = w.n)
summary(mod.fit.nodist) ##
## Call:
## glm(formula = success/trials ~ wind, family = binomial(link = logit),
## data = w.n, weights = trials)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -4.1098 -1.8930 -1.0842 0.6039 9.7430
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.08973 0.08803 23.738 <2e-16 ***
## wind -0.48030 0.27279 -1.761 0.0783 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 317.35 on 70 degrees of freedom
## Residual deviance: 314.51 on 69 degrees of freedom
## AIC: 423.81
##
## Number of Fisher Scoring iterations: 5pred <- predict(mod.fit.nodist)
# Standardized Pearson residuals
stand.resid <- rstandard(model = mod.fit.nodist, type = "pearson")
par(mfrow = c(1,2))
# Standardized pearson residual vs predicted without distance
plot(x = pred, y = stand.resid, xlab = "Estimated logit(P(success))",
ylab = "Standardized Pearson residuals",
main = "Standardized residuals vs. Estimated logit", ylim = c(-6, 13), pch = 19)
grid()
abline(h = c(-3,-2,0,2,3), lty = "dotted", col = "red")
# Standardized pearson residual vs Distance
plot(w.n$distance, y = stand.resid, xlab = "Distance",
ylab = "Standardized Pearson residuals",
main = "Standardized residuals vs. Distance", ylim = c(-6, 13), pch = 19)
grid()
abline(h = c(-3,-2,0,2,3), lty = "dotted", col = "red")
dist.ord <- order(w.n$distance)
lines(x = w.n$distance[dist.ord], y = predict(loess(formula = stand.resid ~ w.n$distance,
weights = w.n$trials))[dist.ord], col = "blue")
>Figura 5.8: Gráficos de resíduos padronizados para
dados de placekick quando o modelo de regressão logística contém apenas
vento. As linhas em \(\pm\) 2 e \(\pm\) 3 são limites aproximados para
resíduos padronizados. Esquerda: Resíduos versus o logit da
probabilidade estimada de sucesso. Direita: Resíduos versus a variável
omitida distance, com a curva de uma suavização de
loess ponderada adicionada para acentuar a tendência média.
O ajuste do modelo sem distância é mostrado acima. A razão deviance/df é 314.51/69 = 4.5, bem acima do limite superior esperado para esta estatística, 1+3\(\sqrt{2/69}\) = 1.5. Este resultado não deixa dúvidas de que o modelo não se ajusta, mas não explica o porquê. O gráfico dos resíduos padronizados contra o preditor linear, na Figura 5.8, gráfico à esquerda, mostra um padrão geralmente superdisperso, com vários resíduos bem fora do intervalo esperado.
Este gráfico não explica a causa dos resíduos extremos e pode ser pensado genericamente para indicar superdispersão. No entanto, o gráfico à direita mostra que os resíduos têm um padrão decrescente muito claro à medida que a distância da variável omitida aumenta. Isso ocorre porque o modelo assume uma probabilidade constante de sucesso para todas as distâncias em um determinado nível de wind. Portanto, as probabilidades de sucesso observadas são maiores do que o modelo espera para chutes curtos (short placekicks), levando a resíduos geralmente positivos e as probabilidades de sucesso observadas são menores do que o modelo espera para chutes longos, levando a resíduos negativos.
Em seguida, adicionamos distance ao modelo e repetimos a análise:
# Adding distance to the model.
mod.fit.dist <- glm(formula = success/trials ~ distance + wind, weights = trials,
family = binomial(link = logit), data = w.n)
summary(mod.fit.dist) ##
## Call:
## glm(formula = success/trials ~ distance + wind, family = binomial(link = logit),
## data = w.n, weights = trials)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.25028 -0.86865 -0.08738 0.67005 2.32243
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 5.884528 0.331916 17.729 <2e-16 ***
## distance -0.115588 0.008396 -13.767 <2e-16 ***
## wind -0.582124 0.314051 -1.854 0.0638 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 317.345 on 70 degrees of freedom
## Residual deviance: 76.453 on 68 degrees of freedom
## AIC: 187.76
##
## Number of Fisher Scoring iterations: 5stand.resid <- rstandard(model = mod.fit.dist, type = "pearson") # Standardized Pearson residuals
pred <- predict(mod.fit.dist)
pred.ord <- order(predict(mod.fit.dist))
# Standardized pearson residual vs predicted with distance
par(mfrow = c(1,2))
plot(x = pred, y = stand.resid, xlab = "Estimated logit(P(Success))", pch = 19,
ylab = "Standardized Pearson residuals", ylim = c(-6, 13))
grid()
abline(h = c(-3,-2,0,2,3), lty = "dotted", col = "red")
# Add a loess fit to the residuals
pred.ord <- order(pred)
lines(x = pred[pred.ord], y = predict(loess(formula = stand.resid ~ pred,
weights = w.n$trials))[pred.ord], col = "blue")
# Standardized pearson residual vs Distance
stand.resid <- rstandard(model = mod.fit.nodist, type = "pearson") # Standardized Pearson residuals
plot(w.n$distance, y = stand.resid, xlab = "Distance", ylab = "Standardized Pearson residuals",
main = "Standardized residuals vs. Distance", ylim = c(-6, 13), pch = 19)
grid()
abline(h = c(-3,-2,0,2,3), lty = "dotted", col = "red")
dist.ord <- order(w.n$distance)
lines(x = w.n$distance[dist.ord], y = predict(loess(formula = stand.resid ~ w.n$distance,
weights = w.n$trials))[dist.ord], col = "blue")
Figura 5.9: Resíduos padronizados contra o preditor
linear para dados de placekick quando o modelo de regressão logística
para sucesso contém velocidade e distância do vento. As linhas vermelhas
superior e inferior em \(\pm\) 2 e
\(\pm\) 3 são limites aproximados para
resíduos padronizados. A curva sólida é de um loess ponderado mais suave
para destacar qualquer tendência média.
A variável adicionada reduz a razão deviance/df para 76.453/68 = 1.1, que está bem dentro do limite inferior de 1+2\(\sqrt{2/68}\) = 1.3. Os resíduos são mostrados na Figura 5.9 na mesma escala dos gráficos anteriores para facilitar a comparação. A curva de tendência média loess ponderada mostra um padrão muito semelhante ao observado na Figura 5.3 e a interpretação oferecida para esse gráfico no exemplo correspondente se aplica aqui. Embora ainda existam alguns pontos fora dos limiares \(\pm\) 2 e \(\pm\) 3, nenhum é tão extremo quanto quando distance foi deixada de fora do modelo.
As variáveis medidas com um efeito grande o suficiente para criar uma superdispersão digna de nota raramente são omitidas de um modelo quando um procedimento de seleção de variável apropriado foi aplicado aos dados. No entanto, a seleção de variáveis geralmente não considera as interações até que um ajuste de modelo ruim sugira que elas possam ser necessárias. Assim, se a superdispersão aparecer e não houver outras variáveis disponíveis que não tenham sido consideradas é possível que adicionar uma ou mais interações ao modelo possa aliviar o problema.
Outras causas de superdispersão requerem diferentes alterações de modelo. Por exemplo, se a aparente superdispersão for causada pela análise de dados agrupados como se fossem independentes, o problema geralmente pode ser resolvido adicionando um termo de efeito aleatório ao modelo com um nível diferente para cada agrupamento. Em seguida, um parâmetro separado é ajustado, o que representa a variabilidade extra criada pela correlação dentro do cluster. O resultado é um modelo misto linear generalizado, ou seja, um modelo contendo variáveis de efeito fixo e aleatório. Detalhes sobre como formular e contabilizar efeitos aleatórios são fornecidos na Seção 6.5.
5.3.3.1 Modelos de quase verossimilhança
Quando não há causa aparente para a superdispersão, pode ser devido à omissão de variáveis importantes que são desconhecidas e não medidas, às vezes chamadas de variáveis ocultas (Moore and Notz, 2009). Adicionar essas variáveis ao modelo obviamente não é uma opção. Em vez disso, a solução é mudar a família distributiva para uma com um parâmetro adicional para medir a variância extra que não é explicada pelo modelo original. Existem várias abordagens diferentes para fazer isso, cada uma das quais fornece um modelo mais flexível para a variância do que o Poisson ou as famílias binomiais permitem. Recomendamos fortemente contra o uso rotineiro desses métodos, a menos que todos os outros caminhos para a melhoria do modelo tenham sido esgotados. Esses métodos geralmente são apenas um remendo que encobre um sintoma de um problema, em vez de uma cura para o problema.
Uma abordagem para fazer isso, chamada quase verossimilhança, pode ser usada tanto para análises binomiais quanto para análises de Poisson. No contexto atual, uma função de quase verossimilhança é uma função de verossimilhança que tem parâmetros extras adicionados a ela que não fazem parte da distribuição na qual a verossimilhança se baseia. Como exemplo, suponha que modelamos contagens como Poisson com média \(\mu(x)\), onde \(x\) representa uma ou mais variáveis explicativas. Suponha que a superdispersão decorra de uma inflação constante da variância; ou seja, suponha que \(\mbox{Var}(Y|x) = \gamma \mu(x)\), onde \(\gamma\geq 1\) é uma constante desconhecida chamada de parâmetro de dispersão. Uma quase-verossimilhança pode ser criada para explicar isso dividindo-se o logaritmo de Poisson usual por \(\gamma\).
A quase-verossimilhança é definida mais rigorosamente em Wedderburn (1974) de acordo com as propriedades da primeira derivada da log-verossimilhança em relação a \(\mu\). Dividindo o log-verossimilhança ou sua primeira derivada por fornecer resultados equivalentes. Ver McCullagh and Nelder (1989) para um tratamento mais abrangente da quase-verossimilhança.
Isso não tem efeito nas estimativas dos parâmetros de regressão, mas depois de computadas, uma estimativa de \(\gamma\) é encontrada dividindo-se a estatística de bondade de ajuste de Pearson para o modelo por seus graus de liberdade residuais, \(M-\widetilde{p}\), onde \(\widetilde{p}\) é o número de parâmetros estimados no modelo. Veja Wedderburn (1974) para detalhes.
Estimativas de parâmetros e estatísticas de teste calculadas a partir de uma função de quase verossimilhança têm as mesmas propriedades daquelas calculadas a partir de uma verossimilhança regular, portanto, as inferências são realizadas usando as mesmas ferramentas básicas, com pequenas alterações. Primeiro, a estimativa do parâmetro de dispersão \(\widehat{\gamma}\), que é maior que 1 quando existe superdispersão, é usada para ajustar erros padrão e testar estatísticas para inferências subsequentes. Em segundo lugar, as distribuições amostrais usadas para testes e intervalos de confiança precisam refletir o fato de que a dispersão está sendo estimada com uma estatística baseada no modelo estatístico de Pearson, que tem aproximadamente distribuição qui-quadrado com \(M-\widetilde{p}\) graus de liberdade em grandes amostras.
Especificamente, considere uma estatística LRT para um efeito de modelo que normalmente seria comparado a uma distribuição qui-quadrada com \(q\) graus de liberdade (df). A estatística é dividida por \(\widehat{\gamma}\), o que não apenas a torna menor, mas também altera sua distribuição. Dividir ainda mais a estatística por \(q\) cria uma nova estatística que, em grandes amostras, pode ser comparada a uma distribuição \(F\) com \((q;M-\widetilde{p})\) graus de liberdade. Da mesma forma, os erros padrão dos parâmetros de regressão são multiplicados por \(\sqrt{\widehat{\gamma}}\), o que altera a distribuição de grandes amostras na qual os intervalos de confiança são baseados de normal para \(t_{M-\widetilde{p}}\). As estatísticas de diagnóstico, como resíduos padronizados e a distância de Cook, também são ajustadas adequadamente por \(\widehat{\gamma}\).
Finalmente, muitas vezes é recomendado que \(\widehat{\gamma}\) seja calculado a partir de um “modelo máximo”, ou seja, aquele que contém todas as variáveis disponíveis, mesmo quando o modelo final ao qual a quase verossimilhança é aplicada é um modelo menor. Isso é feito para garantir que não haja inflação artificial da estimativa do parâmetro de dispersão devido à falta de variáveis explicativas. No entanto, em estudos modernos, muitas vezes há um grande número de variáveis explicativas disponíveis, muitas das quais se espera que não sejam importantes. Nesses casos, basear \(\widehat{\gamma}\) em um modelo maximal pode ser excessivamente conservador, se não impossível. Se os graus de liberdade residuais do modelo completo forem muito menores do que os graus de liberdade residuais de um modelo contendo apenas as variáveis importantes, o poder dos testes e as larguras dos intervalos de confiança podem ser prejudicados.
Estimar a partir de um modelo completo é “seguro”, mas se alguém puder ter bastante confiança de que nenhuma variável medida importante foi deixada de fora de um modelo menor específico, esse modelo deve ser capaz de fornecer uma estimativa razoável que pode resultar em resultados mais poderosos de inferências.
Quando a quase verossimilhança é aplicada a um modelo de Poisson, conforme descrito acima, o resultado às vezes é chamado de modelo quase Poisson. A mesma abordagem de quase verossimilhança pode ser aplicada a um modelo binomial, caso em que modelamos \[ \mbox{Var}(Y|x_m) = n_m \pi(x_m)\big(1-\pi(x_m)\big), \] onde \(\pi(x_m)\) é a probabilidade de sucesso e \(n_m\) é o número de tentativas para EVP \(m\). O resultado às vezes é chamado de modelo quas-binomial. Este modelo só é relevante quando pelo menos alguns \(n_m > 1\); caso contrário, a estatística de Pearson não pode ser usada para medir a superdispersão.
Exemplo 5.13: Contagens de pássaros equatorianos.
Neste exemplo, reajustamos os dados da contagem de pássaros equatorianos usando um modelo quasi-Poisson. O ajuste de modelo quasi-Poisson e quasi-binomial está disponível em glm() usando \[ \mbox{family = quasipoisson(link = "log")} \] ou \[ \mbox{quasibinomial(link = "logit")}\cdot \]
Funções de ligação alternativas podem ser especificadas. Aqui aplicamos um modelo quase-Poisson às contagens de aves equatorianas:
####################################################################
# Enter the data
alldata <- read.table(file = "http://leg.ufpr.br/~lucambio/ADC/BirdCounts.csv",
sep = ",", header = TRUE)
head(alldata)## Loc Birds
## 1 ForA 155
## 2 ForA 84
## 3 ForB 77
## 4 ForB 57
## 5 ForB 38
## 6 ForB 40# Fit Poisson Regression
Mpoi <- glm(formula = Birds ~ Loc, family = poisson(link = "log"), data = alldata)
summary(Mpoi)##
## Call:
## glm(formula = Birds ~ Loc, family = poisson(link = "log"), data = alldata)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.4322 -0.7594 -0.1302 0.8874 3.1038
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.87640 0.07198 53.853 <2e-16 ***
## LocForA 0.90692 0.09678 9.371 <2e-16 ***
## LocForB 0.13094 0.09062 1.445 0.1485
## LocFrag 0.11874 0.09082 1.307 0.1911
## LocPasA -0.20010 0.13356 -1.498 0.1341
## LocPasB -0.23881 0.10844 -2.202 0.0277 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 216.944 on 23 degrees of freedom
## Residual deviance: 67.224 on 18 degrees of freedom
## AIC: 217.87
##
## Number of Fisher Scoring iterations: 4# Residual plots vs. predicted
pred <- predict(Mpoi, type = "response")
stand.resid <- rstandard(model = Mpoi, type = "pearson") # Standardized Pearson residuals
par(mfrow = c(1,2))
plot(x = pred, y = stand.resid, xlab = "Predicted count",
ylab = "Standardized Pearson residuals",
main = "Residuals from regular likelihood", ylim = c(-5,5), pch = 19)
abline(h = c(-3, -2, 2, 3), lty = "dotted", col = "red")
grid()
#####################################################################
# Model using quasi-likelihood
# Fit Quasi-Poisson model
Mqp <- glm(formula = Birds ~ Loc, family = quasipoisson(link = "log"),
data = alldata)
(sumq <- summary(Mqp))##
## Call:
## glm(formula = Birds ~ Loc, family = quasipoisson(link = "log"),
## data = alldata)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.4322 -0.7594 -0.1302 0.8874 3.1038
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.8764 0.1391 27.877 2.93e-16 ***
## LocForA 0.9069 0.1870 4.851 0.000128 ***
## LocForB 0.1309 0.1751 0.748 0.464139
## LocFrag 0.1187 0.1755 0.677 0.507153
## LocPasA -0.2001 0.2580 -0.775 0.448115
## LocPasB -0.2388 0.2095 -1.140 0.269257
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasipoisson family taken to be 3.731881)
##
## Null deviance: 216.944 on 23 degrees of freedom
## Residual deviance: 67.224 on 18 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 4# Demonstrate calculation of dispersion parameter
pearson <- residuals(Mpoi, type = "pearson")
sum(pearson^2)/Mpoi$df.residual## [1] 3.731881# From summary()
sumq$dispersion## [1] 3.731881# Residual plots vs. predicted
pred <- predict(Mqp, type = "response")
stand.resid <- rstandard(model = Mqp, type = "pearson") # Standardized Pearson residuals
plot(x = pred, y = stand.resid, xlab = "Predicted count",
ylab = "Standardized Pearson residuals",
main = "Residuals from quasi-likelihood", ylim = c(-5,5), pch = 19)
abline(h = c(qnorm(0.995), 0, qnorm(0.005)), lty = "dotted", col = "red")
grid()
Observe várias coisas sobre esses resultados. Primeiro, o deviance residual é idêntico ao do ajuste do modelo de Poisson. Esta é uma indicação de que a parte da função de verossimilhança usada para estimar os parâmetros de regressão não foi alterada.
O parâmetro de dispersão agora é estimado em 3.73 e mostramos o código demonstrando que essa é a estatística de Pearson dividida por seus graus de liberdade. Um gráfico dos resíduos padronizados é fornecido no gráfico à direita na figura acima. Todos os resíduos agora estão contidos em \(\pm\) 3 e apenas dois permanecem fora de \(\pm\) 2.
Para comparar as inferências dos modelos de Poisson e quase-Poisson, calculamos os LRTs para o efeito dos locais nas médias usando a função anova() e, em seguida, calculamos os intervalos de confiança LR para as contagens médias de pássaros. A codificação envolve uma reparametrização para simplificar os cálculos: o parâmetro de intercepto é removido do modelo, permitindo que o logaritmo da média seja estimado diretamente pelo modelo. Podemos então aplicar confint() aos objetos do modelo e exponenciar os resultados para criar intervalos de confiança para as médias.
#####################################################################
# Comparison of inferences
# Note: The confint() function computes LR confidence intervals for model parameters.
# Here, these parameters are not as meaningful as means.
confint(Mpoi)## 2.5 % 97.5 %
## (Intercept) 3.73191332 4.01423188
## LocForA 0.71774122 1.09737999
## LocForB -0.04541042 0.31004606
## LocFrag -0.05803190 0.29822928
## LocPasA -0.46707656 0.05728215
## LocPasB -0.45245695 -0.02695684confint(Mqp)## 2.5 % 97.5 %
## (Intercept) 3.5908707 4.1370866
## LocForA 0.5418629 1.2767664
## LocForB -0.2078713 0.4800714
## LocFrag -0.2209366 0.4685678
## LocPasA -0.7266846 0.2904979
## LocPasB -0.6542274 0.1698912anova(Mpoi, test = "Chisq") ## Analysis of Deviance Table
##
## Model: poisson, link: log
##
## Response: Birds
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 23 216.944
## Loc 5 149.72 18 67.224 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1anova(Mqp, test = "F") ## Analysis of Deviance Table
##
## Model: quasipoisson, link: log
##
## Response: Birds
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev F Pr(>F)
## NULL 23 216.944
## Loc 5 149.72 18 67.224 8.0238 0.0003964 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# The parameters are based on contrasts that are differences between means.
# Re-parameterizing the model by removing the intercept causes the model to
# estimate the 6 log-means directly.
# Confidence intervals for these are now meaningful!
Mpoi.rp <- glm(formula = Birds ~ Loc - 1, family = poisson(link = "log"), data = alldata)
summary(Mpoi.rp)##
## Call:
## glm(formula = Birds ~ Loc - 1, family = poisson(link = "log"),
## data = alldata)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.4322 -0.7594 -0.1302 0.8874 3.1038
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## LocEdge 3.87640 0.07198 53.85 <2e-16 ***
## LocForA 4.78332 0.06468 73.95 <2e-16 ***
## LocForB 4.00733 0.05505 72.80 <2e-16 ***
## LocFrag 3.99514 0.05538 72.13 <2e-16 ***
## LocPasA 3.67630 0.11251 32.68 <2e-16 ***
## LocPasB 3.63759 0.08111 44.85 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 8196.289 on 24 degrees of freedom
## Residual deviance: 67.224 on 18 degrees of freedom
## AIC: 217.87
##
## Number of Fisher Scoring iterations: 4Mqp.rp <- glm(formula = Birds ~ Loc - 1, family = quasipoisson(link = "log"), data = alldata)
summary(Mqp.rp)##
## Call:
## glm(formula = Birds ~ Loc - 1, family = quasipoisson(link = "log"),
## data = alldata)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.4322 -0.7594 -0.1302 0.8874 3.1038
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## LocEdge 3.8764 0.1391 27.88 2.93e-16 ***
## LocForA 4.7833 0.1250 38.28 < 2e-16 ***
## LocForB 4.0073 0.1063 37.68 < 2e-16 ***
## LocFrag 3.9951 0.1070 37.34 < 2e-16 ***
## LocPasA 3.6763 0.2173 16.91 1.70e-12 ***
## LocPasB 3.6376 0.1567 23.21 7.24e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasipoisson family taken to be 3.731881)
##
## Null deviance: 8196.289 on 24 degrees of freedom
## Residual deviance: 67.224 on 18 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 4round(exp(cbind(mean = coef(Mpoi.rp), confint(Mpoi.rp))), 2)## mean 2.5 % 97.5 %
## LocEdge 48.25 41.76 55.38
## LocForA 119.50 104.98 135.30
## LocForB 55.00 49.28 61.15
## LocFrag 54.33 48.65 60.45
## LocPasA 39.50 31.42 48.86
## LocPasB 38.00 32.27 44.37round(exp(cbind(mean = coef(Mqp.rp), confint(Mqp.rp))), 2)## mean 2.5 % 97.5 %
## LocEdge 48.25 36.27 62.62
## LocForA 119.50 92.57 151.20
## LocForB 55.00 44.32 67.27
## LocFrag 54.33 43.72 66.54
## LocPasA 39.50 24.97 58.79
## LocPasB 38.00 27.49 50.89# Alternatively, Wald confidence intervals can be computed on the predicted values
# (means) from the original model
# Predicted means and CIs
pred.data <- data.frame(Loc = c("ForA", "ForB", "Frag", "Edge", "PasA", "PasB"))
means.poi <- predict(object = Mpoi, newdata = pred.data, type = "link", se.fit = TRUE)
means.qp <- predict(object = Mqp, newdata = pred.data, type = "link", se.fit = TRUE)
df.qp <- Mqp$df.residual
# Wald CI for log means
alpha <- 0.05
lower.logmean.poi <- means.poi$fit + qnorm(alpha/2)*means.poi$se.fit
upper.logmean.poi <- means.poi$fit + qnorm(1-alpha/2)*means.poi$se.fit
lower.logmean.qp <- means.qp$fit + qt(alpha/2, df = df.qp)*means.qp$se.fit
upper.logmean.qp <- means.qp$fit + qt(1-alpha/2, df = df.qp)*means.qp$se.fit
# Combine means and confidence intervals in count scale
mean.wald.ci.poi <- data.frame(pred.data, round(cbind(exp(means.poi$fit),
exp(lower.logmean.poi), exp(upper.logmean.poi)), digits = 2))
colnames(mean.wald.ci.poi) <- c("Location", "Mean", "Lower", "Upper")
mean.wald.ci.poi## Location Mean Lower Upper
## 1 ForA 119.50 105.27 135.65
## 2 ForB 55.00 49.37 61.27
## 3 Frag 54.33 48.74 60.56
## 4 Edge 48.25 41.90 55.56
## 5 PasA 39.50 31.68 49.25
## 6 PasB 38.00 32.41 44.55mean.wald.ci.qp <- data.frame(pred.data, round(cbind(exp(means.qp$fit),
exp(lower.logmean.qp), exp(upper.logmean.qp)), digits = 2))
colnames(mean.wald.ci.qp) <- c("Location", "Mean", "Lower", "Upper")
mean.wald.ci.qp## Location Mean Lower Upper
## 1 ForA 119.50 91.91 155.38
## 2 ForB 55.00 43.99 68.77
## 3 Frag 54.33 43.40 68.03
## 4 Edge 48.25 36.03 64.62
## 5 PasA 39.50 25.02 62.36
## 6 PasB 38.00 27.34 52.81O teste para \(H_0 \, : \, \mu_1 = \mu_2 = \cdots = \mu_6\) rejeita essa hipótese nula em ambos os modelos, embora a correção da superdispersão altere o extremo da estatística do teste, medida pelos \(p\)-valores. A estatística LRT para o modelo de Poisson é \(-2\log(\Lambda ) = 149.72\), que tem um \(p\)-valor muito pequeno usando a aproximação \(\chi_5^2\). Por outro lado, o modelo quasi-Poisson usa \[ F = (149.72/5)/(67.22/18) = 8.33, \] que tem um \(p\)-valor de 0.0004 usando uma aproximação da distribuição \(F_{5,18}\).
As médias estimadas pelos dois modelos são idênticas como esperado, porque ambos os modelos usam a mesma verossimilhança para estimar os parâmetros de regressão. No entanto, os intervalos de confiança para o modelo quasi-Poisson são mais amplos do que os do Poisson. Novamente, a conclusão principal não é alterada: a Floresta A ForA tem uma média consideravelmente maior do que todas as outras localidades. No entanto, com o quasi-Poisson há mais sobreposição entre os intervalos de confiança para as duas pastagens e para a borda Edge, fragmento Frag e Floresta B ForB.
Observe que \(\widehat{\gamma}\) não é encontrado por máxima verossimilhança - o cálculo é executado depois que os MLEs são encontrados para os parâmetros de regressão. Assim, o valor de \(\widehat{\gamma}\) não afeta o valor da log-verossimilhança. Em particular, isso significa que os critérios de informação padrão descritos na Seção 5.1.2 não podem ser computados em resultados de estimativas de quase verossimilhança. Em vez disso, existe uma série de critérios de quase-informação, que podemos denotar por \(QIC(k,\gamma)\), que podem ser usados para comparar diferentes modelos de regressão dentro da mesma família de quase-verossimilhança.
Estes são obtidos dividindo o log-verossimilhança \[ \log\Big(L\big(\widehat{\beta} | y_1,\cdots,y_n\big)\Big) \] por \(\widehat{\gamma}\) nas fórmulas para qualquer \(IC(k)\) e adicionando 1 ao número de parâmetros.
Por exemplo, \[ QAIC = -2\log\Big(L\big(\widehat{\beta} | y_1,\cdots,y_n\big)\Big)/\widehat{\gamma} +2(k+1), \] onde \(k\) é o número de parâmetros de regressão estimados, incluindo o intercepto; \(QAIC_c\) e \(QBIC\) são definidos de forma semelhante.
O uso de um \(QIC(k,\gamma)\) para comparar diferentes modelos de regressão deve ser feito com cuidado. Como \(\widehat{\gamma}\) é calculado externamente aos cálculos do MLE, o efeito de alterar seu valor de modelo para modelo não é contabilizado adequadamente no cálculo de \(QIC(k,\gamma)\). Portanto, é importante que todos os modelos de regressão sejam comparados usando o mesmo valor de \(\widehat{\gamma}\). Uma estratégia apropriada é estimar a partir do maior modelo considerado e, em seguida, usar a mesma estimativa nos cálculos de \(QIC(k,\gamma )\) para todos os modelos sendo comparados. Conforme observado antes do exemplo de Contagem de pássaros, isso também garante que a estatística de qualidade de ajuste de Pearson na qual \(\gamma\) se baseia, seja menos provável de ser inflada devido a variáveis omitidas. Para obter detalhes sobre o cálculo de valores \(QIC(k)\) em R, consulte Bolker (2009).
5.3.3.2 Modelos binomial negativo e beta-binomial
Existem outros modelos que podem ser utilizados como alternativas aos modelos padrão ou seus quase homólogos. A distribuição binomial negativa é mais frequentemente usada quando uma alternativa à distribuição de Poisson é necessária. A distribuição binomial negativa resulta de permitir que a média \(\mu\) em uma distribuição de Poisson seja uma variável aleatória com uma distribuição gama.
A distribuição binomial negativa foi originalmente derivada das propriedades dos ensaios de Bernoulli. É a distribuição do número de sucessos observados antes da enésima falha, que dá origem ao nome “binômio negativo”. Consulte, por exemplo, Casella and Berger (2002).
Quando uma distribuição gama é usada como distribuição para a média, surge uma relação específica entre a variância da variável aleatória de contagem \(Y\) e sua média \(\mu\): \[ \mbox{Var}(Y)=\mu+\theta \mu^2, \] onde \(\theta\geq 0\) é um parâmetro desconhecido. Observe que \(\theta=0\) retorna a mesma relação média-variância do modelo de Poisson. Observe também que esta relação é diferente daquela assumida pelo modelo quasi-Poisson, \(\mbox{Var}(Y) = \gamma \mu\). Portanto, esses dois modelos são distintos e pode haver instâncias em que um modelo é preferido em detrimento do outro.
Ver Hoef and Boveng (2007) fornecem algumas orientações para ajudar a decidir entre esses dois modelos. Em particular, um gráfico de \((y_i - \widehat{\mu}_i)^2\) vs.\(\widehat{\mu}_i\) do modelo Poisson pode ajudar a identificar a relação variância-média. Se uma versão suavizada deste gráfico segue uma tendência principalmente linear, então um modelo quase-Poisson é apropriado. Se a tendência for mais de uma quadrática crescente, então o binômial negativo é o preferido. Ver Hoef and Boveng (2007) sugerem que a tendência no gráfico pode ficar mais clara agrupando primeiro os dados de acordo com valores semelhantes de \(\widehat{\mu}_i\), semelhante ao que é feito no teste de Hosmer-Lemeshow discutido na Seção 5.2.2, em seguida, mostrando gráficamente o resíduo quadrático médio em cada grupo em relação à média \(\widehat{\mu}_i\) no grupo.
Ao contrário do modelo quasi-Poisson, todos os parâmetros do modelo binomial negativo, incluindo \(\theta\), são estimados usando MLEs. Portanto, os critérios de informação podem ser usados sem ajustes adicionais para comparar diferentes modelos de regressão binomial negativa. O valor de \(\theta\) conta como um parâmetro adicional nos cálculos de penalidade de \(IC(k)\). Além disso, como esses são os critérios de informação usuais, eles podem ser usados para comparar modelos entre as famílias binomial negativa e de Poisson. No entanto, nenhuma comparação direta com um modelo quasi-Poisson é possível, porque \(QIC(k)\) é um critério diferente.
Exemplo 5.15: Contagens de pássaros equatorianos.
Agora reajustamos os dados da contagem de pássaros do Equador usando uma distribuição binomial negativa. O pacote MASS tem uma função glm.nb() que ajusta a distribuição binomial negativa e estima \(\theta\). A ligação logaritmo é o padrão, mas outras funções de ligação alternativos podem ser especificados usando um argumento link.
Usamos esta função abaixo para ajustar o modelo e examinar os resultados. Em seguida, reajustamos o modelo usando a reparametrização que remove o intercepto e calculamos os intervalos de confiança LR para as médias.
#####################################################################
# Negative Binomial fit
#
# The negative binomial is fit with several functions.
# The MASS package has two ways to do this:
# glm.nb() is a model-fitting function that estimates the dispersion parameter theta.
# A log link is assumed, but alternative link = can be specified.
# family = negative.binomial(theta = )
# fits the negative binomial using the speficied value of theta
library(MASS)
M.nb <- glm.nb(formula = Birds ~ Loc, data = alldata)
summary(M.nb)##
## Call:
## glm.nb(formula = Birds ~ Loc, data = alldata, init.theta = 33.38468149,
## link = log)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.80758 -0.48773 -0.08495 0.55106 1.65702
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 3.8764 0.1126 34.438 < 2e-16 ***
## LocForA 0.9069 0.1784 5.083 3.71e-07 ***
## LocForB 0.1309 0.1438 0.910 0.363
## LocFrag 0.1187 0.1440 0.825 0.410
## LocPasA -0.2001 0.2008 -0.997 0.319
## LocPasB -0.2388 0.1635 -1.460 0.144
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for Negative Binomial(33.3847) family taken to be 1)
##
## Null deviance: 73.370 on 23 degrees of freedom
## Residual deviance: 22.705 on 18 degrees of freedom
## AIC: 198.06
##
## Number of Fisher Scoring iterations: 1
##
##
## Theta: 33.4
## Std. Err.: 14.9
##
## 2 x log-likelihood: -184.061anova(M.nb, test = "Chisq")## Analysis of Deviance Table
##
## Model: Negative Binomial(33.3847), link: log
##
## Response: Birds
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 23 73.370
## Loc 5 50.665 18 22.705 1.013e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# library(car)
# Anova(M.nb)
M.nb.rp <- glm.nb(formula = Birds ~ Loc - 1, data = alldata)
round(exp(cbind(mean = coef(M.nb.rp), confint(M.nb.rp))), 2)## mean 2.5 % 97.5 %
## LocEdge 48.25 38.75 60.26
## LocForA 119.50 91.70 157.91
## LocForB 55.00 46.20 65.64
## LocFrag 54.33 45.62 64.87
## LocPasA 39.50 28.54 54.84
## LocPasB 38.00 30.13 47.99# Plot of squared residuals plots vs. predicted
names(M.nb)## [1] "coefficients" "residuals" "fitted.values"
## [4] "effects" "R" "rank"
## [7] "qr" "family" "linear.predictors"
## [10] "deviance" "aic" "null.deviance"
## [13] "iter" "weights" "prior.weights"
## [16] "df.residual" "df.null" "y"
## [19] "converged" "boundary" "terms"
## [22] "call" "model" "theta"
## [25] "SE.theta" "twologlik" "contrasts"
## [28] "xlevels" "method" "control"res.sq <- residuals(object = Mpoi, type = "response")^2
set1 <- data.frame(res.sq, mu.hat = Mpoi$fitted.values)
fit.lin <- lm(formula = res.sq ~ mu.hat, data = set1)
fit.quad <- lm(formula = res.sq ~ mu.hat + I(mu.hat^2), data = set1)
summary(fit.quad)##
## Call:
## lm(formula = res.sq ~ mu.hat + I(mu.hat^2), data = set1)
##
## Residuals:
## Min 1Q Median 3Q Max
## -159.49 -95.80 -19.95 41.66 320.51
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -108.88160 331.02260 -0.329 0.745
## mu.hat -0.61133 9.69505 -0.063 0.950
## I(mu.hat^2) 0.10115 0.05993 1.688 0.106
##
## Residual standard error: 137.5 on 21 degrees of freedom
## Multiple R-squared: 0.8638, Adjusted R-squared: 0.8508
## F-statistic: 66.6 on 2 and 21 DF, p-value: 8.1e-10plot(x = set1$mu.hat, y = set1$res.sq, xlab = "Predicted count",
ylab = "Squared Residual", pch = 19)
grid()
curve(expr = predict(object = fit.lin, newdata = data.frame(mu.hat = x),
type = "response"), col = "blue",
add = TRUE, lty = "solid")
curve(expr = predict(object = fit.quad, newdata = data.frame(mu.hat = x),
type = "response"), col = "red",
add = TRUE, lty = "dashed")
legend(x = 50, y = 1000, legend = c("Linear", "Quadratic"), col =
c("red", "blue"), lty = c("solid", "dashed"), bty = "n")
Figura 5.10: Gráfico de resíduos quadrados versus
valores preditos para escolher entre modelos quasi-Poisson e binomial
negativa. A linha azul é a linha reta adequada para o modelo
quase-Poisson; linha vermelha é ajuste quadrático para a binomial
negativa.
Os resultados de qualidade do ajuste no summary() mostram que o modelo binomial negativo se ajusta um pouco melhor do que o modelo de Poisson: o deviance residual é 22.7 em 18 df. O parâmetro de dispersão extra \(\theta\) é estimado em 33.4 com um erro padrão de 14.9. Esta estimativa é mais do que dois erros padrão de 0, indicando que a correção da superdispersão é importante.
O LRT para igualdade das médias nas seis localizações é fornecido nos resultados de anova(). O desvio de 50.7 é altamente significativo, embora menos extremo do que o modelo de Poisson não corrigido. As médias estimadas são as mesmas neste modelo que nos modelos anteriores, não precisa ser assim, mas aqui acontece porque estamos usando apenas uma variável explicativa nominal. Os intervalos de confiança são semelhantes aos do modelo quasi-Poisson, exceto que são mais largos para médias maiores e mais estreitos para médias menores. Isso é consistente com a relação variância-média do modelo binomial negativa.
Qual dos dois modelos para corrigir a superdispersão é melhor para esses dados? Para responder a isso, fizemos um gráfico de \((y_i-\widehat{\mu}_i)^2\) vs. \(\widehat{\mu}_i\). Mostramos um ajuste linear e um quadrático para examinar as tendências e ver qual se ajusta melhor.
Os resultados são apresentados na Figura 5.10. A tendência quadrática parece descrever a relação um pouco melhor do que a linha reta, embora a melhora não seja grande. Os coeficientes do ajuste quadrático dos resíduos quadrados contra a média prevista são mostrados acima. O coeficiente quadrático tem um \(p\)-valor de 0.1, que não é significativo, mas não muito grande. Os resultados neste caso são um tanto inconclusivos, então há justificativa para qualquer um dos modelos.
Semelhante ao modelo binomial negativo, o modelo beta-binomial (Williams, 1975) pode servir como uma alternativa ao quase-binomial como um modelo para contagens superdispersas de números fixos de tentativas. Suponha que observamos contagens binomiais de \(M\) EVPs, \(y_1,y_2,\cdots,y_M\), com \(y_m\) resultante de \(n_m\) tentativas com probabilidade \(\pi_m\); \(m = 1,\cdots,M\). O modelo beta-binomial assume que cada \(\pi_m\) segue uma distribuição beta, cuja média pode depender das variáveis explicativas.
A reparametrização da distribuição beta para esse propósito leva ao resultado de que a contagem esperada para o \(m\)-ésimo EVP é \(\mbox{E}(Y_m) = n_m\pi_m\); enquanto a variância é \[ \mbox{Var}(Y_m) = n_m \pi_m(1-\pi_m)(1 + \phi(n_m-1)), \] onde \(0\leq \phi < 1\) é um parâmetro de dispersão desconhecido. Observe que a média dessa distribuição é a mesma da distribuição binomial, assim como a variância, desde que \(\phi= 0\) ou \(n_m = 1\). Quando \(\phi> 0\) e \(n_m > 1\), a variância da contagem é estritamente maior que a variância usual especificada pela distribuição binomial, permitindo assim a superdispersão. Além disso, quando apenas ensaios binários individuais são observados, cada um com suas próprias variáveis explicativas, todos \(n_m = 1\) e o modelo beta-binomial não pode ser ajustado.
Por fim, observe que quando todos os \(n_m\) são iguais, o fator \((1+\phi (n_m-1))\) é o mesmo para todas as observações, de modo que a beta-binomial assume a mesma relação média-variância do modelo quase-binomial. Neste caso, o modelo quasi-binomial mais simples é geralmente preferido.
Parâmetros do modelo beta-binomial são estimados usando MLEs, para que procedimentos de inferência padrão possam ser usados. Além disso, os critérios de informação podem ser computados, então este modelo pode ser comparado a um modelo de regressão binomial comum para ver se a superdispersão é severa o suficiente para justificar o ajuste de um modelo com um parâmetro extra. O ajuste é feito em R usando a função betabin() do pacote aod, abreviação de “Analysis of Overdispersed Data”. A função tem a capacidade de permitir ainda \(\phi\) depender de variáveis explicativas.
A superdispersão pode afetar modelos de regressão multivariada. Infelizmente, a complexidade de um modelo de regressão multicategoria torna a detecção e resolução da superdispersão um pouco mais complicada do que em modelos de resposta única. Geralmente, pode se apresentar como uma inflação de estatísticas de bondade de ajuste que não são explicadas por outras investigações diagnósticas. A solução mais simples é uma formulação do tipo quase verossimilhança, na qual as variâncias e covariâncias entre as contagens para diferentes categorias são todas multiplicadas por uma constante \(\gamma > 1\). Esse processo é discutido em McCullagh and Nelder (1989). Um método alternativo de formulação e ajuste do modelo é discutido em Mebane and Sekhon (2004) e é realizado usando o pacote multinomRob.
Uma extensão do modelo beta-binomial para resposta multivariada, chamada de modelo multinomial de Dirichlet, pode ser usada como alternativa a um modelo de regressão multinomial comum como forma de introduzir variabilidade extra no modelo. Infelizmente, esses modelos são difíceis de ajustar; não temos conhecimento de nenhum pacote R que possa se ajustar a modelos gerais de regressão multinomial de Dirichlet.
Como uma alternativa mais simples para ajustar modelos complexos, uma formulação baseada em Poisson para as contagens multivariadas pode ser usada conforme discutido na Seção 4.2.5. Isso permite o uso de ferramentas mais simples para diagnóstico do modelo e para correção da sobredispersão.
5.4 Exemplos
Nesta seção, reanalisamos dois exemplos que até agora foram apresentados apenas em partes ao longo do texto: os dados de placekicking usando regressão logística e os dados de consumo de álcool usando regressão Poisson.
Nosso objetivo é demonstrar o processo de realização de uma análise completa, começando com a seleção de variáveis, passando pelo ajuste e avaliação do modelo e concluindo com inferências. Apresentamos o código R e os gráficos livremente e explicamos nossa justificativa para cada decisão tomada durante as análises.
5.4.1 Conjunto de dados de regressão logística - placekicking
Agora examinamos o conjunto de dados de placekicking mais de perto para encontrar modelos para a probabilidade de um placekick bem-sucedido que se ajustam bem aos dados. Os dados usados aqui incluem 13 observações adicionais que não faziam parte de nenhum exemplo anterior. A razão pela qual essas observações adicionais são incluídas e eventualmente excluídas, fica clara em nossa análise.
Os dados usados aqui também incluem es variáveis adicionais:
altitude: Altitude oficial em pés para a cidade onde o placekick é tentado, não necessariamente a altitude exata do estádio
home: Variável binária que denota chutes tentados no estádio do placekicker’s em casa (1) vs. fora (0)
precip: Variável binária que indica se a precipitação está caindo no momento do jogo (1) vs. sem precipitação (0)
temp72: Temperatura Fahrenheit no horário do jogo, onde 72² é atribuído a chutes tentados em estádios abobadados
Os dados são lidos da seguinte maneira:
placekick.mb <- read.table("http://leg.ufpr.br/~lucambio/ADC/placekick.mb.csv",
header = TRUE, sep = ",")
head(placekick.mb)## week distance altitude home type precip wind change elap30 PAT field good
## 1 4 18 585 1 0 0 0 0 24.3167 0 0 1
## 2 11 18 585 1 0 0 0 1 13.2000 0 0 1
## 3 11 18 10 0 1 0 0 1 1.5667 0 1 0
## 4 1 19 20 0 1 0 0 0 24.6333 0 1 1
## 5 3 19 5 0 0 0 0 1 25.6000 0 0 1
## 6 6 19 20 0 1 0 0 0 18.2500 0 1 1
## temp72
## 1 72
## 2 72
## 3 74
## 4 79
## 5 72
## 6 82tail(placekick.mb)## week distance altitude home type precip wind change elap30 PAT field good
## 1433 17 55 710 0 0 0 0 0 0.0000 0 0 0
## 1434 13 56 40 0 0 0 0 1 25.4333 0 0 1
## 1435 17 59 1050 1 0 0 0 0 0.1333 0 0 1
## 1436 9 62 100 0 1 0 1 0 0.0000 0 0 0
## 1437 9 63 550 1 1 0 0 1 0.0000 0 0 0
## 1438 15 66 5280 1 1 0 0 0 0.0000 0 1 0
## temp72
## 1433 72
## 1434 72
## 1435 72
## 1436 57
## 1437 55
## 1438 56Seleção variável
Embora pudéssemos usar glmulti() e o algoritmo genético para nos ajudar a pesquisar entre os efeitos principais e todas as suas interações bidirecionais, optamos por limitar as interações àquelas que fazem sentido no contexto do problema. Com base em nossa experiência no futebol americano, acreditamos que as seguintes interações bidirecionais são plausíveis:
distance with altitude, precip, wind, change, elap30, PAT, field e temp72; a distância claramente tem o maior efeito sobre a probabilidade de sucesso e todos esses outros fatores podem ter um efeito maior em chutes mais longos do que em chutes mais curtos.
home with wind; um placekicker em seu campo pode estar mais acostumado aos efeitos do vento local do que um kicker visitante.
precip with type, field e temp72; a precipitação não pode afetar diretamente um jogo em um estádio abobadado, pode ter um efeito maior na grama do que na grama artificial e pode a neve ou outro detalhe deixar os jogadores infelizes se a temperatura estiver baixa o suficiente.
Idealmente, alguém gostaria de considerar todos os efeitos principais e essas 12 interações de uma só vez usando glmulti(), permitindo que seu argumento exclude remova aquelas interações que não são plausíveis. Infelizmente, encontramos um possível erro na função que nos impediu de fazê-lo. Como alternativa, primeiro usamos a função glmulti() para pesquisar entre todos os efeitos principais possíveis para encontrar o modelo com o menor \(AIC_c\). Semelhante aos resultados da Seção 5.1.2, o modelo com distance, wind, change e PAT tem o menor \(AIC_c\).
Em seguida, a partir deste modelo base, realizamos a seleção direta entre as 12 interações. Escrevemos nossa própria função para calcular o \(AIC_c\) para fazer a seleção passo a passo, step() não calcula o \(AIC_c\). Esse processo envolvia adicionar manualmente cada interação ao modelo base em uma sequência de execuções de glm(). Observe que, para qualquer interação que envolva um efeito principal diferente de distance, wind, change e PAT, incluímos esse efeito principal no modelo junto com sua interação. Por exemplo, adicionamos um efeito principal de altitude ao modelo ao avaliar distance:altitude. Abaixo está o primeiro passo da seleção para frente (forward):
# Data has been read in and it is stored in placekick.mb
AICc <- function ( object ) {
n <- length ( object$y )
r <- length ( object$coefficients )
AICc <- AIC( object ) + 2*r*(r+1) /(n-r -1)
list ( AICc = AICc , BIC = BIC( object ))
}
# Main effects model
mod.fit <- glm( formula = good ~ distance + wind + change + PAT,
family = binomial ( link = logit ), data = placekick.mb)
AICc ( object = mod.fit)## $AICc
## [1] 780.8063
##
## $BIC
## [1] 807.1195# Models with one interaction included
mod.fit1 <- glm( formula = good ~ distance + wind + change + PAT + altitude +
distance : altitude , family = binomial ( link = logit ), data = placekick.mb)
mod.fit2 <- glm(formula = good ~ distance + wind + change + PAT + precip + distance:precip,
family = binomial(link = logit), data = placekick.mb)
mod.fit3 <- glm(formula = good ~ distance + wind + change + PAT + distance:wind,
family = binomial(link = logit), data = placekick.mb)
mod.fit4 <- glm(formula = good ~ distance + wind + change + PAT + distance:change,
family = binomial(link = logit), data = placekick.mb)
mod.fit5 <- glm(formula = good ~ distance + wind + change + PAT + elap30 + distance:elap30,
family = binomial(link = logit), data = placekick.mb)
mod.fit6 <- glm(formula = good ~ distance + wind + change + PAT + distance:PAT,
family = binomial(link = logit), data = placekick.mb)
mod.fit7 <- glm(formula = good ~ distance + wind + change + PAT + field + distance:field,
family = binomial(link = logit), data = placekick.mb)
mod.fit8 <- glm(formula = good ~ distance + wind + change + PAT + temp72 + distance:temp72,
family = binomial(link = logit), data = placekick.mb)
mod.fit9 <- glm(formula = good ~ distance + wind + change + PAT + home + home:wind,
family = binomial(link = logit), data = placekick.mb)
mod.fit10 <- glm(formula = good ~ distance + wind + change + PAT + type + precip + type:precip,
family = binomial(link = logit), data = placekick.mb)
mod.fit11 <- glm(formula = good ~ distance + wind + change + PAT + precip + field + precip:field,
family = binomial(link = logit), data = placekick.mb)
mod.fit12 <- glm( formula = good ~ distance + wind + change + PAT + precip + temp72 +
precip :temp72 , family = binomial ( link= logit ), data = placekick.mb)
inter <- c("distance:altitude", "distance:precip", "distance:wind", "distance:change",
"distance:elap30", "distance:PAT", "distance:field", "distance:temp72",
"home:wind", "type:precip", "precip:field", "precip:temp72")
AICc.vec <- c( AICc (mod.fit1 )$AICc , AICc (mod.fit2 )$AICc , AICc (mod.fit3 )$AICc ,
AICc (mod.fit4 )$AICc , AICc (mod.fit5 )$AICc , AICc (mod.fit6 )$AICc ,
AICc (mod.fit7 )$AICc , AICc (mod.fit8 )$AICc , AICc (mod.fit9 )$AICc ,
AICc (mod.fit10 )$AICc , AICc (mod.fit11 )$AICc , AICc (mod.fit12 ) $AICc )
all.AICc1 <- data.frame ( inter = inter , AICc.vec )
all.AICc1 [ order (all.AICc1 [ ,2]) , ]## inter AICc.vec
## 3 distance:wind 777.2594
## 6 distance:PAT 777.3321
## 7 distance:field 782.4092
## 4 distance:change 782.6573
## 9 home:wind 783.6260
## 1 distance:altitude 784.4997
## 10 type:precip 784.6068
## 2 distance:precip 784.6492
## 8 distance:temp72 784.6507
## 5 distance:elap30 784.6822
## 11 precip:field 785.7221
## 12 precip:temp72 786.5106O modelo base tem \(AIC_c = 780.8\). Os resultados da adição de cada interação individualmente a este modelo são classificados aumentando o \(AIC_c\). A adição de distance:wind melhora o modelo ao máximo \(AIC_c = 777.25\), portanto, a primeira etapa da seleção para frente adiciona distance:wind ao modelo.
O código para as etapas subseqüentes está incluído no programa acima. Em resumo, a segunda etapa adiciona distance:PAT, \(AIC_c = 773.80\) e a terceira etapa resulta em nenhum modelo com um \(AIC_c\) menor. Assim, a seleção direta descobre que o “melhor” modelo adiciona distance:wind e distance:PAT ao modelo base. Como um método alternativo para avaliar a importância das interações, também usamos glmulti() com os principais efeitos de distance, PAT, wind, change junto com as interações pairwise entre apenas essas variáveis. Isso identificou o mesmo modelo de nossa seleção forward anterior.
######################################################################
# Model selection - try main effects models only
# The 32- or 64-bit version of R being used needs to have the corresponding 32- or
# 64-bit version of
# Java installed on the computer in order for glmulti to work
# Sys.setenv("JAVA_HOME" = "") # If R has problems loading glmulti, may need to use this code
library(glmulti)
mod.fit.full <- glm(formula = good ~ week + distance + altitude + home + type + precip + wind +
change + elap30 + PAT + field, family = binomial(link = logit), data = placekick.mb)
summary(mod.fit.full)##
## Call:
## glm(formula = good ~ week + distance + altitude + home + type +
## precip + wind + change + elap30 + PAT + field, family = binomial(link = logit),
## data = placekick.mb)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.9647 0.1689 0.2030 0.4606 1.5023
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.757e+00 5.691e-01 8.360 < 2e-16 ***
## week -2.472e-02 1.964e-02 -1.259 0.20819
## distance -8.838e-02 1.131e-02 -7.815 5.49e-15 ***
## altitude 6.627e-05 1.085e-04 0.611 0.54120
## home 2.168e-01 1.872e-01 1.158 0.24680
## type 3.516e-01 2.900e-01 1.212 0.22539
## precip -2.024e-01 4.472e-01 -0.453 0.65080
## wind -6.599e-01 3.512e-01 -1.879 0.06027 .
## change -3.210e-01 1.962e-01 -1.636 0.10187
## elap30 3.704e-03 1.052e-02 0.352 0.72482
## PAT 1.088e+00 3.697e-01 2.942 0.00326 **
## field -3.074e-01 2.643e-01 -1.163 0.24475
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1024.77 on 1437 degrees of freedom
## Residual deviance: 765.74 on 1426 degrees of freedom
## AIC: 789.74
##
## Number of Fisher Scoring iterations: 6# All possible using AICc
search.1.aicc <- glmulti(y = mod.fit.full, level = 1, method = "h", crit = "aicc",
family = binomial(link = "logit"), plotty = FALSE, report = FALSE)
slotNames(search.1.aicc)## [1] "name" "params" "nbmods" "crits" "K" "formulas" "call"
## [8] "adi" "objects"search.1.aicc@formulas[[1]]## good ~ 1 + distance + wind + change + PAT
## <environment: 0x560df66826a8>weightable(search.1.aicc)[1:20,]## model aicc weights
## 1 good ~ 1 + distance + wind + change + PAT 780.8063 0.03472394
## 2 good ~ 1 + week + distance + wind + change + PAT 781.1386 0.02940828
## 3 good ~ 1 + week + distance + change + PAT 781.1653 0.02901847
## 4 good ~ 1 + distance + change + PAT 781.2868 0.02730893
## 5 good ~ 1 + distance + wind + PAT 781.6147 0.02317858
## 6 good ~ 1 + distance + home + wind + change + PAT 781.7210 0.02197970
## 7 good ~ 1 + week + distance + home + wind + change + PAT 781.9811 0.01929937
## 8 good ~ 1 + week + distance + home + change + PAT 782.0795 0.01837210
## 9 good ~ 1 + week + distance + wind + PAT 782.1563 0.01768037
## 10 good ~ 1 + distance + PAT 782.1992 0.01730521
## 11 good ~ 1 + distance + home + change + PAT 782.2912 0.01652687
## 12 good ~ 1 + week + distance + PAT 782.3041 0.01642114
## 13 good ~ 1 + distance + type + wind + change + PAT 782.4182 0.01551002
## 14 good ~ 1 + distance + home + wind + PAT 782.5179 0.01475582
## 15 good ~ 1 + distance + altitude + wind + change + PAT 782.5242 0.01470994
## 16 good ~ 1 + distance + wind + change + elap30 + PAT 782.6700 0.01367538
## 17 good ~ 1 + distance + wind + change + PAT + field 782.7084 0.01341554
## 18 good ~ 1 + week + distance + type + wind + change + PAT 782.7914 0.01287009
## 19 good ~ 1 + week + distance + altitude + change + PAT 782.7933 0.01285774
## 20 good ~ 1 + distance + precip + wind + change + PAT 782.7976 0.01282999print(search.1.aicc)## glmulti.analysis
## Method: h / Fitting: glm / IC used: aicc
## Level: 1 / Marginality: FALSE
## From 100 models:
## Best IC: 780.80634381996
## Best model:
## [1] "good ~ 1 + distance + wind + change + PAT"
## Evidence weight: 0.0347239351027186
## Worst IC: 784.673641893819
## 20 models within 2 IC units.
## 90 models to reach 95% of evidence weight.Em seguida, consideramos se o modelo atual pode ser melhorado considerando as transformações das variáveis explicativas. Como PAT, wind e change são variáveis explicativas binárias, nenhuma transformação para essas variáveis precisa ser considerada. Para avaliar distance, convertemos os dados em formato EVP, reajustamos o modelo, obtemos os resíduos padronizados de Pearson e, em seguida, mostramos esses resíduos padronizados de Pearson versus distance.
# Convert data to EVP form ; interactions are not needed in aggregate () because they do not
# change the number of unique combinations of explanatory variables.
w <- aggregate ( good ~ distance + wind + change + PAT , data = placekick.mb , FUN = sum )
n <- aggregate ( good ~ distance + wind + change + PAT , data = placekick.mb , FUN = length )
w.n <- data.frame (w, trials = n$good , prop = round ( w$good / n$good , 4))
head (w.n)## distance wind change PAT good trials prop
## 1 18 0 0 0 1 1 1.0000
## 2 19 0 0 0 3 3 1.0000
## 3 20 0 0 0 15 15 1.0000
## 4 21 0 0 0 11 12 0.9167
## 5 22 0 0 0 7 8 0.8750
## 6 23 0 0 0 15 15 1.0000nrow (w.n) # Number of EVPs (M)## [1] 124sum(w.n$trials ) # Number of observations## [1] 1438# Estimates here match those had before converting data to EVP form
mod.prelim1 <- glm( formula = good / trials ~ distance + wind + change + PAT + distance : wind +
distance :PAT , family = binomial ( link = logit ), data = w.n, weights = trials )
round ( summary (mod.prelim1 ) $coefficients , digits = 4)## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.4964 0.4814 9.3399 0.0000
## distance -0.0807 0.0114 -7.0620 0.0000
## wind 2.9248 1.7850 1.6385 0.1013
## change -0.3320 0.1945 -1.7068 0.0879
## PAT 6.7119 2.1137 3.1754 0.0015
## distance:wind -0.0918 0.0457 -2.0095 0.0445
## distance:PAT -0.2717 0.0980 -2.7726 0.0056# Plot of standardized Pearson residuals vs. distance
stand.resid <- rstandard ( model = mod.prelim1 , type = "pearson")
plot (x = w.n$distance , y = stand.resid ,
ylim = c(min (-3, stand.resid ), max (3, stand.resid )),
ylab = " Standardized Pearson residuals ", xlab = " Distance ")
abline (h = c(3, 2, 0, -2, -3) , lty = "dotted", col = "blue")
smooth.stand <- loess ( formula = stand.resid ~ distance , data = w.n, weights = trials )
ord.dist <- order (w.n$distance )
lines (x = w.n$distance [ord.dist ], y = predict ( smooth.stand )[ord.dist ],
lty = "solid", col = "red")
grid()
Figura 5.11: Resíduos padronizados de Pearson
vs. distância do placekick.
A figura acima mostra o gráfico junto com uma curva de loess. A curva ondula suavemente em torno de 0, não mostrando tendências aparentes para o valor médio dos resíduos. Isso sugere que nenhuma transformação de distance é necessária no modelo. Para fins de ilustração, também adicionamos temporariamente um termo quadrático para distance ao modelo. Isso aumenta o \(AIC_c\) para 775.72, o que concorda com nossas descobertas do gráfico. Portanto, um modelo preliminar para nossos dados inclui distance, PAT, wind, change, distance:wind e distance:PAT.
Avaliando o ajuste do modelo - modelo preliminar
Para agilizar o processo de avaliação do ajuste do modelo preliminar, escrevemos uma função que implementa a maioria dos métodos descritos na Seção 5.2 de maneira simplificada especificamente para regressão logística. Essa função, chamada examine.logistic.reg(), está disponível aqui. O único argumento necessário é mod.fit.obj, que corresponde ao objeto glm-class que contém o modelo cujo ajuste deve ser avaliado.
Alguns dos argumentos opcionais incluem identity.points que permite aos usuários identificar pontos interativamente em um gráfico, scale.n e scale.cookd que permitem aos usuários redimensionar valores numéricos usados como o tamanho do círculo em gráficos de bolhas e pearson.dev para denotar se Pearson padronizado ou os resíduos de deviance padronizados são plotados, o padrão é Pearson. Esses argumentos serão explicados com mais detalhes em breve. O uso da função é demonstrado abaixo e os gráficos resultantes estão na figura abaixo.
# Used with examine . logistic .reg () for rescaling numerical values
one.fourth.root <- function (x) { x^0.25}
one.fourth.root (16) # Example## [1] 2# Read in file containing Examine.logistic.reg () and run function
source ( file = "http://leg.ufpr.br/~lucambio/ADC/Examine_logistic_reg.R")
save.info1 <- examine.logistic.reg( mod.fit.obj = mod.prelim1 ,
identify.points = TRUE , scale.n = one.fourth.root , scale.cookd = sqrt )
names ( save.info1 )## [1] "pearson" "stand.resid" "stand.dev.resid" "deltaXsq"
## [5] "deltaD" "cookd" "pear.stat" "dev"
## [9] "dev.df" "gof.threshold" "pi.hat" "h"Figura 5.12: Gráficos diagnósticos para o modelo de regressão logística placekicking; todas as observações são incluídas no conjunto de dados.
Depois que cada gráfico é criado, R solicita ao usuário que identifique pontos nesse gráfico. Esta identificação é feita clicando com o botão esquerdo nos pontos de interesse, e estes são subsequentemente rotulados pelo nome da linha em placekick.mb. Cada linha de um quadro de dados tem um “nome”. Esses nomes de linha são mostrados na coluna mais à esquerda de um quadro de dados impresso. Normalmente, o número da linha do quadro de dados é o nome da linha. No entanto, esses nomes de linha podem ser alterados para serem mais descritivos. Por exemplo, se set1 for um conjunto de dados de duas linhas, então
row.names(set1) = c("row 1", "row 2")
substituirá os nomes de linha padrão para set1 pelos nomes linha 1 e linha 2.
Para o gráfico (linha, coluna) = (1,1) na Figura 5.12, EVPs 15, 34, 48, 55, 60, 87, 101 e 103 são todos identificados dessa maneira. Para finalizar o processo de identificação de uma determinada parcela, o usuário pode clicar com o botão direito do mouse e selecionar Parar da janela resultante. Por padrão, o argumento identity.points é definido como TRUE, mas pode ser alterado para FALSE na chamada de função se a identificação não for de interesse.
Os gráficos (1,1) e (1,2) são semelhantes aos mostrados na Seção 5.2 para os resíduos padronizados de Pearson, distâncias de Cook e alavancagens. Linhas horizontais na plotagem (1,1) são desenhadas em -3, -2, 2 e 3 para ajudar a julgar os EVPs periféricos. Existem alguns EVPs fora ou perto dessas linhas que podemos querer investigar mais. Uma curva de loess incluída no gráfico não mostra uma relação clara entre os resíduos e as probabilidades estimadas. Uma linha horizontal é desenhada em 4/\(M\) no gráfico (1,2) para ajudar a determinar quais EVPs podem ser potencialmente influentes conforme julgado pela distância de Cook. O gráfico mostra que o EVP 120 tem um valor muito grande em comparação com os outros EVPs, então definitivamente queremos investigar mais este EVP.
Existem alguns outros EVPs com distâncias de Cook que se destacam do resto que podemos querer examinar mais de perto também. Linhas verticais no gráfico (1,2) são desenhadas em 2\(p/M\) e 3\(p/M\) para julgar o potencial de influência conforme indicado pela alavancagem. Para esta medida, vemos que tanto o EVP 117 quanto o 120 possuem alavancagem muito alta. Dois outros EVPs, 121 e 123, também têm valores de alavancagem à direita da linha vertical 3\(p/M\) indicando a potencial de influência.
Os gráficos (2,1) e (2,2) fornecem gráficos de bolhas de \(\Delta X^2_m\) contra a probabilidade de sucesso estimada pelo modelo. Linhas horizontais são desenhadas em 4 e 9 para ajudar a apontar os EVPs que podem ser influentes. O ponto de plotagem do gráfico (2,1) tem um raio que é proporcional ao número de tentativas para o EVP. Isso ajuda a julgar se um valor periférico indica ou não um problema potencial ou se é simplesmente devido a uma aproximação distribucional ruim.
Alguns EVPs envolvendo PATs no conjunto de dados têm um número relativamente maior de tentativas do que outros (por exemplo, EVP 117 tem o maior número de tentativas com 614), o que pode distorcer um gráfico de bolhas desse tipo. Isso nos levou a usar o argumento scale.n para redimensionar o número de tentativas para que as diferenças relativas no raio entre 1 e 614 tentativas sejam menos pronunciadas. Depois de tentar sqrt() e log(), decidimos que uma escala de raiz quarta criou o gráfico mais bonito e, como não há uma função R integrada para calcular essa transformação, criamos a nossa própria.
Para o gráfico (2,2), encontramos problemas um tanto semelhantes devido ao valor muito grande da distância de Cook do EVP 120 e decidimos que sqrt() funcionou melhor para redimensionar.
O gráfico de bolhas (2,1) mostra que alguns EVPs com grandes probabilidades estimadas também têm valores \(\Delta X^2_m\) um tanto grandes. No entanto, esses EVPs correspondentes têm um pequeno número de tentativas, conforme mostrado pelo tamanho de seu ponto de plotagem (exceto talvez EVP 15), portanto, esses EVPs podem não ser necessariamente realmente incomuns. Ainda assim, devemos examinar esses EVPs mais de perto antes de fazer um julgamento final. Uma característica interessante do gráfico (2,2) é que o valor muito grande da distância de Cook (EVP 120, o maior círculo no gráfico) tem um resíduo padronizado quadrado relativamente pequeno. Isso pode indicar um EVP muito influente que está “puxando” o modelo em sua direção para melhorar seu ajuste.
Abaixo dos gráficos gerados por examine.logistic.reg(), a estatística deviance/df é mostrada como \[ D/(M-\widetilde{p}) = 1.01\cdot \] Os limiares de \[ 1 + 2\sqrt{2/(M-\widetilde{p})} = 1.26 \qquad \mbox{e} \qquad 1+3\sqrt{2/(M-\widetilde{p})} = 1.39 \] também são dados na parte inferior do gráfico.
Como o deviance/df está bem abaixo desses limiares, não há evidência de nenhum problema com o ajuste geral do modelo. Também aplicamos o teste Hosmer-Lemeshow (\(g\) = 10; resultado não mostrado aqui) e obtivemos um \(p\)-valor de 0.97, indicando novamente que não há evidências suficientes de um problema com o ajuste geral do modelo. Em seguida, examinamos os EVPs identificados nos gráficos mais de perto.
Nosso método preferido para isso é examinar todos os EVPs com suas probabilidades estimadas, resíduos de Pearson padronizados, distâncias de Cook e valores de alavancagem juntos em um conjunto de dados. Com apenas 124 EVPs, isso é administrável; no entanto, para economizar espaço aqui e para ilustrar o que pode ser feito quando o número de EVPs é muito maior, imprimimos apenas aqueles EVPs com resíduos de Pearson padronizados maiores que 2 em valor absoluto, distâncias de Cook maiores que 4/124 = 0.0323, ou valores de alavancagem maiores que \(3\times 7\)/124 = 0.17. O código abaixo ilustra o processo de extração desses EVPs do quadro de dados w.n principal:
w.n.diag1 <- data.frame (w.n, pi.hat = round ( save.info1$pi.hat , 2) ,
std.res = round ( save.info1$stand.resid , 2) ,
cookd = round ( save.info1$cookd , 2) , h = round ( save.info1$h , 2))
p <- length (mod.prelim1$coefficients )
ck.out <- abs(w.n.diag1$std.res ) > 2 | w.n.diag1$cookd > 4/ nrow (w.n) | w.n.diag1$h >
3*p/ nrow (w.n) # "|" means "or"
extract.EVPs <- w.n.diag1 [ck.out ,]
extract.EVPs [ order ( extract.EVPs$distance ) ,] # Order by distance## distance wind change PAT good trials prop pi.hat std.res cookd h
## 60 18 0 1 0 1 2 0.5000 0.94 -2.57 0.01 0.01
## 117 20 0 0 1 605 614 0.9853 0.98 0.32 0.06 0.81
## 121 20 1 0 1 42 42 1.0000 0.99 0.52 0.01 0.19
## 123 20 0 1 1 94 97 0.9691 0.98 -0.75 0.02 0.23
## 101 25 1 1 0 1 2 0.5000 0.94 -2.73 0.06 0.05
## 119 29 0 0 1 0 1 0.0000 0.73 -1.76 0.07 0.13
## 120 30 0 0 1 3 4 0.7500 0.65 0.83 0.31 0.76
## 103 31 1 1 0 0 1 0.0000 0.85 -2.43 0.03 0.03
## 15 32 0 0 0 12 18 0.6667 0.87 -2.67 0.06 0.05
## 48 32 1 0 0 0 1 0.0000 0.87 -2.62 0.02 0.02
## 87 45 0 1 0 1 5 0.2000 0.63 -2.03 0.02 0.03
## 55 50 1 0 0 1 1 1.0000 0.23 1.90 0.04 0.07A maioria destas EVPs não são verdadeiramente preocupantes porque consistem num número muito pequeno de ensaios. Conforme detalhado na Secção 5.2.1, os limiares de 2 e 3 baseados numa aproximação de distribuição normal padrão não são muito úteis nesta situação. Os grandes valores de alavancagem (h) para os EVPs 121 e 123 são provavelmente devidos ao seu número relativamente grande de ensaios, o que lhes dá automaticamente o potencial de influência.
Existem três EVPs que requerem discussão mais aprofundada. O EVP 117 tem uma das maiores distâncias de Cook e a maior alavancagem. No entanto, este EVP consiste em 614 do total de 1.438 ensaios no conjunto de dados. Esperaríamos que um EVP com uma percentagem tão grande do total de observações fosse influente.
A principal preocupação com uma observação tão influente é que ela poderia “puxar” o modelo de regressão em sua direção, o que criaria uma grande distância de Cook e poderia causar resíduos maiores (em valor absoluto) para EVPs semelhantes. Vemos apenas uma distância de Cook ligeiramente elevada e nenhum efeito aparente em outros resíduos, portanto o EVP 117 não nos causa mais preocupação. O EVP 15 parece simplesmente ter um número de sucessos invulgarmente baixo em comparação com a sua probabilidade estimada de sucesso. Isto causa um resíduo padronizado de Pearson um tanto grande (ainda inferior a 3 em valor absoluto) e uma distância de Cook.
Finalmente, o EVP 120 tem de longe a maior distância de Cook e a segunda maior alavancagem. Isso sugere que provavelmente é influente. Suas variáveis explicativas observadas correspondem a um tipo muito incomum de placekick – um PAT de 30 jardas, em vez do habitual PAT de 20 jardas – que ocorre apenas como resultado de uma penalidade em uma tentativa inicial de placekick. Na verdade, notamos que o EVP 119 também é um PAT a uma distância não padrão. Isso nos leva a perguntar se esses tipos incomuns de placekicks são de alguma forma diferentes dos tipos mais típicos de placekicks e talvez precisem de atenção separada.
Para examinar mais de perto os EVPs 119 e 120 e seus efeitos no modelo, nós os removemos temporariamente do conjunto de dados e reestimamos o modelo:
mod.prelim1.wo119.120 = glm( formula = good/trials ~ distance + wind + change + PAT +
distance:wind + distance:PAT, family = binomial ( link = logit ),
data = w.n[-c(119 , 120) ,], weights = trials )
round ( summary (mod.prelim1.wo119.120)$coefficients , digits = 4)## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.4985 0.4816 9.3400 0.0000
## distance -0.0807 0.0114 -7.0640 0.0000
## wind 2.8770 1.7866 1.6103 0.1073
## change -0.3308 0.1945 -1.7010 0.0889
## PAT -12.0703 49.2169 -0.2452 0.8063
## distance:wind -0.0907 0.0457 -1.9851 0.0471
## distance:PAT 0.6666 2.4607 0.2709 0.7865A saída mostra uma mudança dramática na estimativa correspondente à distance:PAT. Quando EVP 119 e 120 estão no conjunto de dados, a estimativa é -0.2717 com um \(p\)-valor do teste de Wald de 0.0056. Agora, a estimativa é 0.6666 com um \(p\)-valor do teste de Wald de 0.7865. Portanto, parece que a presença desta interação se deveu apenas aos cinco placekicks correspondentes a estes EVPs.
Existem 5 EVPs contendo um total de 13 observações que não são PATs de 20 jardas no conjunto de dados e 11 desses placekicks são sucessos, as duas falhas estão incluídas nos EVPs 119 e 120. Devido ao pequeno número desses tipos de placekicks, é difícil determinar se o que observamos aqui é uma tendência real ou uma anomalia nos dados. Isto leva então a três opções possíveis:
Retorne os EVPs 119 e 120 ao conjunto de dados e reconheça que eles são responsáveis por fazer com que a interação distância:PAT pareça importante
Remova todos os PATs que não sejam de 20 jardas do conjunto de dados, o que subsequentemente reduz a população de inferência
Remova todos os PATs do conjunto de dados e encontre modelos separados para metas de campo e PATs
Decidimos que a opção 2 era uma escolha um pouco melhor do que as outras duas. PATs que não sejam de 20 jardas são eventos um tanto incomuns e sempre seguem penalidades. Se eles realmente tiverem probabilidades de sucesso diferentes, não teremos uma boa maneira de fazer essa determinação.
Portanto, acreditamos que PATs que não sejam de 20 jardas podem ser fundamentalmente diferentes de outros chutes de posição e devem ser removidos dos dados. Por sua vez, isto leva a uma redução correspondente da população de inferência, embora extremamente pequena, para a análise. Manter os PATs de 20 jardas nos dados é um julgamento separado.
Eles também são diferentes dos arremessos de campo porque valem um ponto em vez de três e são sempre chutados do meio do campo. Portanto, há motivos para removê-los e desenvolver modelos separados para os dois tipos de chutes. No entanto, presumimos que os efeitos de outras variáveis, como o vento e suas interações, são os mesmos para qualquer tipo de chute, e a perda dos 614 PATs de 20 jardas dos dados reduziria a precisão para estimar esses efeitos. Escolhemos, portanto, a opção 2: removemos os PATs que não são de 20 jardas e continuamos a análise.
Avaliando o modelo ajuste - modelo revisado
Abaixo está o código para remover os PATs que não sejam de 20 jardas:
# Remove non -20 yard PATs - "!" negates and "&" means "and"
placekick.mb2 = placekick.mb [!( placekick.mb$distance !=20 & placekick.mb$PAT ==1) ,]
nrow ( placekick.mb2) # Number of observations after 13 were removed## [1] 1425Voltamos agora à etapa de seleção de variáveis com este conjunto de dados revisado contendo um total de 1.425 placekicks. Os detalhes são fornecidos em nosso programa correspondente, e o modelo resultante é o mesmo de antes, exceto que distância:PAT não está mais selecionado. Abaixo está o resultado correspondente do ajuste do novo modelo.
# EVP form
w2 <- aggregate(good ~ distance + wind + change + PAT, data = placekick.mb2, FUN = sum)
n2 <- aggregate(good ~ distance + wind + change + PAT, data = placekick.mb2, FUN = length)
w.n2 <- data.frame(w2, trials = n2$good, prop = round(w2$good/n2$good, 2))
head(w.n2)## distance wind change PAT good trials prop
## 1 18 0 0 0 1 1 1.00
## 2 19 0 0 0 3 3 1.00
## 3 20 0 0 0 15 15 1.00
## 4 21 0 0 0 11 12 0.92
## 5 22 0 0 0 7 8 0.88
## 6 23 0 0 0 15 15 1.00nrow(w.n2) # Number of EVPs## [1] 119sum(w.n2$trials) # Number of observations## [1] 1425# Verify model fit to EVP data matches the model fit to the binary response data format
mod.prelim2 <- glm(formula = good/trials ~ distance + wind + change + PAT + distance:wind,
family = binomial(link = logit), data = w.n2, weights = trials)
summary(mod.prelim2)##
## Call:
## glm(formula = good/trials ~ distance + wind + change + PAT +
## distance:wind, family = binomial(link = logit), data = w.n2,
## weights = trials)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2386 -0.5836 0.1965 0.8736 2.2822
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.49835 0.48163 9.340 < 2e-16 ***
## distance -0.08074 0.01143 -7.064 1.62e-12 ***
## wind 2.87783 1.78643 1.611 0.10719
## change -0.33056 0.19445 -1.700 0.08914 .
## PAT 1.25916 0.38714 3.252 0.00114 **
## distance:wind -0.09074 0.04570 -1.986 0.04706 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 376.01 on 118 degrees of freedom
## Residual deviance: 113.86 on 113 degrees of freedom
## AIC: 260.69
##
## Number of Fisher Scoring iterations: 5stand.resid2 <- rstandard(model = mod.prelim2, type = "pearson")
# ord.dist <- order(w.n2$distance)
plot(x = w.n2$distance, y = stand.resid2, ylim = c(min(-3, stand.resid2), max(3, stand.resid2)),
ylab = "Standardized Pearson residuals", xlab = "Distance")
abline(h = c(3, 2, 0, -2, -3), lty = "dotted", col = "blue")
ord.dist2 <- order(w.n2$distance)
smooth.stand2 <- loess(formula = stand.resid2 ~ distance, data = w.n2, weights = trials)
lines(x = w.n2$distance[ord.dist2], y = predict(smooth.stand2)[ord.dist2], lty = "solid", col = "red")
HL <- HLTest(obj = mod.prelim2, g = 10)
cbind(HL$observed, round(HL$expect, digits = 1))## Y0 Y1 Y0hat Y1hat
## [0.0371,0.406] 11 1 9.3 2.7
## (0.406,0.54] 15 18 16.7 16.3
## (0.54,0.631] 31 39 28.8 41.2
## (0.631,0.708] 21 59 26.2 53.8
## (0.708,0.771] 25 68 23.8 69.2
## (0.771,0.839] 21 89 21.3 88.7
## (0.839,0.885] 13 67 10.8 69.2
## (0.885,0.917] 9 75 8.1 75.9
## (0.917,0.944] 5 65 4.7 65.3
## (0.944,0.995] 12 781 13.3 779.7HL##
## Hosmer and Lemeshow goodness-of-fit test with 10 bins
##
## data: mod.prelim2
## X2 = 4.3935, df = 8, p-value = 0.82o.r.test(obj = mod.prelim2)## z = -0.4463477 with p-value = 0.6553461stukel.test(obj = mod.prelim2)## Stukel Test Stat = 7.229242 with p-value = 0.02692713Novamente usamos examine.logistic.reg() para avaliar o ajuste do modelo. Os gráficos correspondentes não são fornecidos aqui porque mostram essencialmente os mesmos resultados de antes, excluindo os EVPs que removemos. O EVP 116 (anteriormente EVP 117) tem a maior distância de Cook atualmente. Este EVP contém os 614 PATs a 20 jardas, então esperamos novamente que isso seja influente. Nenhum dos outros EVPs com distâncias de Cook relativamente grandes possui qualquer característica identificável que possa levar ao seu tamanho.
Demos um passo extra ao remover temporariamente alguns desses EVPs, um de cada vez, e reajustar o modelo para determinar se as estimativas dos parâmetros de regressão mudaram substancialmente. Essas estimativas não o fizeram, portanto não fazemos mais alterações nos dados ou no modelo.
# Diagnostics using data without the non-20 yard placekicks
save.info2 <- examine.logistic.reg(mod.fit.obj = mod.prelim2, identify.points = TRUE,
scale.n = one.fourth.root, scale.cookd = sqrt)
# Examine individual EVPs more closely
w.n.diag2 <- data.frame(w.n2, pi.hat = round(save.info2$pi.hat, 2),
std.res = round(save.info2$stand.resid, 2),
cookd = round(save.info2$cookd, 2), h = round(save.info2$h, 2))
# w.n.diag2 # Excluded to save space in the book
# Potential EVPs to examine further
p <- length(mod.prelim2$coefficients)
ck.out <- abs(w.n.diag2$std.res) > 2 | w.n.diag2$cookd > 4/nrow(w.n2) |
w.n.diag2$h > 3*p/nrow(w.n2)
extract.EVPs2 <- w.n.diag2[ck.out,] # Extract EVPs
extract.EVPs2[order(extract.EVPs2$distance),] # Order by distance## distance wind change PAT good trials prop pi.hat std.res cookd h
## 60 18 0 1 0 1 2 0.50 0.94 -2.58 0.01 0.01
## 116 20 0 0 1 605 614 0.99 0.98 0.45 0.15 0.82
## 117 20 1 0 1 42 42 1.00 0.99 0.54 0.01 0.20
## 118 20 0 1 1 94 97 0.97 0.98 -0.72 0.03 0.23
## 101 25 1 1 0 1 2 0.50 0.94 -2.71 0.07 0.05
## 103 31 1 1 0 0 1 0.00 0.85 -2.41 0.03 0.03
## 15 32 0 0 0 12 18 0.67 0.87 -2.67 0.07 0.05
## 48 32 1 0 0 0 1 0.00 0.87 -2.60 0.03 0.02
## 53 42 1 0 0 2 4 0.50 0.54 -0.19 0.00 0.16
## 87 45 0 1 0 1 5 0.20 0.63 -2.03 0.02 0.03
## 55 50 1 0 0 1 1 1.00 0.23 1.89 0.05 0.07w.n2[100:102,]## distance wind change PAT good trials prop
## 100 22 1 1 0 1 1 1.0
## 101 25 1 1 0 1 2 0.5
## 102 28 1 1 0 1 1 1.0w.n[100:102,]## distance wind change PAT good trials prop
## 100 22 1 1 0 1 1 1.0
## 101 25 1 1 0 1 2 0.5
## 102 28 1 1 0 1 1 1.0mod.prelim2.wo101 <- glm(formula = good/trials ~ distance + wind + change +
PAT + distance:wind, family = binomial(link = logit),
data = w.n2[-101,], weights = trials)
summary(mod.prelim2.wo101)##
## Call:
## glm(formula = good/trials ~ distance + wind + change + PAT +
## distance:wind, family = binomial(link = logit), data = w.n2[-101,
## ], weights = trials)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2336 -0.5701 0.2093 0.8587 2.2907
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.50634 0.48380 9.314 < 2e-16 ***
## distance -0.08108 0.01148 -7.065 1.6e-12 ***
## wind 4.14721 2.19080 1.893 0.05836 .
## change -0.31261 0.19557 -1.599 0.10993
## PAT 1.24216 0.38911 3.192 0.00141 **
## distance:wind -0.12057 0.05514 -2.187 0.02875 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 374.20 on 117 degrees of freedom
## Residual deviance: 110.42 on 112 degrees of freedom
## AIC: 255.86
##
## Number of Fisher Scoring iterations: 5w.n2[14:16,]## distance wind change PAT good trials prop
## 14 31 0 0 0 8 8 1.00
## 15 32 0 0 0 12 18 0.67
## 16 33 0 0 0 10 11 0.91w.n[14:16,]## distance wind change PAT good trials prop
## 14 31 0 0 0 8 8 1.0000
## 15 32 0 0 0 12 18 0.6667
## 16 33 0 0 0 10 11 0.9091mod.prelim2.wo15 <- glm(formula = good/trials ~ distance + wind + change + PAT +
distance:wind, family = binomial(link = logit), data = w.n2[-15,],
weights = trials)
summary(mod.prelim2.wo15)##
## Call:
## glm(formula = good/trials ~ distance + wind + change + PAT +
## distance:wind, family = binomial(link = logit), data = w.n2[-15,
## ], weights = trials)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0346 -0.5785 0.1510 0.8577 2.2633
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.75170 0.50669 9.378 < 2e-16 ***
## distance -0.08529 0.01186 -7.194 6.29e-13 ***
## wind 2.72101 1.77974 1.529 0.12629
## change -0.39675 0.19802 -2.004 0.04511 *
## PAT 1.11168 0.39687 2.801 0.00509 **
## distance:wind -0.08777 0.04553 -1.928 0.05388 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 369.88 on 117 degrees of freedom
## Residual deviance: 108.45 on 112 degrees of freedom
## AIC: 252.03
##
## Number of Fisher Scoring iterations: 5# Compare
# beta^s
round(data.frame(orig = summary(mod.prelim2)$coefficients[,1],
wo101 = summary(mod.prelim2.wo101)$coefficients[,1],
wo15 = summary(mod.prelim2.wo15)$coefficients[,1]), digits = 4)## orig wo101 wo15
## (Intercept) 4.4984 4.5063 4.7517
## distance -0.0807 -0.0811 -0.0853
## wind 2.8778 4.1472 2.7210
## change -0.3306 -0.3126 -0.3968
## PAT 1.2592 1.2422 1.1117
## distance:wind -0.0907 -0.1206 -0.0878# SEs
round(data.frame(orig = summary(mod.prelim2)$coefficients[,2],
wo101 = summary(mod.prelim2.wo101)$coefficients[,2],
wo15 = summary(mod.prelim2.wo15)$coefficients[,2]), digits = 4)## orig wo101 wo15
## (Intercept) 0.4816 0.4838 0.5067
## distance 0.0114 0.0115 0.0119
## wind 1.7864 2.1908 1.7797
## change 0.1944 0.1956 0.1980
## PAT 0.3871 0.3891 0.3969
## distance:wind 0.0457 0.0551 0.0455# Wald test p-values
round(data.frame(orig = summary(mod.prelim2)$coefficients[,4],
wo101 = summary(mod.prelim2.wo101)$coefficients[,4],
wo15 = summary(mod.prelim2.wo15)$coefficients[,4]), digits = 4)## orig wo101 wo15
## (Intercept) 0.0000 0.0000 0.0000
## distance 0.0000 0.0000 0.0000
## wind 0.1072 0.0584 0.1263
## change 0.0891 0.1099 0.0451
## PAT 0.0011 0.0014 0.0051
## distance:wind 0.0471 0.0288 0.0539Nosso modelo final é \[ \begin{array}{rcl} logit(\widehat{\pi}) & = & 4.4983 - 0.08074\mbox{distance} + 2.8778\mbox{wind} - 0.3306\mbox{change} \\ & & \qquad \qquad + 1.2592\mbox{PAT} - 0.09074\mbox{distance}\times \mbox{wind}\cdot \end{array} \]
Interpretando o modelo
Calculamos odds ratio e intervalos LR de confiança perfilada de 90% correspondentes para interpretar as variáveis explicativas no modelo:
################################################################################
# Model interpretation
# OR estimates
library(package = mcprofile)
OR.name <- c("Change", "PAT", "Distance, 10-yard decrease, windy",
"Distance, 10-yard decrease, not windy", "Wind, distance = 20",
"Wind, distance = 30", "Wind, distance = 40", "Wind, distance = 50",
"Wind, distance = 60")
var.name <- c("int", "distance", "wind", "change", "PAT", "distance:wind")
K <- matrix(data = c(0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 1, 0,
0, -10, 0, 0, 0, -10,
0, -10, 0, 0, 0, 0,
0, 0, 1, 0, 0, 20,
0, 0, 1, 0, 0, 30,
0, 0, 1, 0, 0, 40,
0, 0, 1, 0, 0, 50,
0, 0, 1, 0, 0, 60),
nrow = 9, ncol = 6, byrow = TRUE, dimnames = list(OR.name, var.name))
# K # Check matrix - excluded to save space
linear.combo <- mcprofile(object = mod.prelim2, CM = K)
ci.log.OR <- confint(object = linear.combo, level = 0.90, adjust = "none")
# ci.log.OR
exp(ci.log.OR)##
## mcprofile - Confidence Intervals
##
## level: 0.9
## adjustment: none
##
## Estimate lower upper
## Change 0.7185 0.5223 0.991
## PAT 3.5225 1.8857 6.785
## Distance, 10-yard decrease, windy 5.5557 2.8871 12.977
## Distance, 10-yard decrease, not windy 2.2421 1.8646 2.717
## Wind, distance = 20 2.8950 0.7764 16.242
## Wind, distance = 30 1.1683 0.5392 3.094
## Wind, distance = 40 0.4715 0.2546 0.869
## Wind, distance = 50 0.1903 0.0598 0.515
## Wind, distance = 60 0.0768 0.0111 0.377# Wald CIs (if desired)
save.wald <- wald(linear.combo)
save.wald##
## Multiple Contrast Profiles
##
## Estimate Std.err
## Change -0.331 0.194
## PAT 1.259 0.387
## Distance, 10-yard decrease, windy 1.715 0.449
## Distance, 10-yard decrease, not windy 0.807 0.114
## Wind, distance = 20 1.063 0.910
## Wind, distance = 30 0.156 0.524
## Wind, distance = 40 -0.752 0.370
## Wind, distance = 50 -1.659 0.646
## Wind, distance = 60 -2.567 1.056ci.log.OR.wald <- confint(object = save.wald, level = 0.90, adjust = "none")
exp(ci.log.OR.wald)##
## mcprofile - Confidence Intervals
##
## level: 0.9
## adjustment: none
##
## Estimate lower upper
## Change 0.7185 0.5218 0.989
## PAT 3.5225 1.8633 6.659
## Distance, 10-yard decrease, windy 5.5557 2.6551 11.625
## Distance, 10-yard decrease, not windy 2.2421 1.8578 2.706
## Wind, distance = 20 2.8950 0.6475 12.943
## Wind, distance = 30 1.1683 0.4937 2.764
## Wind, distance = 40 0.4715 0.2564 0.867
## Wind, distance = 50 0.1903 0.0657 0.551
## Wind, distance = 60 0.0768 0.0135 0.436As interpretações das variáveis explicativas change e PAT são as mais simples porque não há interações envolvendo-as no modelo. Com 90% de confiança, as probabilidades de sucesso são entre 0.52 e 0.99 vezes maiores para placekicks de mudança de liderança do que para placekicks de mudança sem liderança, quando mantidas as outras variáveis constantes.
Isto indica evidência moderada de um efeito de pressão para chutes de posição; ou seja, a probabilidade de sucesso é menor para iniciativas de mudança de liderança. Com relação à variável PAT, as chances de sucesso são muito maiores para PATs de 20 jardas do que para arremessos de mesma distância, quando mantidas as outras variáveis constantes.
As interpretações das variáveis explicativas da distance e wind precisam levar em conta sua interação. Para uma diminuição de 10 jardas na distância, o intervalo de confiança de 90% para o odds ratio é (2.89, 12.98) quando há condições de vento e (1.86, 2.72) quando não há condições de vento. Isso significa que diminuir a distância de um chute de posição é ainda mais importante quando as condições estão ventosas do que quando não estão. Também calculamos as taxas de probabilidade estimadas e os intervalos de confiança correspondentes para condições com vento versus sem vento para chutes de 20, 30, 40, 50 e 60 jardas. Novamente, vemos que os efeitos das condições de vento são mínimos para chutes curtos, mas pronunciados para chutes mais longos.
A probabilidade estimada de sucesso juntamente com os intervalos LR do perfil podem ser calculadas para combinações específicas de variáveis explicativas. Por exemplo, examinamos as probabilidades de sucesso para PATs e gols de campo a uma distância de 20 jardas com wind = 0 e change = 0 da seguinte forma:
# Examine probability of success for PATs vs. field goals
predict(object = mod.prelim2, newdata = data.frame(distance = c(20, 20), wind = c(0, 0),
change = c(0, 0), PAT = c(1, 0)), type = "response")## 1 2
## 0.9843685 0.9470274# Using mcprofile to obtain profile LR
K <- matrix(data = c(1, 20, 0, 0, 1, 0,
1, 20, 0, 0, 0, 0), nrow = 2, ncol = 6, byrow = TRUE,
dimnames = list(c("PAT", "FG"), var.name))
# K # Check matrix - excluded to save space
linear.combo <- mcprofile(object = mod.prelim2, CM = K)
ci.lin.pred <- confint(object = linear.combo, level = 0.90, adjust = "none")
ci.lin.pred##
## mcprofile - Confidence Intervals
##
## level: 0.9
## adjustment: none
##
## Estimate lower upper
## PAT 4.14 3.69 4.67
## FG 2.88 2.45 3.34# exp(ci.lin.pred$estimate)/(1 + exp(ci.lin.pred$estimate))
# plogis(q = c(4.14, 2.88))
# as.matrix() is needed to get the proper class for plogis()
# as.numeric() and as.vector() do not work
round(plogis(q = as.matrix(ci.lin.pred$estimate)), digits = 3) ## Estimate
## PAT 0.984
## FG 0.947round(plogis(q = as.matrix(ci.lin.pred$confint)), digits = 3)## lower upper
## [1,] 0.976 0.991
## [2,] 0.921 0.966#Elliott's kick discussed in Bilder and Loughin (1998)
K <- matrix(data = c(1, 42, 0, 1, 0, 0), nrow = 1, ncol = 6, byrow = TRUE)
K## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 1 42 0 1 0 0linear.combo <- mcprofile(object = mod.prelim2, CM = K)
ci.lin.pred <- confint(object = linear.combo, level = 0.90, adjust = "none")
round(plogis(q = as.matrix(ci.lin.pred$estimate)), digits = 3)## Estimate
## C1 0.685round(plogis(q = as.matrix(ci.lin.pred$confint)), digits = 3)## lower upper
## [1,] 0.628 0.738# Plot - Probability of success for four combinations of explanatory variables
beta.hat <- mod.prelim2$coefficients
# Change = 0, wind = 0
curve(expr = plogis(beta.hat[1] + beta.hat[2]*x), lty = "solid", xlim = c(18, 66),
ylim = c(0, 1), lwd = 2, col = "red", panel.first = grid(col = "gray",
lty = "dotted"), ylab = "Estimated probability of success", xlab = "Distance")
# change = 1, wind = 0
curve(expr = plogis(beta.hat[1] + beta.hat[2]*x + beta.hat[4]), lty = "dashed",
lwd = 2 , col = "darkgreen", add = TRUE)
# change = 0, wind = 1
curve(expr = plogis(beta.hat[1] + beta.hat[2]*x + beta.hat[3] + beta.hat[6]*x),
lty = "dotted", lwd = 2, col = "blue", add = TRUE)
# change = 1, wind = 1
curve(expr = plogis(beta.hat[1] + beta.hat[2]*x + beta.hat[3] + beta.hat[4] + beta.hat[6]*x),
lty = "dotdash", lwd = 2, col = "purple", add = TRUE)
names1 <- c("Change = 0, Wind = 0", "Change = 1, Wind = 0", "Change = 0, Wind = 1",
"Change = 1, Wind = 1")
legend(x = 20, y = 0.39, legend = names1, lty = c("solid", "dashed", "dotted", "dotdash"),
col = c("red","darkgreen","blue","purple"), bty = "n", cex = 1, lwd = 2)
Figura 5.13: Probabilidade estimada de sucesso versus
distância da cesta de campo (PAT = 0) para quatro
combinações de mudança e vento.
Os resultados aqui mostram que a probabilidade de sucesso é maior para PATs do que para gols de campo, como demonstramos anteriormente com o uso de odds ratio. A Figura 5.13 representa graficamente o modelo estimado em função de distance. Com a adição de factores de “risco”, condições ventosas e tentativas de mudança de liderança, a probabilidade estimada de sucesso geralmente diminui. A Figura 5.14 enfatiza ainda mais esse ponto ao representar graficamente a probabilidade de sucesso estimada para os objetivos de campo menos arriscados, change = 0 e wind = 0 e mais arriscados, change = 1 e wind = 1, juntamente com faixas de intervalo de confiança de Wald de 90%. Observe que os intervalos de confiança de 90% não se sobrepõem mais após uma distância de aproximadamente 38 metros.
É importante observar que nossos intervalos de confiança aqui estão todos em níveis declarados de 90% e não controlam uma taxa geral de erro familiar. Para um determinado número de probabilidades de sucesso e cálculos de probabilidade de sucesso, a função confint() fornece uma maneira conveniente para esse controle usando o argumento adjust (veja exemplos na Seção 2.2.6).
# Plot - Probability of success for two combinations of explanatory variables with CIs
# Most of this function is 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
ci.pi(newdata = data.frame(distance = c(20, 20), wind = c(0, 0),
change = c(0, 0), PAT = c(1, 0)), mod.fit.obj = mod.prelim2, alpha = 0.10)## $pi.hat
## 1 2
## 0.9843685 0.9470274
##
## $lower
## 1 2
## 0.9748877 0.9199173
##
## $upper
## 1 2
## 0.9903056 0.9653061# Change = 0, wind = 0
curve(expr = ci.pi(newdata = data.frame(distance = x, wind = 0, change = 0, PAT = 0),
mod.fit.obj = mod.prelim2, alpha = 0.10)$pi.hat, xlim = c(18, 66),
lty = "solid", lwd = 2, col = "red", xlab = "Distance",
ylab = "Estimated probability of success", ylim = c(0, 1),
panel.first = grid(col = "gray", lty = "dotted"))
curve(expr = ci.pi(newdata = data.frame(distance = x, wind = 0, change = 0, PAT = 0),
mod.fit.obj = mod.prelim2, alpha = 0.10)$lower,
lty = "dotted", lwd = 2, col = "red", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(distance = x, wind = 0, change = 0, PAT = 0),
mod.fit.obj = mod.prelim2, alpha = 0.10)$upper,
lty = "dotted", lwd = 2, col = "red", add = TRUE)
# Change = 1 and wind = 1
curve(expr = ci.pi(newdata = data.frame(distance = x, wind = 1, change = 1, PAT = 0),
mod.fit.obj = mod.prelim2, alpha = 0.10)$pi.hat,
lty = "dotdash", lwd = 2, col = "purple", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(distance = x, wind = 1, change = 1, PAT = 0),
mod.fit.obj = mod.prelim2, alpha = 0.10)$lower,
lty = "dotted", lwd = 2, col = "purple", add = TRUE)
curve(expr = ci.pi(newdata = data.frame(distance = x, wind = 1, change = 1, PAT = 0),
mod.fit.obj = mod.prelim2, alpha = 0.10)$upper,
lty = "dotted", lwd = 2, col = "purple", add = TRUE)
names1 <- c("Estimated Probability", "90% Confidence Interval")
text(x = 22, y = 0.38, "Least risky")
legend(x = 17, y = 0.38, legend = names1, lty = c("solid", "dotted", "dotted"),
col = c("red","red"), bty = "n", lwd = 2)
text(x = 21.5, y = 0.18, "Most risky")
legend(x = 17, y = 0.18, legend = names1, lty = c("dotdash", "dotted", "dotted"),
col = c("purple","purple"), bty = "n", lwd = 2)
Figura 5.14: Probabilidade estimada de sucesso versus
distância da cesta de campo (PAT = 0) para as
tentativas de cesta de campo mais e menos arriscadas.
5.4.2 Regressão Poisson - conjunto de dados de consumo de álcool
Neste exemplo, voltamos à análise de regressão Poisson dos dados de consumo de álcool apresentados na Seção 4.2.2. Voltamos a nos concentrar no consumo dos sujeitos durante o primeiro sábado do estudo. Agora realizamos uma análise mais completa dos dados, incluindo exame inicial dos dados, seleção de variáveis, avaliação de ajuste, correção para superdispersão e análise e interpretação dos resultados. Os dados estão disponíveis a seguir:
#####################################################################
# Read the data
dehart = read.csv( file = "http://leg.ufpr.br/~lucambio/ADC/DeHartSimplified.csv",
header = TRUE, sep = ",", na.strings = " ")
head(dehart)## id studyday dayweek numall nrel prel negevent posevent gender rosn
## 1 1 1 6 9 1.000000 0.0000000 0.4000000 0.5250000 2 3.3
## 2 1 2 7 1 0.000000 0.0000000 0.2500000 0.7000000 2 3.3
## 3 1 3 1 1 1.000000 0.0000000 0.2666667 1.0000000 2 3.3
## 4 1 4 2 2 0.000000 1.0000000 0.5333333 0.6083333 2 3.3
## 5 1 5 3 2 1.333333 0.3333333 0.6633333 0.6933333 2 3.3
## 6 1 6 4 1 1.000000 0.0000000 0.5900000 0.6800000 2 3.3
## age desired state
## 1 39.48528 5.666667 4.000000
## 2 39.48528 2.000000 2.777778
## 3 39.48528 3.000000 4.222222
## 4 39.48528 3.666667 4.111111
## 5 39.48528 3.000000 4.222222
## 6 39.48528 4.000000 4.333333# Reduce data to what is needed for examples
saturday <- dehart[dehart$dayweek == 6,]
head(round(x = saturday, digits = 3))## id studyday dayweek numall nrel prel negevent posevent gender rosn age
## 1 1 1 6 9 1.000 0.000 0.400 0.525 2 3.3 39.485
## 11 2 4 6 4 5.833 0.833 2.377 0.924 2 3.9 38.001
## 18 4 4 6 1 0.333 4.000 0.233 1.346 2 3.7 30.048
## 24 5 3 6 0 0.000 0.000 0.200 1.500 2 3.0 27.608
## 35 7 7 6 2 0.000 2.333 0.000 1.633 2 3.3 40.350
## 39 9 4 6 7 1.000 3.000 0.550 0.625 2 3.5 33.046
## desired state
## 1 5.667 4.000
## 11 5.667 4.111
## 18 5.000 4.111
## 24 1.667 4.222
## 35 4.000 4.444
## 39 7.333 4.222dim(saturday)## [1] 89 13# Setting the row labels to be the subject ID values for easier identification.
row.names(saturday) <- saturday$id
# Summarize variables. First three columns are ID and day info, not needed anymore
summary(saturday[,-c(1:3,9)])## numall nrel prel negevent
## Min. : 0.000 Min. :0.0000 Min. :0.000 Min. :0.0000
## 1st Qu.: 2.000 1st Qu.:0.0000 1st Qu.:1.000 1st Qu.:0.1500
## Median : 4.000 Median :0.0000 Median :3.000 Median :0.3500
## Mean : 4.101 Mean :0.4034 Mean :3.297 Mean :0.4404
## 3rd Qu.: 5.000 3rd Qu.:0.3333 3rd Qu.:5.333 3rd Qu.:0.6000
## Max. :21.000 Max. :5.8333 Max. :9.000 Max. :2.3767
## posevent rosn age desired
## Min. :0.0000 Min. :2.100 Min. :24.43 Min. :1.000
## 1st Qu.:0.6833 1st Qu.:3.200 1st Qu.:30.53 1st Qu.:4.000
## Median :1.0333 Median :3.500 Median :34.57 Median :5.000
## Mean :1.1583 Mean :3.436 Mean :34.29 Mean :4.846
## 3rd Qu.:1.4333 3rd Qu.:3.800 3rd Qu.:38.19 3rd Qu.:6.000
## Max. :3.4000 Max. :4.000 Max. :42.28 Max. :8.000
## state
## Min. :2.778
## 1st Qu.:3.778
## Median :4.000
## Mean :4.007
## 3rd Qu.:4.333
## Max. :5.000tabulate(saturday[,9])## [1] 39 50Examinando os dados
Primeiro, introduzimos novas variáveis que não foram usadas antes. O exemplo na Seção 4.2.2 regrediu o número de bebidas consumidas numall contra um índice para o positivo eventos posevent e eventos negativos negevent vivenciados pelo sujeito a cada dia. No Exercício 26 do Capítulo 4, consideramos variáveis explicativas adicionais para eventos de relacionamento romântico positivo prel, eventos de relacionamento romântico negativo nrel, idade age, traço (longo prazo) auto-estima rosn e estado (curto prazo) auto-estima state.
Neste exemplo, adicionamos mais duas variáveis: gender 1=masculino, 2=feminino e desired, que mede o desejo de um sujeito de beber a cada dia, com uma pontuação mais alta significando maior desejo.
Observe que o traço de auto-estima foi medido uma vez no início do estudo, enquanto o estado de auto-estima foi medido diariamente. Observe também que, embora gender seja uma representação numérica de uma variável categórica, não há mal algum em tratá-la como numérica porque há apenas dois níveis. O coeficiente de “inclinação” é exatamente o mesmo que o parâmetro de “diferença” para uma variável categórica de dois níveis quando é codificado com números separados por 1 unidade.
O exemplo da Seção 4.2.2 mostra a criação inicial do conjunto de dados a partir de um arquivo de dados maior. Continuamos a seguir com boxplots e uma matriz de dispersão das nove variáveis numéricas. Os boxplots mostram a extensão da assimetria ou dos dados periféricos.
plotdata <- saturday[,-c(1:3,9)]
par(mfrow = c(3,3), mai = c(0.5, 0.5, 0.5, 0.5))
for (i in 1:ncol(plotdata)) {
boxplot(plotdata[,i], main = names(plotdata[i]), type = "l", cex.axis = 1.5, cex.main = 1.5)
grid()
}
Figura 5.15: Boxplots da resposta
numall e variáveis explicativas para os dados do
consumo de álcool.
Os gráficos de dispersão ajudam a mostrar se há problemas substanciais com a multicolinearidade a serem considerados e também fornecem uma impressão preliminar sobre quais variáveis explicativas podem estar relacionadas à resposta. Usando a função de matriz de dispersão aprimorada spm() do pacote car, obtemos um ajuste suave e um ajuste linear adicionado a cada gráfico de dispersão, bem como uma estimativa da função de densidade ou, opcionalmente, um boxplot para cada variável.
# Enhanced scatterplot available from car package spm()
library(car)
spm(saturday[,-c(1:3,9)], cex.labels = 1.4, cex.axis = 1.4)
Figura 5.16: Matriz de dispersão da resposta
numall e variáveis explicativas para os dados de
consumo de álcool.
Os boxplots e as estimativas de densidade mostram alguma assimetria à direita acentuada em nrel e negevent, o que pode ser uma fonte potencial de alta influência em uma regressão. Também vemos uma inclinação um pouco mais suave em suas contrapartes positivas e um pouco de inclinação à esquerda em rosn.
Na variável resposta numall, destaca-se a contagem extrema de bebida de 21, mencionada nos exemplos anteriores. Isso representa um possível valor discrepante que pode ter um grande resíduo, ou pode ser influente forçando variáveis no modelo para tentar explicá-lo ou alterando parâmetros de regressão em algumas variáveis.
A matriz do gráfico de dispersão não revela correlações substanciais entre as variáveis explicativas. A relação de aparência mais linear parece ser prel vs. posevent, mas há variabilidade considerável para a relação, por isso não é provável que seja uma fonte importante de multicolinearidade. É claro que a multicolinearidade pode ocorrer devido a combinações de mais de duas variáveis e este gráfico não pode retratar tais relações.
Entre as associações entre a resposta e variáveis explicativas, a relação positiva mais forte parece ser com desired, o que sugere que um forte desejo de beber álcool pode ser seguido por um aumento no consumo. Também é interessante notar que o sujeito com o valor extremo do numall relatou o desejo máximo possível de beber desired = 8, empatado com alguns outros e um valor zero para relacionamentos negativos, empatado com muitos outros, mas fora isso não foi extremo em qualquer outra medição.
Selecionando variáveis
Usamos a média do modelo (Seção 5.1.6) para selecionar variáveis para um modelo. Existem nove variáveis explicativas, portanto, uma busca exaustiva dos principais efeitos é possível como primeiro passo para ver quais variáveis parecem mais fortemente relacionadas à contagem de bebidas. Utilizamos o \(AIC_c\) como critério de avaliação de cada modelo.
############### First a main-effects-only search. Exhaustive search is feasible.
library(glmulti)
search.1.aicc <- glmulti(y = numall ~ ., data = saturday[,-c(1:3)],
fitfunction = "glm", plotty = FALSE,
level = 1, method = "h", crit = "aicc",
family = poisson(link = "log"))## Initialization...
## TASK: Exhaustive screening of candidate set.
## Fitting...
##
## After 50 models:
## Best model: numall~1+nrel+negevent
## Crit= 503.738763602739
## Mean crit= 509.078844693516
##
## After 100 models:
## Best model: numall~1+nrel+negevent+posevent+age
## Crit= 500.22397268556
## Mean crit= 508.406725708743
##
## After 150 models:
## Best model: numall~1+nrel+negevent+desired
## Crit= 440.886434713568
## Mean crit= 496.602406083572
##
## After 200 models:
## Best model: numall~1+nrel+negevent+desired
## Crit= 440.886434713568
## Mean crit= 468.270272167456
##
## After 250 models:
## Best model: numall~1+nrel+negevent+age+desired
## Crit= 435.880821999845
## Mean crit= 446.070755229804
##
## After 300 models:
## Best model: numall~1+nrel+negevent+age+desired
## Crit= 435.880821999845
## Mean crit= 445.219946628547
##
## After 350 models:
## Best model: numall~1+nrel+negevent+age+desired
## Crit= 435.880821999845
## Mean crit= 445.219946628547
##
## After 400 models:
## Best model: numall~1+nrel+negevent+age+desired
## Crit= 435.880821999845
## Mean crit= 445.167549412295
##
## After 450 models:
## Best model: numall~1+nrel+negevent+desired+state
## Crit= 435.045075918863
## Mean crit= 443.282167641987
##
## After 500 models:
## Best model: numall~1+nrel+negevent+age+desired+state
## Crit= 430.109908874369
## Mean crit= 441.121806562024
## Completed.print(search.1.aicc)## glmulti.analysis
## Method: h / Fitting: glm / IC used: aicc
## Level: 1 / Marginality: FALSE
## From 100 models:
## Best IC: 430.109908874369
## Best model:
## [1] "numall ~ 1 + nrel + negevent + age + desired + state"
## Evidence weight: 0.258040276400709
## Worst IC: 444.502983808218
## 2 models within 2 IC units.
## 37 models to reach 95% of evidence weight.# Look at top 6 models
head(weightable(search.1.aicc))## model aicc
## 1 numall ~ 1 + nrel + negevent + age + desired + state 430.1099
## 2 numall ~ 1 + nrel + negevent + rosn + age + desired + state 432.0628
## 3 numall ~ 1 + nrel + prel + negevent + age + desired + state 432.2393
## 4 numall ~ 1 + nrel + negevent + posevent + age + desired + state 432.4503
## 5 numall ~ 1 + nrel + negevent + gender + age + desired + state 432.4645
## 6 numall ~ 1 + nrel + prel + negevent + rosn + age + desired + state 434.2853
## weights
## 1 0.25804028
## 2 0.09718959
## 3 0.08898058
## 4 0.08007105
## 5 0.07950429
## 6 0.03198980Existem \(2^9 = 512\) modelos na
pesquisa. O modelo superior contém 5 variáveis e tem peso de
aproximadamente 0.25, portanto, o suporte para o modelo superior não é
extremamente grande. No entanto, todos os próximos melhores modelos têm
pesos entre 0.05 e 0.10, portanto, há pelo menos uma preferência de 2.5
para 1 pelo modelo superior em relação a qualquer outro modelo. O
gráfico dos pesos das variáveis médias do modelo indica claramente que
há cinco variáveis que são importantes: desired,
negevent,
Conforme descrito em DeHart et al. (2008), os pesquisadores estavam interessados em possíveis interações entre determinadas variáveis. Podemos estender a busca para considerar apenas essas interações ou podemos considerar as interações de forma mais ampla entre pares de variáveis. Para fins de demonstração, escolhemos a última abordagem aqui. No entanto, observe que entre os nove efeitos principais, existem \(9*8/2 = 36\) possíveis interações de pares que podem ser formadas, levando a um potencial problema de seleção de variáveis que consiste em 45 variáveis.
Isso é muito grande para ser realizado exaustivamente em glmulti(). Mesmo impondo marginalidade na pesquisa, ou seja, exigir que efeitos principais sejam incluídos em qualquer modelo que contenha suas interações, ainda deixa um conjunto muito grande de modelos possíveis para concluir uma pesquisa exaustiva. Oobserve que executar glmulti() com method = “d” executa vários minutos e retorna: \[ \mbox{"Your candidate set contains more than 1 billion (1e9) models."} \] “Seu conjunto de candidatos contém mais de 1 bilhão (1e9) de modelos.”).
Uma maneira de contornar esse problema é considerar as interações apenas entre os efeitos principais que a pesquisa anterior escolheu como importantes. Então, há apenas \(5* 4/2 = 10\) interações, resultando em um conjunto de “apenas” \(2^{5+10} = 32.768\) modelos. A imposição de marginalidade reduz ainda mais esse conjunto.
A execução dessa seleção leva apenas alguns segundos e resulta em um melhor modelo com os cinco efeitos principais, além de state:negevent e age:desired. O \(AIC_c\) para este modelo é 421.2, em comparação com 430.1 para o melhor modelo com somente de efeitos principais, portanto, incluir essas interações melhora o modelo.
plot(search.1.aicc, type = "w") # Plot of model weights
plot(search.1.aicc, type = "p") # Plot of IC values
plot(search.1.aicc, type = "s") # Plot of variable weights
# Note: Best model has 5 variables; same variables stand out as top ones in BMA with >90% weight.
# All other variables have weight < 30%.Figura 5.17: Resultados da pesquisa de variáveis de efeito principal para o exemplo do consumo de álcool usando a média do modelo com pesos de evidência: Perfil dos pesos de evidência nos 100 principais modelos individuais (esquerda) e peso de evidência total de todos os modelos para cada variável (direita).
Uma abordagem alternativa é não limitar as variáveis consideradas e, em vez disso, usar um algoritmo genético \((GA)\) para explorar o espaço do modelo de forma aleatória mas inteligente. Como esse é um processo de amostragem aleatória, não é garantido encontrar sempre o melhor modelo. É possível que uma determinada execução do \(GA\) fique “presa” procurando modelos um pouco inferiores e nunca encontre aqueles com melhor desempenho. Para aumentar as chances de encontrar os melhores modelos, executamos a busca do \(GA\) várias vezes.
Optamos por executar a busca quatro vezes, o que é um compromisso entre aumentar a chance de encontrar os melhores modelos e diminuir o tempo de execução. Mantemos os 100 melhores modelos de cada execução. Esses quatro conjuntos de 100 modelos não são idênticos, mas contêm sobreposições consideráveis. Muitos modelos aparecem em mais de um resultado de pesquisa, mas nem todos os melhores resultados aparecem em uma única pesquisa.
A combinação dos resultados das várias execuções do \(GA\) fornece um “consenso” no qual os melhores modelos de cada execução são reunidos em um conjunto final de 100 modelos. Os cálculos dos pesos das evidências são realizados a partir desse conjunto de consenso. O processo foi concluído em cerca de 10 minutos em um processador dual-core de 2.7 GHz com 8 GB de RAM. Os resultados resumidos são mostrados abaixo e representados na figura.
############### Now second order with ALL variables
# Enumerate the exhaustive search size first
glmulti(y = numall ~ ., data = saturday[,-c(1:3)], fitfunction = "glm", level = 2,
plotty = FALSE, report = FALSE, marginality = TRUE, method = "d", crit = "aicc",
family = poisson(link = "log"))## TASK: Diagnostic of candidate set.
## Sample size: 89
## 0 factor(s).
## 9 covariate(s).
## 0 f exclusion(s).
## 0 c exclusion(s).
## 0 f:f exclusion(s).
## 0 c:c exclusion(s).
## 0 f:c exclusion(s).
## Size constraints: min = 0 max = -1
## Complexity constraints: min = 0 max = -1
## Marginality rule.
## Your candidate set contains more than 1 billion (1e9) models.## [1] -1# "Your candidate set contains more than 1 billion (1e9) models."
# We will use Genetic Algorithm instead.
# Run multiple times in case one run gets stuck in sub-optimal model.
set.seed(129981872) # Unfortunately, glmulti() does not heed the seed. This is ineffective in forcing the results to be the same run after run.
search.2g0.aicc <- glmulti(y = numall ~ . , plotty = FALSE, report = FALSE,
data = saturday[,-c(1:3)], fitfunction = "glm", level = 2,
marginality = TRUE, method = "g", crit = "aicc", family = poisson(link = "log"))## TASK: Genetic algorithm in the candidate set.
## Initialization...
## Algorithm started...
## Improvements in best and average IC have bebingo en below the specified goals.
## Algorithm is declared to have converged.
## Completed.search.2g1.aicc <- glmulti(y = numall ~ . , plotty = FALSE, report = FALSE,
data = saturday[,-c(1:3)], fitfunction = "glm", level = 2,
marginality = TRUE, method = "g", crit = "aicc", family = poisson(link = "log"))## TASK: Genetic algorithm in the candidate set.
## Initialization...
## Algorithm started...
## Improvements in best and average IC have bebingo en below the specified goals.
## Algorithm is declared to have converged.
## Completed.search.2g2.aicc <- glmulti(y = numall ~ . , plotty = FALSE, report = FALSE,
data = saturday[,-c(1:3)], fitfunction = "glm", level = 2,
marginality = TRUE, method = "g", crit = "aicc", family = poisson(link = "log"))## TASK: Genetic algorithm in the candidate set.
## Initialization...
## Algorithm started...
## Improvements in best and average IC have bebingo en below the specified goals.
## Algorithm is declared to have converged.
## Completed.search.2g3.aicc <- glmulti(y = numall ~ . , plotty = FALSE, report = FALSE,
data = saturday[,-c(1:3)], fitfunction = "glm", level = 2,
marginality = TRUE, method = "g", crit = "aicc", family = poisson(link = "log"))## TASK: Genetic algorithm in the candidate set.
## Initialization...
## Algorithm started...
## Improvements in best and average IC have bebingo en below the specified goals.
## Algorithm is declared to have converged.
## Completed.# Look at top models from all 4 runs. Not always the same!
head(weightable(search.2g0.aicc))## model
## 1 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 2 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 3 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 4 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:negevent + age:rosn + desired:gender + desired:age + state:negevent
## 5 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 6 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:prel + desired:gender + desired:age + state:negevent
## aicc weights
## 1 407.1299 0.08665279
## 2 408.2561 0.04934476
## 3 408.2563 0.04933957
## 4 408.5685 0.04220805
## 5 408.9020 0.03572615
## 6 409.1171 0.03208300head(weightable(search.2g1.aicc))## model
## 1 numall ~ 1 + nrel + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:nrel + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 2 numall ~ 1 + nrel + prel + negevent + posevent + gender + rosn + age + desired + state + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 3 numall ~ 1 + nrel + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:nrel + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:prel + state:negevent
## 4 numall ~ 1 + nrel + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:nrel + gender:nrel + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 5 numall ~ 1 + nrel + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:nrel + rosn:prel + rosn:posevent + age:negevent + age:rosn + desired:gender + desired:age + state:negevent
## 6 numall ~ 1 + nrel + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:nrel + posevent:negevent + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## aicc weights
## 1 410.9251 0.09409217
## 2 411.2034 0.08186963
## 3 411.7865 0.06116523
## 4 412.8179 0.03652108
## 5 412.8494 0.03595104
## 6 412.8887 0.03525108head(weightable(search.2g2.aicc))## model
## 1 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 2 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 3 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:negevent + age:rosn + desired:gender + desired:age + state:negevent
## 4 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 5 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:prel + desired:gender + desired:age + state:negevent
## 6 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent + state:desired
## aicc weights
## 1 407.1299 0.11082273
## 2 408.2563 0.06310178
## 3 408.5685 0.05398108
## 4 408.9020 0.04569119
## 5 409.1171 0.04103186
## 6 409.2950 0.03753956head(weightable(search.2g3.aicc))## model
## 1 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 2 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 3 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:negevent + age:rosn + desired:gender + desired:age + state:negevent
## 4 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 5 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:prel + desired:gender + desired:age + state:negevent
## 6 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent + state:desired
## aicc weights
## 1 407.1299 0.11245529
## 2 408.2563 0.06403135
## 3 408.5685 0.05477629
## 4 408.9020 0.04636428
## 5 409.1171 0.04163631
## 6 409.2950 0.03809257# Should combine these to make a "best of" listing
# This is what "consensus()" does.
search.2allg.aicc <- consensus(xs = list(search.2g0.aicc, search.2g1.aicc,
search.2g2.aicc, search.2g3.aicc), confsetsize = 100)
head(weightable(search.2allg.aicc))## model
## 1 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 2 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 3 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + rosn:posevent + age:rosn + desired:gender + desired:age + state:negevent
## 4 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:negevent + age:rosn + desired:gender + desired:age + state:negevent
## 5 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + rosn:prel + age:rosn + desired:gender + desired:age + state:negevent
## 6 numall ~ 1 + prel + negevent + posevent + gender + rosn + age + desired + state + posevent:negevent + rosn:prel + age:rosn + desired:prel + desired:gender + desired:age + state:negevent
## aicc weights
## 1 407.1299 0.06599809
## 2 408.2561 0.03758286
## 3 408.2563 0.03757891
## 4 408.5685 0.03214727
## 5 408.9020 0.02721040
## 6 409.1171 0.02443564print(search.2allg.aicc)## consensus of 4-glmulti.analysis
## Method: g / Fitting: glm / IC used: aicc
## Level: 2 / Marginality: TRUE
## From 100 models:
## Best IC: 407.129916150943
## Best model:
## [1] "numall ~ 1 + prel + negevent + posevent + gender + rosn + age + "
## [2] " desired + state + posevent:negevent + rosn:prel + age:rosn + "
## [3] " desired:gender + desired:age + state:negevent"
## Evidence weight: 0.0659980932444975
## Worst IC: 413.959214697394
## 6 models within 2 IC units.
## 79 models to reach 95% of evidence weight.
## Convergence after 520 generations.
## Time elapsed: 1.88425623973211 minutes.plot(search.2allg.aicc, type = "w")
plot(search.2allg.aicc, type = "p")
par(mai = c(1,1,.7,.5))
plot(search.2allg.aicc, type = "s")
# Note that top model is also the one with all variables of high importance
# Analysis of parameter estimates
parms <- coef(search.2allg.aicc)
# Renaming columns to fit in book output display
colnames(parms) <- c("Estimate", "Variance", "n.Models", "Probability", "95%CI +/-")
parms.ord <- parms[order(parms[,4], decreasing = TRUE),]
round(parms.ord, digits = 3)## Estimate Variance n.Models Probability 95%CI +/-
## (Intercept) 7.491 25.442 100 1.000 10.053
## prel 0.629 0.066 100 1.000 0.513
## negevent -5.569 3.848 100 1.000 3.909
## posevent -0.812 0.721 100 1.000 1.693
## gender 1.862 0.334 100 1.000 1.152
## rosn -2.799 1.817 100 1.000 2.686
## age -0.233 0.021 100 1.000 0.291
## desired 1.595 0.135 100 1.000 0.734
## state -0.962 0.115 100 1.000 0.675
## desired:gender -0.323 0.008 100 1.000 0.178
## prel:rosn -0.196 0.005 99 0.997 0.146
## age:rosn 0.096 0.001 98 0.989 0.077
## negevent:state 1.170 0.223 97 0.985 0.942
## age:desired -0.023 0.000 96 0.973 0.021
## negevent:posevent 0.355 0.117 48 0.642 0.681
## posevent:rosn 0.192 0.072 57 0.408 0.536
## nrel -0.048 0.010 45 0.183 0.198
## nrel:posevent 0.011 0.001 23 0.073 0.045
## age:negevent 0.003 0.000 6 0.062 0.015
## desired:state 0.004 0.000 4 0.043 0.019
## gender:prel -0.001 0.000 6 0.043 0.007
## age:posevent 0.000 0.000 4 0.041 0.003
## desired:prel -0.001 0.000 3 0.040 0.003
## posevent:state 0.003 0.000 4 0.037 0.019
## desired:rosn -0.002 0.000 5 0.037 0.013
## gender:state -0.007 0.000 5 0.037 0.040
## age:state 0.001 0.000 4 0.036 0.005
## prel:state -0.001 0.000 3 0.035 0.006
## age:gender 0.000 0.000 4 0.032 0.003
## gender:negevent -0.005 0.000 4 0.032 0.035
## negevent:prel -0.001 0.000 3 0.030 0.007
## gender:posevent -0.004 0.000 4 0.028 0.021
## desired:posevent 0.001 0.000 2 0.027 0.005
## negevent:rosn -0.007 0.000 2 0.027 0.041
## gender:rosn -0.002 0.000 3 0.027 0.021
## age:prel 0.000 0.000 3 0.027 0.000
## desired:negevent 0.001 0.000 2 0.025 0.011
## rosn:state -0.003 0.000 2 0.020 0.019
## nrel:state 0.005 0.000 5 0.020 0.022
## posevent:prel 0.000 0.000 1 0.018 0.002
## gender:nrel 0.004 0.000 3 0.010 0.017
## nrel:prel 0.000 0.000 1 0.004 0.000
## nrel:rosn 0.001 0.000 1 0.004 0.004
## negevent:nrel 0.000 0.000 1 0.002 0.001
## desired:nrel 0.000 0.000 1 0.002 0.000# Reorder parameters in decreasing order of probability
parms.ord <- parms[order(parms[,4], decreasing = TRUE),]
# Confidence intervals for parameters (coef() contains a column with the confidence interval add-ons)
ci.parms <- cbind(lower = parms.ord[,1] - parms.ord[,5], upper = parms.ord[,1] + parms.ord[,5])
round(cbind(parms.ord[,1], ci.parms), digits = 3)## lower upper
## (Intercept) 7.491 -2.562 17.544
## prel 0.629 0.116 1.143
## negevent -5.569 -9.478 -1.659
## posevent -0.812 -2.504 0.881
## gender 1.862 0.710 3.014
## rosn -2.799 -5.485 -0.113
## age -0.233 -0.524 0.057
## desired 1.595 0.861 2.328
## state -0.962 -1.636 -0.287
## desired:gender -0.323 -0.501 -0.145
## prel:rosn -0.196 -0.342 -0.050
## age:rosn 0.096 0.020 0.173
## negevent:state 1.170 0.228 2.111
## age:desired -0.023 -0.044 -0.002
## negevent:posevent 0.355 -0.326 1.036
## posevent:rosn 0.192 -0.344 0.728
## nrel -0.048 -0.246 0.149
## nrel:posevent 0.011 -0.034 0.056
## age:negevent 0.003 -0.011 0.018
## desired:state 0.004 -0.015 0.023
## gender:prel -0.001 -0.009 0.006
## age:posevent 0.000 -0.003 0.002
## desired:prel -0.001 -0.004 0.002
## posevent:state 0.003 -0.016 0.023
## desired:rosn -0.002 -0.015 0.011
## gender:state -0.007 -0.047 0.033
## age:state 0.001 -0.004 0.005
## prel:state -0.001 -0.007 0.005
## age:gender 0.000 -0.003 0.002
## gender:negevent -0.005 -0.039 0.030
## negevent:prel -0.001 -0.008 0.006
## gender:posevent -0.004 -0.025 0.017
## desired:posevent 0.001 -0.004 0.005
## negevent:rosn -0.007 -0.048 0.034
## gender:rosn -0.002 -0.023 0.019
## age:prel 0.000 0.000 0.000
## desired:negevent 0.001 -0.009 0.012
## rosn:state -0.003 -0.022 0.016
## nrel:state 0.005 -0.017 0.027
## posevent:prel 0.000 -0.002 0.002
## gender:nrel 0.004 -0.013 0.021
## nrel:prel 0.000 0.000 0.000
## nrel:rosn 0.001 -0.003 0.005
## negevent:nrel 0.000 0.000 0.001
## desired:nrel 0.000 0.000 0.000Figura 5.18: Resultados da busca de variáveis do algoritmo genético para o exemplo do consumo de álcool usando modelo de média com pesos de evidência em todas as variáveis e interações bidirecionais.
Talvez seja desconcertante notar que o melhor modelo nem sempre é o mesmo nas quatro execuções do \(GA\), conforme indicado pelos diferentes valores de \(AIC_c\): 407.1, 407.1, 406.1 e 406.1. Com base nessa variabilidade, não podemos ter certeza de que o melhor entre eles, 406.1, é realmente o melhor valor entre todos os modelos. Isso pode levar a uma falta de fé no \(GA\). No entanto, do ponto de vista prático, todas as quatro execuções tiveram melhores modelos substancialmente melhores do que o encontrado na primeira análise usando um conjunto reduzido de variáveis.
De fato, o pior dos 100 modelos no top 100 de consenso tem \(AIC_c = 414.2\), o que ainda é muito melhor do que o melhor modelo da busca no conjunto restrito de variáveis. Isso indica claramente que
as interações entre as variáveis podem ser importantes, mesmo quando seus efeitos principais parecem não ser, e
o \(GA\) é uma ferramenta útil, embora não perfeita, para encontrar essas interações.
As variáveis preferidas nesta busca irrestrita incluem todas aquelas da busca exaustiva no conjunto restrito de variáveis, exceto nrel. Eles também incluem as interações desired:gender, prel:rosn e age:rosn, bem como os principais efeitos adicionais exigidos por essas interações, rosn, gender e prel. Usamos este modelo como um modelo de trabalho inicial.
##############
# What would happen if instead I did an exhaustive search on only the
# important main-effect variables and their interactions?
search.2e.aicc <- glmulti(y = numall ~ desired + negevent + state + nrel + age,
data = saturday[,-c(1:3)], fitfunction = "glm", level = 2, plotty = FALSE, report = FALSE,
marginality = TRUE, method = "h", crit = "aicc", family = poisson(link = "log"))
print(search.2e.aicc)## glmulti.analysis
## Method: h / Fitting: glm / IC used: aicc
## Level: 2 / Marginality: TRUE
## From 100 models:
## Best IC: 421.226589653843
## Best model:
## [1] "numall ~ 1 + desired + negevent + state + nrel + age + state:negevent + "
## [2] " age:desired"
## Evidence weight: 0.0524878467486765
## Worst IC: 426.229493723406
## 9 models within 2 IC units.
## 88 models to reach 95% of evidence weight.# Look at top 6 models
head(weightable(search.2e.aicc))## model
## 1 numall ~ 1 + desired + negevent + state + nrel + age + state:negevent + age:desired
## 2 numall ~ 1 + desired + negevent + state + age + state:negevent + age:desired + age:negevent
## 3 numall ~ 1 + desired + negevent + state + age + state:negevent + age:desired
## 4 numall ~ 1 + desired + negevent + state + nrel + age + state:negevent + age:desired + age:negevent
## 5 numall ~ 1 + desired + negevent + state + nrel + age + negevent:desired + state:negevent + age:desired
## 6 numall ~ 1 + desired + negevent + state + nrel + age + state:negevent + age:desired + age:state
## aicc weights
## 1 421.2266 0.05248785
## 2 422.0582 0.03463137
## 3 422.1941 0.03235626
## 4 422.3512 0.02991268
## 5 422.5301 0.02735254
## 6 422.8335 0.02350301# Top model is AICC = 421.2, not nearly as good as top model from expanded search using GA.
plot(search.2e.aicc, type = "w")
plot(search.2e.aicc, type = "p")
plot(search.2e.aicc, type = "s")
Avaliando o modelo
Para avaliar o ajuste do modelo escolhido, primeiro ajustamos a regressão Poisson usando glm() e então usamos as ferramentas da Seção 5.2 no objeto do modelo. Como uma verificação inicial, olhamos para o deviance/df:mod.fit <- glm( formula = numall ~ 1 + prel + negevent + gender + rosn + age + desired +
state + rosn : prel + age : rosn + desired : gender + desired :age +
state : negevent , family = poisson ( link = "log") , data = saturday )
############### Analyze the model fit with various functions
summary(mod.fit)##
## Call:
## glm(formula = numall ~ 1 + prel + negevent + gender + rosn +
## age + desired + state + rosn:prel + age:rosn + desired:gender +
## desired:age + state:negevent, family = poisson(link = "log"),
## data = saturday)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.7209 -0.8376 -0.1412 0.6054 3.1444
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 8.015603 4.530669 1.769 0.076863 .
## prel 0.473968 0.171645 2.761 0.005757 **
## negevent -4.961117 1.788111 -2.775 0.005529 **
## gender 1.644862 0.484104 3.398 0.000679 ***
## rosn -2.868548 1.194148 -2.402 0.016298 *
## age -0.259757 0.130635 -1.988 0.046765 *
## desired 1.482124 0.306374 4.838 1.31e-06 ***
## state -0.924530 0.217413 -4.252 2.11e-05 ***
## prel:rosn -0.155899 0.051161 -3.047 0.002310 **
## rosn:age 0.101648 0.034888 2.914 0.003573 **
## gender:desired -0.293941 0.086508 -3.398 0.000679 ***
## age:desired -0.020563 0.009317 -2.207 0.027322 *
## negevent:state 1.143170 0.449123 2.545 0.010917 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 250.34 on 88 degrees of freedom
## Residual deviance: 119.84 on 76 degrees of freedom
## AIC: 401.24
##
## Number of Fisher Scoring iterations: 5# Check fit statistic:
deviance (mod.fit )/ mod.fit$df.residual## [1] 1.5768251 + 2* sqrt (2/ mod.fit$df.residual )## [1] 1.3244431 + 3* sqrt (2/ mod.fit$df.residual )## [1] 1.486664# Somewhat of an indication of lack-of-fit somehow. A razão deviance/df do modelo é 1.57, que é um pouco maior do que os limiares aproximados. Portanto, concluímos que este modelo pode ter alguns problemas. Para explorar isso ainda mais, primeiro verificamos a inflação de zeros; ou seja, verificamos se há mais sujeitos que não consomem bebidas alcoólicas do que o modelo espera. Calculamos o número observado de contagens de zero \(n_0\), juntamente com o número esperado com base no modelo.
Para um sujeito com valor esperado estimado \(\widehat{\mu}_i\), a probabilidade de consumir zero bebidas de acordo com o modelo de Poisson é \(e^{-\widehat{\mu}_i}\). O número esperado de zeros é, portanto, \[ \widehat{n}_0 = \sum_{i=1}^M e^{-\widehat{\mu}_i}\cdot. \] Uma estatística de Pearson pode então ser usada para medir a discrepância entre \(n_0\) e \(\widehat{n}_0\), \[ X^2_0 = \dfrac{(n_0-\widehat{n}_0)^2}{\widehat{n}_0}\cdot \]
############### Is there zero inflation? Create a Pearson Statistic to check
mu.poi <- exp(predict(mod.fit))
zero.poi <- sum(exp(-mu.poi)) # Expected number of zeroes for Poisson
zero.obs <- sum(saturday$numall == 0) # Total zeroes in data
zero.pear <- ( zero.poi - zero.obs)^2/ zero.poi # Pearson Stat comparing them
c( zero.poi , zero.obs , zero.pear )## [1] 7.075870834 7.000000000 0.000813523# p = 0.97, NO EVIDENCE OF ZERO INFLATION AS EXPECTED.
# Check overall goodness of fit and look at Pearson residuals from it.
# Useful to check for link issues.
# Assuming that this resides in same folder as current programHouve 7 contagens zero nos dados, enquanto o modelo estima que deveria haver cerca de 7.07. Esses números são tão próximos que claramente não há evidências que sugiram um problema com inflação de zeros. Poderíamos confirmar isso ajustando o modelo de Poisson inflado de zeros e comparando seu \(AIC_c\) com o do ajuste de Poisson. Não perseguimos isso aqui.
Existem outros aspectos de um ajuste de modelo que podem causar desvio inflado de deviance/df. Em particular, podemos verificar se os valores médios estimados produzidos pelo modelo se desviam das contagens observadas de outras maneiras. Um teste padrão de Pearson ou GOF de desvio não pode ser usado porque muitas das contagens observadas e esperadas são pequenas. Em vez disso, aplicamos o teste de ajuste omnibus descrito no final da Seção 5.2.2 que está contido na função PostFitGOFTest. O uso do número padrão de grupos produz os seguintes resultados:
#####################################################################
# NAME: Tom Loughin #
# DATE: 06-24-2013 #
# PURPOSE: Grouped-prediction goodness of fit test for count models #
# #
# NOTES: #
# Program operates on user-supplied numerical objects containing #
# observed counts for each observation and predicted counts in the #
# same order. User can supply number of groups; uses n/5 otherwise, #
# unless n>100, whereupn g defaults to 20. #
# #
# Source this program before calling the function. #
#####################################################################
PostFitGOFTest = function(obs, pred, g = 0) {
if(g == 0) g = round(min(length(obs)/5,20))
ord <- order(pred)
obs.o <- obs[ord]
pred.o <- pred[ord]
# Creates factor with levels 1,2,...,g
interval = cut(pred.o, quantile(pred.o, 0:g/g), include.lowest = TRUE)
counts = xtabs(formula = cbind(obs.o, pred.o) ~ interval)
centers <- aggregate(pred.o ~ interval, FUN = "mean")
pear.res <- rep(NA,g)
for(gg in (1:g)) pear.res[gg] <- (counts[gg] - counts[g+gg])/sqrt(counts[g+gg])
pearson <- sum(pear.res^2)
if (any(counts[((g+1):(2*g))] < 5))
warning("Some expected counts are less than 5. Use smaller number of groups")
P = 1 - pchisq(pearson, g - 2)
cat("Post-Fit Goodness-of-Fit test with", g, "bins", "\n", "Pearson Stat = ",
pearson, "\n", "p = ", P, "\n")
return(list(pearson = pearson, pval = P, centers = centers$pred.o, observed = counts[1:g],
expected = counts[(g+1):(2*g)], pear.res = pear.res))
}
GOFtest <- PostFitGOFTest(obs = saturday$numall, pred = mu.poi, g = 0)## Post-Fit Goodness-of-Fit test with 18 bins
## Pearson Stat = 13.88894
## p = 0.6069871Como esse modelo foi determinado usando seleção de variáveis com base em dados, não podemos interpretar o \(p\)-valor literalmente como uma probabilidade. No entanto, o fato de ser tão grande é um tanto reconfortante, se não uma evidência conclusiva de um bom ajuste. Repetindo o teste com diferentes números de grupos (não mostrados) não altera substancialmente este resultado. A saída adicional (não mostrada) não mostra resíduos de Pearson particularmente grandes, nem quaisquer cadeias longas de resíduos de Pearson positivos ou negativos. A partir disso, concluímos que a ligação logaritmo parece ser razoável.
############### Examine residuals.
saturday$mu.hat <- predict(mod.fit, type = "response")
saturday$p.res <- residuals(mod.fit, type = "pearson")
saturday$s.res <- rstandard(mod.fit, type = "pearson")
saturday$lin.pred <- mod.fit$linear.predictors
## saturday$cookd <- cooks.distance(mod.fit)
## saturday$hat <- mod.fit$hat
resid.plot <- function(y, x, x.label, color1 = "blue", color2 = "red") {
ord.x <- order(x)
plot(x = x, y = y, xlab = x.label, ylab = "Standardized residuals",
ylim = c(min (-3, y), max(3,y)))
abline(h = c(3, 2, 0, -2, -3), lty = 3, col = color1)
smooth.stand <- loess(formula = y ~ x)
lines(x = x[ord.x], y = predict(smooth.stand)[ord.x], lty = 2, col = color2)
invisible()
}
# Removed most of top margin because plots do not have titles
par(mfrow = c(3,3), mar = c(5, 4, 1, 2))
resid.plot(y = saturday$s.res, x = saturday$prel, x.label = "Positive relations")
resid.plot(y = saturday$s.res, x = saturday$negevent, x.label = "Negative Events")
resid.plot(y = saturday$s.res, x = saturday$gender, x.label = "Gender")
# Not sure if plot is worthwhile for a binary variable
resid.plot(y = saturday$s.res, x = saturday$rosn, x.label = "Rosenberg Self Esteem")
resid.plot(y = saturday$s.res, x = saturday$state, x.label = "State Self Esteem")
resid.plot(y = saturday$s.res, x = saturday$desired, x.label = "Desire to Drink")
resid.plot(y = saturday$s.res, x = saturday$age, x.label = "Age")
resid.plot(y = saturday$s.res, x = saturday$mu.hat, x.label = "Estimated mean")
resid.plot(y = saturday$s.res, x = saturday$lin.pred, x.label = "Linear predictor")
Figura 5.19: Gráficos residuais do modelo funcional de
regressão de Poisson para os dados de consumo de álcool.
Em seguida, verificamos os resíduos e a influência de observações individuais. Os resíduos padronizados de Pearson são plotados contra o efeito principal de cada variável explicativa e contra as médias estimadas e preditores lineares. Os resultados são mostrados na figura acima. Tendo em mente que a suavização de loess não é confiável perto das bordas do intervalo do eixo \(x\), os gráficos não mostram nenhum problema claro com má escolha da ligação ou curvatura clara em quaisquer preditores.
As curvas de loess geralmente oscilam em torno da linha horizontal traçada em 0. O gráfico para negevent pode mostrar alguma curvatura, mas a curva de loess na metade direita do gráfico é estimada usando poucos pontos de dados. Pode ser distorcido por esses pontos que atraem a curva em direção aos seus valores residuais. Há um resíduo padronizado muito grande \((> 4)\) e um pequeno número entre 2 e 3. Ao todo, 6/89 situam-se além de 2, com outros três em quase -2. Este número é talvez um pouco mais do que o que se pode esperar, em média, que aconteça por acaso 5% de \(M = 89\) é 4.45, e há vários resíduos negativos logo abaixo do limite em -2. No geral, o que vemos nesses gráficos não é necessariamente incomum para um ajuste de modelo de regressão Poisson.
Finalmente, realizamos diagnósticos de influência usando nossa função glmInfDiag(). Os resultados são mostrados na figura abaixo.
glmInflDiag <- function(mod.fit, print.output = TRUE, which.plots = c(1,2)){
# Which set of plots to show
show <- rep(FALSE, 2) # Idea from plot.lm()
show[which.plots] <- TRUE
# Main quantities: Pearson and deviance residual, model Pearson and deviance stats
pear <- residuals(mod.fit, type = "pearson")
dres <- residuals(mod.fit, type = "deviance")
x2 <- sum(pear^2)
N <- length(pear)
P <- length(coef(mod.fit))
# Hat values (leverages)
hii <- hatvalues(mod.fit)
# Computed quantities: Standardized Pearson residual, Delta-beta, Delta-deviance
sres <- pear/sqrt(1-hii)
# D.beta <- (pear^2*hii/(1-hii)^2)
# cookD <- D.beta / (P * summary(mod.fit)$dispersion)
cookD <- pear^2 * hii / ((1-hii)^2 * (P) * summary(mod.fit)$dispersion)
D.dev2 <- dres^2 + hii*sres^2
D.X2 <- sres^2
yhat <- fitted(mod.fit)
# Plots against fitted values
if(show[1] == TRUE) {
par(mfrow = c(1,4), lty = "dotted")
plot(x = yhat, y = hii, xlab = "Estimated Mean or Probability",
ylab = "Hat (leverage) value", ylim = c(0, max(hii,3*P/N)))
abline(h = c(2*P/N,3*P/N))
plot(x = yhat, y = D.X2, xlab = "Estimated Mean or Probability",
ylab = "Approx change in Pearson stat", ylim = c(0, max(D.X2,9)))
abline(h = c(4,9), lty = "dotted")
plot(x = yhat, y = D.dev2, xlab = "Estimated Mean or Probability",
ylab = "Approx change in deviance", ylim = c(0, max(D.dev2,9)))
abline(h = c(4,9), lty = "dotted")
plot(x = yhat, y = cookD, xlab = "Estimated Mean or Probability",
ylab = "Approx Cook's Distance", ylim = c(0, max(cookD, 1)))
abline(h = c(4/N,1), lty = "dotted")
}
# Plots against hat values
if(show[2] == TRUE) {
par(mfrow = c(1,3))
plot(x = hii, y = D.X2, xlab = "Hat (leverage) value", ylab = "Approx change in Pearson stat",
ylim = c(0, max(D.X2, 9)), xlim = c(0, max(hii,3*P/N)))
abline(h = c(4,9), lty = "dotted")
abline(v = c(2*P/N,3*P/N), lty = "dotted")
plot(x = hii, y = D.dev2, xlab = "Hat (leverage) value", ylab = "Approx change in deviance",
ylim = c(0, max(D.dev2,9)), xlim = c(0, max(hii,3*P/N)))
abline(h = c(4,9), lty = "dotted")
abline(v = c(2*P/N,3*P/N), lty = "dotted")
plot(x = hii, y = cookD, xlab = "Hat (leverage) value", ylab = "Approx Cook's Distance",
ylim = c(0, max(cookD, 1)), xlim = c(0, max(hii,3*P/N)))
abline(h = c(4/N,1), lty = "dotted")
abline(v = c(2*P/N,3*P/N), lty = "dotted")
}
# Listing of values to check
# Create flags to identify high values in listing
hflag <- ifelse(test = hii > 3*P/N, yes = "**", no =
ifelse(test = hii > 2*P/N, yes = "*", no = ""))
xflag <- ifelse(test = D.X2 > 9, yes = "**", no =
ifelse(test = D.X2 > 4, yes = "*", no = ""))
dflag <- ifelse(test = D.dev2 > 9, yes = "**", no =
ifelse(test = D.dev2 > 4, yes = "*", no = ""))
cflag <- ifelse(test = cookD > 1, yes = "**", no =
ifelse(test = cookD > 4/N, yes = "*", no = ""))
chk.hii2 <- which(hii > 3*P/N)
chk.DX22 <- which(D.X2 > 9 | (D.X2 > 4 & hii > 2*P/N))
chk.Ddev2 <- which(D.dev2 > 9 | (D.dev2 > 4 & hii > 2*P/N))
chk.cook2 <- which(cookD > 4/N)
all.meas <- data.frame(h = round(hii,2), hflag, Del.X2 = round(D.X2,2), xflag,
Del.dev = round(D.dev2,2), dflag, Cooks.D = round(cookD,3), cflag)
if(print.output == TRUE) {
cat("Potentially influential observations by any measures","\n")
print(all.meas[sort(unique(c(chk.hii2, chk.DX22, chk.Ddev2, chk.cook2))),])
cat("\n","Data for potentially influential observations","\n")
print(cbind(mod.fit$data, yhat = round(yhat, 3))
[sort(unique(c(chk.hii2, chk.DX22, chk.Ddev2, chk.cook2))),])
}
data.frame(hat = hii, CD = cookD, delta.Xsq = D.X2, delta.D = D.dev2)
}
glmInflDiag (mod.fit = mod.fit)
## Potentially influential observations by any measures
## h hflag Del.X2 xflag Del.dev dflag Cooks.D cflag
## 2 0.46 ** 0.01 0.01 0.000
## 5 0.22 2.26 4.01 * 0.050 *
## 39 0.14 3.83 5.11 * 0.047 *
## 52 0.11 5.78 * 3.98 0.052 *
## 57 0.12 8.14 * 6.01 * 0.085 *
## 58 0.41 * 4.72 * 4.39 * 0.257 *
## 61 0.35 * 3.02 2.73 0.123 *
## 108 0.32 * 1.92 2.16 0.069 *
## 113 0.56 ** 0.18 0.19 0.018
## 118 0.66 ** 0.12 0.12 0.018
## 129 0.44 ** 0.05 0.05 0.003
## 137 0.08 17.88 ** 11.25 ** 0.114 *
##
## Data for potentially influential observations
## id studyday dayweek numall nrel prel negevent posevent gender
## 2 2 4 6 4 5.833333 0.8333333 2.3766667 0.9241667 2
## 5 5 3 6 0 0.000000 0.0000000 0.2000000 1.5000000 2
## 39 39 4 6 2 0.000000 5.3333333 0.8000000 1.4333333 1
## 52 52 1 6 4 0.500000 4.5000000 0.4000000 1.1500000 2
## 57 57 3 6 8 0.000000 1.5000000 0.3000000 1.0500000 1
## 58 58 4 6 21 0.000000 5.0000000 0.4000000 1.2000000 1
## 61 61 7 6 10 1.666667 2.1666667 0.8400000 2.4933333 2
## 108 108 7 6 4 0.000000 0.0000000 0.6250000 0.6250000 1
## 113 113 5 6 12 3.000000 6.0000000 0.4000000 3.3000000 1
## 118 118 3 6 11 0.000000 9.0000000 0.4000000 2.7000000 2
## 129 129 7 6 10 1.000000 0.0000000 0.2333333 0.1333333 2
## 137 137 4 6 9 0.000000 7.3333333 0.2000000 1.1333333 2
## rosn age desired state yhat
## 2 3.9 38.00137 5.666667 4.111111 4.126
## 5 3.0 27.60849 1.666667 4.222222 1.753
## 39 3.5 34.24230 7.000000 4.222222 6.709
## 52 4.0 31.68241 1.000000 3.777778 1.354
## 57 4.0 37.97399 4.333333 4.555556 3.207
## 58 3.6 31.99179 8.000000 4.000000 14.636
## 61 3.9 39.76454 8.000000 4.333333 6.439
## 108 2.9 35.08830 6.666667 3.000000 7.035
## 113 2.8 28.00548 7.000000 4.888889 13.024
## 118 2.8 32.83231 6.000000 2.777778 11.693
## 129 3.0 27.90691 5.666667 3.444444 10.518
## 137 3.7 38.25051 3.666667 4.111111 2.533## hat CD delta.Xsq delta.D
## 1 0.07463058 3.623215e-02 5.840308377 4.502572983
## 2 0.45792791 4.604335e-04 0.007085494 0.007125164
## 4 0.05274348 8.721521e-03 2.036265352 2.825628108
## 5 0.22287607 4.975120e-02 2.255141460 4.007665861
## 7 0.07326642 8.542509e-04 0.140468421 0.151485266
## 9 0.13813192 1.578624e-03 0.128046853 0.123433342
## 10 0.08154543 4.383976e-04 0.064190323 0.060823680
## 11 0.15374282 3.530406e-03 0.252624566 0.237936193
## 16 0.13658245 2.060183e-02 1.693070897 3.154898025
## 17 0.07337703 2.433377e-02 3.994806069 7.696485112
## 18 0.07663704 1.514246e-03 0.237177484 0.261138379
## 19 0.07018749 1.063079e-02 1.830815893 2.493622741
## 21 0.07664969 1.134302e-03 0.177634865 0.162073221
## 22 0.20360836 4.276304e-04 0.021744181 0.022083795
## 23 0.11165878 1.898471e-03 0.196351475 0.184249527
## 24 0.12038947 6.807471e-04 0.064659308 0.069161443
## 25 0.08088147 1.089249e-02 1.609136972 2.011652131
## 26 0.15146557 6.897808e-03 0.502354134 0.592314741
## 27 0.06838512 2.304422e-03 0.408112728 0.462601514
## 28 0.12316507 3.168153e-02 2.932106467 5.503079850
## 29 0.27198284 2.231847e-02 0.776618799 0.912737611
## 30 0.15658537 1.886678e-03 0.132108609 0.123378550
## 33 0.08086807 4.907128e-03 0.725055908 0.850216517
## 34 0.13143141 1.309305e-02 1.124835381 1.018397135
## 35 0.14442365 2.963388e-04 0.022821926 0.023228540
## 37 0.18315333 1.067286e-02 0.618799623 0.565629402
## 38 0.04435934 7.686135e-03 2.152588151 1.811362182
## 39 0.13804494 4.723465e-02 3.834142278 5.105525006
## 40 0.13543361 1.203314e-04 0.009986061 0.010253292
## 41 0.10782476 6.830223e-03 0.734699730 0.656353745
## 42 0.11184661 4.395097e-03 0.453708593 0.404967406
## 43 0.09217993 2.080470e-02 2.663595784 2.122178643
## 44 0.10413553 3.517220e-02 3.933564531 7.457505246
## 45 0.10217019 2.562974e-02 2.927908049 3.847891184
## 46 0.12361355 1.478272e-02 1.362470959 1.763679293
## 47 0.04798249 2.748292e-04 0.070887297 0.067969063
## 49 0.07703625 2.998091e-03 0.466957860 0.532599557
## 50 0.14676355 2.150860e-02 1.625573650 1.929664904
## 52 0.10526739 5.230154e-02 5.779060535 3.982132847
## 53 0.05285012 6.415640e-04 0.149470712 0.157394562
## 54 0.09137505 5.019624e-05 0.006488907 0.006576021
## 56 0.15428962 7.644354e-03 0.544714696 0.645543903
## 57 0.11961936 8.506649e-02 8.138996730 6.014455976
## 58 0.41394472 2.565591e-01 4.722011726 4.390400823
## 60 0.12366233 1.494081e-02 1.376422182 1.570442645
## 61 0.34732307 1.234790e-01 3.016484051 2.729483048
## 62 0.08674758 9.686360e-05 0.013256761 0.012813125
## 64 0.10254486 1.947200e-02 2.215403639 1.869448039
## 65 0.10735903 3.100637e-04 0.033514480 0.034376404
## 66 0.23214129 1.910969e-02 0.821723740 0.771566339
## 100 0.20933459 1.123652e-02 0.551730376 0.618562256
## 102 0.11036025 3.210164e-04 0.033641245 0.032778793
## 103 0.05534441 7.469215e-03 1.657364465 1.371916539
## 104 0.18350206 5.793062e-03 0.335093273 0.313846063
## 107 0.08192161 2.530361e-03 0.368643971 0.432680657
## 108 0.31827215 6.898554e-02 1.920940071 2.164830211
## 109 0.09822682 7.410649e-04 0.088443682 0.093736854
## 110 0.16960373 3.157599e-02 2.009788452 2.489299767
## 111 0.16146932 1.332584e-02 0.899635851 1.654008111
## 112 0.14370800 4.053104e-02 3.139583751 4.089351389
## 113 0.56329109 1.830346e-02 0.184474188 0.186673370
## 114 0.10535758 3.393475e-03 0.374603428 0.406738063
## 115 0.10556832 2.468070e-03 0.271840630 0.243835224
## 116 0.06354693 4.073017e-03 0.780280955 0.898359345
## 118 0.65965357 1.799135e-02 0.120673621 0.121509920
## 122 0.07503876 3.248781e-02 5.205970262 3.846337410
## 123 0.13223471 3.954574e-02 3.373648474 2.856809872
## 124 0.08356054 1.036302e-02 1.477516150 1.957348678
## 125 0.07125988 1.066882e-02 1.807627105 1.323999784
## 128 0.04775513 5.808566e-03 1.505708372 2.939511439
## 129 0.44076663 2.763367e-03 0.045579155 0.046008034
## 131 0.11038784 1.067772e-05 0.001118669 0.001114713
## 133 0.16503035 9.035878e-04 0.059432031 0.061078705
## 136 0.08185444 3.559110e-03 0.518984129 0.624940089
## 137 0.07648344 1.138977e-01 17.878684166 11.254349060
## 138 0.17201317 2.372839e-02 1.484818310 1.285239900
## 139 0.27935593 8.039608e-05 0.002696132 0.002708899
## 140 0.09315040 1.130482e-03 0.143073015 0.135302764
## 141 0.22871695 3.304940e-02 1.448846579 1.290285280
## 144 0.10337172 1.763137e-03 0.198810900 0.223570794
## 148 0.08004366 9.349807e-04 0.139696745 0.130858648
## 149 0.10480078 1.243963e-03 0.138135736 0.144606100
## 150 0.18732387 3.587423e-02 2.023253823 2.492546900
## 152 0.08024889 5.914407e-03 0.881223143 0.651360063
## 153 0.24285200 2.728135e-03 0.110572798 0.106541806
## 154 0.04569629 2.720880e-03 0.738683537 0.658840602
## 155 0.12358285 5.008187e-03 0.461717723 0.423575229
## 156 0.11902102 3.218722e-02 3.097195801 2.686891316
## 160 0.14147828 5.685638e-03 0.448522338 0.483938928Figura 5.20: Gráficos de diagnóstico de influência para dados de consumo de álcool.
Das parcelas e das listagens, destacam-se 6 pontos: quatro têm grandes valores de alavancagem; observações 2, 113, 118 e 129. Um tem grande \(\Delta X^2_m\) e \(\Delta D^2_m\) e distância de Cook moderadamente grande, mas baixa alavancagem: observação 137 e um tem uma combinação de valores moderadamente grandes de todas as medidas, incluindo uma distância de Cook que se destaca das demais: observação 58. Um exame mais aprofundado das quatro primeiras revela que a observação 2 tem o maior valor de negevent, mas com apenas uma média estimada moderada; a observação 113 tem um prel grande, uma estranha combinação de traço de auto-estima muito baixo, mas estado de auto-estima muito alto e uma média estimada muito alta; a observação 118 tem o maior prel, o menor estado e uma média estimada alta; e a observação 129 tem valores moderados de todas as variáveis, mas uma média estimada alta.
Nos casos de estimativas altas, a contagem real é muito próxima da média estimada e a influência real nos parâmetros do modelo não é grande de acordo com a distância de Cook. Portanto, não estamos especialmente preocupados com esses quatro assuntos. O sujeito com \(\Delta X^2_m\) e \(\Delta D^2_m\) muito grandes tem um prel muito grande, um negevent e desired um tanto baixo e é muito mal previsto pelo modelo, observado 9 drinques, mas previsto 2.5.
Este assunto parece influenciar a regressão principalmente por ter uma contagem muito inesperada. Os dados dessa pessoa podem ser verificados quanto à precisão. O mesmo é verdade para o sujeito 58, cujas 21 bebidas são de longe as mais altas observadas. Este assunto tem os valores máximos de prel e desired, e a maior média estimada em 14.6. Para destacar essas descobertas, criamos gráficos de coordenadas paralelas mostrando a posição de cada observação em relação ao restante dos dados. Um exemplo para a observação 58 é mostrado na figura abaixo.
# In Which percentile of the data do these three people fall
pcts <- matrix(NA, nrow = 3, ncol = 9)
colnames(pcts) <- colnames(saturday[,5:13])
rownames(pcts) <- list(113, 118, 129)
counter <- 1
for(j in c(113, 118, 129)){
for(k in c(5:13)){
pcts[counter, k-4] <- sum((saturday[,k] <= saturday[saturday$id == j,k]))/length(saturday[,k])
}
counter <- counter + 1
}
pcts## nrel prel negevent posevent gender rosn age
## 113 0.9775281 0.8876404 0.6179775 0.98876404 0.4382022 0.08988764 0.1348315
## 118 0.7415730 1.0000000 0.6179775 0.96629213 1.0000000 0.08988764 0.3820225
## 129 0.8988764 0.1797753 0.4157303 0.02247191 1.0000000 0.21348315 0.1123596
## desired state
## 113 0.9325843 0.98876404
## 118 0.8314607 0.01123596
## 129 0.6853933 0.11235955###### 113: high nrel, desired, posevent, state; low rosn
###### 118: high prel, posevent; low state, rosn
###### 129: high nrel, low prel
# Assess this visually with Parallel Coordinate Plot
library(MASS)
table(saturday$numall)##
## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 21
## 7 14 18 5 10 16 3 3 2 3 3 2 1 1 1# Plot highlighting observations
# May be good to have the printed information from glmInflDiag() to also be printed returned
# in the object so that one would not need to manually type in the id numbers below
cols <- c("gray50","red")
for(i in c(2, 113, 118, 129, 137, 58)){
pot.infl <- (saturday$id == i)
parcoord(x = saturday[, c(4:8, 10:13, 9)], col = cols[pot.infl + 1], lwd = 1 + 3*pot.infl,
main = paste("Potentially influential observation ", i, " identified by thick red lines"))
}
Figura 5.21: Gráfico de coordenadas paralelas
destacando a posição da observação 58 em relação ao restante dos
dados.
Por não termos acesso aos diários de bordo originais ou aos próprios sujeitos, não podemos verificar a veracidade de seus dados. Portanto, temos duas opções:
ignorar os problemas e prosseguir, ou
executar novamente a análise sem uma ou ambas as observações questionáveis e comparar os resultados com a presente análise.
Seguindo a segunda opção, reexecutamos o algoritmo genético sem
observação 58 e descobrimos que gender e a interação
Todas as outras variáveis permaneceram importantes e nenhuma nova surgiu para ser considerada. Concluímos, portanto, que esta única observação tem influência considerável sobre a importância da interação deired:gender. Agora temos uma incerteza adicional em relação à escolha do modelo que seria idealmente resolvida em conversa com os pesquisadores.
Para o restante deste exemplo, assumimos que a observação 58 é um valor legítimo. Observamos que foram registradas contagens de bebida de 18, 15, 14 e 13 em outros dias não incluídos nesta análise, portanto, as 21 bebidas consumidas por esta pessoa neste Sábado não é tão extremo em relação ao conjunto de dados maior.
Lidando com a superdispersão
Nossa investigação do ajuste do modelo não forneceu nenhuma evidência concreta de qualquer falha específica em nosso modelo. Mas o indicador deviance/df ainda sugere um problema com o ajuste do modelo. Na falta de qualquer outra explicação, concluímos que há superdispersão por algum motivo.
Talvez existam variáveis adicionais importantes que não foram medidas ou talvez interações de três variáveis ou superiores possam ser úteis. Sem dados adicionais ou orientação dos pesquisadores sobre quais de muitas interações de três variáveis ou superiores devemos considerar, resta-nos tentar ajustar as inferências para explicar a superdispersão.
Primeiro, avaliamos se um modelo quasi-Poisson ou binomial negativo é o preferido. Aplicando a análise da Seção 5.3.3, ajustamos uma regressão dos resíduos quadrados contra as médias ajustadas e procuramos curvatura na relação:
res.sq <- residuals ( object = mod.fit , type = "response")^2
set1 <- data.frame (res.sq , mu.hat = saturday$mu.hat)
fit.quad <- lm( formula = res.sq ~ mu.hat + I(mu.hat ^2) , data = set1 )
anova (fit.quad )## Analysis of Variance Table
##
## Response: res.sq
## Df Sum Sq Mean Sq F value Pr(>F)
## mu.hat 1 681.9 681.93 11.9460 0.0008532 ***
## I(mu.hat^2) 1 20.1 20.10 0.3521 0.5544753
## Residuals 86 4909.2 57.08
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1O termo quadrático claramente não é importante, indicando que um modelo quasi-Poisson é preferido. Nosso próximo passo deve ser retornar ao estágio de seleção de variáveis e repetir a avaliação de média do modelo de variáveis usando um modelo quasi-Poisson. Fizemos isso no programa para este exemplo e descobrimos que as mesmas variáveis são consideradas importantes como antes, embora com peso de evidência um pouco menor em alguns casos. Procedemos assim à análise do modelo quasi-Poisson escolhido.
Análise e interpretação de estimativas de parâmetros
Nosso passo final é quantificar os efeitos das variáveis explicativas sobre o número de bebidas consumidas. Essa análise é complicada pelo fato de que cada variável que consideramos está envolvida em pelo menos uma interação. Portanto, precisamos estimar os efeitos de uma determinada variável explicativa separadamente em diferentes níveis de suas variáveis interativas. Isso envolve calcular certas combinações lineares de estimativas de parâmetros e calcular suas variâncias correspondentes.
Infelizmente, as variâncias não podem ser calculadas com precisão usando as estimativas de parâmetro de média do modelo, porque glmulti() não fornece a matriz de variância-covariância completa das estimativas dos parâmetros. Poderíamos calcular as estimativas, mas não teríamos uma estimativa confiável de sua variabilidade. Aqui, concentramos nossa análise no melhor modelo único, reajustado por glm() usando um modelo quasi-Poisson abaixo.
mq <- glm ( formula = numall ~ prel + negevent + gender + rosn + age + desired +
state + rosn : prel + age: rosn + desired : gender + desired : age +
state : negevent , family = quasipoisson ( link = "log") , data = saturday )
round ( summary (mq)$coefficients , 3)## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.016 5.548 1.445 0.153
## prel 0.474 0.210 2.255 0.027
## negevent -4.961 2.189 -2.266 0.026
## gender 1.645 0.593 2.775 0.007
## rosn -2.869 1.462 -1.962 0.053
## age -0.260 0.160 -1.624 0.109
## desired 1.482 0.375 3.951 0.000
## state -0.925 0.266 -3.473 0.001
## prel:rosn -0.156 0.063 -2.489 0.015
## rosn:age 0.102 0.043 2.379 0.020
## gender:desired -0.294 0.106 -2.775 0.007
## age:desired -0.021 0.011 -1.802 0.075
## negevent:state 1.143 0.550 2.079 0.041O modelo estimado é \[ \log(\widehat{\mu}) = 8.016 + 0.474 \, \mbox{prel} -4.961 \, \mbox{negevent} + \cdots - 0.021 \, \mbox{age}\times \mbox{desired} + 1.143 \, \mbox{negevent}\times \mbox{state}\cdot \] Ver os sinais e magnitudes dos coeficientes nos ajuda a entender suas relações entre a resposta e as variáveis explicativas.
Por exemplo, prel tem um coeficiente de 0.474, enquanto que para prel:rosn é -0.156. Assim, estima-se que o efeito do rosn no número de drinques seja \[ \dfrac{\widehat{\mu}(\mbox{prel}+1, \mbox{rosn})}{\widehat{\mu}(\mbox{prel},\mbox{rosn})} = \exp(0.474-0.156 \, \mbox{rosn})\cdot \]
Além disso, na figura dos bosplots no começo do exemplo, vemos que o intervalo de rosn é 2-4. Assim, quando mantemos todas as outras variáveis explicativas constantes, o consumo de álcool aumenta à medida que o número de eventos de relacionamento positivo aumenta para valores mais baixos de traço de auto-estima, por exemplo, \[ \exp(0.474-0.156*2) = 1.18\cdot \]
No entanto, quando o traço de auto-estima é alto, o efeito dos eventos de relacionamento positivos sobre o consumo de álcool é revertido, por exemplo, \[ \exp(0.474 - 4*0.156) = 0.86\cdot \]
Para aprofundar esta análise, calculamos a razão das médias estimadas correspondentes a um aumento de 1 unidade para uma variável explicativa em cada um dos quartis das outras variáveis; no caso de desired:gender, nos dois níveis de gender. Por exemplo, para avaliar melhor os efeitos de prel, primeiro calculamos os três quartis de rosn e, em seguida, calculamos \[ \exp(0.474-0.156 \, \mbox{rosn})\cdot \] O código para fazer isso manualmente é mostrado abaixo.
bhat <- mq$coefficients
rosn.quart <- summary ( saturday$rosn )[c(2 ,3 ,5)]
rosn.quart## 1st Qu. Median 3rd Qu.
## 3.2 3.5 3.8mprel.rosn <- exp( bhat ["prel"] + rosn.quart * bhat ["prel:rosn"])
mprel.rosn## 1st Qu. Median 3rd Qu.
## 0.9753995 0.9308308 0.8882985100*( mprel.rosn - 1)## 1st Qu. Median 3rd Qu.
## -2.460046 -6.916922 -11.170151Observe que, por conveniência, podemos especificar o elemento do vetor de coeficientes por seu nome, como em >strong>bhat[“prel”]. No primeiro quartil de rosn, o efeito do prel já é negativo, reduzindo o número médio de bebidas consumidas em cerca de \(100(1-0.975) = 2.5\)% para cada aumento de 1 unidade no prel. A diminuição no número de bebidas atinge cerca de 11% por aumento de 1 unidade em prel no terceiro quartil de rosn.
Podemos usar essas quantidades para obter intervalos de confiança de (quase) verossimilhança perfilada para os valores de parâmetro verdadeiros usando o pacote mcprofile. Veja as Seções 2.2.4 e 4.2.2 para exemplos anteriores usando este pacote. A matriz de coeficientes contém uma linha para cada estimativa e uma coluna para cada parâmetro do modelo. Uma entrada de 1 é colocada na posição do efeito principal para a variável cuja inclinação estamos estimando. O valor do quartil da variável de interação vai para a posição para a interação. Todas as outras posições são definidas com coeficientes de 0.
Para o cálculo do intervalo de confiança, não especificamos um método para ajuste de multiplicidade no código abaixo, sem argumento adjust, portanto, o método padrão de etapa única é usado. Por fim, reexpressamos as estimativas dos parâmetros e os intervalos de confiança como variações percentuais.
library ( mcprofile )
# Create coefficient matrices as 1* target coefficient + quartile * interaction (s)
# Look at bhat for ordering of coefficients
# CI for prel , controlling for rosn
K.prel <- matrix ( data =
c(0, 1, 0, 0, 0, 0, 0, 0, rosn.quart [1] , 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, rosn.quart [2] , 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, rosn.quart [3] , 0, 0, 0, 0),
nrow = 3, byrow = TRUE )
# Produces wider intervals than with regular Poisson regression model
profile.prel <- mcprofile ( object = mq , CM = K.prel )
ci.prel <- confint ( object = profile.prel , level = 0.95)
100*( exp(ci.prel$estimate ) - 1) # Verifies got same answer as above## Estimate
## C1 -2.460046
## C2 -6.916922
## C3 -11.170151100*( exp(ci.prel$confint ) - 1)## lower upper
## 1 -8.496191 3.8483568
## 2 -12.860803 -0.7118282
## 3 -18.986757 -2.8078914As estimativas correspondem ao que calculamos manualmente anteriormente. O intervalo de confiança no primeiro quartil de rosn contém zero, então o efeito das relações positivas sobre o consumo de álcool não é claro. No entanto, a associação é decrescente para os quartis superiores de rosn.
5.5 Exercícios
1- Às vezes, é difícil visualizar a compensação de viés-variância. O programa a seguir contém uma simulação projetada para demonstrar que às vezes pode ser melhor usar um modelo muito pequeno do que um muito grande, ou mesmo o modelo correto!
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))
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()
O programa simula dados binários, \(Y_1,\cdots,Y_n\), com probabilidade de sucesso \(\pi_i\) definida por \(logit(\pi_i) = \beta_0 + \beta_1 x_{i1} + \beta_2 x_{i2} + \beta_3 x_{i3}\), onde cada \(x_{ij}\) é selecionado de uma distribuição uniforme entre 0 e 1. Os valores dos parâmetros de regressão são inicialmente definidos como \(\beta_0 = -1\), \(\beta_1 = 1\), \(\beta_2 = 1\) e \(\beta_3 = 0\) de modo que o modelo correto tenha apenas \(x_1\) e \(x_2\). O programa se encaixa em três modelos com conjuntos de variáveis \(\{x_1\}\), \(\{x_1, x_\}\) e \(\{x_1, x_2, x_3\}\) e compara as probabilidades estimadas dos modelos com as verdadeiras probabilidades em uma grade de \((x_1, x_2, x_3)\) combinações. O viés médio, a variância e o erro quadrático médio, MSE = viés\(^2\) + variância, para as previsões são calculados em cada combinação \(x\) em 200 conjuntos de dados simulados. Quanto mais próximo de 0 cada uma dessas três quantidades resumidas estiver, melhor será o modelo.
Execute o modelo usando as configurações padrão, que incluem \(n = 20\). Examine os gráficos de tendência, variância e MSE, bem como as médias dessas quantidades impressas no final do programa. Quais modelos têm melhor e pior desempenho em relação a cada quantidade? O modelo correto (“Modelo 2” no programa) é sempre o melhor? Explicar.
Aumente o tamanho da amostra para 100 e repita a análise. Como o viés, a variância e o MSE mudam para os três modelos? Os melhores e os piores modelos mudam?
Aumente o tamanho da amostra para 200 e repita a análise novamente. Responda às mesmas perguntas dadas em (b).
Usando \(n = 20\), tente aumentar e diminuir os valores de \(\beta_1\) e \(\beta_2\), mantendo \(\beta_0 = −(\beta_1 + \beta_2)/2\) de modo que as probabilidades permaneçam centradas em 0.5, os resultados \(logit\) resumidos devem permanecer simétricos em torno de zero. Você pode tirar conclusões sobre os efeitos de cada um desses dois parâmetros no viés, variância e MSE?
2- Divida o conjunto de dados de placekick aproximadamente ao meio e repita a seleção variável em cada metade. Determine se os resultados são semelhantes nas duas metades. O código parcial para fazer isso é mostrado abaixo, supondo que os dados estejam contidos no data.frame chamado placekick.
set.seed (32876582)
placekick$set <- ifelse ( runif ( n = nrow ( placekick ) ) > 0.5 , yes = 2 , no = 1)
library ( glmulti )
search.1.aicc <- glmulti ( y = good ~ . , data = placekick [ placekick$set ==1 , -10] ,
fitfunction = "glm" , level = 1 , method = "h" ,
crit = "aicc" , family = binomial ( link = "logit") )## Initialization...
## TASK: Exhaustive screening of candidate set.
## Fitting...
##
## After 50 models:
## Best model: good~1+distance+PAT
## Crit= 344.496840875508
## Mean crit= 398.622450621582
##
## After 100 models:
## Best model: good~1+distance+PAT
## Crit= 344.496840875508
## Mean crit= 393.45764743554
##
## After 150 models:
## Best model: good~1+distance+PAT
## Crit= 344.496840875508
## Mean crit= 362.62173362931
##
## After 200 models:
## Best model: good~1+distance+PAT
## Crit= 344.496840875508
## Mean crit= 351.278857201416
##
## After 250 models:
## Best model: good~1+distance+PAT
## Crit= 344.496840875508
## Mean crit= 349.25912840107
## Completed.a1 <- weightable ( search.1.aicc )
cbind ( model = a1 [ c (1:5) ,1] , round ( a1 [ c (1:5) ,c (2 ,3) ] , digits = 3) )## model aicc weights
## 1 good ~ 1 + distance + PAT 344.497 0.074
## 2 good ~ 1 + distance + change + PAT 345.463 0.046
## 3 good ~ 1 + distance + PAT + wind 345.955 0.036
## 4 good ~ 1 + distance + elap30 + PAT 346.023 0.034
## 5 good ~ 1 + distance 346.171 0.0323- Consulte as definições de \(AIC\), \(AIC_c\) e \(BIC\) na Seção 5.1.2. Construa um gráfico comparando os coeficientes de penalidade \((k)\) contra \(p\) para os três critérios com \(n = 10\) e \(p = 1, 2,\cdots, n/2\). Considerando que um coeficiente de penalidade maior faz com que um critério de informação prefira um modelo menor, o que esses resultados implicam para os modelos selecionados por esses três critérios? Repita para \(n = 100\) e \(n = 1000\). As conclusões mudam?
4- Consulte o Exercício 7 no Capítulo 2 para os dados de placekicking coletados por Berry and Wood (2004). Usando Distance, Weather, Wind15, Temperature, Grass, Pressure e Ice como variáveis explicativas e Good como resposta, execute a seleção do modelo das seguintes maneiras:
Compare quais variáveis são selecionadas sob seleção direta, eliminação retrógrada e seleção passo a passo usando \(BIC\).
Realize \(BMA\) usando \(BIC\). Quais variáveis parecem importantes e quais parecem claramente sem importância?
Estime os parâmetros de regressão para as análises stepwise. Compare essas estimativas com as da \(BMA\). Como eles são diferentes?
Explique por que a estimativa do parâmetro de regressão para Grass usando BMA é um pouco mais próxima de 0 do que usando stepwise.
5- Continuando o Exercício 4 do Capítulo 2, considere o modelo usando a temperatura como única variável explicativa.
Reajuste o modelo usando uma ligação \(probit\) e \(\log-\log\) complementar em vez de uma ligação \(logit\). Trace todas as três curvas com os dados, usando uma faixa de temperatura de 31℃ a 81℃ no eixo \(x\). Um parece se encaixar melhor do que os outros? Eles fornecem probabilidades semelhantes de falha em 31℃?
Compare os valores de \(BIC\) para as três ligações diferentes. Qual ligação parece se encaixar melhor?
Calcule as probabilidades do modelo \(BMA\) para as três ligações. Comente sobre a incerteza da seleção do modelo entre essas três ligações
6- Consulte o exemplo e o programa de regressão de todos os subconjuntos da Seção 5.1.3 com o conjunto de dados de placekicking. Execute o algoritmo genético usando \(AIC_c\) e inclua interações pairwise no modelo com marginality = TRUE, ou seja, nenhuma interação pairwise entre variáveis é considerada, a menos que ambas as variáveis também estejam no modelo. Use set.seed(837719911) antes de usar glmulti(). Observe que a função levará alguns minutos para ser executada.
Relate o melhor modelo e seu \(AIC_c\) . Compare isso com o \(AIC_c\) do melhor modelo encontrado sem interações. As interações melhoram o modelo?
Quantos modelos estão dentro de 2 unidades do \(AIC_c\) do melhor modelo? O que isso implica em nossa confiança em ter encontrado o melhor modelo?
Quantas gerações o algoritmo produziu?
Execute novamente o algoritmo, mas não execute novamente o código set.seed(). Isso fará com que o algoritmo use números aleatórios diferentes. Reexamine os mesmos itens solicitados em (a) - (c) e compare com o que você obteve inicialmente.
Execute novamente o algoritmo e o código set.seed() original, aumentando a probabilidade de mutação para 0.01, adicione o valor do argumento mutrate = 0.01; o padrão é 0.001. Relate os resultados conforme solicitado nas partes (a) - (c). Os resultados são diferentes daqueles em (a) - (c)? Observe que, nesse contexto, aumentar a probabilidade de mutação aumenta a probabilidade de uma variável ser adicionada ou removida aleatoriamente de um modelo. Em geral, aumentar a probabilidade de mutação pode tornar o algoritmo melhor para encontrar os melhores modelos, mas pode aumentar o tempo de execução.
7- A Seção 5.1.4 inclui um exemplo envolvendo o conjunto de dados placekicking e seleção passo a passo alternada de suas variáveis para um modelo de regressão logística. Execute o programa de seleção passo a passo alternado referido no exemplo e relate os resultados. Para o modelo final, calcule quanto BIC aumentaria com cada alteração possível que poderia ser feita no modelo.
8- Consulte novamente o exemplo mencionado no Exercício 7 e seu programa usando a seleção passo a passo alternada. Execute o código de seleção passo a passo alternado usando \(k = 0\).
Observe que todas as variáveis estão no modelo final. Por que isso deve acontecer?
No modelo final, as variáveis estão em ordem em relação a quanto \(IC(0)\) mudaria se a variável fosse descartada. Observe que isso não é o mesmo que a ordem em que as variáveis foram inseridas. Explique por que isso pode acontecer.
9- Consulte os dados de visitas hospitalares descritos no Exercício 16 do Capítulo 4. Considere o problema de tentar prever se uma pessoa tem seguro privado com base em seu padrão de uso de serviços de saúde. Isso sugere um modelo de regressão logística para privins, uma variável binária. Use o LASSO para identificar quais das variáveis restantes se relacionam com a probabilidade de uma pessoa ter seguro privado. Interpretar os resultados; em particular, estimar o efeito de cada variável explicativa sobre essa probabilidade.
10- Um criminologista que estudava a pena de morte estava interessado em identificar se certos atributos sociais, econômicos e políticos de um país estavam relacionados ao uso da pena de morte. Ela coletou dados de fontes públicas em 194 países, registrando as seguintes variáveis:
COUNTRY: O nome do país;
STATUS: As leis do país sobre penas de morte, codificadas como a = Execuções públicas; b = Execuções privadas; c = Execuções permitidas mas nenhuma realizada nos últimos 10 anos; d = Sem pena de morte;
LEGAL: A base do sistema legal do país, codificada como a = islâmica; b = Cível; c = Comum; d = Cível/Comum; e = Socialista; f = Outro;
HDI: Índice de Desenvolvimento Humano, medida numérica que varia de 0 (desenvolvimento humano muito baixo) a 1 (desenvolvimento humano muito alto);
GINI: Índice de GINI de desigualdade de renda, uma medida numérica que varia de 0 (perfeita igualdade) a 1 (perfeita desigualdade);
GNI: Renda Nacional Bruta per capita (US$);
LITERACY: Taxa de alfabetização (% de adultos de 15 anos ou mais que são alfabetizados);
URBAN: Percentagem da população total que vive em áreas urbanas;
POL: Índice de Instabilidade Política para o nível de ameaça que os protestos sociais representam para os governos, uma medida numérica que varia de 0 (sem risco) a 10 (alto risco);
CONFLICT: Nível de conflito vivido no país, codificado como a = Sem conflito, b = conflito latente (não violento), c = conflito manifesto, d = crise, e = crise grave, f = guerra.
Os dados dos 141 países com registros completos estão disponíveis no arquivo:
Death.Penalty = read.csv(file = "http://leg.ufpr.br/~lucambio/ADC/DeathPenalty.csv")
head(Death.Penalty)## COUNTRY STATUS LEGAL HDI GINI GNI LITERACY URBAN POL CONFLICT
## 1 Burundi b b 0.282 33.3 140 67.2 10 6.9 d
## 2 Congo (DR) a b 0.239 44.4 150 66.8 33 8.2 e
## 3 Liberia c c 0.300 52.6 170 60.8 47 7.4 a
## 4 Ethiopia b f 0.328 29.8 280 42.7 17 5.1 e
## 5 Malawi c c 0.385 39.0 280 74.8 15 5.7 a
## 6 Sierra Leone a c 0.317 42.5 320 35.1 39 7.2 bDados cortesia de Diana Peel, Departamento de Criminologia, Simon Fraser University. A variável de resposta é o status de pena de morte do país, enquanto todas as outras variáveis, exceto COUNTRY, são explicativas.
Ajuste um modelo de regressão multinomial (resposta nominal) a esses dados usando todas as variáveis explicativas disponíveis como termos lineares. Calcule o \(AIC\) e o \(BIC\) para este modelo. Calcule também o \(AIC_c\). Observe que os graus de liberdade do modelo necessários para calcular o \(AIC_c\) podem ser encontrados da função extractAIC().
Explique por que STATUS pode ser visto como uma variável ordinal.
Ajuste um modelo de regressão de chances proporcionais (consulte a Seção 3.4) a esses dados usando todas as variáveis explicativas disponíveis. Calcule \(AIC\), \(BIC\) e \(AIC_c\) como no modelo de regressão multinomial.
Observe que o modelo de chances proporcionais assume a ordinalidade da resposta e coeficientes iguais em diferentes logits. Com base nos critérios de informação, há evidências que sugiram que essas suposições levam a um ajuste inadequado do modelo? Explicar.
11- Continuando o Exercício 10, o principal interesse do investigador era determinar quais das variáveis explicativas, se alguma, estão associadas ao uso da pena de morte no país. Complete os itens abaixo tendo isso em mente.
Explique por que uma abordagem BMA seria mais apropriada do que uma abordagem gradual, dado o contexto deste problema.
Tratando a resposta como multinomial nominal, realize a análise BMA utilizando apenas efeitos principais. Relate os resultados e obtenha conclusões. Observe que isso exigirá a programação de uma função de ajuste de modelo para uso em glmulti(), porque o modelo multinomial normalmente não é ajustado usando glm(). O código para fazer isso está disponível no programa a seguir:
library(nnet)
# Unfortunately, have to deactivate a system variable in order to get rJava to work.
# See http://stackoverflow.com/questions/7019912/using-the-rjava-package-on-win7-64-bit-with-r
# True for 32 bit as well
if (Sys.getenv("JAVA_HOME")!= "")
Sys.setenv(JAVA_HOME = "")
library(glmulti)
# First need to create a multinom()-based function that can be called as the
# fitfunction = in glmulti()
multinom.glmulti <- function(formula, data){
multinom(as.formula(paste(deparse(formula))), data = data, Hess = TRUE)
}
# Need a method function for computing sample size; multinom() does not have one built in.
nobs.multinom <- function(obj){nobs(logLik(obj))}
# Next need to create a version of the "getfit" internal function for glmulti() that can
# read multinom-class objects and return the parameter estimates, standard errors,
# and residual DF
#
# Because glmulti() is an S4 function and multinom() is S3, need to "register" multinom
# for use in S4 computing
setOldClass("multinom")
# Now creating the getfit internal function for multinom.
# Started with the generic getfir, obtained using getMethod("getfit")
# Needed to add "multinom" to signature = argument, and tell it where to find the DF
setMethod("getfit",signature = "multinom",
function (object, ...)
{
summ = summary(object)
sumc = as.vector(summ$coefficients)
sums = as.vector(summ$standard.errors)
namen = c()
q = 1
for(i in c(1:length(object$coefnames))){
for (j in c(1:(length(object$lab)-1))){
namen[q] <- paste(object$lab[j+1], "-", object$coefnames[i])
q = q+1
}
}
summ1 = as.data.frame(cbind(Estimate = sumc,Std.Error = sums))
row.names(summ1) <- namen
didi = dimnames(summ1)
if (is.null(didi[[1]])) {
summ1 = matrix(rep(0, 2), nrow = 1, nc = 2, dimnames = list(c("NULLOS"),
list("Estimate", "Std. Error")))
return(cbind(summ1, data.frame(df = c(0))))
}
summ1 = summ1[, 1:2]
if (length(dim(summ1)) == 0) {
didi = dimnames(summ$coefficients)
summ1 = matrix(summ1, nrow = 1, nc = 2, dimnames = list(didi[[1]],
didi[[2]][1:2]))
}
# Need to fix location of residual df:
return(cbind(summ1, data.frame(df = rep(nobs(object) - summ$edf, length(summ$coefficients[,1])))))
}
)Este código precisa ser executado antes que glmulti() seja chamado no ajuste do modelo de classe multinom.
12- Repita a análise do Exercício 11 usando um modelo de regressão de probabilidades proporcionais. Observe que isso exigirá a programação de uma função de ajuste de modelo para uso em glmulti(), porque o modelo de probabilidades proporcionais normalmente não é ajustado usando glm(). O código para fazer isso está disponível no programa a seguir:
library(MASS)
# Unfortunately, have to deactivate a system variable in order to get rJava to work.
# See http://stackoverflow.com/questions/7019912/using-the-rjava-package-on-win7-64-bit-with-r
# True for 32 bit as well
if (Sys.getenv("JAVA_HOME")!= "")
Sys.setenv(JAVA_HOME = "")
library(glmulti)
# First need to create a polr()-based function that can be called as the
# fitfunction = in glmulti()
polr.glmulti <- function(formula, data){
#Need Hess = TRUE to get hessian stored for use later in estimating
# standard errors for parameter estimates
polr(as.formula(paste(deparse(formula))), data = data, Hess = TRUE)
}
# Next need to create a version of the "getfit" internal function for glmulti() that can
# read polr-class objects and return the parameter estimates, standard errors, and residual DF
#
# Because glmulti() is an S4 function and polr() is S3, need to "register" polr
# for use in S4 computing
setOldClass("polr")
# Now creating the getfit internal function for polr.
# Started with the generic getfir, obtained using getMethod("getfit")
# Needed to add "polr" to signature = argument, and tell it where to find the DF
setMethod("getfit",signature = "polr",
function (object, ...)
{
summ = summary(object)
summ1 = summ$coefficients
didi = dimnames(summ1)
if (is.null(didi[[1]])) {
summ1 = matrix(rep(0, 2), nrow = 1, nc = 2, dimnames = list(c("NULLOS"),
list("Estimate", "Std. Error")))
return(cbind(summ1, data.frame(df = c(0))))
}
summ1 = summ1[, 1:2]
if (length(dim(summ1)) == 0) {
didi = dimnames(summ$coefficients)
summ1 = matrix(summ1, nrow = 1, nc = 2, dimnames = list(didi[[1]],
didi[[2]][1:2]))
}
# Need to fix location of residual df:
return(cbind(summ1, data.frame(df = rep(summ$df.residual, length(summ$coefficients[,1])))))
}
)Este código precisa ser executado antes que glmulti() seja chamado no ajuste do modelo da classe polr.
Para cada variável, relate a probabilidade posterior de que ela pertença ao modelo e interprete os resultados.
Obtenha estimativas médias do modelo das razões de probabilidade correspondentes ao efeito de cada variável explicativa. Interprete esses valores.
Calcule intervalos de confiança de 95% para cada razão de chances e interprete. Em particular, que variáveis parecem ser mais importantes na descrição da utilização da pena de morte pelos países?
Repita esta análise nas razões de probabilidades de um único modelo de probabilidades proporcionais usando todas as variáveis explicativas. Compare os resultados com os valores médios do modelo.
13- Consulte os dados sobre pena de morte fornecidos no Exercício 10. Identifique quais variáveis estão relacionadas à resposta binária “Permite Pena de Morte” (STATUS é a, b ou c) versus “Sem Pena de Morte” (STATUS é d). Forme um modelo e use-o para estimar as probabilidades de os Estados Unidos e o Canadá permitirem a pena de morte.
14- Consulte os dados de visitas hospitalares descritos no Exercício 16 do Capítulo 4. Use a BMA com um critério \(BIC\) em um modelo de Poisson inflacionado de zero para identificar quais das variáveis explicativas estão relacionadas ao número de consultas médicas de uma pessoa ofp e a probabilidade de zero visitas. Observe que health_excellent e health_poor são, na verdade, apenas dois níveis de um fator de três níveis. Combine-os em uma única nova variável com três níveis, por exemplo, tomando \[ \mbox{health = as.factor(health_excellent - health_poor)}\cdot \]
Para cada variável, informe:
a probabilidade estimada de pertencer ao modelo,
estimativas de parâmetros pontuais e por intervalos de confiança em ambas as partes do modelo.
Obtenha conclusões de sua investigação. Como esse problema requer a programação de uma função de ajuste de modelo para uso em glmulti(), um modelo ZIP normalmente não é ajustado usando <strongglm(), fornecemos parte do código necessário no programa a seguir:
#############################################################################
# NAME: Tom Loughin #
# DATE: 1-10-13 #
# PURPOSE: Accessory functions to fit zeroinfl() models in glmulti() #
# #
# NOTES: Based on similar programs from Vincent Calcagno #
#############################################################################
#
# Unfortunately, have to deactivate a system variable in order to get rJava to work.
# See http://stackoverflow.com/questions/7019912/using-the-rjava-package-on-win7-64-bit-with-r
# True for 32 bit as well
if (Sys.getenv("JAVA_HOME")!="")
Sys.setenv(JAVA_HOME = "")
library(glmulti)
library(pscl)
#
# Need to call zeroinfl from glmulti.
# Formula for zeroinfl has two parts: one for mu and one for pi.
# Have to be able to recreate the formula from two separate parts.
# This function defaults to assuming that that variable selection is to take place
# both in the mean model and in the probability model. The same variables are
# either in both models or excluded from both models. Unfortunately,
# the way glmulti() is structured, it appears that it would be very difficult
# to do separate variable selection on the mean and the probability models.
#
# Usage:
# If variable selection is desired in both mean and probability, then use the
# formula = ... specificaiton to list the variables to be considered in both models.
# Do not include an inflate = ... argument.
# If the probability model is to be held fixed, then list the variables for the mean
# model in the formula = ... and list the variables for the probability model in inflate = "...".
# For the inflate = parameter, use format "x1 + x2" and enclose the terms in quotes.
# If no variables are to be used, list "1".
#
# Needed to add "width.cutoff = 500" or the formula may be put together wrong and cause errors.
# Also recemmended to use short variable names when there are many variables.
zeroinfl.glmulti = function(formula, data, inflate = NULL, ...) {
if (is.null(inflate)) zeroinfl(as.formula(paste(deparse(formula, width.cutoff = 500))),data = data,...)
else zeroinfl(as.formula(paste(deparse(formula, width.cutoff = 500), "|" ,inflate)),data = data,...)
}
# There is no nobs() method for zeroinfl, so one is created here.
nobs.zeroinfl <- function(obj){obj$n}
# Next need to create a version of the "getfit" internal function for glmulti() that can
# read zeroinfl-class objects and return the parameter estimates, standard errors, and residual DF
#
# Because glmulti() is an S4 function and zeroinfl() is S3, need to "register" zeroinfl
# for use in S4 computing
setOldClass("zeroinfl")
# Now creating the getfit internal function for zeroinfl.
# Started with the generic getfir, obtained using getMethod("getfit")
# Needed to add "zeroinfl" to signature = argument, and separately process Mean and Probability model parameters.
setMethod("getfit",signature = "zeroinfl",
function (object, ...)
{
summ = summary(object)
summ1.c = summ$coefficients$count
didi.c = dimnames(summ1.c)
if (is.null(didi.c[[1]])) {
summ1.c = matrix(rep(0, 2), nrow = 1, nc = 2, dimnames = list(c("NULLOS"),
list("Estimate", "Std. Error")))
return(cbind(summ1.c, data.frame(df.c = c(0))))
}
summ1.z = summ$coefficients$zero
didi.z = dimnames(summ1.z)
if (is.null(didi.z[[1]])) {
summ1.z = matrix(rep(0, 2), nrow = 1, nc = 2, dimnames = list(c("NULLOS"),
list("Estimate", "Std. Error")))
return(cbind(summ1.z, data.frame(df.z = c(0))))
}
summ1 = rbind(summ1.c[, 1:2],summ1.z[,1:2])
didi = dimnames(rbind(summ1.c, summ1.z))
rdimn <- rbind(cbind(paste("mu-",didi.c[[1]],sep = "")),cbind(paste("pi-",didi.z[[1]],sep = "")))
dimnames(summ1) = list(rdimn, didi[[2]][1:2])
rr <- cbind(summ1, data.frame(df = rep(summ$df.residual, nrow(summ1))))
return(rr)
}
)Este código precisa ser executado antes que glmulti() e chamado na classe zeroinfl de ajuste do modelo. Por favor, veja os comentários no arquivo do programa para obter ajuda sobre como usar glmulti() para este modelo. Observe que a seleção de variáveis é aplicada apenas às variáveis listadas no modelo para a média. O modelo para a probabilidade deve ser especificado antecipadamente ou terá as mesmas variáveis incluídas em cada modelo médio.
15- Repita o Exercício 14 incluindo interações entre pares na lista de variáveis, mantendo a marginalidade do modelo. Observe que isso exigirá o uso do algoritmo genético. Sugerimos desligar a opção de gráfico plotty = FALSE, porque ela produz uma enorme quantidade de saída gráfica que pode travar alguns sistemas. Além disso, observe que este pode levar várias horas para ser executado.
16- Usando os dados do placekick dos exemplos da Seção 5.1, ajuste um modelo de regressão logística com as variáveis distance e PAT. Salve os resultados como um objeto, digamos mod.fit.
Execute summary(mod.fit) e observe que existe um valor chamado \(AIC\) na saída. Informe este valor. Relate também o desvio residual.
Obtenha o \(AIC\) e o desvio residual extraindo-os do objeto de ajuste do modelo usando mod.fit$aic e mod.fit$deviance. Extraia o número de parâmetros do modelo usando mod.fit$rank. Usando os valores resultantes, calcule o \(AIC\) e o \(AIC_c\).
As funções \(AIC()\) e extractAIC() podem calcular valores de IC(k) para determinados valores de \(k\), onde fit é o objeto do modelo. Use essas funções para calcular o desvio do modelo, o \(AIC\), o \(BIC\) e o \(AIC_c\). Observe que para \(AIC_c\) você precisará usar o valor de mod.fit$rank da parte anterior no cálculo do parâmetro de penalidade \(k\).
17- Demonstre quão bem a aproximação normal padrão é válida para resíduos de um modelo de Poisson com médias diferentes. Especificamente, para contagens
y <- c(0:10)
e para média
yhat <- 2
- Calcule os resíduos de Pearson
pear <- (y-yhat)/sqrt(yhat)
- Calcule as probabilidades acumuladas de Poisson e normais padrão para um valor maior que o resíduo de Pearson,
pp <- 1-ppois(y,yhat)
e
pn <- 1-pnorm(pear)
respectivamente.
- Use
cbind(y,pear,pp,pn)
para imprimir os resultados. Compare essas probabilidades para qualquer resíduo de Pearson acima de 2, 3 e 4. As probabilidades são semelhantes? Existem outros resíduos de Pearson abaixo de 2 com probabilidade <0.05? Existem outros resíduos de Pearson acima de 2 com probabilidade > 0.05?
Das partes (a) a (c), o que você pode concluir sobre a interpretação dos resíduos de Pearson a partir de modelos onde \(\widehat{y} = 2\)?
Repita essas etapas para \(\widehat{y} = 1, 0.5, 0.25, 0.1\). Comente se você se sente confortável em usar as diretrizes 2, 3 e 4 acima para identificar grandes resíduos de Pearson nesses casos.
18- Continuando o Exercício 4, utilize as variáveis Distance e Grass conforme sugerido pelo BMA. Inclua a interação dessas duas variáveis no modelo e realize os diagnósticos da seguinte forma:
Plote os resíduos de Pearson padronizados em relação à distância, às probabilidades estimadas e ao preditor linear. Interprete os resultados.
Realize o teste de Hosmer-Lemeshow usando 10 grupos. Declare hipóteses, estatística de teste, \(p\)-valor e conclusões. Além disso, examine os resíduos de Pearson dos agrupamentos e indique se eles mostram algum padrão específico.
Realize os testes de Osius-Rojek e Stukel e tire conclusões.
Faça uma análise de influência. Identifique quaisquer observações influentes e indique como elas são influentes. Interprete os resultados.
Escreva um breve resumo dos resultados do diagnóstico e conclua se o modelo é razoavelmente bom para os dados.
19- Margolin et al. (1981) fornecem dados que mostram o número de colónias revertentes de Salmonella em resposta a doses variadas de quinolina. Existem seis níveis de dose diferentes e três observações independentes por dose. Os dados são fornecidos no quadro de dados salmonella do pacote aod.
Observe que os espaçamentos entre os níveis de dose são aproximadamente constantes em uma escala logarítmica. Trace a resposta (\(y\)) em relação à dose e ào logarítmico base 10 da dose, log10(y+1) e comente quaisquer tendências aparentes. Observe que usamos a base 10 aqui porque os níveis de dose 10, 100 e 1000 são simplesmente 1, 2 e 3 no logaritmo da base 10. O +1 é usado no logaritmo aqui porque \(\log_{10}(0)\) não está definido, mas \(\log_{10}(1) = 0\). Neste problema todos os logaritmos devem ser considerados desta forma.
Estime um modelo de regressão de Poisson para \(y\) com dose, log-dose ou uma versão categórica de dose, trate a dose como um fator categórico de seis níveis usando fator(dose) em formula como variável explicativa. Que conclusões você pode tirar com base em testes de efeito de dose?
Examine as estatísticas de deviance/df para cada modelo. Os ajustes do modelo parecem bons? Explicar.
Plote os resíduos padronizados em relação às médias ajustadas para os dois modelos que utilizam dose de maneira numérica. Comente o que essas tramas lhe dizem.
Plote os resíduos padronizados em relação às médias ajustadas para o modelo que trata a dose como categórica. Não há dúvida sobre a linearidade da resposta ou a adequação da função de ligação aqui. O que esse enredo sugere?
20- Consulte os dados do Challenger do Exercício 4 no Capítulo 2. Ajuste um modelo incluindo apenas a temperatura como variável explicativa.
Examine a estatística deviance/df. Realize também uma avaliação gráfica dos resíduos. Discuta o ajuste do modelo.
Examine a qualidade do ajuste do modelo e tire conclusões.
Realizar uma análise de influência e tirar conclusões.
Explique por que \(h_{14}\) é tão grande.
Reestime a regressão logística sem observação 14 no conjunto de dados. Para o modelo com e sem esta observação, compare os intervalos de confiança para os parâmetros e represente graficamente a probabilidade estimada de falha do anel de vedação em relação à temperatura em um gráfico. Os resultados mudam de forma significativa?
21- Consulte os dados sobre a pena de morte com uma interpretação binária da resposta para a presença ou ausência de pena de morte (ver Exercícios 10 e 13). Considere um modelo composto pelas variáveis LEGAL, HDI e GNI. Avalie o ajuste do modelo e identifique quaisquer preocupações.
22- Consulte o Exercício 12 no Capítulo 4. Trace os resíduos padronizados versus os escores 1-2-3-4-5 para a ideologia política. Quais modelos examinados neste exercício anterior ajustam-se razoavelmente bem aos dados?
23- Agresti (2007) fornece dados sobre o comportamento social dos caranguejos-ferradura. Esses dados estão contidos no arquivo:
HorseshoeCrabs = read.csv(file = "http://leg.ufpr.br/~lucambio/ADC/HorseshoeCrabs.csv")
head(HorseshoeCrabs)## Color Spine Width Weight Sat
## 1 2 3 28.3 3.05 8
## 2 3 3 26.0 2.60 4
## 3 3 3 25.6 2.15 0
## 4 4 2 21.0 1.85 0
## 5 2 3 29.0 3.00 1
## 6 1 2 25.0 2.30 3Cada observação corresponde a uma fêmea de caranguejo. A variável de resposta é Sat, o número de machos “satélites” nas proximidades dela. As medidas físicas da fêmea – Cor (ordinal de 4 níveis), Spine (ordinal de 3 níveis), Width (cm) e Weight (kg) – são variáveis explicativas.
Ajuste um modelo de regressão de Poisson com uma ligação logarítmica usando todas as quatro variáveis explicativas de forma linear. Teste sua significância e resuma os resultados.
Calcule deviance/df e interprete seu valor.
Examine os diagnósticos residuais e identifique quaisquer problemas potenciais com o modelo.
Realize o teste de bondade de ajuste usando as funções disponíveis no Exemplo 5.7. Use o número padrão de grupos, \(M/5\) quando \(M\leq 100\).
Estabeleça as hipóteses, teste a estatística, o \(p\)-valor e interprete os resultados.
Plote os resíduos de Pearson para os grupos em relação aos centros de intervalo, disponíveis nos componentes pear.res e centers, respectivamente, da lista retornada pela função. Use este gráfico e os gráficos residuais da parte (c) para explicar os resultados.
24- Continuando o Exercício 23, conduza uma análise de influência. Interprete os resultados.
25- Continuando o Exercício 23, observe que existe um caranguejo com peso substancialmente diferente dos demais. Isto pode ser visto, por exemplo, num histograma dos pesos. Remova esse caranguejo dos dados e repita as etapas do Exercício 23. Isso corrigiu algum problema com o modelo? Existem outros problemas com o modelo e o que poderia ser feito para resolver esses problemas?
26- Consulte o Exercício 18 do Capítulo 4 sobre os dados de contagem de salamandras.
Calcular o deviance/df. O que esse valor sugere sobre o modelo?
Examine os resíduos padronizados e realize uma análise de influência. Interprete os resultados.
27- Continuação do Exercício 26:
Realize o teste de bondade de ajuste usando as funções disponíveis no Exemplo 5.7. Use o número padrão de grupos, que é \(n/5\) quando \(n\leq 100\). Estabeleça as hipóteses, teste a estatística, o \(p\)-valor e interprete os resultados. Trace os resíduos de Pearson para os grupos ($pear.res) e contra os centros de intervalo ($centers). Use este gráfico e os gráficos residuais do Exercício 26 para explicar os resultados.
Realize uma simulação de Monte Carlo para investigar se o teste GOF mantém o tamanho correto para este modelo e dados. Especificamente, supondo que o modelo esteja contido em um objeto glm chamado mod.fit, use set.seed(1348765911) e repita as seguintes etapas 1000 vezes:
- Simule dados de resposta de Poisson do modelo estimado. Por exemplo, use predict() para salvar as médias estimadas em um objeto chamado mean e simular novas respostas usando
y <- rpois (n = length (mean), lambda = mean)
Estime o modelo de regressão de Poisson para os dados simulados e obtenha os valores previstos do modelo para cada observação.
Aplique o programa a seguir aos dados simulados e valores previstos; obter o \(p\)-valor, o componente pval do objeto retornado.
#####################################################################
# NAME: Tom Loughin #
# DATE: 06-24-2013 #
# PURPOSE: Grouped-prediction goodness of fit test for count models #
# #
# NOTES: #
# Program operates on user-supplied numerical objects containing #
# observed counts for each observation and predicted counts in the #
# same order. User can supply number of groups; uses n/5 otherwise, #
# unless n>100, whereupn g defaults to 20. #
# #
# Source this program before calling the function. #
#####################################################################
#
PostFitGOFTest = function(obs, pred, g = 0) {
if(g == 0) g = round(min(length(obs)/5,20))
ord <- order(pred)
obs.o <- obs[ord]
pred.o <- pred[ord]
# Creates factor with levels 1,2,...,g
interval = cut(pred.o, quantile(pred.o, 0:g/g), include.lowest = TRUE)
counts = xtabs(formula = cbind(obs.o, pred.o) ~ interval)
centers <- aggregate(formula = pred.o ~ interval, FUN = "mean")
pear.res <- rep(NA,g)
for(gg in (1:g)) pear.res[gg] <- (counts[gg] - counts[g+gg])/sqrt(counts[g+gg])
pearson <- sum(pear.res^2)
if (any(counts[((g+1):(2*g))] < 5))
warning("Some expected counts are less than 5. Use smaller number of groups")
P = 1 - pchisq(pearson, g - 2)
cat("Post-Fit Goodness-of-Fit test with", g, "bins", "\n", "Pearson Stat = ",
pearson, "\n", "p = ", P, "\n")
return(list(pearson = pearson, pval = P, centers = centers$pred.o, observed = counts[1:g],
expected = counts[(g+1):(2*g)], pear.res = pear.res))
}A fração dos \(p\)-valores abaixo de 0.05 é o tamanho estimado do teste quando um nível de erro tipo I deste mesmo valor é usado. Esta fração está próxima de 5%, como seria de esperar se o teste tivesse o tamanho correto? Use um intervalo de confiança para levar em conta a variabilidade da simulação ao responder a esta pergunta.
28- Consulte o Exercício 26 do Capítulo 4 sobre dados de consumo de álcool, no qual um modelo de regressão de Poisson foi ajustado usando o consumo de bebida no primeiro sábado como resposta e prel.nrel, posother, negother, age, rosn e state como variáveis explicativas. Examine o ajuste deste modelo e tire conclusões.
29- Consulte o exemplo dos grãos de trigo da Seção 3.3, Exemplo 3.4. Examine o ajuste do modelo com as seis variáveis explicativas. Use a função multinomDiag() a seguir para ajudar em seus cálculos.
#######################################################################
# NAME: Tom Loughin #
# DATE: 1-10-13 #
# PURPOSE: Diagnostics for nominal multinomial model using multinom() #
# #
# NOTES: ASSUMES THAT multinom() HAS BEEN FIT TO BINARY-FORM DATA #
# Assumes that arguments Hess = TRUE and model = TRUE have been #
# added to multinom() #
# (Need binaries and model = TRUE to extract response binaries #
# for calculations) #
#######################################################################
#
# First compute the variance-covariance matrix for beta-hat manually.
# This can help to identify when there are problems in the data that are
# not immediately apparent from the fit of the model (e.g. zero cell counts).
# Also identifies when scaling the explanatories might be useful.
# In particular, if the matrix produced by vcov() on the multinom-class
# object does not match the one we compute, then there is a problem and
# the analysis should be rerun with either scaled explanatories or
# adjusted binaries.
multinomDiag <- function(mod.fit){
# Going to compute X'VX
# Use generics to find residuals and estimated probabilities
res <- as.data.frame(residuals(mod.fit))
pi.hat <- as.data.frame(predict(mod.fit, type = "prob"))
# Rearrange categorical response into J binary columns.
levs <- colnames(res)
counts <- mod.fit$weights
# Rearrange X in the right order to match vcov from multinom()
J <- length(levs)
n <- nrow(res)
indices <- c(t(matrix(data = 1:(n*(J-1)), nrow = n, ncol = J-1, byrow = FALSE)))
X <- diag(J-1) %x% model.matrix(mod.fit) # %x% is Kronecker Product
X <- X[indices,]
# Now get V = Var-hat(Y)
# Remember that first column of pi.hat is reference category
V <- matrix(data = 0, nrow = n*(J-1), ncol = n*(J-1))
# Need a different form of Pearson Residual for later
pear.res1 <- matrix(data = NA, nrow = n, ncol = J-1)
for(ii in c(1:n)) {
p.i <- as.numeric(pi.hat[ii,-1])
V.i <- (diag(p.i) - p.i%*%t(p.i))*counts[ii]
index <- (J - 1)*(ii - 1) + 1
V[c(index:(index+(J-2))),c(index:(index+(J-2)))] <- V.i
vinv <- solve(V.i)
e <- eigen(vinv)
ev <- e$vectors
B <- ev %*% diag(sqrt(e$values)) %*% t(ev) # = V^{-1/2}
pear.res1[ii,] <- counts[ii]*as.numeric(res[ii,-1]) %*% B
}
# Get Var(beta-hat) = (X' V X)^{-1}
sigma <- solve(t(X) %*% V %*% X) # Could just take vcov(mod.fit)
# Form hat matrix: V^{1/2} X (X' V X)^{-1} X' V^{1/2}
# Take square root of V using eigen-decomposition
e <- eigen(V)
ev <- e$vectors
B <- ev %*% diag(sqrt(e$values)) %*% t(ev) # = V^{1/2}: B %*% B = V
H <- B %*% X %*% sigma %*% t(X) %*% B # Hat Matrix
##############################################################################
# Standard diagnostics:
# 1. Deviance/DF
# 2. Pearson residuals and Pearson values for each observation
# Deviance/DF
cat("Deviance = ", mod.fit$deviance, "df = ", (n - mod.fit$edf),"\n")
cat("Deviance/df = ", mod.fit$deviance/(n - mod.fit$edf),"\n")
cat("Threshold = 1 + 3*sqrt(2/(n- mod.fit$edf))",
1 + 3*sqrt(2/(n- mod.fit$edf)),"\n")
# Create Pearson residuals and Pearson goodness-of-fit value for observation
response <- mod.fit$model[,1]
if(class(response) == "matrix") binary = response else{
binary <- matrix(data = NA, nrow = length(response), ncol = J)
colnames(binary) <- levs
for(jj in c(1:J)){
binary[,jj] = as.numeric(response == levs[jj])
}
}
pear.res <- (binary - counts*pi.hat)/sqrt(counts*pi.hat)
pear.obs <- apply(X = pear.res^2, MARGIN = 1, FUN = sum)
X2 <- sum(pear.obs)
# Plot results of Pearson statistics
plot(x = c(1:length(pear.obs)), y = pear.obs, xlab = "Observation number",
ylab = "Pearson Statistic",
main = "Index Plot of Pearson Values")
abline(h = qchisq(p = 0.95, df = J-1), lty = "dotted")
abline(h = qchisq(p = 0.99, df = J-1), lty = "dotted")
dev.res2 <- -2*apply(X = binary*log(pi.hat), MARGIN = 1, FUN = sum)
# Plot results of Deviance statistics
plot(x = c(1:length(dev.res2)), y = dev.res2, xlab = "Observation number",
ylab = "Deviance Statistic",
main = "Index Plot of Deviance Values")
abline(h = qchisq(p = 0.95, df = J-1), lty = "dotted")
abline(h = qchisq(p = 0.99, df = J-1), lty = "dotted")
Xmat <- as.matrix(mod.fit$model[,-1])
colnames(Xmat) <- colnames(mod.fit$model[,-1])
# Combine results into data frame so that we can interpret large Pearson values
resid.stats <- data.frame(Xmat, binary, pi.hat = round(pi.hat,3),
p.res = round(pear.res,2), pear.val = round(pear.obs,2),
dev.val = round(dev.res2, 2))
# Print observations with large Pearson or Deviance values
print("Observations with Pearson values above the Chi-Square(.95) threshold")
print(resid.stats[(resid.stats$pear.val > qchisq(p = 0.95,df = J-1)),])
print("Observations with Deviance values above the Chi-Square(.95) threshold")
print(resid.stats[(resid.stats$dev.val > qchisq(p = 0.95,df = J-1)),])
############################################################################
# Influence Statistics
# See Lesaffre and Albert (1989) for details.
#
# Hat matrix is H
# Evidence that Hat matrix diagonal sums to (p+1)(J-1)
# sum(diag(H))
# Prepare to calculate some building blocks for influence diagnostics
# Use Hii as (J-1)x(J-1) diagonal block elements of H for obs i
detM <- vector(length = n) # Will hold determinant of Mii = 1 - Hii
cookD <- vector(length = n) # Will hold approximate Cook's D values.
hii <- vector(length = n) # Will hold leverage values for each obs
deltaDev <- vector(length = n) # Will hold leverage values for each obs
deltaX2 <- vector(length = n) # Will hold leverage values for each obs
for(ii in (1:n)){
start <- (J-1)*(ii-1) + 1 # Index to guide extraction of block from diagonal of H
Hii <- matrix(data = H[c(start:(start+J-2)),c(start:(start+J-2))], nrow = J-1)
# leverage value is sum of all diagonal elements of H for that observation
hii[ii] <- sum(diag(Hii))
Mii <- diag(J-1) - Hii
# Determinant of Mii is approximately the CovRatio (Lesaffre and Albert 1989).
# They give a threshold of < 1-2DF/n for leverage,
# DF = model DF = # parameters in model
# detM[ii] <- det(x = Mii)
Minv <- solve(Mii)
# 1-step approximation to Cook's D as per Lesaffre and Albert (1989).
# They give threshold of chi-square(DF), but values are typically < 2, so this seems unrealistic
cookD[ii] <- (t(pear.res1[ii,]) %*% Minv %*% Hii %*% Minv %*% pear.res1[ii,]/mod.fit$edf)
# Approximate Deviance test for outlier as per Lesaffre and Albert (1989)
# Compare to critical values of chi-square(J-1)
deltaDev[ii] <- dev.res2[ii] + t(pear.res1[ii,]) %*% Minv %*% Hii %*% pear.res1[ii,]
deltaX2[ii] <- t(pear.res1[ii,]) %*% Minv %*% pear.res1[ii,]
}
# Add influence neasures to PostFit stats
infl.stats <- data.frame(Xmat, binary, pi.hat = round(pi.hat,3), detM = round(detM,3),
CookD = round(cookD,2),
deltaDev = round(deltaDev, 2), hat = round(hii,2))
# Print observations with extreme invluence statistics
print("Observations with large leverage values")
print(infl.stats[(hii > 3*mod.fit$edf/n),])
print("Observations with large Delta Pearson")
print(infl.stats[(deltaX2 > qchisq(p = .95, df = J-1)),])
print("Observations with large DeltaDeviance (outliers)")
print(infl.stats[(deltaDev > qchisq(p = .95, df = J-1)),])
print("Observations with large Cook's D")
print(infl.stats[(cookD > 4/n),])
# plot(infl.stats$detM, hii): Looks very nearly 1:1. Either measure will do for leverage.
# Plots of case-deletion stats vs. leverage
x11()
plot(x = hii, y = cookD, main = "Cook's distance against approximate leverage",
xlab = "Hat value (approx. leverage)", ylab = "Cook's Distance")
abline(v = c(2,3)*mod.fit$edf/n, lty = "dotted")
x11()
plot(x = hii, y = deltaDev,
main = "Change in Deviance from deletion against approximate leverage",
xlab = "Hat value (approx. leverage)", ylab = "Delta Deviance")
abline(v = c(2,3)*mod.fit$edf/n, lty = "dotted")
abline(h = qchisq(p = 0.95, df = J-1), lty = "dotted")
abline(h = qchisq(p = 0.99, df = J-1), lty = "dotted")
x11()
plot(x = hii, y = deltaX2,
main = "Change in Pearson from deletion against approximate leverage",
xlab = "Hat value (approx. leverage)", ylab = "Change in Pearson")
abline(v = c(2,3)*mod.fit$edf/n, lty = "dotted")
abline(h = qchisq(p = 0.95, df = J-1), lty = "dotted")
abline(h = qchisq(p = 0.99, df = J-1), lty = "dotted")
# Not covered in book
# # Pregibon Plot
# x11()
# plot(x = hii, y = pear.obs/X2, main = "Fractional Pearson value against Approximate Leverage",
# xlab = "Approximate leverage", ylab = "Fractional contribution to Pearson Statistic")
# abline(a = 2*(1+mod.fit$edf)/n, b = -1, lty = "dotted")
# abline(a = 3*(1+mod.fit$edf)/n, b = -1, lty = "dotted")
}30- Consulte o Exercício 16 do Capítulo 4. Ajuste o modelo ZIP com todas as variáveis listadas como termos lineares.
Realize o teste de bondade de ajuste usando as funções disponíveis no Exemplo 5.7. Use o número padrão de grupos. Plote os resíduos de Pearson para os grupos $pear.res em relação aos centros dos intervalos $centers. Use este gráfico para ajudar a explicar os resultados do teste.
Faça um gráfico dos resíduos de Pearson em relação a cada variável explicativa e interprete os resultados.
Adicione um termo quadrático para numchron ao modelo. Este termo é significativo? Quão bem o modelo se ajusta agora? Explicar.
Sugira como o modelo pode ser melhorado ainda mais.
31- Repita o teste de Hosmer-Lemeshow nos dados do placekick com distance como variável explicativa e usando \(g = 5, 6,\cdots, 12\) grupos. Relate os resultados e comente a sensibilidade do teste ao número de grupos.
32- Consulte o Exemplo 5.10 sobre simulação de dados com superdispersão. Em geral, considere um modelo em que \(Y\sim Po(\mu)\), onde \(\mu\) possui distribuição normal com média \(\tau\) e variância \(\sigma^2\). Usando o fato de que \[ \mbox{E}(Y) = \mbox{E}_N\big(\mbox{E}_P (Y|\mu)\big) \] e \[ \mbox{Var}(Y) = \mbox{E}_N\big(\mbox{Var}_P (Y|\mu)\big) + \mbox{Var}_N\big(\mbox{E}_P(Y|\mu )\big), \] onde \(\mbox{E}_N\) e \(\mbox{Var}_N\) são considerados em relação à distribuição normal para a média \(\mu\) e \(\mbox{E}_P\) e \(\mbox{Var}_P\) são tomados em relação à distribuição de Poisson para a resposta \(Y\), mostram que \[ \mbox{E}(Y) = \tau \qquad \mbox{e} \qquad \mbox{Var}(Y) =\tau+\sigma^2\cdot \]
33- Consulte o Exemplo 4.13: Resposta de postura de besouro à aglomeração.
Verifique o modelo final usado no exemplo contido em zip.mod.t0 para superdispersão. Ao traçar os resíduos de Pearson versus temperatura, a função jitter() será útil. Esta função adiciona uma pequena quantidade de ruído aleatório aos valores de temperatura, o que ajuda a distinguir entre resíduos de Pearson semelhantes na mesma temperatura.
Ajuste um modelo binomial negativo inflacionado de zeros. Compare as estimativas dos parâmetros e os intervalos de confiança com os do modelo de Poisson inflacionado em zero. Verifique este modelo quanto a sinais de superdispersão.
34- Continuando o Exercício 13 do Capítulo 4, complete o seguinte.
Encontre a média amostral e a variância para cada dia da semana. Há evidências de superdispersão? Explicar.
Usando um modelo de regressão binomial negativa em vez de um modelo de regressão de Poisson, complete todas as partes fornecidas no Exercício 13(c) do Capítulo 4.
Considere o modelo ANOVA \(Y_{ij} = \mu +\alpha_i+ \epsilon_{ij}\) onde \(\epsilon_{ij}\) são erros independentes, normalmente distribuídos com média 0 e variância \(\sigma^2 > 0\). Este é o modelo linear usual encontrado em uma análise de variância unidirecional. Abaixo está o código que pode ser usado para encontrar a tabela ANOVA e realizar múltiplas comparações, os dados estão contidos no arquivo Starbucks:
starbucks = read.csv("http://leg.ufpr.br/~lucambio/ADC/starbucks.csv")
head(starbucks)## Date Day Count
## 1 7/18/2011 Monday 1
## 2 7/19/2011 Tuesday 2
## 3 7/20/2011 Wednesday 7
## 4 7/21/2011 Thursday 4
## 5 7/22/2011 Friday 0
## 6 7/25/2011 Monday 2mod.fit.anova = aov (formula = Count ~ Day, data = starbucks)
summary(mod.fit.anova)## Df Sum Sq Mean Sq F value Pr(>F)
## Day 4 54.64 13.66 0.933 0.465
## Residuals 20 292.80 14.64# Least significant differences
pairwise.t.test (x = starbucks$Count, g = starbucks$Day,
p.adjust.method = "none", alternative = "two.sided")##
## Pairwise comparisons using t tests with pooled SD
##
## data: starbucks$Count and starbucks$Day
##
## Friday Monday Thursday Tuesday
## Monday 0.175 - - -
## Thursday 0.684 0.084 - -
## Tuesday 0.744 0.295 0.466 -
## Wednesday 0.935 0.201 0.625 0.807
##
## P value adjustment method: none# Tukey honest significant differences
TukeyHSD (x = mod.fit.anova , conf.level = 0.95)## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = Count ~ Day, data = starbucks)
##
## $Day
## diff lwr upr p adj
## Monday-Friday -3.4 -10.641299 3.841299 0.6316343
## Thursday-Friday 1.0 -6.241299 8.241299 0.9933879
## Tuesday-Friday -0.8 -8.041299 6.441299 0.9971987
## Wednesday-Friday -0.2 -7.441299 7.041299 0.9999884
## Thursday-Monday 4.4 -2.841299 11.641299 0.3911028
## Tuesday-Monday 2.6 -4.641299 9.841299 0.8172789
## Wednesday-Monday 3.2 -4.041299 10.441299 0.6810631
## Tuesday-Thursday -1.8 -9.041299 5.441299 0.9433773
## Wednesday-Thursday -1.2 -8.441299 6.041299 0.9868380
## Wednesday-Tuesday 0.6 -6.641299 7.841299 0.9990899Compare esses resultados com aqueles obtidos usando os modelos Poisson e binomial negativa de regressão. Qual das três abordagens de modelagem é a mais apropriado? Discutir.
35- Para os dados sobre Salmonella do Exercício 19, podem existir sinais de sobredispersão. Considerar apenas o modelo que trata a dose como uma variável explicativa categórica.
Repita a análise do Exemplo 5.15 para ver se um quase-Poisson ou um binômio negativo é uma opção melhor. Em particular, crie um gráfico como Figura 5.10 e calcule a regressão quadrática conforme mostrado no exemplo. O que você conclui sobre as duas opções de modelo?
Ajustar o modelo quase-Poisson aos dados e testar a significância da dose efeito. Como os resultados se comparam aos do Exercício 19?
Plotar os resíduos padronizados em relação às médias estimadas. Comente os resultados.
36- Para os dados do caranguejo-ferradura do Exercício 23, pode haver sinais de sobredispersão.
Repita a análise do Exemplo 5.15 aplicado a estes dados para ver se um quase-Poisson ou um binômio negativo é uma opção melhor. Em particular, crie um gráfico como Figura 5.10 e calcule a regressão quadrática conforme mostrado no exemplo. O que você conclui sobre as duas opções de modelo?
Ajustar o modelo quase-Poisson aos dados e testar novamente os efeitos do modelo. Como os resultados se comparam aos do Exercício 23?
Plotar os resíduos padronizados em relação às médias estimadas. Comente os resultados.
37- Kupper and Haseman (1978) descrevem vagamente um experimento no qual camundongos fêmeas grávidas foram atribuídos a um de dois grupos, denominados “tratamento” e “controle”. Os dados estão disponíveis no arquivo de dados mice do pacote aod. De cada fêmea foi registrado o número de filhotes nascidos na ninhada (\(n\)) e a contagem daqueles que foram afetados de alguma forma (\(y\)).
Ajuste um modelo de regressão logística a esses dados. Teste a significância do efeito do tratamento e encontre um intervalo de confiança para a razão de probabilidade do efeito do “tratamento” em relação ao “controle”.
Observe que o número de níveis de variáveis explicativas é fixo, portanto não aumentaria se o tamanho da amostra aumentasse. Isso significa que podemos usar o desvio residual para testar formalmente o ajuste do modelo. Faça este teste. Indique as hipóteses, a estatística do teste, o \(p\)-valor e as conclusões.
Ajuste um modelo de regressão quase binomial e repita a análise da parte (a). Os resultados são substancialmente diferentes?
Use um modelo beta-binomial para repetir a análise da parte (a). Isso pode ser feito usando a função betabin() do pacote aod. Os resultados são substancialmente diferentes?