Exercícios - Lista 01

Exercício 1:

A) O estudo da alternativa (a) refere-se à um caso-controle.

tab1 = matrix(c(7,1,1,31), nrow=2, byrow=T,
              dimnames=list(Grupo=c("Caso","Controle"),
                            Uso=c("Sim","Não"))) ;tab1

##           Uso
## Grupo      Sim Não
##   Caso       7   1
##   Controle   1  31

Verificando a possibilidade da Correção de Yates:

yates.chisq.test(tab1, alfa = 0.05)

## 
##  Valores Esperados
##            Uso
## Grupo      Sim  Não
##   Caso     1.6  6.4
##   Controle 6.4 25.6
## 
##  Resultados
##

##       Valor      p-valor
## Qc 28.47656 9.483963e-08
## Qy 23.44727 1.283851e-06

Observado uma casela com $e_i<5$, podemos utilizar o resultado de Yates.

Com um nível de significância de 5%, rejeita-se fortemente a hipótese nula (p-valor = 0.0000128). Há evidências amostrais de que existe associação entre o uso de estilbestrol durante a gestação e o desenvolvimento de câncer de útero em mulheres jovens.

Calculando Razão de Chances (Odds Ratio), usando o comando epi.2by2:

epi.2by2(tab1, method = "case.control", conf.level = 0.95)

##              Outcome +    Outcome -      Total                       Odds
## Exposed +            7            1          8         7.00 (1.67 to Inf)
## Exposed -            1           31         32        0.03 (0.00 to 0.10)
## Total                8           32         40        0.25 (0.08 to 0.48)
## 
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Exposure odds ratio                            217.00 (12.05, 3906.92)
## Attrib fraction (est) in the exposed (%)      99.26 (89.01, 99.99)
## Attrib fraction (est) in the population (%)   87.10 (19.21, 97.94)
## -------------------------------------------------------------------
## Yates corrected chi2 test that OR = 1: chi2(1) = 23.447 Pr>chi2 = <0.001
## Fisher exact test that OR = 1: Pr>chi2 = <0.001
##  Wald confidence limits
##  CI: confidence interval

Portanto, com 95% de confiança, podemos afirmar que filhas de mulheres que utilizaram estilbestrol durante a gravidez apresentaram uma chance 217 vezes maior de desenvolver câncer de útero quando adultas, quando comparadas às que não utilizaram o medicamento (OR = 217; IC95%: 12,05 a 3906,92).

B) O estudo da alternativa (b) refere-se ao Ensaio Clínico Aleatorizado.

tab1.2 <- matrix(c(10,990,50,950), byrow = T, nrow = 2,
               dimnames = list(Grupo=c("Tratado","Controle"),
                               Desfecho=c("Contraiu","Nao Contraiu"))) ;tab1.2

##           Desfecho
## Grupo      Contraiu Nao Contraiu
##   Tratado        10          990
##   Controle       50          950

Testando Qui-Quadrado:

yates.chisq.test(tab1.2, alfa = 0.05)

## 
##  Valores Esperados
##            Desfecho
## Grupo      Contraiu Nao Contraiu
##   Tratado        30          970
##   Controle       30          970
## 
##  Resultados
##

##       Valor      p-valor
## Qc 27.49141 1.577939e-07
## Qy 26.13402 3.185222e-07

Rejeita-se hipótese nula com 5% de significância ($X_c^2=27.49$; p-valor=0.0000), mostrando evidencias estatisticas da associação entre estar vacinado e contrair hepatite B. Podemos calcular o risco relativo dessa medida:

epi.2by2(tab1.2, method = "cohort.count", conf.level = 0.95)

##              Outcome +    Outcome -      Total                 Inc risk *
## Exposed +           10          990       1000        1.00 (0.48 to 1.83)
## Exposed -           50          950       1000        5.00 (3.73 to 6.54)
## Total               60         1940       2000        3.00 (2.30 to 3.84)
## 
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Inc risk ratio                                 0.20 (0.10, 0.39)
## Inc odds ratio                                 0.19 (0.10, 0.38)
## Attrib risk in the exposed *                   -4.00 (-5.48, -2.52)
## Attrib fraction in the exposed (%)            -400.00 (-880.32, -155.02)
## Attrib risk in the population *                -2.00 (-3.54, -0.46)
## Attrib fraction in the population (%)         -66.67 (-87.16, -48.42)
## -------------------------------------------------------------------
## Uncorrected chi2 test that OR = 1: chi2(1) = 27.491 Pr>chi2 = <0.001
## Fisher exact test that OR = 1: Pr>chi2 = <0.001
##  Wald confidence limits
##  CI: confidence interval
##  * Outcomes per 100 population units

O risco relativo (RR) de contrair hepatite no grupo vacinado é 0.20 (IC95%: 0.10 a 0.39), indicando que o risco é 80% menor em relação ao grupo controle. Isso caracteriza a vacina como um fator de proteção significativo. Observamos também que a incidencia nos Expostos (tratados) (1%) é menor que na dos Não-Expostos (5%), reforçando o fator de proteção do fator em estudo.

Outras métricas:

Risco de contrair Hepatite B | Recebeu vacina experimental : 1,00% [0.48%;1.83%]
Risco de contrair Hepatite B | Recebeu placebo: 5,00% [3.73%;6.54%]
Incidência Global: 3,00% [2.3%;3.84%]

Exercício 2:

Na minha opinião, isso seria um estudo de Coorte, pois eu estou administrando a vitamina C (Exposição) para os pacientes e observando em um certo espaço de tempo se houve ou não a melhora clínica (Desfecho).

Inserção dos dados:

tab2 <- matrix( c(34,8,19,23), byrow = T, nrow = 2,
  dimnames = list("Vitamina C"=c("Sim","Nao"),
                  "Melhora Clinica"=c("Sim","Nao"))) ;tab2

##           Melhora Clinica
## Vitamina C Sim Nao
##        Sim  34   8
##        Nao  19  23

Após inserção dos dados, formulamos a hipótese:

$H_0$: Não há associação entre o uso de Vitamina C e a melhora clínica.
$H_1$: Há associação entre o uso de Vitamina C e a melhora clínica.

yates.chisq.test(tab2, alfa = 0.05)

## 
##  Valores Esperados
##            Melhora Clinica
## Vitamina C  Sim  Nao
##        Sim 26.5 15.5
##        Nao 26.5 15.5
## 
##  Resultados
##

##       Valor      p-valor
## Qc 11.50335 0.0006947096
## Qy 10.02069 0.0015479114

De acordo com $X_c^2=11.50 ; \ p-valor=0.0006$, rejeita-se $H_0$ à 05% de significância, ou seja, existem evidências estatísticas de que o consumo da Vitamina C está relacionada a melhora clinica em pacientes com Desordem Renal Genética.

epi.2by2(tab2, conf.level = 0.95)

