diff --git a/NAMESPACE b/NAMESPACE index 4a89b06..8fd7fa1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,7 +9,7 @@ fuzz_m_ratio, fuzz_partial_ratio, fuzz_token_sort_ratio, fuzz_token_set_ratio, find_duplicates, extract_unique_references, merge_columns, make_dtm, run_topic_model, revwords, screen_duplicates, screen_titles, screen_abstracts, -screen_topics) +screen_full_texts, screen_topics) S3method(summary, screen_topics_progress) S3method(format_citation, bibliography) S3method(format_citation, list) @@ -44,6 +44,7 @@ importFrom(shinydashboard, sidebarMenu, menuItem, sidebarMenuOutput, renderMenu) importFrom(stats, xtabs, plogis) importFrom(stringdist, stringdist) +importFrom(stringr, str_starts) importFrom(tm, removePunctuation, removeWords, removeNumbers, stemDocument, tm_map, Corpus, VectorSource, DocumentTermMatrix, removeSparseTerms, stopwords, content_transformer, weightTf) diff --git a/R/screen_full_texts.R b/R/screen_full_texts.R new file mode 100644 index 0000000..209a02b --- /dev/null +++ b/R/screen_full_texts.R @@ -0,0 +1,611 @@ +screen_full_texts <- function( + x = NULL, + max_file_size +){ + + # set file size if requested, ensuring to reset on exit + if(!missing(max_file_size)){ + initial_file_size <- options("shiny.maxRequestSize") + options(shiny.maxRequestSize = max_file_size * 1024^2) + on.exit(options(initial_file_size)) + } + + # load data + data_in <- load_full_text_data( + data = x + ) + + # create ui + ui_data <- screen_full_texts_ui() + ui <- shinydashboard::dashboardPage( + title = "revtools | screen_full_texts", + ui_data$header, + ui_data$sidebar, + ui_data$body, + skin = "black" + ) + + # start server + server <- function(input, output, session){ + + # build reactive values + data <- reactiveValues( + raw = data_in$data$raw + ) + progress <- reactiveValues( + order = data_in$progress$order, + available = data_in$progress$available, + current = data_in$progress$current, + row = data_in$progress$row, + max_n = data_in$progress$max_n + ) + display <- reactiveValues( + notes = FALSE, + column = "label" + ) + + # create header image + output$header <- renderPlot({ + revtools_logo(text = "screen_full_texts") + }) + + # DATA INPUT + ## when specified, ensure input data is processed correctly + observeEvent(input$data_in, { + if(is.null(data$raw)){ + data_previous <- data_in$raw + }else{ + data_previous <- data$raw + } + import_result <- import_shiny( + source = input$data_in, + current_data = data_previous + ) + import_result <- add_full_text_columns(import_result) + + # export to reactiveValues + data$raw <- import_result + + # set progress values + progress$order <- set_row_order( + data$raw, + input$order, + input$order_result + ) + if(is.null(progress$current) | progress$current < 1){ + progress$current <- 1 + } + if(input$hide_screened){ + # if(length(progress$screen_cols) > 1){ + # progress$available <- which( + # apply(data$raw[, progress$screen_cols], 1, function(a){all(is.na(a))}) + # ) + # }else{ + # progress$available <- which(is.na(data$raw[, progress$screen_cols])) + # } + progress$available <- which(is.na(data$raw$screened_full_texts)) + progress$max_n <- length(progress$available) + }else{ + progress$max_n <- nrow(data$raw) + progress$available <- seq_len(progress$max_n) + } + progress$row <- choose_full_text_row( + progress$order, progress$available, progress$current + ) + }) + + # allow user to select order + output$column_selector <- renderUI({ + if(input$order == "user_defined"){ + available_colnames <- colnames(data$raw) + selectInput( + inputId = "order_result", + label = "Select variable to order by:", + choices = available_colnames, + selected = display$column + ) + } + }) + + # ensure decisions about selected columns are retained + observeEvent(input$order_result, { + display$column <- input$order_result + }) + + # FULL TEXT SCREENING + # change order of articles as necessary + observeEvent(input$order_result_go, { + progress$order <- set_row_order( + data$raw, + input$order, + input$order_result + ) + progress$current <- 1 + progress$row <- choose_full_text_row( + progress$order, progress$available, progress$current + ) + }) + + # display text for the current entry + # note that observe is necessary to force changes when input$order changes + observe({ + output$citation <- renderPrint({ + validate( + need(data$raw, "Import data to begin") + ) + validate( + need(progress$max_n > 0, + "No unscreened data remaining\nAdd more data, or save and exit to continue") + ) + if(any(colnames(data$raw) == "abstract")){ + abstract_text <- data$raw$abstract[progress$row] + }else{ + abstract_text <- "<em>No abstract available</em>" + } + current_status <- data$raw$screened_full_texts[progress$row] + if(is.na(current_status)){ + text_color <- "black" + text_label <- "" + }else{ + if(current_status == "excluded"){ + text_color <- "'#993f3f'" + text_label <- "Status: Excluded" + }else{ + text_color <- "'#405d99'" + text_label <- "Status: Selected" + } + } + cat( + paste0( + "<font color =", text_color, ">", + format_citation( + data$raw[progress$row, ], + abstract = FALSE, + details = (input$hide_names == FALSE), + add_html = TRUE + ), + "<br>", + text_label, + "<br><br>", + abstract_text, + "</font>" + ) + ) + }) + }) + # doi link + observe({ + validate(need(data$raw, "")) + validate(need(progress$max_n > 0, "")) + if(any(colnames(data$raw) == "doi")) { + if (stringr::str_starts(data$raw$doi[progress$row], "htt") == FALSE) { # for when DOIs don't have url element + output$doi <- renderUI( + a(href=paste0("https://doi.org/", data$raw$doi[progress$row]),"DOI link",target="_blank") + ) + } else { + output$doi <- renderUI( + a(href=paste0(data$raw$doi[progress$row]),"DOI link",target="_blank") + ) + } + }else{ + output$doi <- renderUI( + paste0("No DOI available") + ) + } + }) + # full-text pdf + #observe({ + # if(any(colnames(data$raw) == "doi")) { + # metagear::PDF_download( + # DOI = data$raw$doi[progress$row], + # directory = './www//', + # theFileName = 'full-text' + # ) + # } + #}) + #observe({ + # output$pdf_view <- renderUI({ + # tags$iframe(style = "height:1500px; width:100%; scrolling=yes", + # src = "full-text.pdf") + # }) + #}) + + # RENDER SELECTION BUTTONS + output$selector_bar <- renderUI({ + if(!is.null(data$raw)){ + text_out <- HTML( + paste0( + nrow(data$raw) - length(which(is.na(data$raw$screened_full_texts))), + " entries screened | Showing entry ", + progress$current, + " of ", + progress$max_n + ) + ) + + div( + list( + div( + style = " + display: inline-block; + vertical-align: top; + text-align: right; + width: 350px", + renderText({text_out}) + ), + div( + style = " + display: inline-block; + vertical-align: top; + text-align: right; + width: 20px", + renderText(" ") + ), + div( + style = " + display: inline-block; + vertical-align: top; + width: 40px", + actionButton( + inputId = "full_text_10previous", + label = "<<", + width = "40px", + style = "background-color: #6b6b6b;" + ) + ), + div( + style = " + display: inline-block; + vertical-align: top; + width: 40px", + actionButton( + inputId = "full_text_previous", + label = "<", + width = "40px", + style = "background-color: #6b6b6b;" + ) + ), + div( + style = " + display: inline-block; + vertical-align: top; + text-align: right; + width: 100px", + actionButton( + inputId = "select_yes", + label = "Select", + style = " + background-color: #7c93c1; + color: #fff; + width: 100px" + ) + ), + div( + style = " + display: inline-block; + vertical-align: top; + text-align: right; + width: 100px", + actionButton( + inputId = "select_no", + label = "Exclude", + style = " + background-color: #c17c7c; + color: #fff; + width: 100px" + ) + ), + div( + style = " + display: inline-block; + vertical-align: top; + width: 40px", + actionButton( + inputId = "full_text_next", + label = ">", + width = "40px", + style = "background-color: #6b6b6b;" + ) + ), + div( + style = " + display: inline-block; + vertical-align: top; + width: 40px", + actionButton( + inputId = "full_text_10next", + label = ">>", + width = "40px", + style = "background-color: #6b6b6b;" + ) + ) + ) + ) + } + }) + + output$render_notes_toggle <- renderUI({ + if(!is.null(data$raw)){ + if(progress$max_n > 0){ + actionButton( + inputId = "notes_toggle", + label = "Show notes window", + style = " + background-color: #adadad; + color: #fff; + width: 200px" + ) + } + } + }) + + # NOTES + # when toggle is triggered, invert display status of notes + observeEvent(input$notes_toggle, { + display$notes <- !display$notes + }) + + # render notes + output$render_notes <- renderUI({ + if(display$notes){ + div( + list( + br(), + textAreaInput( + inputId = "full_text_notes", + label = NULL, + value = data$raw$notes[progress$row], + resize = "both", + width = "400px", + height = "150px" + ), + actionButton( + inputId = "notes_save", + label = "Save Notes", + width = "100px" + ), + br() + ) + ) + } + }) + + # save notes + observeEvent(input$notes_save, { + data$raw$notes[progress$row] <- input$full_text_notes + }) + + + # SELECTION & NAVIGATION + observeEvent(input$select_yes, { + data$raw$screened_full_texts[progress$row] <- "selected" + if(input$hide_screened){ # progress$current remains the same and progress$available changes + progress$available <- which(is.na(data$raw$screened_full_texts)) + progress$max_n <- length(progress$available) + if(progress$current > progress$max_n){ + progress$current <- progress$max_n + } + }else{ # i.e. if screened elements are visible, then current is used for navigation + if(progress$current < progress$max_n){ + progress$current <- progress$current + 1 + } + } + }) + + observeEvent(input$select_no, { + data$raw$screened_full_texts[progress$row] <- "excluded" + if(input$hide_screened){ + progress$available <- which(is.na(data$raw$screened_full_texts)) + progress$max_n <- length(progress$available) + if(progress$current > progress$max_n){ + progress$current <- progress$max_n + } + }else{ + if(progress$current < progress$max_n){ + progress$current <- progress$current + 1 + } + } + }) + + observeEvent(input$full_text_next, { + if((progress$current + 1) > progress$max_n){ + progress$current <- progress$max_n + }else{ + progress$current <- progress$current + 1 + } + }) + + observeEvent(input$full_text_previous, { + if((progress$current - 1) > 0){ + progress$current <- progress$current - 1 + } + }) + + observeEvent(input$full_text_10previous, { + if((progress$current - 10) > 0){ + progress$current <- progress$current - 10 + }else{ + progress$current <- 1 + } + }) + + observeEvent(input$full_text_10next, { + if((progress$current + 10) > progress$max_n){ + progress$current <- progress$max_n + }else{ + progress$current <- progress$current + 10 + } + }) + + # choose then row of the next entry when progress$current is updated + observeEvent(progress$current, { + if(!is.null(data$raw)){ + progress$row <- choose_full_text_row( + progress$order, progress$available, progress$current + ) + } + }) + + # ditto if progress$available is pinged + observeEvent(progress$available, { + if(!is.null(data$raw)){ + progress$row <- choose_full_text_row( + progress$order, progress$available, progress$current + ) + progress$max_n <- length(progress$available) + } + }) + + observeEvent(input$hide_screened, { + if(!is.null(data$raw)){ + if(input$hide_screened){ # i.e. text were shown but are now hidden + # ensure that - if the currently viewed row is not selected - then it stays displayed + # if(is.na(data$raw$screened_abstracts[progress$row])){ + if(progress$row %in% progress$available){ + progress$current <- choose_full_text_current( + progress$order, + which(is.na(data$raw$screened_full_texts)), + progress$row + ) + # this doesn't work at present + } + progress$available <- which(is.na(data$raw$screened_full_texts)) + }else{ + if(progress$current < 1){ + progress$current <- 1 + } + progress$available <- seq_len(nrow(data$raw)) + } + } + }) + + observeEvent(progress$max_n, { + if(!is.null(data$raw) & progress$max_n < 1){ + showModal( + modalDialog( + HTML( + "All full texts have been screened. Would you like to save your progess?<br><br> + <i>If you have specified an object in your workspace and click 'Exit App', + your progress will be invisibly saved to that object.</i><br><br>" + ), + textInput("save_filename", + label = "File Name" + ), + selectInput("save_data_filetype", + label = "File Type", + choices = c("csv", "rds") + ), + actionButton( + inputId = "save_data_execute", + label = "Save to File" + ), + actionButton( + inputId = "exit_app_confirmed", + label = "Exit App" + ), + modalButton("Cancel"), + title = "Save As", + footer = NULL, + easyClose = FALSE + ) + ) + } + }) + + # SAVE OPTIONS + observeEvent(input$save_data, { + if(is.null(data$raw)){ + showModal( + modalDialog( + HTML( + "Import some data to begin<br><br> + <em>Click anywhere to exit</em>" + ), + title = "Error: no data to save", + footer = NULL, + easyClose = TRUE + ) + ) + }else{ + showModal( + modalDialog( + textInput("save_filename", + label = "File Name" + ), + selectInput("save_data_filetype", + label = "File Type", + choices = c("csv", "rds") + ), + actionButton("save_data_execute", "Save"), + modalButton("Cancel"), + title = "Save As", + footer = NULL, + easyClose = FALSE + ) + ) + } + }) + + observeEvent(input$save_data_execute, { + if(nchar(input$save_filename) == 0){ + filename <- "revtools_full_text_screening" + }else{ + if(grepl("\\.[[:lower:]]{3}$", input$save_filename)){ + filename <- substr( + input$save_filename, 1, + nchar(input$save_filename) - 4 + ) + }else{ + filename <- input$save_filename + } + } + filename <- paste(filename, input$save_data_filetype, sep = ".") + switch(input$save_data_filetype, + "csv" = {write.csv(data$raw, file = filename, row.names = FALSE)}, + "rds" = {saveRDS(data$raw, file = filename)} + ) + removeModal() + }) + + # add option to remove data + observeEvent(input$clear_data, { + shiny::showModal( + shiny::modalDialog( + HTML("If you proceed, all data will be removed from this window, + including any progress you have made screening your data. + If you have not saved your data, + you might want to consider doing that first.<br><br> + Are you sure you want to continue?<br><br>" + ), + shiny::actionButton( + inputId = "clear_data_confirmed", + label = "Confirm"), + shiny::modalButton("Cancel"), + title = "Clear all data", + footer = NULL, + easyClose = FALSE + ) + ) + }) + + observeEvent(input$clear_data_confirmed, { + data$raw <- NULL + progress$current <- 1 + progress$row <- NULL + display$notes <- FALSE + removeModal() + }) + + observeEvent(input$exit_app, { + exit_modal() + }) + + observeEvent(input$exit_app_confirmed, { + stopApp(returnValue = invisible(data$raw)) + }) + + } # end server + + print(shinyApp(ui, server, options = list(launch.browser = TRUE))) + +} diff --git a/R/screen_full_texts_infrastructure.R b/R/screen_full_texts_infrastructure.R new file mode 100644 index 0000000..0ba6c74 --- /dev/null +++ b/R/screen_full_texts_infrastructure.R @@ -0,0 +1,125 @@ +load_full_text_data <- function(data){ + + x <- list( + data = list( + raw = NULL + ), + progress = list( + order = NULL, + available = 1, + current = 1, + row = NULL, + max_n = NULL + ) + ) + + if(!is.null(data)){ + + # throw a warning if a known file type isn't given + accepted_inputs <- c("bibliography", "data.frame") + if(any(accepted_inputs == class(data)) == FALSE){ + stop("only classes 'bibliography' or 'data.frame' accepted by screen_full_texts")} + + switch(class(data), + "bibliography" = {data <- as.data.frame(data)}, + "data.frame" = {data <- data} + ) + + data <- add_full_text_columns(data) + colnames(data) <- tolower(colnames(data)) + x$data$raw <- data + + # set order assuming randomness and hide_screened == TRUE + x$progress$order <- base::rank( + rnorm(nrow(data)), + ties.method = "random" + ) + x$progress$available <- which(is.na(data$screened_full_texts)) + x$progress$max_n <- length(x$progress$available) + x$progress$row <- x$progress$available[ + which.min( + x$progress$order[x$progress$available] + ) + ] + + + } # end if is.null + + return(x) + +} + + +add_full_text_columns <- function(df){ + + if(!any(colnames(df) == "label")){ + df$label <- generate_bibliographic_names(df) + df <- df[, c(ncol(df), seq_len(ncol(df)-1))] + } + if(!any(colnames(df) == "screened_full_texts")){ + df$screened_full_texts <- NA + } + if(!any(colnames(df) == "notes")){ + df$notes <- "" + } + + return(df) +} + + +set_row_order <- function( + df, + order_by, # options are: random, initial, alphabetical, user_defined + user_column # if order_by = "user_defined", this is the column name of the user selection +){ + switch(order_by, + "random" = { + base::rank( + rnorm(nrow(df)), + ties.method = "random" + ) + }, + "initial" = { + seq_len(nrow(df)) + }, + "alphabetical" = { + if(any(colnames(df) == "title")){ + base::rank( + df$title, + ties.method = "random" + ) + }else{ + seq_len(nrow(df)) + } + }, + "user_defined" = { + base::rank( + df[, user_column], + ties.method = "random" + ) + } + ) +} # end function + +# set progress$row when other inputs are known +choose_full_text_row <- function( + order_vec, # vector giving order of rows (numeric). progress$order + available_vec, # vector showing which are available (numeric). progress$available + current # currently selected row # progress$current +){ + ordered_vals <- order_vec[available_vec] + selected_val <- ordered_vals[order(ordered_vals)][current] + return(which(order_vec == selected_val)) +} + +# set progress$current when other inputs are known +choose_full_text_current <- function( + order_vec, # progress$order + available_vec, # vector showing which are available (numeric). which(is.na(data$raw$screened_abstracts)) + row # currently selected row # progress$row +){ + order_current <- order_vec[row] + ordered_vals <- order_vec[available_vec] + result <- which(order_vec[order(order_vec)] == order_current) + return(result) +} \ No newline at end of file diff --git a/R/screen_full_texts_ui.R b/R/screen_full_texts_ui.R new file mode 100644 index 0000000..03fd0fd --- /dev/null +++ b/R/screen_full_texts_ui.R @@ -0,0 +1,103 @@ +screen_full_texts_ui <- function(){ + + # build user interface + header <- shinydashboard::dashboardHeader( + tag("li", + list( + class = "dropdown", + uiOutput("selector_bar") + ) + ), + title = plotOutput("header") + ) + + sidebar <- shinydashboard::dashboardSidebar( + sidebarMenu( + id = "tabs", + menuItem("Data", + icon = shiny::icon("bar-chart-o"), + startExpanded = TRUE, + fileInput( + inputId = "data_in", + label = "Import", + multiple = TRUE + ), + actionButton( + inputId = "clear_data", + label = "Clear Data", + width = "85%" + ), + actionButton( + inputId = "exit_app", + label = "Save to Workspace", + width = "85%" + ), + actionButton( + inputId = "save_data", + label = "Save to File", + width = "85%" + ), + br() + ), + menuItem("Appearance", + icon = icon("paint-brush"), + selectInput("hide_names", + label = "Hide identifying information?", + choices = c("Yes" = "TRUE", "No" = "FALSE"), + multiple = FALSE + ), + selectInput( + inputId = "hide_screened", + label = "Hide screened entries?", + choices = c("Yes" = "TRUE", "No" = "FALSE"), + multiple = FALSE + ), + selectInput( + inputId = "order", + label = "Order citations by:", + choices = list( + "Random" = "random", + "Input" = "initial", + "Alphabetical" = "alphabetical", + "User-defined" = "user_defined" + ) + ), + uiOutput("column_selector"), + actionButton( + inputId = "order_result_go", + label = "Re-order", + width = "85%" + ), + br() + ) + ) + ) + + body <- shinydashboard::dashboardBody( + revtools_css(), + fluidRow( + column(width = 1), + column( + width = 10, + tableOutput("citation"), + br(), + uiOutput("doi"), + #uiOutput("pdf_view"), + br(), + br(), + uiOutput(outputId = "render_notes_toggle"), + uiOutput(outputId = "render_notes") + ), + column(width = 1) + ) + ) + + return( + list( + header = header, + sidebar = sidebar, + body = body + ) + ) + +} diff --git a/man/screen_full_texts.Rd b/man/screen_full_texts.Rd new file mode 100644 index 0000000..7288be0 --- /dev/null +++ b/man/screen_full_texts.Rd @@ -0,0 +1,32 @@ +\name{screen_full_texts} +\alias{screen_full_texts} +\title{Shiny app for screening articles by their full-text} +\description{This is a simple app for displaying DOI links and bibliographic data one entry at a time, and manually selecting or excluding them. Articles can be ordered by a user-specified column, or or in one of three automated ways: as in the input dataset, alphabetically by title, or in random order (the default). +} +\usage{ +screen_full_texts(x, max_file_size) +} +\arguments{ + \item{x}{An (optional) object of class \code{data.frame} or \code{bibliography} to open in the browser. If empty, the app will launch with no data. Data can be added within the app via the 'import' button.} + \item{max_file_size}{Optional argument to set the maximum file size (in MB) that the app will accept.} +} +\value{ +This function launches a Shiny app in the users' default browser, allowing the user to select or exclude individual articles. +} +\seealso{ + \code{\link{screen_titles}} for screening articles in groups rather than individually; \code{\link{screen_topics}} to view articles as a point cloud; \code{\link{screen_abstracts}} for screening articles by their abstract. +} +\examples{ +# to run the app and upload data interactively +\dontrun{screen_full_texts()} +# or to specify data from the workspace +file_location <- system.file( + "extdata", + "avian_ecology_bibliography.ris", + package = "revtools") +x <- read_bibliography(file_location) +# to run the app using these data: +\dontrun{screen_full_texts(x)} +# or to run the app & save results to the workspace: +\dontrun{result <- screen_full_texts(x)} +}