R/add_cite.R

In NicolasJBM/writer: Functions and interfaces to support academic writing with R

#' Gadget for the selection and insertion of references in documents.
#' @return A citation.
#' @importFrom miniUI miniPage
#' @importFrom miniUI gadgetTitleBar
#' @importFrom miniUI miniTabstripPanel
#' @importFrom miniUI miniTabPanel
#' @importFrom miniUI miniContentPanel
#' @importFrom shiny fillCol
#' @importFrom shiny fillRow
#' @importFrom shiny icon
#' @importFrom shiny fileInput
#' @importFrom shiny textInput
#' @importFrom shiny dateInput
#' @importFrom shiny numericInput
#' @importFrom shiny textAreaInput
#' @importFrom shiny selectInput
#' @importFrom shiny checkboxInput
#' @importFrom shiny downloadButton
#' @importFrom shiny downloadHandler
#' @importFrom shiny stopApp
#' @importFrom shiny runGadget
#' @importFrom shiny conditionalPanel
#' @importFrom shiny tags
#' @importFrom shiny dataTableOutput
#' @importFrom shiny htmlOutput
#' @importFrom shiny uiOutput
#' @importFrom shiny plotOutput
#' @importFrom shiny textOutput
#' @importFrom shiny actionButton
#' @importFrom shiny renderDataTable
#' @importFrom shiny renderUI
#' @importFrom shiny renderPlot
#' @importFrom shiny renderText
#' @importFrom shiny reactive
#' @importFrom shiny reactiveValues
#' @importFrom shiny observe
#' @importFrom shiny observeEvent
#' @importFrom shiny withProgress
#' @importFrom shiny incProgress
#' @importFrom shiny h3
#' @importFrom shiny isolate
#' @importFrom shiny reactiveValuesToList
#' @importFrom shiny tableOutput
#' @importFrom shiny renderTable
#' @importFrom shiny HTML
#' @importFrom shiny validate
#' @importFrom shiny need
#' @importFrom shiny fluidRow
#' @importFrom shiny column
#' @importFrom shiny showModal
#' @importFrom shiny modalDialog
#' @importFrom shiny eventReactive
#' @importFrom shiny dialogViewer
#' @importFrom shinythemes shinytheme
#' @importFrom tibble column_to_rownames
#' @importFrom tibble rownames_to_column
#' @importFrom tibble tibble
#' @importFrom tibble as_tibble
#' @importFrom dplyr select
#' @importFrom dplyr filter
#' @importFrom dplyr group_by
#' @importFrom dplyr summarize_all
#' @importFrom dplyr mutate
#' @importFrom dplyr %>%
#' @importFrom dplyr case_when
#' @importFrom dplyr arrange
#' @importFrom dplyr bind_rows
#' @importFrom dplyr everything
#' @importFrom tibble tibble
#' @importFrom stringr str_extract
#' @importFrom stringr str_extract_all
#' @importFrom stringr str_remove_all
#' @importFrom stringr str_split
#' @importFrom stringr str_detect
#' @importFrom stringr str_to_lower
#' @importFrom rhandsontable renderRHandsontable
#' @importFrom rhandsontable rHandsontableOutput
#' @importFrom rhandsontable hot_to_r
#' @importFrom rhandsontable rhandsontable
#' @importFrom rhandsontable hot_cols
#' @importFrom lubridate year
#' @importFrom stats na.omit
#' @importFrom utils read.csv
#' @importFrom RefManageR ReadBib
#' @export