##              Outcome +    Outcome -      Total                 Inc risk *
## Exposed +           34            8         42     80.95 (65.88 to 91.40)
## Exposed -           19           23         42     45.24 (29.85 to 61.33)
## Total               53           31         84     63.10 (51.87 to 73.37)
## 
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Inc risk ratio                                 1.79 (1.24, 2.57)
## Inc odds ratio                                 5.14 (1.93, 13.72)
## Attrib risk in the exposed *                   35.71 (16.54, 54.89)
## Attrib fraction in the exposed (%)            44.12 (19.61, 61.15)
## Attrib risk in the population *                17.86 (-0.39, 36.11)
## Attrib fraction in the population (%)         28.30 (8.76, 43.66)
## -------------------------------------------------------------------
## Uncorrected chi2 test that OR = 1: chi2(1) = 11.503 Pr>chi2 = <0.001
## Fisher exact test that OR = 1: Pr>chi2 = 0.001
##  Wald confidence limits
##  CI: confidence interval
##  * Outcomes per 100 population units

O risco relativo de melhora clínica entre os pacientes que consumiram Vitamina C foi de $1.79$ (IC95%: 1.24 a 2.57), indicando que esses pacientes apresentaram $79$% mais chance relativa de melhora clínica em comparação ao grupo que não consumiu a vitamina. Apresentando outras métricas:

Risco de ter Melhora Clínica | Consumiu Vitamina C: 80.95% [65.88%;91.40%]
Risco de ter Melhora Clínica | Não Consumiu Vitamina C: 45.24% [29.85%;61.33%]
Prevalência Global: 63.10% [51.87%;73.37%] (De ter melhora clinica independente se consumiu ou não Vitamina C).

O fato do risco de apresentar melhora clínica consumindo vitamina C (80.95%) ser maior do que não consumir (45.24%) é um efeito benéfico do uso da vitamina contra Desordem Renal Genética.

Exercício 3:

Inserção dos dados:

tab3 <- matrix(c(2,1,8,6), byrow = T, nrow = 2,
               dimnames = list("Consumo de Álcool"=c("Sim","Não"),
                               "Grupo de Resultados"=c("Fumou","Não Fumou"))) ;tab3

##                  Grupo de Resultados
## Consumo de Álcool Fumou Não Fumou
##               Sim     2         1
##               Não     8         6

Podemos formular a hipótese:

$H_0$: Não existe associação entre o consumo de álcool e recaída no tabagismo.
$H_1$: Existe associação entre o consumo de álcool e recaída no tabagismo.

Iremos testar essa hipótese utilizando Teste Exato de Fisher (devido ao baixo tamanho amostral):

fisher.test(tab3)

## 
##  Fisher's Exact Test for Count Data
## 
## data:  tab3
## p-value = 1
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##    0.06174145 102.96146302
## sample estimates:
## odds ratio 
##   1.465606

O teste exato de Fisher não indicou associação estatisticamente significativa entre o consumo de álcool e a recaída no tabagismo durante a crise ($p-valor: 1$) Apesar do odds ratio estimado ser $1.47$, o intervalo de confiança (IC95%: 0.06–102.96) é extremamente amplo, indicando incerteza elevada na estimativa. Com base nos dados disponíveis, não é possível afirmar que o consumo de álcool tenha influenciado a interrupção da abstinência.

Exercício 4:

Inserção dos dados:

tab4 <- matrix(c(15,2,9,12), byrow = T, nrow = 2,
               dimnames = list("Grupo"=c("Controle","Experimental"),
                               "Ausência de Dor"=c("Sim","Não"))) ;tab4

##               Ausência de Dor
## Grupo          Sim Não
##   Controle      15   2
##   Experimental   9  12

Formulação das Hipóteses:

$H_0$: Não existe associação entre o uso de betametasona e o efeito de dor no paciente.
$H_1$: Existe associação entre o uso de betametasona e o efeito de dor no paciente.

yates.chisq.test(tab4, alfa = 0.05)

## 
##  Valores Esperados
##                Ausência de Dor
## Grupo            Sim  Não
##   Controle     10.74 6.26
##   Experimental 13.26 7.74
## 
##  Resultados
##

##       Valor     p-valor
## Qc 8.313926 0.003934227
## Qy 6.478108 0.010921118

Utilizando correção de Yates ($n<40$), temos $X_y^2=6.4781 \ pvalor:0.0109$, rejeitamos a hipótese nula com um $\alpha:0.05$, portanto podemos associar o uso do medicamento Betametasona e efeito de dor no paciente. Na próxima medida poderemos dizer se o efeito foi benéfico ou maléfico.

epi.2by2(tab4)

##              Outcome +    Outcome -      Total                 Inc risk *
## Exposed +           15            2         17     88.24 (63.56 to 98.54)
## Exposed -            9           12         21     42.86 (21.82 to 65.98)
## Total               24           14         38     63.16 (45.99 to 78.19)
## 
## Point estimates and 95% CIs:
## -------------------------------------------------------------------
## Inc risk ratio                                 2.06 (1.22, 3.48)
## Inc odds ratio                                 10.00 (1.81, 55.28)
## Attrib risk in the exposed *                   45.38 (19.25, 71.50)
## Attrib fraction in the exposed (%)            51.43 (18.02, 71.22)
## Attrib risk in the population *                20.30 (-5.84, 46.44)
## Attrib fraction in the population (%)         32.14 (4.06, 52.01)
## -------------------------------------------------------------------
## Uncorrected chi2 test that OR = 1: chi2(1) = 8.314 Pr>chi2 = 0.004
## Fisher exact test that OR = 1: Pr>chi2 = 0.006
##  Wald confidence limits
##  CI: confidence interval
##  * Outcomes per 100 population units

De imediato podemos notar que o Risco Relativo (RR) é de 2.06 [1.22;3.48], evidenciando um fator protetivo do medicamento (lembrando que o Outcome/Desfecho é ausência de dor, que é benefico para o paciente no pós-operatório), ou seja, o paciente que faz uso de betametasona tem risco 2.06 vezes maior de não sentir dor comparado ao paciente que não fez o uso no pós-operatório.

