a)

• n tentativas idênticas

• apenas dois resultados possíveis para cada tentativa

• tentativas independentes

• probabilidade de sucesso constante

• variável aleatória de interesse é o número de sucessos

b)

Intervalo de confiança de Agresti-Coull:

# Agresti-Coull
n <- 750
w <- 48
alpha <- 0.05

kable(binom.confint(x = w, n = n, conf.level = 1-alpha, methods = "agresti-coull"))

Com \(\hat{\pi} = 0,064\), o valor estimado para a proporção de indivíduos com clamídia é muito pequeno. Com 95% de confiança, o mesmo varia entre 0,05 e 0,08.

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"))

A proporção estimada de indivíduos verdadeiramente positivos com teste positivo é 0,96, assim como a proporção de indivíduos verdadeiramente negativos com teste negativo (quase 0,97). Com 95% de confiança, as mesmas variam entre 0,93 e 0,98, e 0,95 e 0,98, respectivamente.

b)

Para calcular os intervalos de Clopper-Pearson (com \(\alpha = 0,05\)) para as outras combinações de doença, gênero, espécime e sintoma da tabela aptima, construí duas tabelas, uma para \(S_e\) e outra para \(S_p\). Em ambos os casos, as proporções estimadas, além das extremidades dos intervalos, são elevadas e indicam uma grande incidência de casos positivos realmente positivos e casos negativos realmente 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)

se <- binom.confint(x = aptima$True_positive, n = (aptima$True_positive + aptima$False_negative), conf.level = (1 - alpha), methods = "exact")
  
sp <- binom.confint(x = aptima$True_negative, n = (aptima$False_positive + aptima$True_negative), conf.level = (1 - alpha), methods = "exact")

kable(se)

kable(sp)

a)

Assim como no exemplo apresentado na disciplina, o intervalo de Wald, com 95% de confiança, apresentou um pequeno deslocamento para a esquerda, em relação ao intervalo de Agresti-Caffo. No primeiro caso, a diferença entre as probabilidades de ser HIV positivo com base no uso de preservativo se encontra entre -0.58 e -0.19, e no segundo entre -0.57 e -0.19, indicando, nessa amostra, diferença entre as mesmas.

c.table <- array(data = c(135, 15, 434, 9), dim = c(2, 2), 
                 dimnames = list(Preservativo = c('Nunca', 'Sempre'), HIV = c('Positivo', 'Negativo')))

# 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 abaixo fornece uma estatística de teste \(Z_0 ^2 = 18.322\) e um p-valor muito pequeno (\(P(W > 18.322) = 1.866e-05\)), onde \(W\) segue uma distribuição qui-quadrado. Com isso, rejeitamos a hipótese nula de que não há diferença significativa entre as probabilidades de sucesso. Já no teste LRT, a conclusão é a mesma, além da estimação do valor de \(\pi\) (\(\hat{\pi} = 0,253\)).

# 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

# 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. Sendo assim, as chances estimadas de contrair HIV são 0,19 vezes menores com o uso do preservativo. Esse valor varia entre 0,08 e 0,44, com 95% de confiança. Como 1 não está dentro do intervalo, há evidências suficientes para indicar que o uso do preservativo diminui as verdadeiras chances e, assim, a probabilidade de contrair HIV.

# Razão de Chances
OR.hat <- c.table[1,1] * c.table[2,2] / (c.table[2,1] * c.table[1,2])

round(OR.hat, 2)

## [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

c.table

##             HIV
## Preservativo Positivo Negativo
##       Nunca       135      434
##       Sempre       15        9

d)

Apesar da conclusão da alternativa anterior, de que o uso do preservativo diminui a probabilidade do indivíduo contrair HIV, a estimativa da razão de chances acaba sendo baixa, com o extremo inferior de seu intervalo de confiança igual a 0,08, um valor muito pequeno. No meu ponto de vista, nessa amostra (que é pequena), o uso do preservativo não se mostrou tão importante quanto esperado. Sugiro que novas amostras (com mais casos) sejam analisadas.