Tópico 9: Análise de confiabilidade usando o Kappa

Precisão de juízes.

Correlação entre avaliadores
Problema da concordância ao acaso
Importante em testes projetivos, de criatividade, redação que requerem um trabalho intenso de pontuaçào ou classificação por juízes
Veja esses papers:
Sim, J., & Wright, C. C. (2005). The kappa statistic in reliability studies: use, interpretation, and sample size requirements. Physical therapy, 85(3), 257-268.link
Viera, A. J., & Garrett, J. M. (2005). Understanding interobserver agreement: the kappa statistic. Fam Med, 37(5), 360-363 link
Kappa calcula um índice de concordânciasubtraindo a concordância observada com aquela que poderia ser obtida por acaso.

Exercício com kappa. importando banco de dados

Base do Teste de Criatividade figural Infantil (TCFI, Nakano, T. & Primi, (2012) A Estrutura Fatorial do Teste de Criatividade Figural Infantil. Psicologia: Teoria e Pesquisa, v. 28, n. 3, p. 275-283) link
Três atividades. Trabalharemos com a atividade 3.
Foi avaliado usando um método de avaliação de qualidade por juízes.

library(readxl)
        setwd("~/Dropbox/R Stat/")
        bd <- read_excel("bd_tcfi.xlsx")
        bd$id_rwn <- as.numeric(rownames(bd))

source("http://www.labape.com.br/rprimi/R/sharedcount.R")
        
names(bd)

##  [1] "ord0"     "RaterN"   "Rater"    "ID"       "At.1"     "At.2 "   
##  [7] "At.3"     "At3.01"   "At3.02"   "At3.03"   "At3.04"   "At3.05"  
## [13] "At3.06"   "At3.07"   "At3.08"   "At3.09"   "At3.10"   "Obs."    
## [19] "id_letra" "id"       "id_num_f" "idnum"    "id_rwn"

# Quantos sujeitos
length(unique(bd$id))

## [1] 219

# Quantos juízes e quantas avaliações cada um fez
table(bd$Rater)

## 
##   1   2   3   4   5   6 
## 163  79  78  54  79  78

bd <- bd[!is.na(bd$ID), ]

Organizando banco de dados

Formatos long e short
Reshape package !!
Veja esse paper: Tidy data link

library(reshape2)
 
names(bd)

##  [1] "ord0"     "RaterN"   "Rater"    "ID"       "At.1"     "At.2 "   
##  [7] "At.3"     "At3.01"   "At3.02"   "At3.03"   "At3.04"   "At3.05"  
## [13] "At3.06"   "At3.07"   "At3.08"   "At3.09"   "At3.10"   "Obs."    
## [19] "id_letra" "id"       "id_num_f" "idnum"    "id_rwn"

vars <- names(bd[ , c(4, 2, 23, 5:17)]) 
bd_long <- melt(bd[ , vars], 
                id.vars =1:3,
                measured.vars=4:16)

bd_long2 <-  dcast(data = bd_long[ , -3], formula = ID+variable~RaterN, value.var = "value")

# quantos idéias em comum cada juiz avaliou ?         
source("http://www.labape.com.br/rprimi/R/sharedcount.R")
sharedcount(bd_long2[ , c(3:8)])

##           X1       X2 out
## 1  alexandre    andre   0
## 2  alexandre    carla   0
## 3  alexandre  everson 843
## 4  alexandre jurandir   0
## 5  alexandre    marco 604
## 6      andre    carla 898
## 7      andre  everson   0
## 8      andre jurandir   0
## 9      andre    marco 614
## 10     carla  everson   0
## 11     carla jurandir   0
## 12     carla    marco 615
## 13   everson jurandir   0
## 14   everson    marco 623
## 15  jurandir    marco 662

Correlação simples entre os escores

names(bd_long2)

## [1] "ID"        "variable"  "alexandre" "andre"     "carla"     "everson"  
## [7] "jurandir"  "marco"

table(bd_long2$carla, bd_long2$andre)

##    
##       1   2   3   4   5
##   1 102  71  18   2   8
##   2  81 194  56  17   5
##   3  18  67  67  19   3
##   4   4  36  87  37   6

library(psych)
describe(bd_long2[ , 3:8])

##           vars    n mean   sd median trimmed  mad min max range  skew
## alexandre    1  844 3.18 0.75      3    3.19 0.00   2   5     3  0.17
## andre        2  900 2.27 0.98      2    2.18 1.48   1   5     4  0.59
## carla        3  906 2.34 1.03      2    2.30 1.48   1   4     3  0.32
## everson      4  864 2.22 1.08      2    2.10 1.48   1   5     4  0.77
## jurandir     5  702 2.27 1.11      2    2.31 1.48   0   5     5 -0.19
## marco        6 2117 2.07 0.85      2    2.20 0.00   0   4     4 -1.01
##           kurtosis   se
## alexandre    -0.34 0.03
## andre        -0.02 0.03
## carla        -1.03 0.03
## everson       0.02 0.04
## jurandir      0.46 0.04
## marco         1.15 0.02

multi.hist(bd_long2[ , 3:8])

pairs.panels(bd_long2[ , 3:8])

corPlot(bd_long2[ , 3:8],numbers=TRUE,upper=FALSE,diag=FALSE)


library(d3heatmap)
d3heatmap(cor(bd_long2[ , 3:8], use="pair"), 
          symn= TRUE,  symm = TRUE, 
          k_row = 1, k_col =1)

##### Concordância e kappa

veja esse excelente cookbook link

names(bd_long2)

## [1] "ID"        "variable"  "alexandre" "andre"     "carla"     "everson"  
## [7] "jurandir"  "marco"

library(irr)

## Loading required package: lpSolve

agree(bd_long2[, c(8, 3)])

##  Percentage agreement (Tolerance=0)
## 
##  Subjects = 604 
##    Raters = 2 
##   %-agree = 28.3

agree(bd_long2[ , c(8, 3)], tolerance = 1)

##  Percentage agreement (Tolerance=1)
## 
##  Subjects = 604 
##    Raters = 2 
##   %-agree = 81

icc(bd_long2[, c(8, 3)], model="twoway", type="consistency")

##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : consistency 
## 
##    Subjects = 604 
##      Raters = 2 
##    ICC(C,1) = 0.308
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##  F(603,603) = 1.89 , p = 4.37e-15 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.234 < ICC < 0.379