Risco de NÃO sentir dor | Fez uso do medicamento: 88.24% [63.56%;98.54%]
Risco de NÃO sentir dor | Não fez uso do medicamento: 42.86% [21.82%;65.98%]
Risco global de NÃO sentir dor no pós-operatório (em toda a amostra): 63.16% [45.99%;78.19%

De acordo com os resultados, o uso de Betametasona é BENÉFICO para controlar a dor no pós operatorio para pacientes submetidos a um tratamento endodôntico.

Exercício 5:

Inserindo os dados:

# Matriz de dados
tab5 <- matrix(c(108,152,223,41,181,82), ncol = 2, byrow = TRUE,dimnames = list("Dieta" = c("Usual", "Restrição Sal","Restrição Gordura"),
                               "Redução PAD" = c("Sim","Não")))
tab5

##                    Redução PAD
## Dieta               Sim Não
##   Usual             108 152
##   Restrição Sal     223  41
##   Restrição Gordura 181  82

(5.a)

Graficamente, temos:

De acordo com o gráfico acima, podemos observar visualmente que a dieta com restrição de sal apresentou a maior porcentagem de redução da pressão arterial diastólica (PAD). Em seguida, vem a dieta com restrição de gordura. É interessante notar que ambas as dietas parecem ser mais benéficas do que a dieta usual para a redução da PAD.

(5.b)

Análise: {#sec-b-análise-u}

Formulação das hipóteses:

$H_0$: A proporção de pacientes com redução da PAD é igual entre as dietas.
$H_1$: A proporção de pacientes com redução da PAD varia conforme a dieta.

yates.chisq.test(tab5)

## 
##  Valores Esperados
##                     Redução PAD
## Dieta                  Sim   Não
##   Usual             169.15 90.85
##   Restrição Sal     171.75 92.25
##   Restrição Gordura 171.10 91.90
## 
##  Resultados
##

##       Valor      p-valor
## Qc 108.6656 2.532606e-24
## Qy 106.6241 0.000000e+00

Há evidências estatísticas fortes de que a proporção de pacientes com redução da PAD varia conforme a dieta . ($X_c^2=108.6656$ $ p-valor:0…$). A dieta com restrição de sal foi associada à maior proporção de redução, seguida pela dieta com restrição de gordura. Esses resultados sugerem que intervenções alimentares específicas podem impactar significativamente o controle da pressão arterial.
Adicional: Refinando nossa análise, podemos utilizar o comando score.test para saber estatisticamente qual a melhor dieta (que obteve maior resultado em reduzir PAD).

Atribuindo score 2 para SIM, e 1 para NÃO, temos:

score.test(tab5, escore = c(1,1,1),comp.mult = T, correcao.p = "bonferroni")

## $Global
## 
##  Estatistica Qs - Teste Escore
## 
## data:  tab5
## Qs = 35.421, df = 2, p-value < 2.2e-16
## 
## 
## $Comp.multiplas
##                               Grupo     Qs gl p.value correct.p
## 1             Usual - Restrição Sal 37.143  1 0.00000   0.00000
## 2         Usual - Restrição Gordura 20.604  1 0.00001   0.00002
## 3 Restrição Sal - Restrição Gordura  3.126  1 0.07705   0.23116
## 
## $Fbar
##             Usual     Restrição Sal Restrição Gordura 
##             1.415             1.845             1.688

De acordo com o resultado acima, podemos observar que para um alpha de 5%, apenas a dieta usual se diferencia das outras (sem sal e sem gordura). A dieta sem sal não se diferencia da dieta sem gordura. Então ficaria a critério da pessoa escolher qual restrição alimentar escolher. Talvez para ganhos máximos de eficiência de dieta, a pessoa poderia escolher a dieta sem sal, que apresentou maior f-bar dentre as 3 listadas.

Exercício 6:

Inserindo os dados, podemos notar que são amostras pareadas.

Alta Exposição (coletadas em um certo mês), e Baixa Exposição (Os mesmos indíviduos, 4 meses após a primeira coleta).

tab6 <- matrix(c(12,8,4,30), byrow = T, nrow = 2,
               dimnames = list("Alta Exposição (Antes)"=c("Sim","Não"),
                               "Baixa Exposição (4 meses Depois)"=c("Sim","Não"))) ;tab6

##                       Baixa Exposição (4 meses Depois)
## Alta Exposição (Antes) Sim Não
##                    Sim  12   8
##                    Não   4  30

Devido a estrutura dos dados, iremos usar o Teste de McNemar. Formulando as hipóteses:

$H_0$: A proporção de pessoas que relataram dor de cabeça se manteve entre o período de baixa e alta exposição ao enxofre.
$H_1$: A proporção de pessoas que relataram dor de cabeça mudou entre o período de baixa e alta exposição ao enxofre.

mcnemar.test(tab6)

## 
##  McNemar's Chi-squared test with continuity correction
## 
## data:  tab6
## McNemar's chi-squared = 0.75, df = 1, p-value = 0.3865

De acordo com o teste de McNemar ($X^2=0.75; pvalor=0.3865)$, não rejeitamos a hipótese nula com 5% de significância. Isso indica que não houve evidência estatística de diferença nas proporções de relato de dor de cabeça entre o período de alta e baixa exposição ao enxofre.
Portanto, a exposição ao enxofre não parece ter influenciado significativamente a ocorrência de dor de cabeça, com base nesta amostra.

Exercício 7:

Iremos realizar a importação dos dados e transformação na base (removendo toda as variáveis quantitativas), deixando apenas as qualitativas. Logo após, classificaremos o EscoreDPP em Sadia/Doente, de acordo com a classificação abaixo:
Categorizacao 1: 0: (Sadia) se EscoreDPP < 7 ou 1 (Doente) caso contrario.

Também iremos montar as tabelas de contigência, comparando todas as variaveis contra EscoreDPP (que agora virou dicotômica).

dpp <- dataDPP
dpp1 <- dpp %>% 
  select(Raca, Escola, EstCivil, Parto, GravPlanej,
         Laqueadura, HospBebe, DcaGravidez, depreFamiliar, TPMforte,
         Religiao, Atividade, EscoreDPP)
dpp1$EscoreDPP <- ifelse(dpp1$EscoreDPP<7, "Sadia","Doente")

## Independentes (Nominal x Nominal):
tab7.1 <- table(dpp1$Raca, dpp1$EscoreDPP);tab7.1 #3x2
tab7.3 <- table(dpp1$EstCivil, dpp1$EscoreDPP);tab7.3 #3x2
tab7.4 <- table(dpp1$Parto, dpp1$EscoreDPP) ;tab7.4 # 2x2
tab7.5 <- table(dpp1$GravPlanej, dpp1$EscoreDPP) ;tab7.5 # 2x2
tab7.7 <- table(dpp1$HospBebe, dpp1$EscoreDPP) ;tab7.7 # 2x2
tab7.8 <- table(dpp1$DcaGravidez, dpp1$EscoreDPP) ;tab7.8 # 2x2
tab7.9 <- table(dpp1$depreFamiliar, dpp1$EscoreDPP) ;tab7.9 # 2x2
tab7.10 <- table(dpp1$TPMforte, dpp1$EscoreDPP);tab7.10 #2x2
tab7.11 <- table(dpp1$Religiao, dpp1$EscoreDPP);tab7.11 #3x2
tab7.12 <- table(dpp1$Atividade, dpp1$EscoreDPP) ;tab7.12 #4x2
 
## Ordinal (Sadio/Doente x Ordinal)
tab7.2 <- table(dpp1$EscoreDPP, dpp1$Escola);tab7.2
tab7.2 <- t(tab7.2) # para poder analisar via test escore.

## Só uma resposta / impossível de analisar
tab7.6 <- table(dpp1$Laqueadura, dpp1$EscoreDPP) ;tab7.6

7.1 Raça x Depressão

$H_0$: Não existe associação entre a raça da mulher e adquirir depressão pós parto.
$H_1$: Existe associação entre a raça da mulher e adquirir depressão pós parto..

tab7.1 <- table(dpp1$Raca, dpp1$EscoreDPP);tab7.1 #3x2

##         
##          Doente Sadia
##   Branca     32    18
##   Mulata     15     5
##   Negra       2     3

yates.chisq.test(tab7.1, alfa = 0.05)

## 
##  Valores Esperados
##          
##          Doente Sadia
##   Branca  32.67 17.33
##   Mulata  13.07  6.93
##   Negra    3.27  1.73
## 
##  Resultados
##

##        Valor   p-valor
## Qc 2.2812009 0.3196270
## Qy 0.9750294 0.6141508

## Não significativo.

Utilizando correção de Yates, temos $X_y^2:0.975;p-valor:0.614$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos evidencias amostrais de que a raça não influencia se a mulher teve ou não depressão pós parto.

7.2 Estado Civil x Depressão

$H_0$: Não existe associação entre o estado civil da mulher e adquirir depressão pós parto.
$H_1$: Existe associação entre o estado civil da mulher e adquirir depressão pós parto.

tab7.3 <- table(dpp1$EstCivil, dpp1$EscoreDPP);tab7.3 #3x2

##           
##            Doente Sadia
##   Casada       23     9
##   REstavel      9     7
##   Solteira     17    10

yates.chisq.test(tab7.3, alfa = 0.05)

## 
##  Valores Esperados
##            
##            Doente Sadia
##   Casada    20.91 11.09
##   REstavel  10.45  5.55
##   Solteira  17.64  9.36
## 
##  Resultados
##

##        Valor   p-valor
## Qc 1.2544561 0.5340702
## Qy 0.6042832 0.7392334

Temos $X_y^2:1.254;p-valor:0.534$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos evidencias amostrais de que o estado civil da mulher não influencia se ela teve ou não depressão pós parto.

7.3 Tipo de Parto x Depressão

$H_0$: Não existe associação entre o tipo de parto ocorrido e adquirir depressão pós parto.
$H_1$: Existe associação entre o tipo de parto ocorrido e adquirir depressão pós parto.

tab7.4 <- table(dpp1$Parto, dpp1$EscoreDPP) ;tab7.4 # 2x2

##          
##           Doente Sadia
##   Cesario     23    12
##   Normal      26    14

yates.chisq.test(tab7.4, alfa = 0.05)

## 
##  Valores Esperados
##           
##           Doente Sadia
##   Cesario  22.87 12.13
##   Normal   26.13 13.87
## 
##  Resultados
##

##          Valor   p-valor
## Qc 0.004204979 0.9482968
## Qy 0.031800151 0.8584670

## Não significativo.

Temos $X_c^2:0.0042;p-valor:0.9482$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos fortes evidencias amostrais de que o tipo de parto ocorrido não influencia se ela teve ou não depressão pós parto.

7.4 Gravidez Planejada x Depressão

$H_0$: Não existe associação entre o planejamento de gravidez e adquirir depressão pós parto.
$H_1$: Existe associação entre o planejamento de gravidez e adquirir depressão pós parto.

tab7.5 <- table(dpp1$GravPlanej, dpp1$EscoreDPP) ;tab7.5 # 2x2

##      
##       Doente Sadia
##   Nao     28    12
##   Sim     21    14

yates.chisq.test(tab7.5, alfa = 0.05)

## 
##  Valores Esperados
##       
##       Doente Sadia
##   Nao  26.13 13.87
##   Sim  22.87 12.13
## 
##  Resultados
##

##        Valor   p-valor
## Qc 0.8241758 0.3639621
## Qy 0.4417856 0.5062619

## Não significativo.

Temos $X_c^2:0.824;p-valor:0.3639$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos evidências amostrais de que o planejamento da gravidez não influencia se ela teve ou não depressão pós parto.

7.5 Hospitalização do Bebê x Depressão

$H_0$: Não existe associação entre o bebê ser hospitalizado e a mãe adquirir depressão pós parto.
$H_1$: Existe associação entre o bebê ser hospitalizado e a mãe adquirir depressão pós parto.

tab7.7 <- table(dpp1$HospBebe, dpp1$EscoreDPP) ;tab7.7 # 2x2

##      
##       Doente Sadia
##   Nao     37    22
##   Sim     12     4

yates.chisq.test(tab7.7, alfa = 0.05)

## 
##  Valores Esperados
##       
##       Doente Sadia
##   Nao  38.55 20.45
##   Sim  10.45  5.55
## 
##  Resultados
##

##        Valor   p-valor
## Qc 0.8391427 0.3596421
## Qy 0.3842901 0.5353162

## Não significativo.

Temos $X_c^2:0.839;p-valor:0.3596$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos evidências amostrais de que o bebê ser hospitalizado após o nascimento não influencia se a mulher teve ou não depressão pós-parto.

7.6 Doença na Gravidez x Depressão

$H_0$: Não existe associação entre o ter doença na gravidez e a mãe adquirir depressão pós parto.
$H_1$: Existe associação entre o ter doença na gravidez e a mãe adquirir depressão pós parto.

tab7.8 <- table(dpp1$DcaGravidez, dpp1$EscoreDPP) ;tab7.8 # 2x2

##      
##       Doente Sadia
##   Nao     34    21
##   sim     15     5

yates.chisq.test(tab7.8, alfa = 0.05)

## 
##  Valores Esperados
##       
##       Doente Sadia
##   Nao  35.93 19.07
##   sim  13.07  6.93
## 
##  Resultados
##

##        Valor   p-valor
## Qc 1.1252141 0.2887985
## Qy 0.6184664 0.4316178

## Não significativo.

Temos $X_c^2:1.125;p-valor:0.288$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos evidências amostrais de que adquirir um doença na gravidez não influência ter ou não depressão pós-parto.

7.7 Depressão Familiar x Depressão

$H_0$: Não existe associação entre ter algum histórico de depressão familiar e adquirir depressão pós parto.
$H_1$: Existe associação entre ter algum histórico de depressão familiar e adquirir depressão pós parto.

tab7.9 <- table(dpp1$depreFamiliar, dpp1$EscoreDPP) ;tab7.9 # 2x2

##      
##       Doente Sadia
##   Nao     30    22
##   Sim     19     4

tab7.9 <- matrix(c(19,4,30,22), nrow = 2, byrow = T) #Invertendo para melhor interpretação OR
yates.chisq.test(tab7.9, alfa = 0.05)

## 
##  Valores Esperados
##        [,1]  [,2]
## [1,] 15.03  7.97
## [2,] 33.97 18.03
## 
##  Resultados
##

##       Valor    p-valor
## Qc 4.371125 0.03655286
## Qy 3.340228 0.06760524

IC.efeito(tab7.9, alfa = 0.05)

	Medida	Li.M1	Ls.M1	Li.M2	Ls.M2
RR	1.43	0.97	2.10	1.06	1.93
OR	3.48	0.91	13.28	1.04	11.69

Temos $X_c^2:4.371;p-valor:0.03$, ou seja, para um $\alpha$ de 5%, podemos rejeitar a hipótese nula, temos evidências amostrais de que ter um histórico familiar de depressão na familia pode influenciar em ter ou não depressão pós-parto.

Quando calculamos OR: 3.48 [1.04;11.69], temos que mulheres que contêm algum familiar com histórico de depressão tem 3.48 vezes mais chances relativas de adquirir depressão pós-parto do que as mulheres que não tem histórico de depressão familiar. Como o intervalo de confiança não inclui 1, essa associação é estatisticamente significativa ao nível de 5%.

7.8 TPM Forte x Depressão

$H_0$: Não existe associação entre a mulher ter TPM forte e adquirir depressão pós-parto.
$H_1$: Existe associação entre a mulher ter TPM forte e adquirir depressão pós-parto.

tab7.10 <- table(dpp1$TPMforte, dpp1$EscoreDPP);tab7.10 #2x2

##      
##       Doente Sadia
##   Nao     30    22
##   Sim     19     4

yates.chisq.test(tab7.10, alfa = 0.05)

## 
##  Valores Esperados
##       
##       Doente Sadia
##   Nao  33.97 18.03
##   Sim  15.03  7.97
## 
##  Resultados
##

##       Valor    p-valor
## Qc 4.371125 0.03655286
## Qy 3.340228 0.06760524

tab7.10 <- matrix(c(19,4,30,22), nrow = 2, byrow = T) #Invertendo para melhor interpretação OR
IC.efeito(tab7.10, alfa = 0.05)

	Medida	Li.M1	Ls.M1	Li.M2	Ls.M2
RR	1.43	0.97	2.10	1.06	1.93
OR	3.48	0.91	13.28	1.04	11.69

## Significativo - olhar OR

Temos $X_c^2:4.371;p-valor:0.03$, ou seja, para um $\alpha$ de 5%, podemos rejeitar a hipótese nula, temos evidências amostrais de que a mulher possuir TPM forte pode influenciar em ter ou não depressão pós-parto.

Quando calculamos OR: 3.48 [1.04;11.69], temos que mulheres que possuem TPM forte tem 3.48 vezes mais chances relativas de adquirir depressão pós-parto do que as mulheres que não possuem TPM forte. Como o intervalo de confiança não inclui 1, essa associação é estatisticamente significativa ao nível de 5%.

(Resultado deu o mesmo que o de cima, coincidência?

7.9 Religião x Depressão

$H_0$: Não existe associação entre a religião da mulher e adquirir depressão pós-parto.
$H_1$: Existe associação entre a religião da mulher e adquirir depressão pós-parto.

tab7.11 <- table(dpp1$Religiao, dpp1$EscoreDPP);tab7.11 #3x2

##           
##            Doente Sadia
##   Catolica     29    12
##   Evang        15    13
##   Nenhuma       5     1

yates.chisq.test(tab7.11, alfa = 0.05)

## 
##  Valores Esperados
##            
##            Doente Sadia
##   Catolica  26.79 14.21
##   Evang     18.29  9.71
##   Nenhuma    3.92  2.08
## 
##  Resultados
##

##       Valor   p-valor
## Qc 3.096146 0.2126573
## Qy 1.794052 0.4077807

Temos $X_y^2:1.794;p-valor:0.4077$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos evidencias amostrais de que a religião da mulher não influencia se ela teve ou não depressão pós parto.

7.10 Atividade x Depressão

$H_0$: Não existe associação entre a atividade da mulher e adquirir depressão pós-parto.
$H_1$: Existe associação entre a atividade da mulher e adquirir depressão pós-parto.

tab7.12 <- table(dpp1$Atividade, dpp1$EscoreDPP) ;tab7.12 #4x2

##               
##                Doente Sadia
##   Desempregada      7     5
##   Empregada         9     1
##   Estudante         9     3
##   Lar              24    17

yates.chisq.test(tab7.12, alfa = 0.05)

## 
##  Valores Esperados
##                
##                Doente Sadia
##   Desempregada   7.84  4.16
##   Empregada      6.53  3.47
##   Estudante      7.84  4.16
##   Lar           26.79 14.21
## 
##  Resultados
##

##       Valor   p-valor
## Qc 4.277386 0.2330273
## Qy 2.473604 0.4800803

Temos $X_y^2:2.4736;p-valor:0.48$, ou seja, para um $\alpha$ de 5%, não rejeitamos a hipótese nula, temos evidencias amostrais de que a atividade exercida da mulher não influencia se ela teve ou não depressão pós parto.

7.11 Escolaridade x Depressão

$H_0$: Não existe associação entre a escolaridade da mulher e adquirir depressão pós-parto.
$H_1$: Existe associação entre a escolaridade da mulher e adquirir depressão pós-parto.

Aqui usaremos o teste Escore, por tratar escolaridade como uma variável ordinal:
1- Menos Escolarizada, 5-Mais Escolarizada.

## Ordinal (Sadio/Doente x Ordinal)
tab7.2 <- table(dpp1$EscoreDPP, dpp1$Escola);tab7.2

##         
##           1  2  3  4  5
##   Doente 13  8 11 14  3
##   Sadia   8  7  5  6  0

t(tab7.2)

##    
##     Doente Sadia
##   1     13     8
##   2      8     7
##   3     11     5
##   4     14     6
##   5      3     0

score.test(t(tab7.2), escore = 2:1, comp.mult = T, correcao.p = "bonferroni")

## $Global
## 
##  Estatistica Qs - Teste Escore
## 
## data:  t(tab7.2)
## Qs = 2.898, df = 4, p-value = 0.575
## 
## 
## $Comp.multiplas
##    Grupo    Qs gl p.value correct.p
## 1  1 - 2 0.256  1 0.61288         1
## 2  1 - 3 0.182  1 0.66966         1
## 3  1 - 4 0.292  1 0.58894         1
## 4  1 - 5 1.646  1 0.19950         1
## 5  2 - 3 0.757  1 0.38427         1
## 6  2 - 4 0.998  1 0.31779         1
## 7  2 - 5 2.182  1 0.13963         1
## 8  3 - 4 0.005  1 0.94363         1
## 9  3 - 5 1.181  1 0.27715         1
## 10 4 - 5 1.165  1 0.28043         1
## 
## $Fbar
##     1     2     3     4     5 
## 1.619 1.533 1.688 1.700 2.000

A grosso modo, observamos pela estatística teste $Q_s:2.898;p-valor:0.575$ que para um alpha de 05%, não podemos rejeitar a hipótese nula, ou seja, o grau de escolaridade não influencia em adquirir depressão pós-parto.

7.12 Laqueadura x Depressão

Para a variável laqueadura, teve-se apenas respostas NÃO. É impossível de analisar.

## Só uma resposta / impossível de analisar
tab7.6 <- table(dpp1$Laqueadura, dpp1$EscoreDPP) ;tab7.6

##      
##       Doente Sadia
##   Nao     49    26

Exercício 8:

Precisamos dar entrada nos dados, criando uma table tridimensional, separada pelas idades (18, 20 e 25 anos).

tab8.18 <- matrix(c(6,17,17,32), byrow = T, nrow = 2,
       dimnames = list(Mononucleose=c("Sim","Nao"),
                       Amidalectomia=c("Sim","Nao")))
tab8.20 <- matrix(c(12,29,34,78), byrow = T, nrow = 2,
               dimnames = list(Mononucleose=c("Sim","Nao"),
                               Amidalectomia=c("Sim","Nao")))
tab8.25 <- matrix(c(4,5,36,39), byrow = T, nrow = 2,
               dimnames = list(Mononucleose=c("Sim","Nao"),
                               Amidalectomia=c("Sim","Nao")))
tab_total <- array(
  data = c(tab8.18, tab8.20, tab8.25),
  dim = c(2, 2, 3),
  dimnames = list(
    Mononucleose = c("Sim", "Nao"),
    Amidalectomia = c("Sim", "Nao"),
    Idade = c("18 anos", "20 anos", "25 anos")
  )
)
tab_total

## , , Idade = 18 anos
## 
##             Amidalectomia
## Mononucleose Sim Nao
##          Sim   6  17
##          Nao  17  32
## 
## , , Idade = 20 anos
## 
##             Amidalectomia
## Mononucleose Sim Nao
##          Sim  12  29
##          Nao  34  78
## 
## , , Idade = 25 anos
## 
##             Amidalectomia
## Mononucleose Sim Nao
##          Sim   4   5
##          Nao  36  39

Formulamos as hipóteses:

$H_0$: O odds ratio comum entre mononucleose e amidalectomia, ajustado por idade, é igual a 1 (não há associação entre as variáveis).
$H_1$: O odds ratio comum é diferente de 1 (existe associação entre mononucleose e amidalectomia, mesmo controlando para idade).

Aplicando o teste de Mantel-Haenszel:

mantelhaen.test(tab_total, conf.level = 0.95)

## 
##  Mantel-Haenszel chi-squared test with continuity correction
## 
## data:  tab_total
## Mantel-Haenszel X-squared = 0.1801, df = 1, p-value = 0.6713
## alternative hypothesis: true common odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.4729173 1.5079737
## sample estimates:
## common odds ratio 
##         0.8444803

Temos uma estatística teste de $0.1801;Pvalor:0.6713$ .Como o p-valor é maior que 0.05, não rejeitamos a hipótese nula com 95% de confiança, e concluímos que não há diferença estatisticamente significativa na chance de ter feito amidalectomia entre pessoas com e sem mononucleose, considerando os diferentes estratos etários analisados.

OR Comum: 0.84 [0.47;1.50] <- 1 está dentro do intervalo.

Exercício 9:

Estamos de cara com dados pareados (antes/depois). Inserindo os dados:

tab9 = matrix(c(20,5,10,10), nrow = 2, byrow = T,
                dimnames=list(Antes=c("Aprova","Reprova"),
                              Depois=c("Aprova","Reprova"))) ;tab9

##          Depois
## Antes     Aprova Reprova
##   Aprova      20       5
##   Reprova     10      10

Formulando as hipóteses:

$H_0$: A taxa de aprovação de um político antes e depois de anúncios de medidas se manteve a mesma.
$H_1$: A taxa de aprovação de um político antes e depois de anúncios de medidas teve alguma mudança significativa.

Usaremos o teste de McNemar:

mcnemar.test(tab9)

## 
##  McNemar's Chi-squared test with continuity correction
## 
## data:  tab9
## McNemar's chi-squared = 1.0667, df = 1, p-value = 0.3017

De acordo com teste, temos que $X_{mc}^2:1.0667 ; Pvalor:0.3017$, ou seja, com um $\alpha$ de 05%, não rejeita-se a hipótese nula, ou seja, não há evidências estatísticas de mudança na taxa de aprovação do político após os anúncios de medidas.

Exercício 10:

10.a)

O experimento é comparativo entre 3 grupos independentes, com respostas ordinais (nível de dor 0 a 4). Modelo multinomial.

10.b/c)

Inserção dos dados:

tab10 <- matrix(c(1,4,5,5,10,9,8,5,3,0,10,8,3,3,1), byrow = T, nrow = 3,
                dimnames = list(Tratamento=c("Placebo","Comercial","Generico"),
                                               "Intensidade de Dor"=0:4)) ;tab10

##            Intensidade de Dor
## Tratamento   0 1 2 3  4
##   Placebo    1 4 5 5 10
##   Comercial  9 8 5 3  0
##   Generico  10 8 3 3  1

Como existe intensidade de dor (variável ordinal), iremos usar o teste Escore e formulamos a hipótese:

$H_{0}$: A distribuição da intensidade da dor é a mesma entre os diferentes medicamentos.
$H_{1}$: A distribuição da intensidade da dor difere para ao menos um medicamento.

score.test(tab10, escore=0:4, comp.mult = T, correcao.p = "bonferroni")

## $Global
## 
##  Estatistica Qs - Teste Escore
## 
## data:  tab10
## Qs = 23.96, df = 2, p-value = 1e-05
## 
## 
## $Comp.multiplas
##                  Grupo     Qs gl p.value correct.p
## 1  Placebo - Comercial 17.343  1   3e-05   0.00009
## 2   Placebo - Generico 16.054  1   6e-05   0.00018
## 3 Comercial - Generico  0.000  1   1e+00   1.00000
## 
## $Fbar
##   Placebo Comercial  Generico 
##      2.76      1.08      1.08

O teste de escore indicou diferença significativa entre os tratamentos ($Q_s = 23.96; Pvalor < 0.001$) para um nível de significância de 05%.

Comparações múltiplas revelaram que os medicamentos Comercial e Genérico apresentaram intensidade média de dor significativamente menor do que o Placebo $pvalor<0.000...$, indicando maior eficácia no alívio das dores abdominais. Não houve diferença significativa entre os tratamentos Comercial e Genérico.

Exercício 11:

tab11 <- matrix(c(75,102,372,179), byrow = T, nrow = 2, 
                dimnames = list("Teste"=c("T+","T-"),
                                "Doença"=c("D+","D-"))) ;tab11

##      Doença
## Teste  D+  D-
##    T+  75 102
##    T- 372 179

Utilizando o comando epi.tests, da library epiR, temos:

epiR::epi.tests(tab11, conf.level = 0.95)

##           Outcome +    Outcome -      Total
## Test +           75          102        177
## Test -          372          179        551
## Total           447          281        728
## 
## Point estimates and 95% CIs:
## --------------------------------------------------------------
## Apparent prevalence *                  0.24 (0.21, 0.28)
## True prevalence *                      0.61 (0.58, 0.65)
## Sensitivity *                          0.17 (0.13, 0.21)
## Specificity *                          0.64 (0.58, 0.69)
## Positive predictive value *            0.42 (0.35, 0.50)
## Negative predictive value *            0.32 (0.29, 0.37)
## Positive likelihood ratio              0.46 (0.36, 0.60)
## Negative likelihood ratio              1.31 (1.18, 1.44)
## False T+ proportion for true D- *      0.36 (0.31, 0.42)
## False T- proportion for true D+ *      0.83 (0.79, 0.87)
## False T+ proportion for T+ *           0.58 (0.50, 0.65)
## False T- proportion for T- *           0.68 (0.63, 0.71)
## Correctly classified proportion *      0.35 (0.31, 0.38)
## --------------------------------------------------------------
## * Exact CIs

11.a) De acordo com os resultados (com um nível de confiança de 95%), temos :

Sensibilidade de 17% [13%;21%]: Uma baixa probabilidade do teste ser positivo quando a pessoa estiver doente.
Especificidade de 64% [58%;69%]: Uma média probabilidade do teste ser negativo quando a pessoa não estiver doente.

11.b) Utilizando uma prevalência populacional de 5%, temos:

diag.tab.test(tab11, p0 = 0.05, conf = 0.95, semente = 107732)

## Resultados: 
##      Doença
## Teste  D+  D-
##    T+  75 102
##    T- 372 179
## 
## 
## |    |     %|    Li|    Ls|
## |:---|-----:|-----:|-----:|
## |p   |  61.4|  57.8|  64.9|
## |ac  |  34.9|  31.5|  38.4|
## |s   |  16.8|  13.6|  20.5|
## |e   |  63.7|  57.9|  69.1|
## -------------------------------------------- 
## Considerando a prevalencia amostral:  61.4 %
## 
## 
## |      |     %|    Li|    Ls|
## |:-----|-----:|-----:|-----:|
## |VPP   |  42.4|  35.3|  49.7|
## |VPN   |  32.5|  28.7|  36.5|
## |VPFP  |  57.6|  50.3|  64.7|
## |VPFN  |  67.5|  63.5|  71.3|
## -------------------------------------------- 
## Considerando a prevalencia populacional (p0):  5 %
## 
## 
## |      |     %|    Li|    Ls|
## |:-----|-----:|-----:|-----:|
## |VPP   |   2.4|   0.9|   5.7|
## |VPN   |  93.6|  91.3|  95.4|
## |VPFP  |  97.6|  94.3|  99.1|
## |VPFN  |   6.4|   4.6|   8.7|

