Nivi-classify-example.R

---
title: "Classify"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    #logo:                     # add the relative path/file.png
    #favicon:                  # add the relative path/file.png
    theme: bootstrap
    #css: custom.css           # add the relative path/file.css
    vertical_layout: fill
runtime: shiny
---

```{r global, include=FALSE, message=FALSE}
# setup
# -----------------------------------------------------------------------------
  library(flexdashboard)
  library(shiny)
  library(rdrop2)
  library(tidyverse)
  library(shinyWidgets)
  library(DT)

# authenticate with dropbox for remote storage
# -----------------------------------------------------------------------------
# is file storage remote (1) or local (0)
  remote <- 0  

# https://github.com/karthik/rdrop2
# https://github.com/karthik/rdrop2/issues/61#issuecomment-423341288
# run once:
  # drop_auth()
  # token <- drop_auth()
  # saveRDS(token, file = "droptoken.rds") # updload to server with app
  
  if (remote==1) {
    outputDir <- "dash"                    # output directory on Dropox (toplevel)
    drop_auth(rdstoken = "droptoken.rds")  # give token
  }
  
# construct helpers
# ----------------------------------------------------------------------------- 
# set reactive to delay eventReactives
  set.seed(1)
  rv <- reactiveValues()
  rv$run2 <- 0
  
# input variables
  vars <- c("rater", "classification", "other", "confidence", "language")
```
  
```{r load, include=FALSE, message=FALSE}
# master files
# -----------------------------------------------------------------------------

# load current masters
  if (remote==1) { # load from dropbox
    master <- reactiveValues(df = drop_read_csv("/dash/master.csv", 
                                                stringsAsFactors = FALSE))
    raters <- drop_read_csv("/dash/raters.csv", stringsAsFactors = FALSE)
  
  } else { # load from local repo
    master <- reactiveValues(df = read.csv("dash/master.csv", 
                                           stringsAsFactors = FALSE))
    raters <- read.csv("dash/raters.csv", stringsAsFactors = FALSE)
  }

# get new master on submit
  eventReactive(rv$run2, {
    
    if (remote==1) {
      master$df <- drop_read_csv("/dash/master.csv", stringsAsFactors = FALSE)
      
    } else {
      master$df <- read.csv("dash/master.csv", stringsAsFactors = FALSE)
    }
    
  }, ignoreNULL = TRUE)
  
# processing
# -----------------------------------------------------------------------------
# check for items that have agreement between two raters  
  done <- eventReactive(rv$run2, {
    master$df %>%
      group_by(id, classification) %>%
      count() %>%
      filter(n>1 & !(is.na(classification)))
  }, ignoreNULL=FALSE)
  
# find items that the rater has not rated
  rated <- eventReactive(rv$run2, {
    master$df %>%
      group_by(id, rater) %>%
      filter(rater==input$rater)
  }, ignoreNULL=FALSE)

# select an item for the rater
  class <- eventReactive(rv$run2, {
    temp <- 
    master$df %>%
      filter(!(id %in% done()$id)) %>%
      filter(!(id %in% rated()$id))
      
  # prevent error message if there are no more messages for this rater
    validate(need(nrow(temp)!=0, 
                  "There are no more messages to classify. Nice work!"))
    
    temp %>%
      sample_n(1)
  
  }, ignoreNULL=FALSE)
```

Task
=====================================  

Column {data-width=300}
-----------------------------------------------------------------------

```{r ui-rater}
# define UI
  conditionalPanel(
    condition = "input.rater == ''",
    mainPanel(br(),
              br(),
              pickerInput(inputId = "rater", 
                          label = "Select your name", 
                          choices = raters$name, 
                          options = list(title = "Make a selection"), 
                          multiple = FALSE)
              )
  )
```

Column {data-width=600}
-----------------------------------------------------------------------
Welcome! You will read SMS messages and classify the user's intent. In other words, you'll try to identify what the user wants based on the text message. The intents that populate the selection list are described on the "Definitions" panel. If you think the user is asking about something not included in the list, select 'Another option not in this list' and describe the user's intent in a few words in the space that will pop-up. If you read the message and have no clue what the user wants, just select 'Cannot make sense of text'. For every selection, you must also rate your confidence in your choice. When you hit the `submit` button, your selections will be captured and a new message will appear. Keep going as long as you want. If you hit the `submit` button and nothing happens, it's likely because you did not make a selection in all fields.