add_cite <- function() {
  
  options(shiny.maxRequestSize=500*1024^2)
  
  ui <- miniPage(
    theme = shinytheme("spacelab"),
    
    gadgetTitleBar("Insert citations"),
    miniTabstripPanel(
      
      # Panel where the author selects references in the filtered list
      miniTabPanel(
        "Search",
        icon = icon("search"),
        miniContentPanel(
          fluidRow(
            column(6,fileInput("biblio", "List of references", accept = c(".bib",".csv"), multiple = FALSE)),
            column(6,actionButton("addref", "Add", width = 150,
                                  icon("paper-plane"), 
                                  style="margin-top: 25px; color: #fff; background-color: #337ab7; border-color: #2e6da4"))
          ),
          tags$hr(),
          fluidRow(
            column(6, uiOutput("filtgroup")),
            column(6, uiOutput("filtjournal"))
          ),  
          fluidRow(
            column(6, uiOutput("filtauthors")),
            column(3, numericInput("slctminyear", "Minimum year:", value = 1900)),
            column(3, numericInput("slctmaxyear", "Maximum year:", value = 2100))
          ), 
          uiOutput("filttitle"),
          uiOutput("filtabstract"),
          uiOutput("filtkeyword"),
          tags$hr(),
          fluidRow(
            column(
              6,
              actionButton("applyfilt", "Apply", width = 150,
                           icon("paper-plane"), 
                           style="color: #fff; background-color: #337ab7; border-color: #2e6da4")
            ),
            column(6,  textOutput("citecount"))
          )
        )
      ),
      
      # Panel where the author checks references in the filtered list
      miniTabPanel(
        "Select",
        icon = icon("list"),
        miniContentPanel(
          fillCol(
            flex = c(7,1,1,1,1,1),
            rHandsontableOutput("reflist"),
            tags$hr(),
            fluidRow(
              column(4, actionButton("add", "Add", width = 150,
                                     icon("paper-plane"), 
                                     style="margin-top: 25px; color: #fff; background-color: #337ab7; border-color: #2e6da4")),
              column(8, uiOutput("selection"))
            ),
            tags$hr(),
            fluidRow(
              column(4, checkboxInput("subject", "Subjects", value = FALSE)),
              column(4, textInput("pages", "Pages", value = "")),
              column(4, actionButton("insert", "Insert", width = 150,
                                     icon("paper-plane"), 
                                     style="margin-top: 25px; color: #fff; background-color: #337ab7; border-color: #2e6da4"))
            )
          )
        )
      ),
      
      # Panel where the authors refines the selection based on abstracts
      miniTabPanel(
        "Check",
        icon = icon("check"),
        miniContentPanel(
          uiOutput("selectref"),
          tags$hr(),
          dataTableOutput("checkref"),
          uiOutput("citations")
          )
      )
      
      
    )
  )
  
  
  
  server <- function(input, output, session) {
    
    
    # Bind variables
    abstract <- NULL
    author <- NULL
    year <- NULL
    key <- NULL
    title <- NULL
    isbn <- NULL
    journal <- NULL
    keywords <- NULL
    V1 <- NULL
    field <- NULL
    
    
    # Prepare reactive values
    values <- reactiveValues()
    if ("bibliogr" %in% row.names(installed.packages())){
      withProgress(message = 'Retrieve the database of references',
                   detail = 'This may take a while...',
                   references <- bibliogr::references)
      values$references <- references
      withProgress(message = 'Identify authors',
                   detail = 'This may take a while...', {
                     values$authors <- references$author %>%
                       str_split(" ") %>%
                       unlist() %>%
                       setdiff("and") %>%
                       str_remove_all(",") %>%
                       str_remove_all("\\.") %>%
                       unique() %>%
                       sort() %>%
                       c("")
                   })
    } else {
      references <- data.frame(
        key = NA,
        bibtype = NA,
        author = NA,
        title = NA,
        journal = NA,
        groups = NA,
        year = NA,
        volume = NA,
        number = NA,
        pages = NA,
        doi = NA,
        abstract = NA,
        keywords = NA,
        url = NA,
        publisher = NA,
        booktitle = NA,
        editor = NA,
        address = NA,
        chapter = NA,
        edition = NA,
        isbn = NA,
        comment = NA,
        note = NA
      )
      values$references <- references
      values$authors <- NA
    }
    values$selected <- c()
    
    
    # Import bibliography
    observeEvent(input$addref, {
      if (!is.null(input$biblio$datapath[[1]])){
        
        withProgress(message = 'Importation in progress',
                     detail = 'This may take a while...', value = 0, {
                       incProgress(1/3)
                       count1 <- nrow(values$references)
                       filetype <- str_extract(input$biblio$datapath[[1]], "....$")
                       if (filetype == ".bib") {
                         add <- ReadBib(input$biblio$datapath[[1]]) %>%
                           as.data.frame() %>%
                           rownames_to_column("key") %>%
                           mutate_all(str_remove_all, pattern = "[{}]")
                         incProgress(1/3)
                       } else {
                         add <- read.csv(input$biblio$datapath[[1]], stringsAsFactors = FALSE)
                         incProgress(1/3)
                       }
                       add <- dplyr::select(add, intersect(names(add), names(values$references)))
                       base <- bind_rows(mutate_all(values$references, as.character), mutate_all(add, as.character)) %>%
                         dplyr::filter(!is.na(year)) %>%
                         unique()
                       incProgress(1/3)
                       values$references <- base
                       values$data <- "yes"
                     })
        
        count2 <- nrow(base)
        
        showModal(modalDialog(
          title = "Done!",
          paste0((count2 - count1), " references added.")
        ))
      } else return()
    })
    
    
    # Prepare filters
    output$filtgroup <- renderUI({
      choices <- sort(c(setdiff(unique(values$references$groups), ""), ""), decreasing = FALSE)
      selectInput("slctgroup", "Group:", choices = choices, selected = "", multiple = FALSE, width = '100%')
    })
    
    afterfiltgroup <- reactive({
      filter <- input$slctgroup
      if (is.null(filter)){
        values$references
      } else if (filter == "") {
        values$references
      } else {
        dplyr::filter(values$references, str_detect(values$references$groups, filter))
      }
    })
    
    
    
    output$filtjournal <- renderUI({
      choices <- sort(c(setdiff(unique(afterfiltgroup()$journal), ""), ""), decreasing = FALSE)
      selectInput("slctjournal", "Journal:", choices = choices, selected = "", multiple = FALSE, width = '100%')
    })
    
    afterfiltjournal <- reactive({
      filter <- input$slctjournal
      if (is.null(filter)){
        afterfiltgroup()
      } else if (filter == "") {
        afterfiltgroup()
      } else {
        dplyr::filter(afterfiltgroup(), str_detect(afterfiltgroup()$journal, filter))
      }
    })
    
    
    
    output$filtauthors <- renderUI({
      choices <- values$authors
      selectInput("slctauthor", "Authors:", choices = choices, selected = "", multiple = TRUE, width = '100%')
    })
    
    afterfiltauthors <- reactive({
      filter <- input$slctauthor
      if (is.null(filter)){
        afterfiltjournal()
      } else if (filter[[1]] == "") {
        afterfiltjournal()
      } else {
        authors <- stringr::str_to_lower(filter)
        base <- afterfiltjournal()
        for (i in 1:length(authors)) base <- dplyr::filter(base, str_detect(stringr::str_to_lower(base$author), authors[i]))
        base
      }
    })
    
    
    
    output$filttitle <- renderUI({
      textInput("slcttitle", "In title:", value = "", width = '100%')
    })
    
    afterfilttitle <- reactive({
      filter <- input$slcttitle
      if (is.null(filter)){
        afterfiltauthors()
      } else if (filter[[1]] == "") {
        afterfiltauthors()
      } else {
        titles <- stringr::str_to_lower(unlist(str_split(filter, " ")))
        titles <- str_replace_all(titles, "_", " ")
        base <- afterfiltauthors()
        for (i in 1:length(titles)) base <- dplyr::filter(base, str_detect(stringr::str_to_lower(base$title), titles[i]))
        base
      }
    })
    
    
    output$filtabstract <- renderUI({
      textInput("slctabstract", "In abstract:", value = "", width = '100%')
    })
    
    afterfiltabstract <- reactive({
      filter <- input$slctabstract
      if (is.null(filter)){
        afterfilttitle()
      } else if (filter[[1]] == "") {
        afterfilttitle()
      } else {
        abstracts <- stringr::str_to_lower(unlist(str_split(filter, " ")))
        abstracts <- str_replace_all(abstracts, "_", " ")
        base <- afterfilttitle()
        for (i in 1:length(abstracts)) base <- dplyr::filter(base, str_detect(stringr::str_to_lower(base$abstract), abstracts[i]))
        base
      }
    })
    
    
    output$filtkeyword <- renderUI({
      textInput("slctkeyword", "In abstract:", value = "", width = '100%')
    })
    
    afterfiltkeyword <- reactive({
      filter <- input$slctkeyword
      if (is.null(filter)){
        afterfiltabstract()
      } else if (filter[[1]] == "") {
        afterfiltabstract()
      } else {
        keywords <- stringr::str_to_lower(unlist(str_split(filter, " ")))
        keywords <- str_replace_all(keywords, "_", " ")
        base <- afterfiltabstract()
        for (i in 1:length(keywords)) base <- dplyr::filter(base, str_detect(stringr::str_to_lower(base$keywords), keywords[i]))
        base
      }
    })
    
    # Apply filters
    filtered <- reactive({
      afterfiltkeyword() %>%
        dplyr:: mutate(year = as.numeric(year)) %>%
        dplyr::filter(year >= input$slctminyear) %>%
        dplyr::filter(year <= input$slctmaxyear) %>%
        dplyr:: mutate(year = as.character(year))
    })
    
    
    
    # Count the number of references filtered
    output$citecount <- renderText({
      paste0("Number of citations selected: ", nrow(filtered()))
    })
    
    
    # Create list for manual selection of references
    output$reflist <- renderRHandsontable({
      
      reflist <- filtered() %>%
        dplyr::mutate(select = FALSE) %>%
        dplyr::select(select, key, author, year, title) %>%
        dplyr::arrange(desc(year), author) %>%
        rhandsontable(stretchH = "all", width = '100%', height = 400, rowHeaders = FALSE) %>%
        hot_cols(colWidths = c(50, 100, 200, 50, 400))
    })
    
    
    # Add the references manually selected
    observeEvent(input$add, {
      addkeys <- isolate(input$reflist) %>%
        hot_to_r() %>%
        dplyr::filter(select == TRUE) %>%
        select(key) %>%
        unlist() %>%
        as.character()
      
      values$selected <- sort(unique(na.omit(c(isolate(input$selection), addkeys))))
    })
    
    
    # Selection of references
    output$selection <- renderUI({
      selectInput("selection", "Selection", choices = values$selected, selected = values$selected, multiple = T, width = '100%')
    })
    
    # Get the abstracts of manually selected references
    output$selectref <- renderUI({
      if (length(input$selection) > 0){
        selectInput("slctref", "Select reference", choices = input$selection, selected = input$selection[[1]])
      } else return()
    })
    
    # Get the abstracts of manually selected references
    output$checkref <- renderDataTable({
      if (!is.null(input$slctref)){
        values$references %>%
          dplyr::filter(key == input$slctref) %>%
          dplyr::select(title, abstract, keywords, author, journal, year) %>%
          t() %>%
          as.data.frame() %>%
          rename(Information = V1) %>%
          rownames_to_column("Item")
      } else return()
    }, options = list(paging = FALSE, searching = FALSE))
    
    
    # Cite
    observeEvent(input$insert, {
      pg <- case_when(
        str_detect(input$pages, "-") ~ ", pp.",
        TRUE ~ ", p."
      )
      citations <- case_when(
        length(input$selection) == 1 & input$subject == FALSE & input$pages != "" ~ paste0("[@", input$selection[[1]], pg, input$pages, "]"),
        length(input$selection) == 1 & input$subject == TRUE ~ paste0("@", input$selection[[1]]),
        length(input$selection) == 1 ~ paste0("[@", input$selection[[1]], "]"),
        TRUE ~ paste0("[@", paste0(input$selection, collapse = "; @"), "]")
      )
      rstudioapi::insertText(citations)
    })
    
    
    observeEvent(input$done, {
      stopApp()
    })
  }
  runGadget(ui, server, viewer = paneViewer(minHeight = "maximize"))
}