A partir dos resultados apresentados, observa-se que o Valor Preditivo Positivo (VPP) é de apenas 2,4% [0,9%; 5,7%]. Isso significa que, entre os indivíduos que testaram positivo, apenas uma pequena fração realmente apresenta a doença. Esse resultado revela uma alta taxa de falsos positivos, o que compromete a utilidade do teste como ferramenta de diagnóstico confirmatório.

Em contrapartida, o Valor Preditivo Negativo (VPN) é de 93,6% [91,3%; 95,4%], indicando que o teste é eficaz para descartar a presença da doença em indivíduos com resultado negativo, visto que a maioria desses indivíduos realmente não está doente.

Exercício 12:

Inserindo as tabelas, temos:

tab12.t1 <- matrix(c(20,4,7,29), byrow = T, nrow = 2,
                dimnames = list("T1"=c("Sim","Não"),
                                "ELISA"=c("Sim","Não"))) ;tab12.t1

##      ELISA
## T1    Sim Não
##   Sim  20   4
##   Não   7  29

tab12.t2 <- matrix(c(15,10,1,34), byrow = T, nrow = 2,
                dimnames = list("T2"=c("Sim","Não"),
                                "ELISA"=c("Sim","Não"))) ;tab12.t2

##      ELISA
## T2    Sim Não
##   Sim  15  10
##   Não   1  34

