Skip to content

Instantly share code, notes, and snippets.

@bearloga
Created Sep 10, 2015
Embed
What would you like to do?
A function which launches a Shiny app for hand coding (manually classifying) data.
#' Manual classification of observations
#'
#' \code{classify} launches a Shiny app to manually classify a subset of observations.
#'
#' @param x A character vector.
#' @param btn_labels A character vector of length 2 corresponding to 0 and 1.
#' @return A vector of 0/1 for each element in \code{x}.
#' @export
#' @examples \dontrun{
#' foo <- sprintf('%s (%.2f miles per gallon)', rownames(mtcars), mtcars$mpg)
#' y <- classify(foo,c("Bad mileage for this car", "Good mileage for this car"))
#' }
classify <- function(x, btn_labels = c('No', 'Yes')) {
if ( "shiny" %in% rownames(installed.packages()) ) {
n <- length(x)
e <- new.env() # where we store classifications
e$classifications <- rep(NA, n) # 0 = no, 1 = yes
e$no <- 0
e$yes <- 0
shiny::runApp(shiny::shinyApp(
ui = shiny::fluidPage(
# Uses left arrow key for "no" and right arrow key for "yes"
shiny::tags$head(shiny::tags$script('$(document).on("keyup", function (e) {
if ( e.which == 37 ) document.getElementById("no").click();
if ( e.which == 39 ) document.getElementById("yes").click();
});')),
shiny::br(), shiny::uiOutput("progress"),
shiny::plotOutput("progressBar", height = "10px"), shiny::br(),
shiny::uiOutput("text"), shiny::br(),
shiny::actionButton("no", btn_labels[1]),
shiny::actionButton("yes", btn_labels[2]),
shiny::helpText(sprintf('Use left and right arrow keys to mark it as "%s" or "%s", respectively.',
btn_labels[1], btn_labels[2]))
),
server = function(input, output) {
output$progress <- shiny::renderUI({
i <- input$no + input$yes
HTML(sprintf("<strong>Observation %.0f of %.0f (%.2f%% done)</strong>", i+1, n, 100*i/n))
})
output$progressBar <- shiny::renderPlot({
i <- (input$no + input$yes)/n
par(mar = rep(0, 4) + 0.01, oma = rep(0, 4), bg = "grey90")
plot(0, 0, type = "n", xlim = c(0, 1), ylim = c(0, 1), xaxs = "i", yaxs = "i")
polygon(c(0, i, i, 0), c(0, 0, 1, 1), col = "cornflowerblue", border = NA)
})
output$text <- shiny::renderUI({
a <- input$no
b <- input$yes
i <- a + b + 1
if ( a>e$no ) {
eval(parse(text = sprintf("classifications[%.0f] <- 0",i-1)), envir = e)
eval(parse(text = sprintf("no <- %0.f",a)), envir = e)
}
if ( b>e$yes ) {
eval(parse(text = sprintf("classifications[%.0f] <- 1",i-1)), envir = e)
eval(parse(text = sprintf("yes <- %0.f",b)),envir=e)
}
if ( i>0 & i<=n ) sprintf("%s", x[i])
else { shiny::stopApp("Done!") }
})
}
), launch.browser = ifelse(Sys.getenv("RSTUDIO") == "1", rstudio::viewer, TRUE)
)
return(e$classifications)
} else {
stop("Requires 'shiny' package to be installed.")
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment