qualitative_coding.R

###############################################################################-
#####      TEMPLATE FOR HIGHLIGHTING AND CODING TEXT IN RSTUDIO SHINY     #####-
##### DEVELOPED IN WINDOWS 7; SHINY 0.14.2; RSTUDIO 1.0.136; R 3.3.2      #####-
##### DIEGO ALBUREZ-GUTIERREZ, 2016                                       #####-
##### http://alburez.me                                                   #####-
############################################################################### -

# *THANKS TO CONTRIBUTORS IN:
# https://stackoverflow.com/questions/42274461/can-shiny-recognise-text-selection-with-mouse-highlighted-text


# PREAMBLE ====
# ++++++++++++++

library(shiny)

text <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Fusce nec quam ut tortor interdum pulvinar id vitae magna. Curabitur commodo consequat arcu et lacinia. Proin at diam vitae lectus dignissim auctor nec dictum lectus. Fusce venenatis eros congue velit feugiat, ac aliquam ipsum gravida. Cras bibendum malesuada est in tempus. Suspendisse tincidunt, nisi non finibus consequat, ex nisl condimentum orci, et dignissim neque est vitae nulla." 

coded_text <- character(0)

# Define jd functions

# use js to select highlighted text
highlight <- '
function getSelectionText() {
var text = "";
if (window.getSelection) {
text = window.getSelection().toString();
} else if (document.selection) {
text = document.selection.createRange().text;
}
return text;
}
document.onmouseup = document.onkeyup = document.onselectionchange = function() {
var selection = getSelectionText();
Shiny.onInputChange("mydata", selection);
};
'
# Press key "1" in keyboard to automatically trigger button to save text in "code 1"
code1 <- "
$(function(){
$(document).keyup(function(e) {
if (e.which == 49) {
$('#code1').click()
}
});
})"

# UI ----
# +++++++

ui <- bootstrapPage(
  tags$script(highlight),
  tags$script(code1),
  fluidRow(
    column(4,
           tags$h1("Text to code"),
           verbatimTextOutput("text")
    ),
    column(4,
           tags$h1("Coding options"),
           actionButton("code1", "Assign selected text to Code1"),
           tags$h1("Code1 output"),
           verbatimTextOutput("selected_text")
    )
  )
)

# SERVER ----
# ++++++++++++

server <- function(input, output) {
  
  output$text <- renderText(text)
  
  coded <- eventReactive(input$code1, {
    coded_text <<- c(coded_text, input$mydata)
    coded_text
  })
  
  output$selected_text <- renderPrint({
    coded()
  })
  
}

# RUN  APP ----
# +++++++++++++

shinyApp(ui = ui, server = server)