inst/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(summaryPuntaje);

      return(
        list(
          tags$p(strong("Comenzar prueba"))#,
          # tableOutput("habilidadesMediasPorGrado")
        )
      )
    }
    
    ##### 
    ## Pantallas y calculos asociados al test
    if(input$Click.Counter > 0 & input$Click.Counter <= length(results)){
      
      if(input$Click.Counter == 1){
        startItem <- catR::startItems(bancoItems, model=NULL, theta=myTheta);
        
        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(mean(summaryPuntaje$meanHability), 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, 
                                              " (Grado:", 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({ plotICC(list(itemCodigo=itemCodigo)) })
      output$plotCurvaInformacion <- renderPlot({ plotInformationCurve(itemCodigo) })
      
      output$evolucionTheta <- renderPlot({
        
        if((input$Click.Counter-1) == 0){
          misRespuestas <- "Inicial"
        } else {
          misRespuestas <- c(results[1:(input$Click.Counter-1)], "Parcial")
        }
        
        myPlotData <- data.frame(theta=c(mean(summaryPuntaje$meanHability), resultsTheta[2: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, (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("respuesta", "Please Select:", 
                                  choices=qlist, inline=TRUE, selected=NULL)
            ),
            tabPanel("Debug",
                     tags$p(strong("Items aplicados:")),
                     verbatimTextOutput("itemsAplicadosOut"),
                     tags$p(strong("Respuestas:")),
                     verbatimTextOutput("resultsOut"),
                     tags$p(strong("Theta estimado:")),
                     verbatimTextOutput("resultsThetaOut"),
                     tags$p(strong("Input:")),
                     verbatimTextOutput("inputOut")
            ),
            tabPanel("Evolucion 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(mean(summaryPuntaje$meanHability), 1)
      );
      
      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, (myCatLength + 1))) + ylim(c(-4, 4));
        
        print(gg)
      })
      
      return(
        list(          
          tabsetPanel(
            tabPanel("Resultados",
                     h4("View aggregate results"),
                     tableOutput("surveyresults"),
                     plotOutput("evolucionTheta")
            ),
            tabPanel("Debug",
                     tags$p(strong("Items aplicados:")),
                     verbatimTextOutput("itemsAplicadosOut"),
                     tags$p(strong("Respuestas:")),
                     verbatimTextOutput("resultsOut"),
                     tags$p(strong("Theta estimado:")),
                     verbatimTextOutput("resultsThetaOut")
            )
          )
        )
      )
    }
  })
  
  
  # 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=myCatLength); # nrow(items))
    resultsTheta <<- rep(NA, length=myCatLength);
    itemsAplicados <<- rep(NA, length=myCatLength);
    }

    # After each click, 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)
  })
  
})