#
# This is a Shiny web application that demonstrates the basic procedures 
# of building an automated scoring model. 
# You can run the application by clicking
# the 'Run App' button above.
# Author details: Author: Amy Burkhardt, Contact details: amy.burkhardt@colorado.edu

packages <- c("shiny", "psych", "nnet")
if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
  install.packages(setdiff(packages, rownames(installed.packages())))  
}

library("nnet")
library("psych")
library("shiny")

dat <- read.csv("asap_demo.csv")
essay1 <- subset(dat, dat$essay_set == 1)
essay2 <- subset(dat, dat$essay_set == 2)


# Define UI for the application
ui <- fluidPage(
  
  # Application title
  titlePanel("Building an Automated Scoring Model"),
  
  # Sidebar with dropdowns, sliders, and action buttons 
  sidebarLayout(
    sidebarPanel(
      titlePanel(h4("Tab 1")),
      selectInput(inputId = "essay",
                  label = "Select an ASAP Prompt:",
                  choices = c("essay1", "essay2")),
      
      selectInput(inputId = "essayid",
                  label = "Select an Essay to View:",
                  choices = c("id_1", "id_2", "id_3", "id_4", "id_5")),
      
      
      titlePanel(h4("Tab 2")),
      sliderInput(inputId = "sample", 
                  label = "Test Set Sample Size (%):", 
                  min = 10, max = 50, value = 30),
      
      titlePanel(h4("Tab 3")),
      checkboxGroupInput(inputId = "features", 
                         label = "Select the Features (Counts):",
                         choiceValues  = list(
                           "comma_count",
                           "discourse_sum",
                           "VBD_count",
                           "lang_error_count",
                           "unique_word_count"),
                         choiceNames  = list("Commas",
                                             "Discourse Elements",
                                             "Verbs (Past Tense)",
                                             "Grammatical Errors",
                                             "Unique Words"),
                         selected = "comma_count"
      ),
      
      
      selectInput(inputId = "classifier",
                  label = "Choose a classifier:",
                  choices = c("Linear Regression", "Logistic Regression"),
                  selected = "Linear Regression"),
      
      
      actionButton(inputId = "build", 
                   label = "Build model"),
      
      
      actionButton(inputId = "reset", 
                   label = "Reset")
    ),
    
    
    
    # Show a plot of 
    mainPanel(
      
      tabsetPanel(type = "tabs",
                  
                  
                  tabPanel("Tab 1: Preprocess and Extract Features",
                           h4(textOutput("features")),
                           h6(tableOutput("Features")),
                           h4(textOutput("unprocessed")),
                           h6(textOutput("Essay")),
                           h4(textOutput("processed")),
                           h6(textOutput("Preprocessed")),
                           h4(textOutput("tokenized")),
                           h6(textOutput("Tokenization")),
                           h4(textOutput("pos_tag")),
                           h6(textOutput("parts_of_speech")),
                  ),
                  
                  tabPanel("Tab 2: Descriptive Statistics of Samples",
                           h4(textOutput("spd")),
                           plotOutput("summarize", height = "150px"),
                           h4(textOutput(("comma_count"))),
                           plotOutput("describe.comma_count", height = "200px"), 
                           h4(textOutput(("discourse_sum"))),
                           plotOutput("describe.discourse_sum", height = "200px"), 
                           h4(textOutput(("VBD_count"))),
                           plotOutput("describe.VBD_count", height = "200px"), 
                           h4(textOutput(("lang_error_count"))),
                           plotOutput("describe.lang_error_count", height = "200px"),
                           h4(textOutput(("unique_word_count"))),
                           plotOutput("describe.unique_word_count", height = "200px"), 
                  ),
                  
                  tabPanel("Tab 3: Test Results",
                           h4(textOutput("agree.title")),
                           h4(tableOutput("agreement")),
                           h4(textOutput("kappa.title")),
                           tableOutput("kappa.table"),
                           h4(textOutput("std.mean.diff.title")),
                           tableOutput("std.mean.diff.table"),
                           h4(textOutput("spd.hist")),
                           plotOutput("spd.test", height = "200px"),
                           h4(textOutput("con.matrix")),
                           h4(tableOutput("confusion")))
                  
                  
                  
                  
      ))))

