ModeloTRI_GRM

Author

Silvio

Modelo de Resposta Gradual (Samejima)

Exemplo: Pesquisa com traça latente Gestão do Conhecimendo nas empresas, utilizando uma escala likert de 5 pontos,1- discordo totalmente, 2 - discordo, 3 - neutro, 4 -concordo e 5 - concordo totalmente.

Em nossa empresa ideias e conceitos são transmitidos entre todas as áreas/departamentos.
Nossa gestão prioriza a ajuda entre as áreas/departamentos para resolver problemas.
Nossa gestão prioriza a ajuda entre as áreas/departamentos para desenvolver novos produtos.
Nossa gestão exige encontros periódicos entre as áreas/ departamentos para o intercâmbio de problemas.
Nossa gestão exige encontros periódicos entre as áreas/departamentos para o intercâmbio de novas ideias.
Nossa gestão encoraja o desenvolvimento de novos produtos ou novos serviços.
Em nossa empresa há circulação periódica de-mails ou informativos escritos sobre novas soluções
Nossos colaboradores tem a habilidade de se comunicar com outros setores da empresa
Em nossa empresa existe um fluxo de informação rápido, por exemplo, se uma área ou departamento obtém uma informação importante, comunica esta informação prontamente para todas as outras áreas ou departamentos.
Nossa empresa periodicamente reavalia tecnologias para ajustá-las aos novos conhecimentos.
Nossa empresa encoraja o fluxo de ideias externas
Nossos colaboradores estão acostumados a absorver novos conhecimentos assim como usar estes conhecimentos em outras finalidades e torná-los disponíveis para a empresa.

Analise de dados politomico

Abrindo dados

dados <- read.csv2("https://raw.githubusercontent.com/Silvioest/teste/refs/heads/master/dadosGC.csv")
apply(dados,2,table)

   i1  i2  i3  i4  i5  i6  i7  i8  i9 i10 i11 i12
1  46  45  62  25  37  45  44  31  56  48  45  61
2  52  48  55  38  46  41  60  48  56  68  63  81
3  62  54  51  59  57  62  54  53  74  65  46  69
4  81  75  74 108  86  89 100  86  51  78  88  74
5 129 148 128 140 144 133 112 152 133 111 128  85

2.Análise descritiva

library(ltm)

Carregando pacotes exigidos: MASS

Carregando pacotes exigidos: msm

Carregando pacotes exigidos: polycor

descript(dados)


Descriptive statistics for the 'dados' data-set

Sample:
 12 items and 370 sample units; 0 missing values

Proportions for each level of response:
         1      2      3      4      5
i1  0.1243 0.1405 0.1676 0.2189 0.3486
i2  0.1216 0.1297 0.1459 0.2027 0.4000
i3  0.1676 0.1486 0.1378 0.2000 0.3459
i4  0.0676 0.1027 0.1595 0.2919 0.3784
i5  0.1000 0.1243 0.1541 0.2324 0.3892
i6  0.1216 0.1108 0.1676 0.2405 0.3595
i7  0.1189 0.1622 0.1459 0.2703 0.3027
i8  0.0838 0.1297 0.1432 0.2324 0.4108
i9  0.1514 0.1514 0.2000 0.1378 0.3595
i10 0.1297 0.1838 0.1757 0.2108 0.3000
i11 0.1216 0.1703 0.1243 0.2378 0.3459
i12 0.1649 0.2189 0.1865 0.2000 0.2297


Frequencies of total scores:
     12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
Freq 13  2  1  1  4  2  3  3  2  0  5  8 12 10  7  4  1  2  5  4  5 10 15  6 10
     37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
Freq  2  0 10 11  7  9  8  7  2 10  7  5 13  8  4  3 12 10 11 10 15 16 23 32


Cronbach's alpha:
               value
All Items     0.9669
Excluding i1  0.9651
Excluding i2  0.9639
Excluding i3  0.9628
Excluding i4  0.9661
Excluding i5  0.9637
Excluding i6  0.9658
Excluding i7  0.9628
Excluding i8  0.9638
Excluding i9  0.9634
Excluding i10 0.9623
Excluding i11 0.9631
Excluding i12 0.9646


Pairwise Associations:
   Item i Item j p.value
1       1      4   0.001
2       1      5   0.001
3       1      8   0.001
4       2      4   0.001
5       2      5   0.001
6       2      6   0.001
7       2      8   0.001
8       3      4   0.001
9       3      8   0.001
10      4      5   0.001

Verificando o número de fatores por meio do ScreePlots

library(psych)


Anexando pacote: 'psych'

O seguinte objeto é mascarado por 'package:ltm':

    factor.scores

O seguinte objeto é mascarado por 'package:polycor':

    polyserial

grapc<-fa.parallel(dados,fa="pc",cor='poly')

Parallel analysis suggests that the number of factors =  NA  and the number of components =  1

Analisando com modelo da TRI Samejima

Analise com o pacote MIRT

library(mirt)

Carregando pacotes exigidos: stats4

Carregando pacotes exigidos: lattice


Anexando pacote: 'mirt'

O seguinte objeto é mascarado por 'package:ltm':

    Science

m1<-mirt(dados,1,'graded',SE=TRUE)

summary(m1)

       F1    h2
i1  0.880 0.774
i2  0.908 0.824
i3  0.937 0.878
i4  0.805 0.648
i5  0.909 0.826
i6  0.848 0.719
i7  0.936 0.876
i8  0.914 0.835
i9  0.925 0.856
i10 0.957 0.916
i11 0.932 0.868
i12 0.880 0.775

     SE.F1
i1  0.0166
i2  0.0138
i3  0.0099
i4  0.0251
i5  0.0135
i6  0.0205
i7  0.0100
i8  0.0130
i9  0.0114
i10 0.0072
i11 0.0105
i12 0.0163

SS loadings:  9.795 
Proportion Var:  0.816 

Factor correlations: 

   F1
F1  1

4.Tabela de coeficiente simples

coef(m1,simplify=TRUE,IRTpars=TRUE)

$items
        a     b1     b2     b3    b4
i1  3.149 -1.305 -0.723 -0.229 0.422
i2  3.688 -1.256 -0.711 -0.264 0.295
i3  4.576 -1.015 -0.525 -0.131 0.434
i4  2.309 -1.856 -1.096 -0.465 0.409
i5  3.706 -1.364 -0.789 -0.317 0.318
i6  2.722 -1.370 -0.838 -0.291 0.411
i7  4.514 -1.215 -0.613 -0.200 0.565
i8  3.827 -1.467 -0.809 -0.368 0.257
i9  4.148 -1.091 -0.567  0.001 0.397
i10 5.623 -1.134 -0.519 -0.047 0.564
i11 4.365 -1.211 -0.572 -0.211 0.440
i12 3.159 -1.106 -0.365  0.200 0.872

$means
F1 
 0 

$cov
   F1
F1  1

Tabela mostrando os erros padrões

coef(m1, IRTpars = TRUE, printSE=T)

$i1
        a     b1     b2     b3    b4
par 3.149 -1.305 -0.723 -0.229 0.422
SE  0.263  0.106  0.080  0.071 0.077

$i2
        a     b1     b2     b3    b4
par 3.688 -1.256 -0.711 -0.264 0.295
SE  0.318  0.099  0.077  0.069 0.072

$i3
        a     b1     b2     b3    b4
par 4.576 -1.015 -0.525 -0.131 0.434
SE  0.400  0.084  0.070  0.066 0.071

$i4
        a     b1     b2     b3    b4
par 2.309 -1.856 -1.096 -0.465 0.409
SE  0.205  0.156  0.107  0.083 0.084

$i5
        a     b1     b2     b3    b4
par 3.706 -1.364 -0.789 -0.317 0.318
SE  0.317  0.106  0.079  0.069 0.072

$i6
        a     b1     b2     b3    b4
par 2.722 -1.370 -0.838 -0.291 0.411
SE  0.234  0.114  0.088  0.075 0.080

$i7
        a     b1     b2     b3    b4
par 4.514 -1.215 -0.613 -0.200 0.565
SE  0.387  0.093  0.071  0.066 0.074

$i8
        a     b1     b2     b3    b4