12.a) Avaliando os testes individualmente, sem considerar a prevalência populacional:

epiR::epi.tests(tab12.t1, conf.level = 0.95)

##           Outcome +    Outcome -      Total
## Test +           20            4         24
## Test -            7           29         36
## Total            27           33         60
## 
## Point estimates and 95% CIs:
## --------------------------------------------------------------
## Apparent prevalence *                  0.40 (0.28, 0.53)
## True prevalence *                      0.45 (0.32, 0.58)
## Sensitivity *                          0.74 (0.54, 0.89)
## Specificity *                          0.88 (0.72, 0.97)
## Positive predictive value *            0.83 (0.63, 0.95)
## Negative predictive value *            0.81 (0.64, 0.92)
## Positive likelihood ratio              6.11 (2.37, 15.73)
## Negative likelihood ratio              0.30 (0.15, 0.57)
## False T+ proportion for true D- *      0.12 (0.03, 0.28)
## False T- proportion for true D+ *      0.26 (0.11, 0.46)
## False T+ proportion for T+ *           0.17 (0.05, 0.37)
## False T- proportion for T- *           0.19 (0.08, 0.36)
## Correctly classified proportion *      0.82 (0.70, 0.90)
## --------------------------------------------------------------
## * Exact CIs

De acordo com o T1, temos:

