Trabalho I - Análise de Dados Categóricos
Vitor Nickhorn Kroeff
GRR20195798
Questão 1
a)
- Existirem n tentativas idênticas.
- Existirem dois resultados possíveis para cada tentativa.
- Tentativas indepêndentes entre si.
- Probabilidade de sucesso constante para cada tentativa.
- A variável de interesse é o número de sucessos.
b)
Usaremos o IC deAgresti-Coull:
# Agresti-Coull
n <- 750
s <- 48
alpha <- 0.05
kable(binom.confint(x = s, n = n, conf.level = 1-alpha, methods = "agresti-coull"))| method | x | n | mean | lower | upper |
|---|---|---|---|---|---|
| agresti-coull | 48 | 750 | 0.064 | 0.0484705 | 0.0839731 |
Considerando que a nossa estimativa $ = 0,064$ e é um valor relativamente baixo, o intervalo de confiança de 95% para esta proporção varia entre 0,05 e 0,08.
Questão 2
a)
Sensibilidade: proporção de indivíduos verdadeiramente positivos com teste positivo.
Especificidade: proporção de indivíduos verdadeiramente negativos com teste negativo.
aptima <- read.table(file = 'http://leg.ufpr.br/~lucambio/CE073/20222S/Aptima_combo.csv', header = TRUE, sep = ',')
c.table <- array(data = c(aptima[1,6], aptima[1,7],
aptima[1,9], aptima[1,8]), dim = c(2,2),
dimnames = list(True = c("+", "-"), Assay = c("+", "-")))
Se.hat <- c.table[1,1] / sum(c.table[1,])
Sp.hat <- c.table[2,2] / sum(c.table[2,])
data.frame(Se.hat, Sp.hat)## Se.hat Sp.hat
## 1 0.964467 0.9686848
w1 <- c.table[1,1]
w2 <- c.table[2,2]
n1 <- sum(c.table[1,])
n2 <- sum(c.table[2,])
kable(binom.confint(x = c(w1,w2), n = c(n1,n2), conf.level = 1-alpha, methods = "exact"))| method | x | n | mean | lower | upper |
|---|---|---|---|---|---|
| exact | 190 | 197 | 0.9644670 | 0.9281616 | 0.9855967 |
| exact | 464 | 479 | 0.9686848 | 0.9488757 | 0.9823693 |
A proporção estimada de indivíduos que são verdadeiramente positivos e obtêm um resultado positivo no teste é de 0,96. Para aqueles que são verdadeiramente negativos e recebem um resultado negativo no teste, a proporção é de aproximadamente 0,97. Com um nível de confiança de 95%, o intervalo de confiança para a primeira proporção varia entre 0,93 e 0,98, enquanto para a segunda, varia entre 0,95 e 0,98.
b)
Para calcular os intervalos de Clopper-Pearson, com um nível de significância de \(\alpha = 0,05\), para as outras combinações de doença, gênero, espécime e sintoma da tabela Aptima, foram construidas duas tabelas, a tabela Sensibilidade a tabela Especificidade. Em ambos os casos, as proporções estimadas, juntamente com os limites dos intervalos, são notavelmente elevadas, o que indica uma alta incidência de verdadeiros positivos e verdadeiros negativos
aptima$Se.hat <- aptima$True_positive / (aptima$True_positive + aptima$False_negative)
aptima$Sp.hat <- aptima$True_negative / (aptima$False_positive + aptima$True_negative)
sensibilidade <- binom.confint(x = aptima$True_positive, n = (aptima$True_positive + aptima$False_negative), conf.level = (1 - alpha), methods = "exact")
especificidade <- binom.confint(x = aptima$True_negative, n = (aptima$False_positive + aptima$True_negative), conf.level = (1 - alpha), methods = "exact")
kable(sensibilidade)| method | x | n | mean | lower | upper |
|---|---|---|---|---|---|
| exact | 190 | 197 | 0.9644670 | 0.9281616 | 0.9855967 |
| exact | 70 | 74 | 0.9459459 | 0.8673449 | 0.9850777 |
| exact | 199 | 202 | 0.9851485 | 0.9572134 | 0.9969267 |
| exact | 77 | 80 | 0.9625000 | 0.8942980 | 0.9921988 |
| exact | 133 | 144 | 0.9236111 | 0.8674307 | 0.9612511 |
| exact | 61 | 62 | 0.9838710 | 0.9133790 | 0.9995917 |
| exact | 136 | 145 | 0.9379310 | 0.8854450 | 0.9712281 |
| exact | 60 | 62 | 0.9677419 | 0.8882809 | 0.9960692 |
| exact | 304 | 307 | 0.9902280 | 0.9717093 | 0.9979802 |
| exact | 15 | 15 | 1.0000000 | 0.7819806 | 1.0000000 |
| exact | 311 | 316 | 0.9841772 | 0.9634632 | 0.9948429 |
| exact | 13 | 13 | 1.0000000 | 0.7529474 | 1.0000000 |
| exact | 94 | 94 | 1.0000000 | 0.9615166 | 1.0000000 |
| exact | 31 | 32 | 0.9687500 | 0.8378290 | 0.9992091 |
| exact | 87 | 94 | 0.9255319 | 0.8525702 | 0.9695365 |
| exact | 28 | 32 | 0.8750000 | 0.7100516 | 0.9648693 |
| method | x | n | mean | lower | upper |
|---|---|---|---|---|---|
| exact | 464 | 479 | 0.9686848 | 0.9488757 | 0.9823693 |
| exact | 309 | 314 | 0.9840764 | 0.9632329 | 0.9948100 |
| exact | 484 | 492 | 0.9837398 | 0.9682134 | 0.9929545 |
| exact | 316 | 320 | 0.9875000 | 0.9683060 | 0.9965840 |
| exact | 653 | 675 | 0.9674074 | 0.9510687 | 0.9794639 |
| exact | 501 | 507 | 0.9881657 | 0.9744206 | 0.9956450 |
| exact | 668 | 676 | 0.9881657 | 0.9768154 | 0.9948773 |
| exact | 502 | 507 | 0.9901381 | 0.9771366 | 0.9967903 |
| exact | 412 | 417 | 0.9880096 | 0.9722415 | 0.9960956 |
| exact | 351 | 363 | 0.9669421 | 0.9429670 | 0.9828041 |
| exact | 433 | 434 | 0.9976959 | 0.9872295 | 0.9999417 |
| exact | 368 | 370 | 0.9945946 | 0.9806112 | 0.9993447 |
| exact | 772 | 787 | 0.9809403 | 0.9687585 | 0.9892942 |
| exact | 562 | 564 | 0.9964539 | 0.9872495 | 0.9995703 |
| exact | 782 | 789 | 0.9911280 | 0.9818062 | 0.9964258 |
| exact | 564 | 567 | 0.9947090 | 0.9846159 | 0.9989075 |
Questão 3
c.table <- array(data = c(135, 15, 434, 9), dim = c(2, 2),
dimnames = list(Preservativo = c('Nunca', 'Sempre'), HIV = c('Positivo', 'Negativo')))
kable(c.table)| Positivo | Negativo | |
|---|---|---|
| Nunca | 135 | 434 |
| Sempre | 15 | 9 |
a)
Podemos observar que o intervalo de confiança de 95% de Wald apresentou um ligeiro deslocamento para a esquerda em comparação ao intervalo de Agresti-Caffo. No teste de Wald, podemos observar que a diferença entre as probabilidades de ser HIV positivo com base no uso de preservativo está entre -0,58 e -0,19, enquanto no segundo está entre -0,57 e -0,19.
# Wald
pi.hat.table <- c.table / rowSums(c.table)
alpha <- 0.05
pi.hat1 <- pi.hat.table[1,1]
pi.hat2 <- pi.hat.table[2,1]
var.wald <- pi.hat1 * (1 - pi.hat1) / sum(c.table[1,]) + pi.hat2 * (1 - pi.hat2) / sum(c.table[2,])
pi.hat1 - pi.hat2 + qnorm(p = c(alpha/2, 1 - alpha/2)) * sqrt(var.wald)## [1] -0.5845563 -0.1909270
# Agresti-Caffo
pi.tilde1 <- (c.table[1,1] + 1) / (sum(c.table[1,]) + 2)
pi.tilde2 <- (c.table[2,1] + 1) / (sum(c.table[2,]) + 2)
var.AC <- pi.tilde1 * (1 - pi.tilde1) / (sum(c.table[1,]) + 2) +
pi.tilde2 * (1 - pi.tilde2) / (sum(c.table[2,]) + 2)
pi.tilde1 - pi.tilde2 + qnorm(p = c(alpha/2, 1 - alpha/2)) * sqrt(var.AC)## [1] -0.5674447 -0.1869673
b)
A saída a seguir apresenta uma estatística de teste \(Z^2_{0}\) de 18,322 e um p-valor muito pequeno, com isso rejeitamos a hipótese nula.
# Teste Escore e Teste Qui-Quadrado de Pearson
prop.test(c.table, conf.level = 0.95, correct = FALSE)##
## 2-sample test for equality of proportions without continuity correction
##
## data: c.table
## X-squared = 18.322, df = 1, p-value = 1.866e-05
## alternative hypothesis: two.sided
## 95 percent confidence interval:
## -0.5845563 -0.1909270
## sample estimates:
## prop 1 prop 2
## 0.2372583 0.6250000
Assim como o teste acima, o LRT apresenta a mesma conclusão. Nesse teste também é estimado um \(\hat{\pi}= 0,253\).
# LRT
pi.bar <- colSums(c.table)[1] / sum(c.table)
log.lambda <- c.table[1,1] * log(pi.bar / pi.hat.table[1,1]) +
c.table[1,2] * log((1 - pi.bar) / (1 - pi.hat.table[1,1])) +
c.table[2,1] * log(pi.bar / pi.hat.table[2,1]) +
c.table[2,2]
test.stat <- -2 * log.lambda
crit.val <- qchisq(p = 0.95, df = 1)
p.val <- 1 - pchisq(q = test.stat, df = 1)
round(data.frame(pi.bar, test.stat, crit.val, p.val, row.names = NULL), 4)## pi.bar test.stat crit.val p.val
## 1 0.253 9.8887 3.8415 0.0017
c)
Encontramos uma razão de chances de 0,19, o que significa que as chances estimadas de contrair o HIV são 0,19 vezes menores com o uso do preservativo. Esse valor varia entre 0,08 e 0,44 com um intervalo de confiança de 95%. Uma vez que o valor 1 não está dentro deste intervalo, existem evidências suficientes para indicar que o uso do preservativo reduz significativamente as verdadeiras chances e, consequentemente, a probabilidade de contrair o HIV.
## [1] 0.19
alpha <- 0.05
var.log.or <- 1 / c.table[1,1] + 1/c.table[1,2] + 1/c.table[2,1] +
1/c.table[2,2]
OR.CI <- exp(log(OR.hat) + qnorm(p = c(alpha/2, 1-alpha/2)) * sqrt(var.log.or))
round(OR.CI, 2)## [1] 0.08 0.44
d)
Após analisar a alternativa anterior, que apontou a relação entre o uso do preservativo e a redução da probabilidade de contrair o HIV, é importante destacar que a estimativa da razão de chances resultou em um valor relativamente baixo. O limite inferior do intervalo de confiança foi de 0,08, o que representa uma probabilidade relativamente pequena.
Sob uma perspectiva estatística, considerando o tamanho limitado da amostra, os resultados indicam que o impacto do uso do preservativo pode não ser tão marcante quanto inicialmente esperado. Seria aconselhável realizar análises adicionais em amostras mais amplas, com um número maior de casos, para obter resultados mais robustos e conclusivos.
Questão 4
Embora o intervalo calculado pela função diffscoreci mostre um desvio ligeiramente menor em comparação com os outros intervalos, é importante notar que todos os três intervalos incluem o valor 0. Esse fato contribui para a não rejeição da hipótese nula.
c.table <- array(data = c(251,48,34,5), dim = c(2,2), dimnames = list(First = c("made", "missed"), Second = c("made", "missed")))
diffscoreci(c.table[1,1], c.table[1,1] + c.table[1,2], c.table[2,1], c.table[2,1] + c.table[2,2], conf.level = 1 - alpha)##
##
##
## data:
##
## 95 percent confidence interval:
## -0.09529146 0.08792491
# Wald
pi.hat.table <- c.table/rowSums(c.table)
pi.hat1 <- pi.hat.table[1 ,1]
pi.hat2 <- pi.hat.table[2 ,1]
var.wald <- pi.hat1*(1 - pi.hat1) / sum(c.table[1,]) +
pi.hat2*(1 - pi.hat2) / sum(c.table[2 ,])
pi.hat1 - pi.hat2 + qnorm (p = c( alpha/2, 1- alpha/2))*sqrt(var.wald )## [1] -0.11218742 0.06227017
# Agresti-Caffo
pi.tilde1 <- (c.table[1,1] + 1) / (sum(c.table[1 ,]) + 2)
pi.tilde2 <- (c.table [2,1] + 1) / (sum(c.table [2 ,]) + 2)
var.AC <- pi.tilde1*(1 - pi.tilde1 ) / (sum(c.table [1 ,]) + 2) +
pi.tilde2*(1 - pi.tilde2 ) / (sum(c.table [2 ,]) + 2)
pi.tilde1 - pi.tilde2 + qnorm (p = c( alpha /2, 1- alpha /2)) * sqrt (var.AC)## [1] -0.10353254 0.07781192
Questão 5
Mostre que OR= 1 quando \(\pi_{1} = \pi_{2}\).
se \(\pi_{1} = \pi_{2}\), então: \[OR = odds_{1} / odds_2 = \frac{\pi_1/ 1 -\pi_1 }{\pi_2/ 1 -\pi_2 } = 1\]