R shiny app for questionInfo

server.R

library(shiny)
library(dplyr)
library(rmongodb)
library(googleVis)

sethost<-""
setdb_platform<-""
setdb_103exam<-""
setdb_102exam<-""
setdbUser<-""
setdbPW<-""

########################################################

source(paste0(getwd(),"/commonFunctions.R"))

gbarColor<-function(ans,optionNum) {  
  ans<-ans+1
  if (optionNum==4 ) {
    setColor<-rep('blue',5)
  } else  {
    setColor<-rep('blue',6)
  }  
  setColor[ans]<-'red'
  setColor<-paste0("['",paste(setColor,collapse="','"),"']")    
  return(setColor)
}

########################################################

shinyServer(function(input, output) {   
  
  getQuestionCounters103 <- reactive({
      # load QuestionCounters Data    
      mongo <- mongo.create(host=sethost,db=setdb_103exam,username = setdbUser,password = setdbPW)
      collections_name<-mongo.get.database.collections(mongo,setdb_103exam)
            
      index_collection<-which(collections_name==paste(setdb_103exam,".QuestionCounters",sep=""))         
      count<-mongo.count(mongo,collections_name[index_collection],list(total=list('$gte'=50)))
      cursor<- mongo.find(mongo,collections_name[index_collection],list(total=list('$gte'=50)),limit=count)
      
      QuestionCounters.question<-rep(NA,count)
      QuestionCounters.total<-rep(NA,count)
      QuestionCounters.right<-rep(NA,count)
      QuestionCounters.duration<-rep(NA,count)
      
      i<-0
      while (mongo.cursor.next(cursor)) {
        i<-i+1 
        QuestionCounters.question[i]<-mongo.oid.to.string(mongo.bson.to.list(mongo.cursor.value(cursor))$'_id') 
        QuestionCounters.total[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$total)
        QuestionCounters.right[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$right)
        QuestionCounters.duration[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$duration)
      }
      
      QuestionCountersDat<-data.frame(question=QuestionCounters.question,
                                      total=QuestionCounters.total,
                                      right=QuestionCounters.right,
                                      rate=round(QuestionCounters.right/QuestionCounters.total,digits = 2),
                                      duration=QuestionCounters.duration/1000,
                                      stringsAsFactors = F)
      return(QuestionCountersDat) 
      })
  
  getQuestionCounters102 <- reactive({
    # load QuestionCounters Data    
    mongo <- mongo.create(host=sethost,db=setdb_102exam,username = setdbUser,password = setdbPW)
    collections_name<-mongo.get.database.collections(mongo,setdb_102exam)
    
    index_collection<-which(collections_name==paste(setdb_102exam,".QuestionCounters",sep=""))         
    count<-mongo.count(mongo,collections_name[index_collection],list(total=list('$gte'=50)))
    cursor<- mongo.find(mongo,collections_name[index_collection],list(total=list('$gte'=50)),limit=count)
    
    QuestionCounters.question<-rep(NA,count)
    QuestionCounters.total<-rep(NA,count)
    QuestionCounters.right<-rep(NA,count)
    QuestionCounters.duration<-rep(NA,count)
    
    i<-0
    while (mongo.cursor.next(cursor)) {
      i<-i+1 
      QuestionCounters.question[i]<-mongo.oid.to.string(mongo.bson.to.list(mongo.cursor.value(cursor))$'_id') 
      QuestionCounters.total[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$total)
      QuestionCounters.right[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$right)
      QuestionCounters.duration[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$duration)
    }
    
    QuestionCountersDat<-data.frame(question=QuestionCounters.question,
                                    total=QuestionCounters.total,
                                    right=QuestionCounters.right,
                                    rate=round(QuestionCounters.right/QuestionCounters.total,digits = 2),
                                    duration=QuestionCounters.duration/1000,
                                    stringsAsFactors = F)
    return(QuestionCountersDat) 
  })
  
  getQuestion <- reactive({
    # load Questions Data
    if (input$yearSummary==103) {
      setdb_exam<-setdb_103exam
    } else if (input$yearSummary==102) {
      setdb_exam<-setdb_102exam
    }
    mongo <- mongo.create(host=sethost,db=setdb_exam,username = setdbUser,password = setdbPW)
    collections_name<-mongo.get.database.collections(mongo,setdb_exam)
    
    index_collection<-which(collections_name==paste(setdb_exam,".Questions",sep=""))         
    count<-mongo.count(mongo,collections_name[index_collection],list('_id'=mongo.oid.from.string(input$inputQuestionID)))
    if (count>0) {
      cursor<- mongo.find(mongo,collections_name[index_collection],list('_id'=mongo.oid.from.string(input$inputQuestionID)),limit=count)
      
      Questions.subject<-rep(NA,count)
      Questions.genre<-rep(NA,count)
      Questions.difficult<-rep(NA,count)
      Questions.answers<-vector("list",count)
      Questions.optionNumber<-vector("list",count)
      Questions.question<-rep(NA,count)
      Questions.options<-rep(NA,count)
      
      i<-0
      while (mongo.cursor.next(cursor)) {
        i<-i+1
        Questions.subject[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$subject)
        Questions.genre[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$genre)
        Questions.difficult[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$difficult)
        Questions.answers[[i]]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$answers)
        Questions.optionNumber[i]<-length(mongo.bson.to.list(mongo.cursor.value(cursor))$options)
        Questions.question<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$question)
        Questions.options<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$options)
      }
      for (j in 1:length(Questions.options)) {
        Questions.options[j]<-gsub("<p>",paste0("<p> (",LETTERS[j],")  "),Questions.options[j])
      }
      
      QuestionsDat<-list(subject=Questions.subject,
                         genre=Questions.genre,
                         difficult=Questions.difficult,
                         answers=Questions.answers,
                         optionNumber=Questions.optionNumber,
                         question=Questions.question,
                         options=Questions.options,
                         stringsAsFactors = F)      
    } else {
      QuestionsDat<-NULL
    }
    return(QuestionsDat)
  })
      
  getQuestionExam <- reactive({   
    if (input$yearSummary==103) {
      setdb_exam<-setdb_103exam
    } else if (input$yearSummary==102) {
      setdb_exam<-setdb_102exam
    }
    mongo <- mongo.create(host=sethost,db=setdb_exam,username = setdbUser,password = setdbPW)
    collections_name<-mongo.get.database.collections(mongo,setdb_exam)
        
    index_collection<-which(collections_name==paste(setdb_exam,".ExamPapers",sep=""))         
    count<-mongo.count(mongo,collections_name[index_collection],list(questions=list('$regex'=input$inputQuestionID)))
    if (count>0) {
      cursor<- mongo.find(mongo,collections_name[index_collection],list(questions=list('$regex'=input$inputQuestionID)),limit=count)
      
      ExamPapers.id<-rep(NA,count)
      ExamPapers.questionIndex<-rep(NA,count)
      
      i<-0
      while (mongo.cursor.next(cursor)) {
        i<-i+1  
        ExamPapers.id[i]<-mongo.oid.to.string(mongo.bson.to.list(mongo.cursor.value(cursor))$'_id')
        ExamPapers.questionIndex[i]<-which(checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$questions)==input$inputQuestionID)
      }
      
      index_collection<-which(collections_name==paste(setdb_exam,".ExamAnswers",sep=""))         
      count<-mongo.count(mongo,collections_name[index_collection],list(examPaper=list('$in'=ExamPapers.id),finished=TRUE,enabled=TRUE))
      cursor<- mongo.find(mongo,collections_name[index_collection],list(examPaper=list('$in'=ExamPapers.id),finished=TRUE,enabled=TRUE),limit=count)
      
      ExamAnswers.examPaper<-rep(NA,count)
      ExamAnswers.subject<-rep(NA,count)
      ExamAnswers.volume<-rep(NA,count)
      ExamAnswers.type<-rep(NA,count)
      ExamAnswers.answer<-vector("list",count)
      ExamAnswers.duration<-rep(NA,count)
      ExamAnswers.right<-rep(NA,count)
      
      i<-0
      while (mongo.cursor.next(cursor)) {
        i<-i+1  
        ExamAnswers.examPaper[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$examPaper)
        ExamAnswers.subject[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$subject)
        ExamAnswers.volume[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$volume)
        ExamAnswers.type[i]<-checkData(mongo.bson.to.list(mongo.cursor.value(cursor))$type)
        ExamAnswers.answer[[i]]<-LETTERS[as.numeric(checkData(unlist(mongo.bson.to.list(mongo.cursor.value(cursor))$answers[ExamPapers.questionIndex[which(ExamPapers.id==ExamAnswers.examPaper[i])]])))+1]
        ExamAnswers.duration[i]<-checkData(unlist(mongo.bson.to.list(mongo.cursor.value(cursor))$durations[ExamPapers.questionIndex[which(ExamPapers.id==ExamAnswers.examPaper[i])]]))
        ExamAnswers.right[i]<-checkData(unlist(mongo.bson.to.list(mongo.cursor.value(cursor))$rights[ExamPapers.questionIndex[which(ExamPapers.id==ExamAnswers.examPaper[i])]]))
      }
      
      ExamAnswersDat<-list(examPaper=ExamAnswers.examPaper,
                                 type=ExamAnswers.type,
                                 volume=ExamAnswers.volume,                           
                                 answer=ExamAnswers.answer,
                                 duration=round(ExamAnswers.duration/1000),
                                 right=ExamAnswers.right,                           
                                 stringsAsFactors = F)      
      ExamAnswersDat$answer[which(is.na(ExamAnswersDat$answer))]<-"無作答"
    } else {
      ExamAnswersDat<-NULL
    }   
    return(ExamAnswersDat)
    })
  
  output$questionCountTable <- renderDataTable({
    if (input$yearCountTable==103) {
      getQuestionCounters103()
    } else if (input$yearCountTable==102) {
      getQuestionCounters102()
    }   
  },options = list(aLengthMenu = c(5,10,25,100)))
  
  output$questionText <- renderUI({
    if (nchar(input$inputQuestionID)==24) {
      QuestionDat<-getQuestion()
      if (!is.null(QuestionDat)) {
        questionText<-HTML(paste0(
          "試題科目 : ",QuestionDat$subject,"  |  試題難度 : ",QuestionDat$difficult,"  |  試題類型 : ",QuestionDat$genre,"<br/>",
          "試題題目 : <br/>",
          QuestionDat$question,"<br/>",          
          #paste0("(",LETTERS[c(1:length(QuestionDat$options))],") ",QuestionDat$options,collapse="<br/>")
          paste0(QuestionDat$options,collapse="<br/>")
          ))
        
      } else {
        questionText<-"沒有此試題"
      }      
    } else {
      questionText<-"沒有此試題"
    }       
    return(questionText)
  })
  
  output$questionSummary <- renderPrint({
    summaryList<-"無人作此題"
    if (nchar(input$inputQuestionID)==24) {
      ExamAnswersDat<-getQuestionExam()      
      if (!is.null(ExamAnswersDat)) {
        summaryList<-vector("list",2)
        names(summaryList)<-c('type' , 'summary')
        summaryList$summary<-summary(as.data.frame(ExamAnswersDat[c('duration','right')]))
        summaryList$type<-table(ExamAnswersDat$type)        
      }       
    } 
    return(summaryList)
  })
  
  output$questionCountPlot <- renderPlot({  
    if (nchar(input$inputQuestionID)==24) { 
      if (input$yearSummary==103) {
        QuestionCountersDat<-getQuestionCounters103()
      } else if (input$yearSummary==102) {
        QuestionCountersDat<-getQuestionCounters102()
      }      
      ExamAnswersDat<-getQuestionExam()
      if (!is.null(QuestionCountersDat)) {
        hist(QuestionCountersDat$rate,xlab="rightRate",ylab="question count",main="rightRate Distribution")
        abline(v=round(sum(ExamAnswersDat$right)/length(ExamAnswersDat$right),digits = 2),lwd=3,col="red")        
      }
    }      
  })
  
  output$questionItemPlot <- renderGvis({  
    if (nchar(input$inputQuestionID)==24) {
      ExamAnswersDat<-getQuestionExam()  
      QuestionsDat<-getQuestion()
      if (!is.null(ExamAnswersDat)) {
        tmptable<-table(unlist(ExamAnswersDat['answer']))
        if (QuestionsDat$optionNumber==4) {          
          A<-data.frame(Var="count",
                        A=as.numeric(tmptable['A']),
                        B=as.numeric(tmptable['B']),
                        C=as.numeric(tmptable['C']),
                        D=as.numeric(tmptable['D']),
                        '無作答'=as.numeric(tmptable['無作答']),
                        stringsAsFactors = F)
        } else {
          A<-data.frame(Var="count",
                        A=as.numeric(tmptable['A']),
                        B=as.numeric(tmptable['B']),
                        C=as.numeric(tmptable['C']),
                        D=as.numeric(tmptable['D']),
                        E=as.numeric(tmptable['E']),
                        '無作答'=as.numeric(tmptable['無作答']),
                        stringsAsFactors = F)
        }
        
        gvisplot<-gvisColumnChart(A,
                                  options=list(
                                    width=500,
                                    colors=gbarColor(unlist(QuestionsDat$answers),QuestionsDat$optionNumber))
        )      
      }
    }      
  })
  
})

ui.R

shinyUI(
  navbarPage("eHanlin",
             tabPanel("試題作答次數",
                      sidebarLayout(
                        sidebarPanel(
                          radioButtons("yearCountTable", "select year",
                                       choices = c(103,102)),
                          hr(),
                          submitButton('search'),
                          width=3
                        ),
                        mainPanel(
                          dataTableOutput('questionCountTable')                                                    
                        )
                      )
             ),
             tabPanel("單一試題作答統計",
                      sidebarLayout(
                        sidebarPanel(
                          radioButtons("yearSummary", "select year",
                                       choices = c(103,102)),
                          textInput("inputQuestionID", "Input Question ID", ""),                          
                          submitButton('search'),
                          width=3
                        ),
                        mainPanel(
                          h4('試題基本資訊'),
                          htmlOutput("questionText"),
                          h4('試題作答摘要'),
                          verbatimTextOutput('questionSummary'),
                          htmlOutput("questionItemPlot"),
                          plotOutput("questionCountPlot",height = "250px")                                                    
                        )
                      )
             )     
  )
)