Prevalência: Para esse teste, temos uma prevalência amostral de 45%.
Acurácia: 81.7% [70.1%;89.4%].
Sensibilidade: 74.1% [55.3%;86.8%] - Probabilidade do T1 ser positivo sabendo que o teste ELISA também é positivo.
Especificidade: 87.9% [72.7%;95.2%] - Probabilidade do T1 ser negativo sabendo que o teste ELISA é negativo

epiR::epi.tests(tab12.t2, conf.level = 0.95)

##           Outcome +    Outcome -      Total
## Test +           15           10         25
## Test -            1           34         35
## Total            16           44         60
## 
## Point estimates and 95% CIs:
## --------------------------------------------------------------
## Apparent prevalence *                  0.42 (0.29, 0.55)
## True prevalence *                      0.27 (0.16, 0.40)
## Sensitivity *                          0.94 (0.70, 1.00)
## Specificity *                          0.77 (0.62, 0.89)
## Positive predictive value *            0.60 (0.39, 0.79)
## Negative predictive value *            0.97 (0.85, 1.00)
## Positive likelihood ratio              4.12 (2.36, 7.22)
## Negative likelihood ratio              0.08 (0.01, 0.54)
## False T+ proportion for true D- *      0.23 (0.11, 0.38)
## False T- proportion for true D+ *      0.06 (0.00, 0.30)
## False T+ proportion for T+ *           0.40 (0.21, 0.61)
## False T- proportion for T- *           0.03 (0.00, 0.15)
## Correctly classified proportion *      0.82 (0.70, 0.90)
## --------------------------------------------------------------
## * Exact CIs

De acordo com o T2, temos:

Prevalência: Para esse teste, temos uma prevalência amostral de 42%.
Acurácia: 81.7% [70.1%;89.4%].
Sensibilidade: 93.8% [71.7%;98.9%] - Probabilidade do T2 ser positivo sabendo que o teste ELISA também é positivo.
Especificidade: 77.3% [63.0%;87.2%] - Probabilidade do T2 ser negativo sabendo que o teste ELISA é negativo.

12.b e 12.c)

Considerando uma prevalência populacional de 01% para a infecção urinária:

diag.combina.test(tab12.t1, tab12.t2, p0 = 0.01)