```{r ui-ratings}
# create object with SMS question
  output$textq <- renderText(class()$question)

# define inputs
# -----------------------------------------------------------------------------
  fillCol(height = 600, flex = c(NA, 1),
  mainPanel(
    br(),
    br(),
  # show SMS question
    tags$style("#textq{font-size: 30px;
                                }"
                         ),
    conditionalPanel(
      condition = "input.rater != ''",
      textOutput("textq")
    ),
    br(),
    br()
  ),
  conditionalPanel(
      condition = "input.rater != ''",
      wellPanel(
      # classification input
        pickerInput(inputId = "classification", 
                    label = "Select the best classification", 
                    choices = c("intent 1", 
                                "intent 2", 
                                "intent 3", 
                                "intent 4", 
                                "Another option not in this list",
                                "Cannot make sense of text"), 
                    options = list(title = "Make a selection"), 
                    multiple = FALSE),
        
        conditionalPanel(
        condition = "input.classification == 'Another option not in this list'",
      # other classification input
        textInput("other", 
                  "In a few words, describe what the user wants to know:",
                  value = NA,
                  width = '600px')
        ),
        
        conditionalPanel(
        condition = "input.classification != 'Cannot make sense of text' & 
                     input.classification != ''",
      # rating confidence
        pickerInput(inputId = "confidence", 
                    label = "How confident are you about this selection?", 
                    choices = c("Not at all confident",
                                "Not very confident",
                                "Somewhat confident",
                                "Very confident"), 
                    options = list(title = "Make a selection"), 
                    multiple = FALSE)
        ),
      # indicate language
        pickerInput(inputId = "language", 
                    label = "Language of message", 
                    choices = c("Engish", "Spanish", "German", "Not sure"), 
                    options = list(title = "Make a selection"), 
                    multiple = FALSE),
        actionButton("submit", "Submit", width = '200px')
        )
      )
  )
```

```{r ratings}
# compile data from inputs
# -----------------------------------------------------------------------------
  dat <- reactive({
    
  # require certain inputs
    req(input$classification)
    
    if (input$classification == "Another option not in this list") {
      req(input$other)
    }
    
    if (input$classification != "Cannot make sense of text" &
        input$classification != "") {
      req(input$confidence)
    }
    
    req(input$rater)
    
    req(input$language)
    
  # 
    dat_ <- data.frame(t(unlist(sapply(vars, function(x) input[[x]]))))
      dat_ %>%
        mutate(id = class()$id, 
               question = class()$question) %>%
        select(id, question, rater, classification, other, confidence, language) 
    })
    
# submit data
# -----------------------------------------------------------------------------
  observeEvent(input$submit, {
    
  # update master with data from inputs
    master$df <- 
    master$df %>%
      bind_rows(dat())
    
  # save 
    if (remote==1) {
      write.csv(master$df, file.path(tempdir(), "master.csv"), row.names = FALSE, 
                quote = TRUE)
      drop_upload(file.path(tempdir(), "master.csv"), path = outputDir)
      
    } else {
      write.csv(master$df, file="dash/master.csv", row.names = FALSE, quote = TRUE)
    }
    
  # update counter for eventReactives
    rv$run2 <- rv$run2 + 1
    
  # update SMS question object for display
    output$textq <- renderText(class()$question)
    
  # update inputs
    updatePickerInput(session, "classification",
                      label = "Select the best classification", 
                      choices = c("intent 1", 
                                  "intent 2", 
                                  "intent 3", 
                                  "intent 4", 
                                  "Another option not in this list",
                                  "Cannot make sense of text"))
    
    updatePickerInput(session, "confidence", 
                      label = "How confident are you about this selection?", 
                      choices = c("Not at all confident",
                                  "Not very confident",
                                  "Somewhat confident",
                                  "Very confident"))
    
    updateTextInput(session, "other", 
                    "In a few words, describe what the user wants to know:",
                    value = NA)
    
    updatePickerInput(session, "language", 
                      label = "Language of message", 
                      choices = c("Engish", "Spanish", "German", "Not sure"))
  })
```

Definitions
=====================================

```{r}
  defs <- data.frame(label = c("intent 1", 
                               "intent 2", 
                               "intent 3", 
                               "intent 4"),
                     definition = c("Insert here",
                                    "Insert here",
                                    "Insert here",
                                    "Insert here"))

  DT::renderDT({
    datatable(defs)
  })
```