lista1
Questão 1
Gere um banco de dados com 50 itens e 1000 respondentes a partir do modelo logístico de 3 parâmetros:
###### from exemplo de Prof. Antonio Eduardo
set.seed(123) # semente (alterado parametro)
no.itens <- 50 # numero de itens
no.resp <- 1000 # numero de respondentes
aa <- rlnorm(no.itens,0,1) # vetor de parametros de discriminacao
bb <- rnorm(no.itens,0,1) # vetor de parametros de dificuldade
cc <- rbeta(no.itens,40,480) # vetor de parametros de acerto ao acaso (alterado parametro)
# proficiencias reais
theta <- rnorm(no.resp,0,1) # proficiencias reais
# calculo da matriz de probabilidades de acerto para geração dos dados
mat.prob <- matrix(0,no.resp,no.itens)
for (i in 1:no.itens) mat.prob[,i] <- cc[i]+(1-cc[i])/(1+exp(-aa[i]*(theta-bb[i])))
# geracao dos dados
n.aux <- no.resp*no.itens
dados.sim <- matrix(sign(c(mat.prob)-runif(n.aux,0,1)),nrow=no.resp)
dados.sim[dados.sim==-1] <- 0A) Calcule o coeficiente de correlação ponto-bisserial para cada um dos itens:
# correlacao ponto bisserial
escores <- apply(dados.sim,1,sum) # escores individuais
prop <- apply(dados.sim,2,sum)/no.resp # proporcao de acertos de cada item
cor.pb <- rep(0,no.itens) # correlacao ponto bisserial
for (i in 1:no.itens) cor.pb[i] <- cor(dados.sim[,i],escores)
print(data.frame(cor.pb))## cor.pb
## 1 0.24085709
## 2 0.34616330
## 3 0.69611404
## 4 0.36034775
## 5 0.44616616
## 6 0.34217484
## 7 0.37091411
## 8 0.18829665
## 9 0.25880249
## 10 0.28825914
## 11 0.64382297
## 12 0.51443939
## 13 0.49079928
## 14 0.42570074
## 15 0.25147621
## 16 0.70736564
## 17 0.53270120
## 18 0.07000872
## 19 0.53374478
## 20 0.24031425
## 21 0.19358853
## 22 0.21925380
## 23 0.22840807
## 24 0.25033217
## 25 0.25860073
## 26 0.14649515
## 27 0.60859839
## 28 0.42388279
## 29 0.17023668
## 30 0.69638954
## 31 0.53670736
## 32 0.31340377
## 33 0.63225892
## 34 0.58226834
## 35 0.61786146
## 36 0.53930156
## 37 0.45996507
## 38 0.39432461
## 39 0.33821233
## 40 0.30553243
## 41 0.22770488
## 42 0.39289048
## 43 0.16958273
## 44 0.67412041
## 45 0.41045831
## 46 0.18476772
## 47 0.19721308
## 48 0.24138425
## 49 0.56328125
## 50 0.35131978B) Plote os valores do coeficiente obtidos em “A”:
C) Elabore um diagrama de dispersão do coeficiente de correlação ponto-bisserial e o parâmetro de discriminação dos itens:
D) Trace a curva de regressão não paramétrica de Nadaraya-Watson:
E) Calcule a correlação linear entre o coeficiente de correlação ponto-bisserial e o parâmetro de discriminação:
## correlacao entre o parametro de discriminacao e o coeficiente de correlacao ponto bisserial
cor(aa,cor.pb)## [1] 0.7248629F) O que o diagrama de dispersão e o valor da correlação linear parecem indicar:
O diagrama de dispersão parece indicar uma relação linear crescente entre o parâmetro “a” com a correlação ponto-bisserial para valores de “a” até 4. Já o valor do coeficiente de correlação linear revela uma correlação positiva de moderada a forte.
G) Elabore um diagrama de dispersão do coeficiente de correlação ponto-bisserial e o parâmetro de dificuldade dos itens:
H) Trace a curva de regressão não paramétrica de Nadaraya-Watson:
I) Calcule a correlação linear entre o coeficiente de correlação ponto-bisserial e o parâmetro de dificuldade dos itens:
## correlacao entre o parametro de dificuldade do item e o coeficiente de correlacao ponto bisserial
cor(bb,cor.pb)## [1] -0.1300792J) O que o diagrama de dispersão e o valor da correlação linear parecem indicar:
O diagrama de dispersão parece indicar uma ausência de relação linear entre o parâmetro “b” com a correlação ponto-bisserial para valores sendo que os maiores valores de correlação estiveram concentrados entre valores de b de -1 a 1 mas de maneira dispersa. Já o valor do coeficiente de correlação indica uma correlação negativa e fraca entre o parâmetro de dificuldade do item e o coeficiente de correlação ponto-bisserial.
K) Calcule o coeficiente de correlação bisserial para cada item:
# correlacao bisserial
cor.b <- cor.pb*sqrt(prop*(1-prop))/dnorm(qnorm(prop,0,1),0,1)
print(data.frame(cor.pb))## cor.pb
## 1 0.24085709
## 2 0.34616330
## 3 0.69611404
## 4 0.36034775
## 5 0.44616616
## 6 0.34217484
## 7 0.37091411
## 8 0.18829665
## 9 0.25880249
## 10 0.28825914
## 11 0.64382297
## 12 0.51443939
## 13 0.49079928
## 14 0.42570074
## 15 0.25147621
## 16 0.70736564
## 17 0.53270120
## 18 0.07000872
## 19 0.53374478
## 20 0.24031425
## 21 0.19358853
## 22 0.21925380
## 23 0.22840807
## 24 0.25033217
## 25 0.25860073
## 26 0.14649515
## 27 0.60859839
## 28 0.42388279
## 29 0.17023668
## 30 0.69638954
## 31 0.53670736
## 32 0.31340377
## 33 0.63225892
## 34 0.58226834
## 35 0.61786146
## 36 0.53930156
## 37 0.45996507
## 38 0.39432461
## 39 0.33821233
## 40 0.30553243
## 41 0.22770488
## 42 0.39289048
## 43 0.16958273
## 44 0.67412041
## 45 0.41045831
## 46 0.18476772
## 47 0.19721308
## 48 0.24138425
## 49 0.56328125
## 50 0.35131978L) Elabore um diagrama de dispersão do coeficiente de correlação ponto-bisserial e do coeficiente de correlação bisserial:
M) Calcule a correlação linear entre os dois coeficientes:
## correlacao entre o coeficiente de correlacao bisserial e o coeficiente de correlacao ponto bisserial
cor(cor.b,cor.pb)## [1] 0.9917236N) O que o diagrama de dispersão e o valor da correlação linear parecem indicar:
O diagrama de dispersão revela uma relação linear crescente e forte entre os dois coeficientes de correlação, visto que quase todas as observações se encontraram sobre a reta diagonal do gráfico. O valor da correlação linear confirmou o exposto pelo diagrama sendo forte e positivo.
Questão 2
A função fii retorna uma tabela com os resultados calculados para o item pela função de informação nos modelos logísticos de 1, 2 e 3 parâmetros dado os parâmetros a,b,c e theta:
library(Deriv)
fii <- function(a,b,c,theta){
P3 <- function(theta) c+(1-c)/(1+exp(-a*(theta-b)))
P2 <- function(theta) 1/(1+exp(-a*(theta-b)))
P1 <- function(theta) 1/(1+exp(-(theta-b)))
Pi3 <- P3(theta)
Pi2 <- P2(theta)
Pi1 <- P1(theta)
Qi3 <- 1 - Pi3
Qi2 <- 1 - Pi2
Qi1 <- 1 - Pi1
Df3 <- Deriv(P3)
Df2 <- Deriv(P2)
Df1 <- Deriv(P1)
FII3 <- Df3(theta)^2/(Pi3*Qi3)
FII2 <- Df2(theta)^2/(Pi2*Qi2)
FII1 <- Df1(theta)^2/(Pi1*Qi1)
tab <- data.frame(FII1, FII2, FII3)
return(tab)
}Exemplo utilizando as 20 primeiras observações do vetor theta, utilizando a = 0.8, b = 0.5 e c = 0.3:
fii(a = 0.8, b = 0.5, c = 0.3,theta[1:20])## FII1 FII2 FII3
## 1 0.24975218 0.15989847 0.08708680
## 2 0.20787125 0.14199394 0.06201037
## 3 0.23630329 0.15431438 0.08965550
## 4 0.20768834 0.14191224 0.06193474
## 5 0.23183854 0.15242741 0.08945329
## 6 0.14450832 0.11144169 0.03831489
## 7 0.12522920 0.10105985 0.03177292
## 8 0.05692296 0.05780267 0.03915109
## 9 0.20403205 0.14027216 0.06043616
## 10 0.24747266 0.15896228 0.08226932
## 11 0.24883791 0.15952348 0.08799906
## 12 0.19808085 0.13757384 0.05804611
## 13 0.24998223 0.15999272 0.08641714
## 14 0.24892992 0.15956124 0.08378080
## 15 0.22055723 0.14758207 0.06744609
## 16 0.23855162 0.15525823 0.07627951
## 17 0.23298769 0.15291471 0.07331967
## 18 0.13713259 0.10754091 0.06960357
## 19 0.17393629 0.12623413 0.04882382
## 20 0.14013555 0.10913926 0.03680846A função abaixo gera um gráfico da FII do item para um dado vetor de parâmetros (a, b, c) para um item específico:
fii.grafico <- function(a,b,c, theta = c(-4.5,-4,-3.5,-3,-2.5,-2,-1.5,-1,-0.5,0,0.5,1,1.5,2,2.5,3,3.5,4)){
P3 <- function(theta) c+(1-c)/(1+exp(-a*(theta-b)))
P2 <- function(theta) 1/(1+exp(-a*(theta-b)))
P1 <- function(theta) 1/(1+exp(-(theta-b)))
Pi3 <- P3(theta)
Pi2 <- P2(theta)
Pi1 <- P1(theta)
Qi3 <- 1 - Pi3
Qi2 <- 1 - Pi2
Qi1 <- 1 - Pi1
Df3 <- Deriv(P3)
Df2 <- Deriv(P2)
Df1 <- Deriv(P1)
FII3 <- Df3(theta)^2/(Pi3*Qi3)
FII2 <- Df2(theta)^2/(Pi2*Qi2)
FII1 <- Df1(theta)^2/(Pi1*Qi1)
tab <- data.frame(FII1, FII2, FII3, theta)
par(mfrow=c(2,2))
plot(tab[,4], tab[,1], main = "1 Parâmetro")
lines(tab[,4], tab[,1], type = "l", lty = 1)
plot(tab[,4], tab[,2], main = "2 Parâmetros")
lines(tab[,4], tab[,2], type = "l", lty = 1)
plot(tab[,4], tab[,3], main = "3 Parâmetros")
lines(tab[,4], tab[,3], type = "l", lty = 1)
}Exemplo para a = 0.8, b = 0.5 e c = 0.3:
fii.grafico(a = 0.8, b = 0.5, c = 0.3)
Questão 3
A) Para cada item, calcule a probabilidade de acerto nas proficiências -3, -2, -1, 0, 1, 2 e 3:
calc <- matrix(0,7,6)
aa <- c(1.8,0.7,1.8,1.2,1.2,0.5)
bb <- c(1,1,1,-0.5,0.5,0)
cc <- c(0,0,0.25,0.2,0,0.1)
theta <- c(-3,-2,-1,0,1,2,3)
for (i in 1:6) calc[,i] <- cc[i]+(1-cc[i])/(1+exp(-aa[i]*(theta-bb[i])))
colnames(calc) <- c("item 1","item 2","item 3","item 4","item 5","item 6")
rownames(calc) <- c(-3,-2,-1,0,1,2,3)
calc <- as.data.frame(calc)
calc$proficiencia <- c(-3,-2,-1,0,1,2,3)
print(calc[,-7])## item 1 item 2 item 3 item 4 item 5 item 6
## -3 0.0007460288 0.05732418 0.2505595 0.2379407 0.01477403 0.2641830
## -2 0.0044962732 0.10909682 0.2533722 0.3134809 0.04742587 0.3420473
## -1 0.0265969936 0.19781611 0.2699477 0.4834750 0.14185106 0.4397866
## 0 0.1418510649 0.33181223 0.3563883 0.7165250 0.35434369 0.5500000
## 1 0.5000000000 0.50000000 0.6250000 0.8865191 0.64565631 0.6602134
## 2 0.8581489351 0.66818777 0.8936117 0.9620593 0.85814894 0.7579527
## 3 0.9734030064 0.80218389 0.9800523 0.9881808 0.95257413 0.8358170B) Construa a curva característica de cada item (CCI):
par(mfrow=c(2,3))
for(i in 1:6){
plot(calc[,7], calc[,i], main = paste0("Item ",i), xlab = "Proficiência", ylab = "Probabilidade de Acerto")
lines(calc[,7], calc[,i], type = "l", lty = 1)
}
C) Qual o item mais fácil?
O item que globalmente foi mais fácil, foi o item 4 com o menor valor do parâmetro b.
D) Qual o item que menos discrimina?
O item 6 em virtude de ter globalmente o menor valor do parâmetro a.
E) Qual o item no qual um aluno com proficiência igual a 0 tem a maior probabilidade de acerto?
O item 4.
F) Qual o item é mais fácil para a proficiência igual a -1? E ára a proficiência 0?
O item 4 é o mais fácil tanto em proficiência = -1 quanto em proficiência = 0.
G) Existem dois itens que são igualmente difíceis na proficiência -1? E na proficiência 1?
Para proficiência igual a -1 não existe itens igualmente difíceis. Já para proficiência igual a 1 temos os itens 1 e 2 com probabilidades iguais de acerto.