par 3.827 -1.467 -0.809 -0.368 0.257
SE  0.329  0.112  0.080  0.070 0.071

$i9
        a     b1     b2    b3    b4
par 4.148 -1.091 -0.567 0.001 0.397
SE  0.356  0.089  0.072 0.067 0.072

$i10
        a     b1     b2     b3    b4
par 5.623 -1.134 -0.519 -0.047 0.564
SE  0.504  0.086  0.067  0.064 0.071

$i11
        a     b1     b2     b3    b4
par 4.365 -1.211 -0.572 -0.211 0.440
SE  0.373  0.094  0.071  0.067 0.072

$i12
        a     b1     b2    b3    b4
par 3.159 -1.106 -0.365 0.200 0.872
SE  0.260  0.095  0.073 0.073 0.087

$GroupPars
    MEAN_1 COV_11
par      0      1
SE      NA     NA

Gráfico compara os tetas estimados com o escores totais

plot(m1)

Curva Caracteristica dos Itens (CCI)

plot(m1,type="trace")

Curva de informação do teste

plot(m1, type = 'info')

Curva de informação do teste com erro padrão

plot(m1, type = 'infoSE')

Curva de informação de todos os item

plot(m1, type = 'infotrace')

Curva de informação por item

itemplot(m1, 1, type = 'info')

Curva característica por itens

itemplot(m1, 1, type = 'trace')

itemplot(m1, 2, type = 'trace')

Curva característica por item com a curva de informação

itemplot(m1, 2, type = 'infotrace')

itemplot(m1, 1, type = 'infotrace')

Calculando os thetas

theta <- fscores(m1,as.data.frame=TRUE, full.scores.SE=TRUE)
head(theta)

              F1     SE_F1
[1,] -0.50819244 0.1471024
[2,] -0.52844642 0.1275594
[3,] -0.92036595 0.1259979
[4,] -0.62736533 0.1749616
[5,]  0.09215149 0.1391069
[6,]  0.25136744 0.1378519

Histograma do escore Theta

library(ggplot2)


Anexando pacote: 'ggplot2'

Os seguintes objetos são mascarados por 'package:psych':

    %+%, alpha

ggplot(data = theta, aes(x = theta[,1])) +
  geom_histogram(fill = 'blue',color='black',bins = 8)

Juntando bases com o escore

dados2<-cbind(dados,theta)
head(dados2)

  i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12          F1     SE_F1
1  3  5  1  3  2  4  3  4  3   3   1   2 -0.50819244 0.1471024
2  3  3  3  4  3  2  2  4  2   2   3   3 -0.52844642 0.1275594
3  2  2  2  2  2  2  2  2  2   2   2   2 -0.92036595 0.1259979
4  4  2  5  2  3  1  1  5  5   2   2   1 -0.62736533 0.1749616
5  4  4  3  5  5  5  4  4  3   4   3   4  0.09215149 0.1391069
6  4  5  4  5  5  4  4  5  3   4   4   3  0.25136744 0.1378519

Mudando a escala theta (0,1) para escala(50,10)

dados2$escore<-10*theta[,1]+50
head(dados2)

  i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12          F1     SE_F1   escore
1  3  5  1  3  2  4  3  4  3   3   1   2 -0.50819244 0.1471024 44.91808
2  3  3  3  4  3  2  2  4  2   2   3   3 -0.52844642 0.1275594 44.71554
3  2  2  2  2  2  2  2  2  2   2   2   2 -0.92036595 0.1259979 40.79634
4  4  2  5  2  3  1  1  5  5   2   2   1 -0.62736533 0.1749616 43.72635
5  4  4  3  5  5  5  4  4  3   4   3   4  0.09215149 0.1391069 50.92151
6  4  5  4  5  5  4  4  5  3   4   4   3  0.25136744 0.1378519 52.51367

Histograma do escore escala (50,10)

ggplot(data = dados2, aes(x = escore)) +
  geom_histogram(fill = 'blue',color='black',bins = 8)

Avaliação da qualidade do ajuste

M2(m1)

          M2 df p RMSEA RMSEA_5 RMSEA_95 SRMSR   TLI   CFI
stats 50.184 18 0  0.07   0.047    0.093 0.046 0.865 0.919