```{r setup, include=FALSE}
knitr::opts_chunk$set(tidy.opts = list(width.cutoff=80), tidy= TRUE)
knitr::opts_chunk$set(
collapse = TRUE,
comment = NA,
echo = FALSE,
warning = FALSE
)
library(ggplot2)
library(sjPlot)
library(corrplot)
library(nnet)
library(formatR)
library(kableExtra)
library(shiny)
IRT <- function(theta, a = 1, b = 0, c = 0,e = 1) {
y <- c + (e - c) * exp(a * (theta - b)) / (1 + exp(a * (theta - b)))
y[is.na(y)] = 1
return(y)
}
i_info <- function(b, a=1,c=0, theta = seq(-5,5,length.out=1000)){
P <- NULL
Q <- NULL
Ii <- NULL
for(i in 1:1000){
P[i] <- 1/(1+ exp (-a*(theta[i] - b)))
Q[i]= 1-P[i]
Ii[i] =(a*Q[i]*(P[i]-c)^2)/(P[i]*((1-c)^2)) # (3PL)
}
return(Ii)
}
# Function to get all item information
item_info <- function(b,a=1, c= 0){
item <- NULL
for(i in 1:length(b)){
item[[i]] <- i_info(b[i],a[i])
}
return(item)
}
set.seed(999)
```
## All together
```{r}
shiny::shinyApp(
ui <- fluidPage(
# Sidebar layout with input and output definitions ----
verticalLayout(
# App title ----
# Sidebar to demonstrate various slider options ----
wellPanel(
# Input: Decimal interval with step value ----
fluidRow(
column(6, div(style="height: 20px;",
sliderInput("b", "Difficulty:",
min = -5, max = 5,
value = 0, step = 0.1))),
column(6, sliderInput("lucky", "Lucky guess:",
min = 0, max = 0.5,
value = 0, step = 0.01))),
fluidRow(
column(6, sliderInput("a", "Discrimination:",
min = -5, max = 5,
value = 1, step = 0.1)),
column(6, sliderInput("care", "Careless error:",
min = 0.5, max = 1,
value = 1, step = 0.01)))
),
plotOutput("plot", height = "250px")
)
),
server <- function(input, output) {
IRT <- function(theta, a = 1, b = 0, c = 0,e = 1) {
y <- c + (e - c) * exp(a * (theta - b)) / (1 + exp(a * (theta - b)))
y[is.na(y)] = 1
return(y)
}
output$plot <- renderPlot({
theta <- theta <- seq(-7, 7, .001)
par(mar = c(5,7,4,2) + 0.1)
plot(theta, IRT(theta, b = 0, a = 1),
cex.lab= 2,
cex.axis =1.5,
xlab = expression(theta), ylab = bquote(.("P(x = 1)")),
xlim = c(-5, 5), ylim = c(0, 1),
type = "l", lwd = 1, lty = 2,
col = "royalblue")
lines(theta, IRT(theta, b=input$b,
a=input$a,
c= input$lucky,
e= input$care),
type = "l", lwd = 3,
col = "seagreen")
})
},
options = list(height = 400)
)
```
## ICC, IIF e TIF
```{r}
shiny::shinyApp(
ui <- fluidPage(
tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: royalblue}")),
tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-edge, .js-irs-1 .irs-bar {background: magenta}")),
tags$style(HTML(".js-irs-2 .irs-single, .js-irs-2 .irs-bar-edge, .js-irs-2 .irs-bar {background: seagreen}")),
tags$style(HTML(".js-irs-3 .irs-single, .js-irs-3 .irs-bar-edge, .js-irs-3 .irs-bar {background: royalblue}")),
tags$style(HTML(".js-irs-4 .irs-single, .js-irs-3 .irs-bar-edge, .js-irs-4 .irs-bar {background: magenta}")),
tags$style(HTML(".js-irs-5 .irs-single, .js-irs-5 .irs-bar-edge, .js-irs-5 .irs-bar {background: seagreen}")),
# Sidebar layout with input and output definitions ----
verticalLayout(
# App title ----
# Sidebar to demonstrate various slider options ----
wellPanel(
# Input: Decimal interval with step value ----
fluidRow(
column(4, div(style="height: 20px;",
sliderInput("b1", "b1",
min = -3, max = 3,
value = 0, step = 0.1))),
column(4, sliderInput("b2", "b2",
min = -3, max = 3,
value = 0, step = 0.1)),
column(4, sliderInput("b3", "b3",
min = -3, max = 3,
value = 0, step = 0.1))),
fluidRow(
column(4, sliderInput("a1", "a1",
min = 0.20, max = 3,
value = 1, step = 0.1)),
column(4, sliderInput("a2", "a2",
min = 0, max = 3,
value = 0.70, step = 0.1)),
column(4, sliderInput("a3", "a3",
min = 0, max = 3,
value = 1.90, step = 0.1)))
),
fluidRow(
column(6,
div(style = "height=20px",
plotOutput("plot", height = "250px"))),
column(6,
div(style = "height=20px",
plotOutput("tif", height = "250px")))
)
)
),
server <- function(input, output) {
IRT <- function(theta, a = 1, b = 0, c = 0,e = 1) {
y <- c + (e - c) * exp(a * (theta - b)) / (1 + exp(a * (theta - b)))
y[is.na(y)] = 1
return(y)
}
i_info <- function(b, a=1,c=0, theta = seq(-5,5,length.out=1000)){
P <- NULL
Q <- NULL
Ii <- NULL
for(i in 1:1000){
P[i] <- 1/(1+ exp (-a*(theta[i] - b)))
Q[i]= 1-P[i]
Ii[i] =(a*Q[i]*(P[i]-c)^2)/(P[i]*((1-c)^2)) # (3PL)
}
return(Ii)
}
# Function to get all item information
item_info <- function(b,a=1){
item <- NULL
for(i in 1:length(b)){
item[[i]] <- i_info(b[i],a[i])
}
return(item)
}
output$plot <- renderPlot({
theta <- theta <- seq(-7, 7, .001)
par(mar = c(5,7,4,2) + 0.1)
b = c(input$b1, input$b2, input$b3)
a = c(input$a1, input$a2, input$a3)
c <- item_info(b,a)
Theta <- matrix(seq(-4,4, length.out=1000))
check <- data.frame(Theta,
item_info = c[[1]],
item_info2 = c[[2]],
item_info3 = c[[3]])
d1 <- do.call('cbind',c)
sum_info2 <- rowSums(d1)
plot(check$Theta, check$item_info, cex.lab= 2, main = "IIF",
cex.axis =1.5,
xlab = expression(theta), ylab = expression(paste("I(", theta, ")")),
type = "l", lwd =2,
col = "royalblue", ylim = c(0,1))
lines(check$Theta, check$item_info2, lwd =2,
col = "magenta", lty = 4)
lines(check$Theta, check$item_info3, lwd =2,
col = "seagreen", lty = 2)
# icc degli stessi item
lines(theta, IRT(theta, b=input$b1,
a=input$a1),
type = "l", lwd = 1, lty = 2,
col = "royalblue")
lines(theta, IRT(theta, b=input$b2,
a=input$a2),
type = "l", lwd = 1, lty = 2,
col = "magenta")
lines(theta, IRT(theta, b=input$b3,
a=input$a3),
type = "l", lwd = 1, lty = 2,
col = "seagreen")
})
output$tif <- renderPlot({
theta <- theta <- seq(-7, 7, .001)
par(mar = c(5,7,4,2) + 0.1)
b = c(input$b1, input$b2, input$b3)
a = c(input$a1, input$a2, input$a3)
c <- item_info(b,a)
Theta <- matrix(seq(-4,4, length.out=1000))
check <- data.frame(Theta,
item_info = c[[1]],
item_info2 = c[[2]],
item_info3 = c[[3]])
d <- do.call('cbind',c)
sum_info1 <- rowSums(d)
d1 <- do.call('cbind',c)
sum_info2 <- rowSums(d1)
Theta <- matrix(seq(-4,4, length.out=1000))
check <- data.frame(Theta, sum_info1, sum_info2)
par(mar = c(5, 4, 4, 4) + 0.3) # Leave space for z axis
plot(check$Theta, check$sum_info2,
type = "l", lwd =2,
col = "black", ylim = c(0, 2),
xlab = expression(theta),
ylab = expression(paste("I(", theta, ")")), cex.lab= 2,
cex.axis=1.5, main = "TIF")
})
# par(new = TRUE)
# plot(check$Theta, sqrt(1/check$sum_info2), cex.lab= 2,
# cex.axis =1.5,
# xlab = expression(theta), ylab = "SEM",
# type = "l", lwd =2,
# col = "firebrick")
},
options = list(height = 400)
)
```