```{r, setup, include=FALSE}
library(knitr)
library(shiny)
library(ggplot2)
library(tidyverse)
library(emoji)
hexes <- function(x) {
  x <- rev(sort(x))
  markup <- function(img) glue::glue('<img width="10%" height="10%" src="www/{img}.jpg" class="title-hex">')
  res <- purrr::map_chr(x, markup)
  paste0(res, collapse = "")
}
IRT <- function(theta, a = 1, b = 0, c = 0,e = 1) {
  y <- c + (e - c) * exp(a * (theta - b)) / (1 + exp(a * (theta - b)))
  return(y)
}
# calcola l'IIF per un item specifico
i_info <- function(b, a=1,c=0, e= 1,  theta = seq(-5,5,length.out=1000)){
  Ii = (a^2)*IRT(theta, b = b, a = a, e = e )*(1- IRT(theta, b = b, a = a, e = e ))
  return(Ii)
}
# calcola l'IIF di tutti gli item e restituisce in una lista di lunghezza ugaule a tutti 
# gli item per cui si è calcolata l'IIF
item_info <- function(ipar, theta = seq(-5,5,length.out=1000)){
  item <- NULL
  if (any(colnames(ipar) == "e")) {
    for(i in 1:nrow(ipar)){
      item[[i]] <- i_info(b = ipar[i, "b"],a = ipar[i, "a"], e = ipar[i, "e"], theta = theta)
    } 
  } else {
    for(i in 1:nrow(ipar)){
      item[[i]] <- i_info(b = ipar[i, "b"],a = ipar[i, "a"], theta = theta)
    }
  }
  item = data.frame(do.call("cbind", item))
  colnames(item) = rownames(ipar)
  return(item)
}
set.seed(999)
```

## Intuitively 

```{r}
#| panel: sidebar
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}"))


 sliderInput("b1", "b1",
                  min = -3, max = 3,
                  value = 0, step = 0.1)
sliderInput("b2", "b2",
                  min = -3, max = 3,
                  value = -1, step = 0.1)
sliderInput("b3", "b3",
                  min = -3, max = 3,
                  value = 1, step = 0.1)

sliderInput("a1", "a1",
                  min = 0.20, max = 3,
                  value = 1, step = 0.1)
sliderInput("a2", "a2",
                  min = 0, max = 3,
                  value = 1, step = 0.1)
sliderInput("a3", "a3",
                  min = 0, max = 3,
                  value = 1, step = 0.1)
checkboxInput("showTif", "Show Test Information Function", value = FALSE)

```

```{r}
#| panel: fill


plotOutput("plot", height = "300px")

plotOutput("tif", height = "300px")
```



```{r}
#| context: server
 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)

 
 plot(theta, IRT(theta, b = input$b1, a = input$a1), 
                 type = "l", lwd = 2, lty = 2,
     col = "royalblue", main = "Item Characteristics Curves - ICCs", 
     ylab = expression(paste("P(", x[p][i],  "= 1|", theta[p], ", ", b[i], ", ", a[i], ")")), 
     xlab = expression(theta), 
     cex.lab = 1.4, 
     cex.main = 2, 
     cex.text=1.2, cex.axis=1)
 
segments(min(theta)-3, 0.5, 
         input$b1, 0.5, 
         col = "gray56", lty = 3, lwd = 1.3)
segments(input$b1, -0.5, 
         input$b1, 0.5, 
         col = "royalblue", lty = 3, lwd = 1.3)
 
lines(theta, IRT(theta, b=input$b2,
                 a=input$a2),
       type = "l", lwd = 2, lty = 2,
     col = "magenta")
 lines(theta, IRT(theta, b=input$b3,
                 a=input$a3),
       type = "l", lwd = 2, lty = 2,
     col = "seagreen")
 segments(min(theta)-3, 0.5, 
         input$b2, 0.5, 
         col = "gray56", lty = 3, lwd = 1.3)
segments(input$b2, -0.5, 
         input$b2, 0.5, 
         col = "magenta", lty = 3, lwd = 1.3)
 segments(min(theta)-3, 0.5, 
         input$b3, 0.5, 
         col = "gray56", lty = 3, lwd = 1.3)
segments(input$b3, -0.5, 
         input$b3, 0.5, 
         col = "seagreen", lty = 3, lwd = 1.3)
  })

output$tif <- renderPlot({
 
Theta <- matrix(seq(-4,4, length.out=1000))
  par(mar = c(5,7,4,2) + 0.1)
parameters = data.frame(b = c(input$b1, input$b2, input$b3), a = c(input$a1, input$a2, input$a3))
c <- item_info(parameters, theta = Theta)
check <- data.frame(Theta,
                    item_info = c[[1]],
                    item_info2 = c[[2]],
                    item_info3 = c[[3]])
d <- c
sum_info1 <- rowSums(d)
d1 <- c
sum_info2 <- rowSums(d1)
plot(check$Theta, check$item_info, cex.lab= 2, main = "Item Information Functions - IIFs",
     cex.lab = 1.4, 
     cex.main = 2, 
     cex.text=1.2, cex.axis=1,
        xlab = expression(theta), ylab = expression(paste("IIF"[i])),
 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)
 
 
checkTif <- data.frame(Theta, sum_info1, sum_info2)

if (input$showTif == TRUE) {
  plot(checkTif$Theta, checkTif$sum_info2,
       type = "l", lwd =2,
     col = "black", ylim = c(0, 2),
       xlab = expression(theta), 
     ylab = expression(paste("I(", theta, ")")), 
     cex.axis=1.5, main = "IIFs and Test Information Functions",  
      cex.lab = 1.4, 
     cex.main = 2, 
     cex.text=1.2, cex.axis=1)
  lines(check$Theta, check$item_info, lwd =2,
       col = "royalblue", lty = 4)
   lines(check$Theta, check$item_info2, lwd =2,
       col = "magenta", lty = 4)
 lines(check$Theta, check$item_info3, lwd =2,
       col = "seagreen", lty = 2)
}



 
})
```