## -------------Resumo do Teste 1------------- 
##    Considerando a prevalencia da Tabela 1   
##           Outcome +    Outcome -      Total
## Test +           20            4         24
## Test -            7           29         36
## Total            27           33         60
## 
## Point estimates and 95% CIs:
## --------------------------------------------------------------
## Apparent prevalence *                  0.40 (0.28, 0.53)
## True prevalence *                      0.45 (0.32, 0.58)
## Sensitivity *                          0.74 (0.54, 0.89)
## Specificity *                          0.88 (0.72, 0.97)
## Positive predictive value *            0.83 (0.63, 0.95)
## Negative predictive value *            0.81 (0.64, 0.92)
## Positive likelihood ratio              6.11 (2.37, 15.73)
## Negative likelihood ratio              0.30 (0.15, 0.57)
## False T+ proportion for true D- *      0.12 (0.03, 0.28)
## False T- proportion for true D+ *      0.26 (0.11, 0.46)
## False T+ proportion for T+ *           0.17 (0.05, 0.37)
## False T- proportion for T- *           0.19 (0.08, 0.36)
## Correctly classified proportion *      0.82 (0.70, 0.90)
## --------------------------------------------------------------
## * Exact CIs
## -------------Resumo do Teste 2------------- 
##    Considerando a prevalencia da Tabela 2   
##           Outcome +    Outcome -      Total
## Test +           15           10         25
## Test -            1           34         35
## Total            16           44         60
## 
## Point estimates and 95% CIs:
## --------------------------------------------------------------
## Apparent prevalence *                  0.42 (0.29, 0.55)
## True prevalence *                      0.27 (0.16, 0.40)
## Sensitivity *                          0.94 (0.70, 1.00)
## Specificity *                          0.77 (0.62, 0.89)
## Positive predictive value *            0.60 (0.39, 0.79)
## Negative predictive value *            0.97 (0.85, 1.00)
## Positive likelihood ratio              4.12 (2.36, 7.22)
## Negative likelihood ratio              0.08 (0.01, 0.54)
## False T+ proportion for true D- *      0.23 (0.11, 0.38)
## False T- proportion for true D+ *      0.06 (0.00, 0.30)
## False T+ proportion for T+ *           0.40 (0.21, 0.61)
## False T- proportion for T- *           0.03 (0.00, 0.15)
## Correctly classified proportion *      0.82 (0.70, 0.90)
## --------------------------------------------------------------
## * Exact CIs
## -------------  Resumo Geral  -------------- 
## Considerando a prevalencia populacional p0 = 1 %
## 
## 
## |     |  Teste 1|  Teste 2|  Paralelo|  Serie|
## |:----|--------:|--------:|---------:|------:|
## |s    |     74.1|     93.8|      98.4|   69.4|
## |e    |     87.9|     77.3|      67.9|   97.2|
## |VPP  |      5.8|      4.0|       3.0|   20.3|
## |VPN  |     99.7|     99.9|     100.0|   99.7|
## |PFP  |     94.2|     96.0|      97.0|   79.7|
## |PFN  |      0.3|      0.1|       0.0|    0.3|

12.b) Avaliando individualmente os testes com uma prevalência populacional de 1%:

Teste 1 tem VPP maior (5,8% [3%;20%]), ou seja, entre os positivos, uma proporção ligeiramente maior realmente está doente. Teste 2 tem sensibilidade muito maior (93,8%), ou seja, detecta melhor quem está doente, e também VPN maior (99,9%), ou seja, quase nenhum falso negativo. Porém, ambos têm VPP baixo, devido à prevalência muito baixa (1%), o que reduz a confiabilidade de qualquer teste positivo.

Em um contexto de doença rara (baixa prevalência), o teste T1 seria melhor pois tem maior especificidade.

Podemos também avaliar via curva ROC.

library(pROC)
tab12.t1csv <- read.csv("t1.CSV", header = T, sep = ";")
table(tab12.t1csv$t1, tab12.t1csv$elisa)

##    
##      0  1
##   0 29  7
##   1  4 20

tab12.t2csv <- read.csv("t2.CSV", header = T, sep = ";")
table(tab12.t2csv$t2, tab12.t2csv$elisa)

##    
##      0  1
##   0 34  1
##   1 10 15

roct1<-roc(form= tab12.t1csv$elisa~tab12.t1csv$t1,
    plot=T, legacy.axes=T, percent=TRUE, col='blue', lwd=2,
    xlab=' 1 - Especificidade (%)', ylab='Sensibilidade (%)')

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

roct2 <-roc(form= tab12.t2csv$elisa~tab12.t2csv$t2,
            percent=TRUE, add=TRUE, col='red', lwd=2, plot=TRUE)

## Setting levels: control = 0, case = 1
## Setting direction: controls < cases

legend("bottomright", legend=c('T1','T2'),
       col=c('blue','red'), lwd=2, bty='n')

roct1$auc

## Area under the curve: 80.98%

roct2$auc

## Area under the curve: 85.51%

Observamos que T2 tem um área pouco maior que T1 ( 85.51%> 80.98%). Vamos avaliar via teste de hipóteses se as áreas são iguais:

$H_0$: ROC_T1 = ROC_T2
$H_1$: ROC_T1 != ROC_T2

roc.test(roct1, roct2)

## 
##  DeLong's test for two ROC curves
## 
## data:  roct1 and roct2
## D = -0.66316, df = 115.55, p-value = 0.5086
## alternative hypothesis: true difference in AUC is not equal to 0
## sample estimates:
## AUC of roc1 AUC of roc2 
##    80.97643    85.51136

Observamos um p-valor de 0.5086, então não se rejeita a hipótese nula de que as áreas da curvas ROC são iguais. Portanto, poderiamos escolher entre T1 ou T2, mas devido a explicação anterior, acredito que para a baixa prevalência da doença, T1 seja melhor.

12.c) Avaliando em conjunto T1 e T2, podemos concluir que:

A combinação em paralelo apresenta alta sensibilidade (0,98) mas sua especificidade é menor que a dos testes isolados. A combinação em série apresenta alta especificidade (0,97) enquanto que a sensibilidade é relativamente baixa comparada com testes isolados.

Temos também que os valores de predição negativa são altos, tanto para os testes isolados como para as duas formas combinadas dos testes. Entretanto, os valores de predição positiva não são altos, sendo que a combinação em série proporcionou o melhor resultado (VPP = 20.3%).

Dessa forma, a combinação em paralelo se mostra mais adequada neste cenário, especialmente por se tratar de uma doença rara. Nesses casos, é fundamental minimizar a ocorrência de falsos negativos — isto é, situações em que o teste indica um resultado negativo, mas o indivíduo na verdade está doente. A combinação em paralelo apresenta valor preditivo negativo (VPN) de 100%, garantindo que praticamente todos os indivíduos com resultado negativo estejam realmente livres da doença.

Lista 01 - Dados Categóricos - RA 107732

Pedro A. G. Contardi

2025-05-20

Exercícios - Lista 01

Exercício 1:

Exercício 2:

Exercício 3:

Exercício 4:

Exercício 5:

(5.a)

(5.b)

Exercício 6:

Exercício 7:

7.1 Raça x Depressão

7.2 Estado Civil x Depressão

7.3 Tipo de Parto x Depressão

7.4 Gravidez Planejada x Depressão

7.5 Hospitalização do Bebê x Depressão

7.6 Doença na Gravidez x Depressão

7.7 Depressão Familiar x Depressão

7.8 TPM Forte x Depressão

7.9 Religião x Depressão

7.10 Atividade x Depressão

7.11 Escolaridade x Depressão

7.12 Laqueadura x Depressão

Exercício 8:

Exercício 9:

Exercício 10:

Exercício 11:

Exercício 12: