server.R

In chi2labs/CATdemo: CATdemo

shinyServer(function(input, output, session) {
  
  # This renderUI function holds the primary actions of the
  # survey area.
  output$MainAction <- renderUI( {
    dynamicUi()
  })
  
  # Dynamic UI is the interface which changes as the survey
  # progresses.  
  dynamicUi <- reactive({
    
    ## Armo objeto para manejar la composicion de la prueba segun Competencias
    myInd <- which(substr(names(input), 1, 8) == "myWeigth");
    weights <- NULL
    for(i in myInd) weights <- c(weights, input[[names(input)[i]]])
    if(sum(weights) == 0){
      cbList <- NULL;
    } else {
      cbList <- list(names = unique(bancoItems$Group), 
                     props = weights);
    }
    
    ##### 
    ## Pantalla inicial
    if(input$Click.Counter == 0){
      
      ## summary de habilidades por grado.
      myItems <- bancoItems;
      output$habilidadesMediasPorGrado <- 
        renderTable({
          names(summaryPuntaje) <- c("Grade Code", "Grade", "Count", "Avg. Ability");
          summaryPuntaje}
        )
      
      return(
        list(
          tags$p(strong("Ability Estimate by Grade")), #note that I removed the word "difficulty" as this is assumed in the estimate def.
          tableOutput("habilidadesMediasPorGrado")
        )
      )
    }
    
    ##### 
    ## Pantallas y calculos asociados al test
    if(input$Click.Counter > 0 & input$Click.Counter <= length(results)){
      
      if(input$Click.Counter == 1){
        myTheta <<- input$thetaInicial
        startItem <- catR::startItems(bancoItems, model=NULL, theta=myTheta, 
                                      cbControl=cbList,
                                      cbGroup = bancoItems$Group);
        
        itemCodigoPosicionBanco <<- startItem$items;
        itemCodigo <<- bancoItems$ItemCodigo[startItem$items];
      } else {
        
        cat(itemsAplicados, "\n");
        cat(resultsTheta, "\n");
        cat(results, "\n");
        
        auxTheta <- catR::eapEst(it=bancoItems[itemsAplicados[complete.cases(itemsAplicados)], ], 
                                 x=results[1:(input$Click.Counter-1)], # vector de respuestas con nombre
                                 priorDist="norm", # priorPar parametros a priori 
                                 priorPar=c(summaryPuntaje$meanHability[which(summaryPuntaje$GradoCodigo == input$grado)], 1) );
        
        myTheta <<- auxTheta;
        
        myNextItem <- catR::nextItem(itemBank=bancoItems, 
                                     model=NULL, # NULL (default) for dichotomous models
                                     theta=myTheta, 
                                     out=itemsAplicados[complete.cases(itemsAplicados)], # items respondidos (posicion en banco items)
                                     x=results[1:(input$Click.Counter-1)], # vector de respuestas
                                     criterion="MFI", # criterio de seleccion del proximo item
                                     # MFI maximum Fisher information
                                     # MEI maximum expected information
                                     cbControl=cbList,
                                     cbGroup = bancoItems$Group );
        
        itemCodigoPosicionBanco <<- myNextItem$item;
        itemCodigo <<- bancoItems$ItemCodigo[myNextItem$item];
      }
      
      Item <- buildItem(itemCodigo);
      
      qlist <- toupper(Item$ItemOpcion$ItemOpcionCredito);
      names(qlist) <- paste0(Item$ItemOpcion$ItemOpcionCodigo, ") ", Item$ItemOpcion$ItemOpcionTexto);
      qlist;
      
      output$itemTitulo <- renderText({ paste(Item$Item$ItemCodigo, ": ",
                                              Item$Item$ItemTitulo, 
                                              " (Grade:", Item$Item$GradoCodigo, ")", sep="") })
      
      output$itemsAplicadosOut <- renderText(itemsAplicados)
      output$resultsOut <- renderText(results[1:(input$Click.Counter-1)])
      output$resultsThetaOut <- renderText(resultsTheta)
      
      ### cosas para debug.
      
      output$plotICC <- renderPlot({ plotICCEng(list(itemCodigo=itemCodigo)) })
      output$plotCurvaInformacion <- renderPlot({ plotInformationCurve(itemCodigo) })
      
      output$evolucionTheta <- renderPlot({
        
        if((input$Click.Counter-1) == 0){
          misRespuestas <- "Initial"
        } else {
          misRespuestas <- c(results[1:(input$Click.Counter-1)], "Partial") #is this the right word? 
        }
        
        myPlotData <- data.frame(theta=resultsTheta[1:length(misRespuestas)], 
                                 respuesta=misRespuestas,
                                 posicion=1:length(misRespuestas)
        )
        
        myPlotData <- myPlotData[complete.cases(myPlotData), ];
        
        gg <- ggplot(myPlotData, aes(x=posicion, y=theta, label=respuesta)) + 
          geom_point() + geom_text(aes(label=respuesta), hjust=0, vjust=0) +
          geom_line(aes(x=posicion, y=theta)) + 
          geom_hline(data=summaryPuntaje, alpha=0.4, aes(yintercept=meanHability, color=Grado)) + 
          xlim(c(0, (input$myCatLength + 1))) + ylim(c(-4, 4));
        
        print(gg)
      })
      
      output$clickCounter <- renderText(input$Click.Counter);
      
      return(
        list(
          tabsetPanel(
            tabPanel("Item",
                     verbatimTextOutput("clickCounter"),
                     br(),
                     verbatimTextOutput("itemTitulo"),
                     br(),
                     if(!is.null(Item$myFileTexto)) shiny::includeHTML(Item$myFileTexto),
                     br(),
                     shiny::includeHTML(Item$myFile),
                     br(),
                     br(),
                     radioButtons("Answer", "Please Select:", 
                                  choices=qlist, inline=TRUE, selected=NULL)
            ),
            tabPanel("Debug",
                     tags$p(strong("Items Applied:")),
                     verbatimTextOutput("itemsAplicadosOut"),
                     tags$p(strong("Answers:")),
                     verbatimTextOutput("resultsOut"),
                     tags$p(strong("Theta Estimate:")),
                     verbatimTextOutput("resultsThetaOut"),
                     tags$p(strong("Input:")),
                     verbatimTextOutput("inputOut")
            ),
            tabPanel("Development of Theta",
                     plotOutput("evolucionTheta")
            ),
            tabPanel("Item Info",
                     plotOutput("plotICC"),
                     plotOutput("plotCurvaInformacion")
            )
          )
        )
      )
    }
    
    ##### 
    ## Pantalla final de resultados
    if(input$Click.Counter > length(results)){
      
      myThetaFinal <- catR::eapEst(it=bancoItems[itemsAplicados[complete.cases(itemsAplicados)], ], 
                                   x=results[1:(input$Click.Counter-1)], # vector de respuestas con nombre
                                   priorDist="norm", # priorPar parametros a priori 
                                   priorPar=c(summaryPuntaje$meanHability[which(summaryPuntaje$GradoCodigo == input$grado)], 
                                              summaryPuntaje$meanHability[which(summaryPuntaje$GradoCodigo == input$grado)])
      );
      
      output$evolucionTheta <- renderPlot({
        
        misRespuestas <- c(results, "Final");
        myPlotData <- data.frame(theta=c(resultsTheta, myThetaFinal), 
                                 respuesta=misRespuestas,
                                 posicion=1:length(misRespuestas)
        );
        
        gg <- ggplot(myPlotData, aes(x=posicion, y=theta, label=respuesta)) + 
          geom_point() + geom_text(aes(label=respuesta), hjust=0, vjust=0) +
          geom_line(aes(x=posicion, y=theta)) + 
          geom_hline(data=summaryPuntaje, alpha=0.4, aes(yintercept=meanHability, color=Grado)) + 
          xlim(c(0, (input$myCatLength + 1))) + ylim(c(-4, 4)) + 
          xlab("Position") + 
          ylab("Estimated Theta") + 
          labs(fill = "Grade");
        
        
        print(gg)
      })
      
      return(
        list(          
          tabsetPanel(
            tabPanel("Results",
                     h4("View aggregate results"),
                     tableOutput("Survey Results"), #likely wrong translation
                     plotOutput("Development of Theta")
            ),
            tabPanel("Debug",
                     tags$p(strong("Items Applied:")),
                     verbatimTextOutput("itemsAplicadosOut"),
                     tags$p(strong("Answers:")),
                     verbatimTextOutput("Results"),
                     tags$p(strong("Theta estimate:")),
                     verbatimTextOutput("Theta Results")
            )
          )
        )
      )
    }
  })
  
  
  # This reactive function is concerned primarily with
  # saving the results of the survey for this individual.
  output$save.results <- renderText({
    
    if(input$Click.Counter == 0){
      # Create an empty vector to hold survey results
      results <<- rep(NA, length=input$myCatLength); # nrow(items))
      resultsTheta <<- rep(NA, length=input$myCatLength);
      itemsAplicados <<- rep(NA, length=input$myCatLength);
    }
    
    # After each lclick, save the results of the radio buttons.
    if((input$Click.Counter > 0) & (input$Click.Counter <= length(results))){
      results[input$Click.Counter] <<- as.numeric(input$respuesta);
      resultsTheta[input$Click.Counter] <<- myTheta;
      itemsAplicados[input$Click.Counter] <<- itemCodigoPosicionBanco;
      names(results)[input$Click.Counter] <<- as.character(itemCodigo);
    }
    # Because there has to be a UI object to call this
    # function I set up render text that distplays the content
    # of this funciton.
    ""
  })
  
  # This function renders the table of results from the test
  output$surveyresults <- renderTable({
    t(results)
  })
  
})