# Define server logic
server <- function(input, output, session) {
  
  essayInput <- reactive ({
    switch(input$essay, 
           "essay1" = essay1, 
           "essay2" = essay2)
    
  })
  
  essayID <- reactive({
    switch(input$essayid,
           "id_1" = 1, "id_2" = 2, "id_3" = 3, "id_4" = 4, "id_5"=5)
  })
  
  classifierInput <- reactive ({
    switch(input$classifier,
           "Linear Regression" = "linear",
           "Logistic Regression" = "logistic")
  })
  
  
  
  
  
  ###################
  # Preprocessing
  ###################
  
  output$features <- renderText("Extracted Features")
  output$Features <- renderTable ({
    
    df <- subset(essayInput(), !is.na(essayInput()$essay))
    
    df <- cbind.data.frame( 
      
      "Rater 1 Score" = df$rater1_domain1,
      "essay_id" = df$essay_id,
      "Commas"= df$comma_count,
      "Discourse Elements"= df$discourse_sum,
      "Verbs (Past Tense)"=df$VBD_count,
      "Grammatical Errors" =df$lang_error_count,
      "Unique Words"= df$unique_word_count
      
    )
    
    df <-df[essayID(),]
    
    df
    
  })
  output$unprocessed <- renderText("Unprocessed Essay")
  output$Essay <- renderText({
    df <- subset(essayInput(), !is.na(essayInput()$essay))
    as.character(df$essay)[essayID()]
  })
  
  output$tokenized <- renderText("Sentence Tokenization")
  output$Tokenization <- renderText ({
    df <- subset(essayInput(), !is.na(essayInput()$essay_sentences))
    as.character(df$essay_sentences)[essayID()]
  })
  
  
  output$processed <- renderText("Processed Essay")
  output$Preprocessed <- renderText ({
    df <- subset(essayInput(), !is.na(essayInput()$essay_processed))
    as.character(df$essay_processed)[essayID()]
  })
  
  
  output$pos_tag <- renderText("Parts of Speech Tags")
  output$parts_of_speech <- renderText ({
    df <- subset(essayInput(), !is.na(essayInput()$essay_pos_tag))
    as.character(df$essay_pos_tag)[essayID()]
  })
  
  
  ###################
  # Sampling
  ###################
  
  
  samplesize <- reactive({
    input$sample
  })
  
  sampling <- reactive ({
    smp_size = floor(samplesize()/100 * nrow(essayInput()))
    test_ind <- sample(seq_len(nrow(essayInput())), size = smp_size)
    
  })
  
  
  test <- reactive({
    test <- essayInput()[sampling(), ]
  })
  
  train <- reactive({
    train <- essayInput()[-sampling(), ]
  })
  
  output$spd <- renderText({
    print("Score Point Distribution" )
    
  })
  
  output$summarize <- renderPlot({
    par(mfrow=c(1,3)) 
    barplot(prop.table(table(train()$rater1_domain1)), 
            main = paste("Train Sample \n n =",nrow(train())),
            col = "#D3DDDC")
    
    barplot(prop.table(table(test()$rater1_domain1)), 
            main = paste("Test Sample \n n =",nrow(test())),
            col = "#C7B19C")
    
  }) 
  
  ###################
  # Features
  ###################
  
  features <- reactive({
    vars <- input$features
  })
  
  
  
  output$view <- renderTable({
    head(test(), n = 0)
  }) 
  
  
  output$comma_count <- renderText({
    print("Commas")
  }) 
  
  output$describe.comma_count <- renderPlot({
    
    par(mfrow=c(1,3)) 
    
    hist(subset(train()$comma_count, train()$comma_count < 100), 
         main = "train set",
         col = "#D3DDDC",
         xlab = "Commas",
         breaks=10)
    
    hist(subset(test()$comma_count,test()$comma_count < 100), 
         main = "test set",
         col = "#C7B19C",
         xlab = "Commas",
         breaks=10)
    
    boxplot(train()$comma_count~train()$rater1_domain1, 
            col = "#D3DDDC",
            xlab = "Rater 1", 
            ylab = "Commas",
            main = "train set",
            outline=FALSE)
    
  }) 
  
  output$discourse_sum <- renderText({
    print("Discourse Elements")
  }) 
  
  output$describe.discourse_sum <- renderPlot({
    
    par(mfrow=c(1,3)) 
    
    hist(subset(train()$discourse_sum, train()$discourse_sum < 100), 
         main = "train set",
         col = "#D3DDDC",
         xlab = "Discourse Elements",
         breaks=10)
    
    hist(subset(test()$discourse_sum, test()$discourse_sum < 100), 
         main = "test set",
         col = "#C7B19C",
         xlab = "Discourse Elements",
         breaks=10)
    
    boxplot(train()$discourse_sum~train()$rater1_domain1, 
            col="#D3DDDC",
            xlab = "Rater 1", 
            ylab = "Discourse Elements",
            main = "train set",
            outline=FALSE)
    
  }) 
  
  
  output$VBD_count <- renderText({
    print("Verbs (Past Tense)")
  }) 
  
  output$describe.VBD_count <- renderPlot({
    
    par(mfrow=c(1,3)) 
    
    hist(subset(train()$VBD_count, train()$VBD_count < 100), 
         main = "train set",
         col = "#D3DDDC",
         xlab = "Verbs (Past Tense)",
         breaks=10)
    
    hist(subset(test()$VBD_count, test()$VBD_count < 100), 
         main = "test set",
         col = "#C7B19C",
         xlab = "Verbs (Past Tense)",
         breaks=10)
    
    
    boxplot(train()$VBD_count~train()$rater1_domain1,
            col ="#D3DDDC",
            xlab = "Rater 1", 
            ylab = "Verbs (Past Tense)",
            main = "train set",
            outline=FALSE)
    
  }) 
  
  
  output$lang_error_count <- renderText({
    print("Grammatical Errors")
  }) 
  
  output$describe.lang_error_count <- renderPlot({
    
    par(mfrow=c(1,3)) 
    
    hist(subset(train()$lang_error_count, train()$lang_error_count < 100), 
         main = "train set",
         col = "#D3DDDC",
         xlab = "Grammatical Errors",
         breaks=10)
    
    hist(subset(test()$lang_error_count, test()$lang_error_count < 100),
         main = "test set",
         col = "#C7B19C",
         xlab = "Grammatical Errors",
         breaks=10)
    
    
    boxplot(train()$lang_error_count~train()$rater1_domain1,
            col ="#D3DDDC",
            xlab = "Rater 1", 
            ylab = "Grammatical Errors",
            main = "train set",
            outline=FALSE)
    
  }) 
  
  output$unique_word_count <- renderText({
    print("Unique Words")
  }) 
  
  output$describe.unique_word_count <- renderPlot({
    
    par(mfrow=c(1,3)) 
    
    hist(subset(train()$unique_word_count, train()$unique_word_count < 1000), 
         main = "train set",
         col = "#D3DDDC",
         xlab = "Unique Words", 
         breaks=10)
    
    hist(subset(test()$unique_word_count, test()$unique_word_count < 1000), 
         main = "test set",
         col = "#C7B19C",
         xlab = "Unique Words",
         breaks=10)
    
    boxplot(train()$unique_word_count~train()$rater1_domain1, 
            col = "#D3DDDC",
            xlab = "Rater 1", 
            ylab = "Unique Words",
            main = "train set",
            outline=FALSE
    )
    
  }) 
  output$preprocess  <- renderText ({
    print("Preprocess text")
    
  })
  
  output$original  <- renderText ({
    print(paste("Preprocess text:", substr(essayInput()$student_essay,1,100)[1]))
    
  })
  
  output$process  <- renderText ({
    print(paste("Processed text:", substr(processtext(),1,100)))
    
  })
  
  
  ###################
  # Model Building
  ###################
  
  md <- eventReactive(input$build, {
    if (classifierInput() == "linear"){
      features <- paste(features(), collapse = "+")
      equation <- paste("rater1_domain1 ~", features)
      print(equation)
      model <- lm(as.formula(equation), data=train())
    }
    
    else {
      features <- paste(features(), collapse = "+")
      equation <- paste("rater1_domain1 ~", features)
      print(equation)
      model <- multinom(as.formula(equation), data=train())
      
    }
    
  })
  
  
  ###################
  # Test Prediction
  ################### 
  
  pred <- eventReactive(input$build, {
    
    
    if (classifierInput() == "linear"){
      predictions <- predict.lm(md(), newdata = test())
      predictions <- mean(train()$rater1_domain1) + (predictions - mean(predictions)) * (sd(train()$rater1_domain1)/sd(predictions)) # re-scale to mean and sd of train sample
      predictions <- round(predictions, 0)
      predictions <- ifelse(predictions < 1, 1, predictions)
      predictions <- ifelse(predictions > 6, 6, predictions)
      rater1 <- test()$rater1_domain1
      rater2 <- test()$rater2_domain1
      scores <- cbind.data.frame(predictions, rater1, rater2)
      
    }
    
    else {
      predictions <- predict(md(), newdata = test(), type = "class")
      rater1 <- test()$rater1_domain1
      rater2 <- test()$rater2_domain1
      scores <- cbind.data.frame(predictions, rater1, rater2)
    }
    
    
    return(scores)
  })
  
  
  
  ##################################
  # Evaluate Model Performance
  ##################################
  
  
  output$build.model <- renderText ({
    print("Model Performance")
  })
  
  output$kappa.title <- renderText({
    print("Quadratic Weighted Kappa")
    
  })
  
  output$kappa.table <- renderTable({
    human_kap <-  cohen.kappa(cbind(pred()$rater1, pred()$rater2))
    machine_kap <- cohen.kappa(cbind(pred()$predictions, pred()$rater1))
    `Rater 1-Rater 2` <- round(human_kap$weighted.kappa,2)
    `Rater 1-AS Model` <- round(machine_kap$weighted.kappa,2)
    kappa.combined <- cbind.data.frame(`Rater 1-Rater 2`, `Rater 1-AS Model`)
    return(kappa.combined) 
  })
  
  output$std.mean.diff.title <- renderText({
    print("Standardized Mean Difference")
  })
  
  output$std.mean.diff.table <- renderTable({
    human_smd <- (mean(pred()$rater1 - mean(pred()$rater2)))
    machine_smd <- (mean(pred()$rater1 - mean(as.numeric(as.character(pred()$predictions)))))
    `Rater 1-Rater 2` <- round(human_smd/sqrt((sd(pred()$rater1)^2 + sd(pred()$rater2)^2)/2), 2)
    `Rater 1-AS Model` <- round(machine_smd/sqrt((sd(pred()$rater1)^2 + sd(as.numeric(as.character(pred()$predictions)))^2)/2), 2)
    smd.combined <- cbind.data.frame(`Rater 1-Rater 2`, `Rater 1-AS Model`)
    return(smd.combined) 
  })

  
  
  output$agree.title <- renderText({
    print("Agreement Rate (%)")
  })
  output$agreement <- renderTable({
    diff <- abs(pred()$rater1-pred()$rater2)
    Exact <- mean(ifelse(diff == 0, 1, 0))*100
    Adjacent <- mean(ifelse(diff == 1, 1, 0))*100
    `Non-adjacent` <- mean(ifelse(diff > 1, 1, 0))*100
    r1r2.agreement <- rbind(Exact, Adjacent, `Non-adjacent`)
    colnames(r1r2.agreement) <- "Rater 1-Rater 2"
    
    diff <- abs(pred()$rater1-as.numeric(pred()$predictions))
    Exact <- mean(ifelse(diff == 0, 1, 0))*100
    Adjacent <- mean(ifelse(diff == 1, 1, 0))*100
    `Non-adjacent` <- mean(ifelse(diff > 1, 1, 0))*100
    agreement <- rbind(Exact, Adjacent, `Non-adjacent`)
    colnames(agreement) <- "Rater 1-AS Model"
    agreement <- cbind(r1r2.agreement, agreement)
    agreement
    
  }, rownames = TRUE)
  
  
  output$con.matrix <- renderText({
    print("Confusion Matrix \n (rows: rater 1 scores; columns: model scores)")
    
  })
  
  output$confusion <- renderTable({
    as.data.frame.matrix(table(pred()$rater1, pred()$predictions))
  }, rownames = TRUE)
  
  
  output$spd.hist <- renderText({
    print("Score Point Distributions")
  })
  
  output$spd.test <- renderPlot({
    par(mfrow=c(1,3))
    
    barplot(prop.table(table(pred()$rater1)), 
            main = "Rater 1")
    text(1, .4, paste("mean: \n", round(mean(pred()$rater1),2),
                      "\nsd: \n", round(sd(pred()$rater1), 2)
    ))
    
    
    barplot(prop.table(table(pred()$predictions)), 
            main = "AS Model")
    
    text(1, .4, paste("mean: \n", round(mean(as.numeric(pred()$predictions)),2),
                      "\nsd: \n", round(sd(as.numeric(pred()$predictions)),2)
                      
    ))
    
  }) 
  
  
  observeEvent(input$reset, {
    updateCheckboxInput(session, "features", value="comma_count")
    updateSliderInput(session, "sample", value=30)
    updateSelectInput(session, "essay", selected="essay1")
    updateSelectInput(session, "classifier", selected="Linear Regression")
    
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)

