diff --git a/.Rbuildignore b/.Rbuildignore
index 82ecd93d..1182ad1d 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -1,3 +1,5 @@
+^renv$
+^renv\.lock$
^.*\.Rproj$
^\.Rproj\.user$
^LICENSE\.md$
diff --git a/.github/workflows/document-and-deploy.yml b/.github/workflows/document-and-deploy.yml
index 03e25e5f..402c7b9e 100644
--- a/.github/workflows/document-and-deploy.yml
+++ b/.github/workflows/document-and-deploy.yml
@@ -53,7 +53,10 @@ jobs:
R -e "
remotes::install_github('ESHackathon/CiteSource', force = TRUE);
rsconnect::setAccountInfo(name=${{secrets.SHINY_LUKAS_ACCOUNT}}, token=${{secrets.SHINY_LUKAS_TOKEN}}, secret=${{secrets.SHINY_LUKAS_SECRET}});
- rsconnect::deployApp(appName = 'CiteSource_latest', appDir = './inst/shiny-app/CiteSource', forceUpdate = TRUE)"
+ rsconnect::deployApp(
+ appName = 'CiteSource_latest',
+ appDir = './inst/shiny-app/CiteSource',
+ forceUpdate = TRUE)"
- name: Deploy stable version from main
if: github.ref == 'refs/heads/main'
@@ -63,7 +66,10 @@ jobs:
R -e "
remotes::install_github('ESHackathon/CiteSource', force = TRUE);
rsconnect::setAccountInfo(name=${{secrets.SHINY_LUKAS_ACCOUNT}}, token=${{secrets.SHINY_LUKAS_TOKEN}}, secret=${{secrets.SHINY_LUKAS_SECRET}});
- rsconnect::deployApp(appName = 'CiteSource', appDir = './inst/shiny-app/CiteSource', forceUpdate = TRUE)"
+ rsconnect::deployApp(
+ appName = 'CiteSource',
+ appDir = './inst/shiny-app/CiteSource',
+ forceUpdate = TRUE)"
- name: Create pkgdown
env:
diff --git a/DESCRIPTION b/DESCRIPTION
index 2eb7a38a..b37c8739 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: CiteSource
Title: Analyze the Utility of Information Sources and Retrieval Methodologies for Evidence Synthesis
-Version: 0.0.1
+Version: 0.1.1
Date: 2023-06-22
Authors@R: c(
person("Trevor", "Riley", , "trevor.riley@noaa.gov", role = c("aut", "cre"),
diff --git a/NEWS.md b/NEWS.md
index 3c812e2c..2f85f30c 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -8,3 +8,10 @@
- Integrated new dedup function into R shiny app
+# CiteSource 0.1.1
+
+- Added new functions which allow creation of tables and plots based on deduplicated (reimported) data.
+
+- Updated shiny functionality, look and feel, and documentation
+
+- Added new vignettes
\ No newline at end of file
diff --git a/R/dedup.R b/R/dedup.R
index d32ccaeb..25445768 100644
--- a/R/dedup.R
+++ b/R/dedup.R
@@ -95,8 +95,9 @@ dedup_citations_add_manual <- function(unique_citations, additional_pairs) {
unique_citations$source = unique_citations$cite_source
unique_citations$label = unique_citations$cite_label
- dedup_results <- ASySD::dedup_citations_add_manual(unique_citations, additional_pairs = additional_pairs
- )
+ dedup_results <- ASySD::dedup_citations_add_manual(unique_citations,
+ additional_pairs = additional_pairs,
+ extra_merge_fields = "cite_string")
dedup_results$cite_source <- dedup_results$source
dedup_results$cite_label <- dedup_results$label
diff --git a/R/export.R b/R/export.R
index b3b93741..fcaa187e 100644
--- a/R/export.R
+++ b/R/export.R
@@ -96,7 +96,8 @@ export_ris <- function(citations, filename = "citations.ris", source_field = "DB
string_field, "cite_string", TRUE,
label_field, "cite_label", TRUE,
"C1", "duplicate_id", TRUE,
- "C2", "record_ids", TRUE
+ "C2", "record_ids", TRUE,
+ "TY", "type", TRUE
),
synthesisr_code_lookup %>% dplyr::filter(.data$ris_synthesisr)
) %>% dplyr::distinct(.data$code, .keep_all = TRUE) # Remove fields from synthesisr specification used for CiteSource metadata
diff --git a/R/new_count_and_table.R b/R/new_count_and_table.R
index 70215c5c..11059413 100644
--- a/R/new_count_and_table.R
+++ b/R/new_count_and_table.R
@@ -315,15 +315,19 @@ calculate_phase_records <- function(unique_citations, n_unique, db_colname) {
total_distinct_records <- dplyr::n_distinct(unique_citations$duplicate_id)
# Split the cite_label column and count any occurrence of "screened" and "final"
+ # Updated for edge cases where a citation is duplicated within the screened set
total_screened <- unique_citations %>%
tidyr::separate_rows(cite_label, sep = ",\\s*") %>%
dplyr::filter(cite_label == "screened") %>%
- nrow()
+ # Count the number of distinct duplicate_ids that remain
+ dplyr::n_distinct(duplicate_id)
+ # Updated for edge cases where a citation is duplicated within the screened set (should never happen)
total_final <- unique_citations %>%
tidyr::separate_rows(cite_label, sep = ",\\s*") %>%
dplyr::filter(cite_label == "final") %>%
- nrow()
+ # Count the number of distinct duplicate_ids that remain
+ dplyr::n_distinct(duplicate_id)
# Step 2: Proceed with the regular calculation for distinct records by source
distinct_count <- unique_citations %>%
diff --git a/R/plots.R b/R/plots.R
index 338f5dab..458f1754 100644
--- a/R/plots.R
+++ b/R/plots.R
@@ -260,7 +260,7 @@ cite_source <- cite_label <- type <- NULL
#'
plot_contributions <- function(data, facets = cite_source, bars = cite_label, color = type,
center = FALSE, bar_order = "keep", facet_order = "keep",
- color_order = "keep", totals_in_legend = TRUE) {
+ color_order = "keep", totals_in_legend = FALSE) {
bars <- rlang::enquo(bars)
color <- rlang::enquo(color)
diff --git a/R/tables.R b/R/tables.R
index befee1d2..9d6f40f2 100644
--- a/R/tables.R
+++ b/R/tables.R
@@ -25,32 +25,32 @@
record_level_table <- function(citations, include = "sources", include_empty = TRUE, return = c("tibble", "DT"), indicator_presence = NULL, indicator_absence = NULL) {
if (!is.data.frame(citations) || nrow(citations) == 0) stop("Citations must be a tibble and cannot have 0 entries")
-
+
if (is.null(indicator_absence)) {
indicator_absence <- switch(return[1],
- tibble = FALSE,
- DT = "✗"
+ tibble = FALSE,
+ DT = "✗"
)
}
if (is.null(indicator_presence)) {
indicator_presence <- switch(return[1],
- tibble = TRUE,
- DT = "✔"
+ tibble = TRUE,
+ DT = "✔"
)
}
sources <- compare_sources(citations, comp_type = include)
-
+
if (nrow(sources) == 0) {
warning("Citations provided contain no information on ", include, ". NA will be displayed, but check whether you intended to do a different comparison")
- sources <- tibble::tibble(duplicate_id = citations$duplicate_id)
- sources[[paste0(stringr::str_sub(include, 1, -2), "__NA")]] <- TRUE
+ sources <- tibble::tibble(duplicate_id = citations$duplicate_id)
+ sources[[paste0(stringr::str_sub(include, 1, -2), "__NA")]] <- TRUE
}
if (!include_empty == TRUE) {
citations <- citations %>% dplyr::filter(.data$duplicate_id %in% sources$duplicate_id)
}
-
+
if (! "url" %in% colnames(citations)) {
citations$url <- NA_character_
}
@@ -65,17 +65,17 @@ record_level_table <- function(citations, include = "sources", include_empty = T
dplyr::arrange(stringr::str_extract(.data$author, "^.*?,"), .data$citation) %>%
dplyr::select("duplicate_id", "citation", "reference", "html_reference") %>%
dplyr::left_join(sources, by = "duplicate_id")
-
+
indicator_presence <- as.character(indicator_presence)
indicator_absence <- as.character(indicator_absence)
-
+
to_display <- citations %>%
dplyr::select(-(1:4)) %>%
dplyr::mutate(dplyr::across(dplyr::everything(), ~ ifelse(.x, indicator_presence, indicator_absence))) %>%
dplyr::rename_with(~ paste0(.x, " ")) # Add space to keep column names unique
-
+
citations <- dplyr::bind_cols(citations, to_display)
-
+
if (return[1] == "DT") {
if (!rlang::is_installed("DT")) {
warning('DT can only be returned when the DT package is installed. Please run install.packages("DT")')
@@ -88,7 +88,7 @@ record_level_table <- function(citations, include = "sources", include_empty = T
stringr::str_remove(glue::glue("^{type}__"))
list(type = type %>% stringr::str_to_title(), values = values)
}) %>% purrr::transpose()
-
+
sketch <- htmltools::tags$table(
class = "display",
htmltools::tags$thead(
@@ -105,7 +105,7 @@ record_level_table <- function(citations, include = "sources", include_empty = T
htmltools::tags$td(colspan = 4 + length(unlist(headings$values)), htmltools::HTML("Click on the ⊕ to view the full reference"))
)
)
-
+
citations %>%
dplyr::select(-"duplicate_id", -"reference") %>%
cbind(" " = "⊕", .) %>%
@@ -113,16 +113,22 @@ record_level_table <- function(citations, include = "sources", include_empty = T
escape = FALSE,
extensions = "Buttons",
options = list(
+ pageLength = 10,
+ lengthMenu = list(c(10, 25, 50, 100, -1), c('10', '25', '50', '100', 'All')),
columnDefs = list(
list(visible = FALSE, targets = c(0, 3:(3 + ncol(to_display)))),
list(orderable = FALSE, className = "details-control", targets = 1)
),
- dom = "Bfrtip",
+ dom = "lBfrtip",
buttons =
list("print", list(
extend = "csv", filename = "CiteSource_record_summary",
text = "Download csv",
- exportOptions = list(columns = c(0, 2:(3 + ncol(to_display))))
+ exportOptions = list(
+ columns = c(0, 2:(3 + ncol(to_display))),
+ modifier = list(page = "all")
+ )
+
))
), container = sketch,
callback = DT::JS("
@@ -585,8 +591,8 @@ generate_apa_reference <- function(authors, year, title, source, volume, issue,
dplyr::rowwise() %>%
dplyr::mutate(
reference = glue::glue("
- {glue::glue_collapse(initialed_names, ', ', last = ' & ')} ({year}). {nNA(title, '.')} {nNA(source, pre = '', '')}{nNA(volume, pre = ', ', '')}{nNA(issue, pre = '(', ')')}. {nNA(link, pre = '')}{nNA(link, '')}
- ")
+ {glue::glue_collapse(initialed_names, ', ', last = ' & ')} ({year}). {nNA(title, '.')} {nNA(source, pre = '', '')}{nNA(volume, pre = ', ', '')}{nNA(issue, pre = '(', ')')}. {nNA(link, pre = '')}{nNA(link, '')}
+ ")
) %>%
dplyr::pull(.data$reference)
} else {
diff --git a/README.md b/README.md
index 638fd5fa..931d34f0 100644
--- a/README.md
+++ b/README.md
@@ -22,7 +22,7 @@ CiteSource was created under [the General Public License (>=v3)](https://www.gnu
**Shiny Web Application**
-Whether you know R or not, we want you to be able to use CiteSource! Check out our [CiteSource Shiny App!](https://litrev.shinyapps.io/CiteSource_latest/)
+Whether you know R or not, we want you to be able to use CiteSource! Check out our [CiteSource Shiny App!](https://litrev.shinyapps.io/CiteSource/)
## Features
**Customizable Metadata Tags**
diff --git a/inst/shiny-app/CiteSource/app.R b/inst/shiny-app/CiteSource/app.R
index 48ab0dbd..2aad160e 100644
--- a/inst/shiny-app/CiteSource/app.R
+++ b/inst/shiny-app/CiteSource/app.R
@@ -2,9 +2,9 @@ library(DT)
library(CiteSource)
library(dplyr)
-# Set background colour
-shiny::tags$head(shiny::tags$style(
- shiny::HTML('
+shiny::tags$head(
+ # style
+ shiny::tags$style(shiny::HTML('
#sidebar {
background-color: #ffffff;
}
@@ -15,356 +15,446 @@ shiny::tags$head(shiny::tags$style(
))
columns2hide <- c("title", "author", "doi", "volume",
- "pages", "number", "year", "abstract", "journal", "isbn")
+ "pages", "number", "year", "abstract", "journal", "isbn")
-# Define UI for data upload app ----
+# ---- Define UI ----
ui <- shiny::navbarPage("CiteSource",
- id = "tabs",
- header = shiny::tagList(
- shinybusy::add_busy_spinner(spin = "circle"),
- shinyjs::useShinyjs(),
- #header text colour
- tags$head(
- tags$style(HTML("
- h6, .h6, h5, .h5, h4, .h4, h3, .h3, h2, .h2, h1, .h1 {
- margin-top: 0;
- margin-bottom: .5rem;
- font-weight: 500;
- line-height: 1.2;
- color: #23395B;
- }
- "))
- )
- ),
- theme = bslib::bs_theme(
- bg = "rgb(251, 251, 251)",
- primary = "#008080",
- secondary = "#CBF7ED",
- success = "#23395B",
- info = "#82D173",
- warning = "#FFC07F",
- danger = "#008080",
- font_scale = NULL,
- bootswatch = "cerulean",
- fg = "#000",
- input_bg = "#E0E0E0", # Set the background color for input boxes
- input_border_color = "#23395B" # Set the border color for input boxes
- ),
- # Home tab
- shiny::tabPanel(
- "Home",
- shiny::navlistPanel(
- shiny::tabPanel(
- title = "About",
- htmltools::includeMarkdown("www/about.md")
- ),
- shiny::tabPanel(
- title = "Use Cases",
- htmltools::includeMarkdown("www/use-cases.md")
- ),
- widths = c(2, 10)
- )
- ),
- shiny::tabPanel(
- "File upload",
- shiny::fluidRow(
- shiny::column(
- 12,
- # Sidebar layout with input and output definitions ----
- shiny::sidebarLayout(
- shiny::sidebarPanel( # Input: Select a file ----
- shiny::h5("Step 1: Upload your citation files"),
- shiny::fileInput("file", "",
- multiple = TRUE,
- accept = c(".ris", ".txt", ".bib")
- ),
- shiny::p(
- HTML("NOTE: OVID citations may be incompatible.
- Import and export them using citation software
- before uploading for accurate metadata mapping."),
- style = "font-size: 85%; color: darkgrey;"
- ),
- shiny::hr(),
- shiny::h5("OR: Re-upload an .ris or .csv exported from CiteSource"),
- shiny::fileInput("file_reimport", "",
- multiple = TRUE,
- accept = c(".ris", ".csv")
- )
- ),
- # Main panel for displaying outputs ----
- shiny::mainPanel(
- shiny::h5("Step 2: Double click the row to edit sources, labels, and strings"),
- # Output: Data file ----
- DT::dataTableOutput("tbl_out")
- )
- )
- )
- )
- ),
- shiny::tabPanel(
- "Deduplicate",
- shiny::tabsetPanel(
- shiny::tabPanel(
- "Automated deduplication",
- br(),
- shiny::h5("Step 3: Deduplicate"),
- shiny::p("Click the button below to detect and remove duplicates automatically"),
-
- # Action button: identify duplicates in uploaded dataset
- shinyWidgets::actionBttn(
- "identify_dups", "Find duplicates",
- style = "jelly",
- color = "primary",
- icon = shiny::icon("search")
- ) %>% htmltools::tagAppendAttributes(style = "background-color: #008080; margin-right: 20px"),
-
- # Output: datatable of deduplication results
- DT::dataTableOutput("dedup_results")
- ),
- shiny::tabPanel(
- "Manual deduplication",
- br(),
- shiny::h5("Step 4: Review potential duplicates manually"),
- shiny::p("The following records were identified as potential duplicates. Potential duplicates are combined into a single row with metadata fields for each record represented (ex. Title 1 & Title 2). Click any row to indicate that the records in that row ARE duplicates. Once all duplicates are identified you can click the button 'Remove additional duplicates' and then proceed to the visualizations."),
- shiny::textOutput("Manual_pretext"),
- shiny::br(),
-
-
- # Button
- shinyWidgets::actionBttn(
- inputId = "nomanualdedup",
- label = "Go to visualisations",
- style = "jelly",
- icon = shiny::icon("arrow-right"),
- color = "primary"
- ) %>% htmltools::tagAppendAttributes(style = "background-color: #82D173"),
- br(),
- shinyWidgets::actionBttn(
- inputId = "manualdedupsubmit",
- label = "Remove additional duplicates",
- style = "jelly",
- icon = shiny::icon("reply"),
- color = "primary" # Hide the button initially
- ) %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
-
- shinyWidgets::dropdown(
-
- tags$h3("Select columns to display"),
+ id = "tabs",
+ header = shiny::tagList(
+ shinybusy::add_busy_spinner(spin = "circle"),
+ shinyjs::useShinyjs(),
+ tags$head(
+ tags$link(rel = "icon", type = "image/png", href = "www/favicon.png"), # Add favicon
+ tags$style(HTML("
+ h6, .h6, h5, .h5, h4, .h4, h3, .h3, h2, .h2, h1, .h1 {
+ margin-top: 0;
+ margin-bottom: .5rem;
+ font-weight: 500;
+ line-height: 1.2;
+ color: #23395B;
+ }
+ "))
+ )
+ ),
+ theme = bslib::bs_theme(
+ bg = "rgb(251, 251, 251)",
+ primary = "#008080",
+ secondary = "#CBF7ED",
+ success = "#23395B",
+ info = "#82D173",
+ warning = "#FFC07F",
+ danger = "#008080",
+ font_scale = NULL,
+ bootswatch = "cerulean",
+ fg = "#000",
+ input_bg = "#E0E0E0", # Set the background color for input boxes
+ input_border_color = "#23395B" # Set the border color for input boxes
+ ),
+ # Home tab ----
+ shiny::tabPanel(
+ "Home",
+ shiny::navlistPanel(
+ shiny::tabPanel(
+ title = "About",
+ htmltools::includeMarkdown("www/about.md")
+ ),
+ shiny::tabPanel(
+ title = "Use Cases",
+ htmltools::includeMarkdown("www/use-cases.md")
+ ),
+ # User Guide
+ shiny::tabPanel(
+ title = "User Guide",
+ # Load the external Markdown file
+ htmltools::includeMarkdown("www/user_guide.md")
+ ),
+ widths = c(2, 10)
+ )
+ ),
+ shiny::tabPanel(
+ "File upload",
+ shiny::fluidRow(
+ shiny::column(
+ 12,
+ # Sidebar layout ----
+ shiny::sidebarLayout(
+ shiny::sidebarPanel( # Input: Select a file ----
+ shiny::h5("Step 1: Upload your citation files"),
+ shiny::fileInput("file", "",
+ multiple = TRUE,
+ accept = c(".ris", ".txt", ".bib")
+ ),
+ shiny::hr(),
+ shiny::h5("OR: Re-upload an .ris or .csv exported from CiteSource"),
+ shiny::fileInput("file_reimport", "",
+ multiple = TRUE,
+ accept = c(".ris", ".csv")
+ )
+ ),
+ # Main panel for displaying outputs ----
+ shiny::mainPanel(
+ shiny::h5("Step 2: Double click on a column to edit sources, labels, and strings. Use *Ctrl+Enter* to save edits, one column at a time"),
+ # Output: Data file ----
+ DT::dataTableOutput("tbl_out")
+ )
+ )
+ )
+ )
+ ),
+ shiny::tabPanel(
+ "Deduplicate",
+ shiny::tabsetPanel(
+ shiny::tabPanel(
+ "Automated deduplication",
+ br(),
+ shiny::h5("Step 3: Deduplicate"),
+ shiny::p("Click the button below to detect and remove duplicates automatically"),
+
+ # Action button: identify duplicates in uploaded dataset
+ shinyWidgets::actionBttn(
+ "identify_dups", "Find duplicates",
+ style = "jelly",
+ color = "primary",
+ icon = shiny::icon("search")
+ ) %>% htmltools::tagAppendAttributes(style = "background-color: #008080; margin-right: 20px"),
+ ),
+ shiny::tabPanel(
+ "Manual deduplication",
+ br(),
+ shiny::h5("Step 4: Review potential duplicates manually"),
+ shiny::p("The following records were identified as potential duplicates. Potential duplicates are combined into a single row with metadata fields for each record represented (ex. Title 1 & Title 2). Click any row to indicate that the records in that row ARE duplicates. Once all duplicates are identified you can click the button 'Remove additional duplicates' and then proceed to the visualizations."),
+ shiny::textOutput("Manual_pretext"),
+ shiny::br(),
+
+ # Button
+ shinyWidgets::actionBttn(
+ inputId = "nomanualdedup",
+ label = "Go to visualisations",
+ style = "jelly",
+ icon = shiny::icon("arrow-right"),
+ color = "primary"
+ ) %>% htmltools::tagAppendAttributes(style = "background-color: #82D173"),
+ br(),
+ shinyWidgets::actionBttn(
+ inputId = "manualdedupsubmit",
+ label = "Remove additional duplicates",
+ style = "jelly",
+ icon = shiny::icon("reply"),
+ color = "primary" # Hide the button initially
+ ) %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
+
+ shinyWidgets::dropdown(
- shinyWidgets::pickerInput(
- inputId = "manual_dedup_cols",
- label = "Choose columns",
- choices = NULL,
- selected = NULL,
- multiple = TRUE,
- options = list(
- `live-search` = TRUE,
- `actions-box` = TRUE,
- style = "btn-primary")
- ),
- icon = icon("filter"),
- inline =TRUE,
- status = "danger", width = "600px",
- tooltip = shinyWidgets::tooltipOptions(title = "Select columns to display")),
-
- DT::DTOutput("manual_dedup_dt"),
- tags$style(HTML(".table.dataTable tbody td.active, .table.dataTable tbody tr.active td {
+ tags$h3("Select columns to display"),
+
+ shinyWidgets::pickerInput(
+ inputId = "manual_dedup_cols",
+ label = "Choose columns",
+ choices = NULL,
+ selected = NULL,
+ multiple = TRUE,
+ options = list(
+ `live-search` = TRUE,
+ `actions-box` = TRUE,
+ style = "btn-primary")
+ ),
+ icon = icon("filter"),
+ inline =TRUE,
+ status = "danger", width = "600px",
+ tooltip = shinyWidgets::tooltipOptions(title = "Select columns to display")),
+
+ DT::DTOutput("manual_dedup_dt"),
+ tags$style(HTML(".table.dataTable tbody td.active, .table.dataTable tbody tr.active td {
background-color: #CBF7ED!important; color: black!important}")),
-
- )
- )
- ),
- shiny::tabPanel(
- "Visualise",
-
- # Sidebar layout with input and output definitions ----
- shiny::sidebarLayout(
-
- # Sidebar panel for inputs ----
- shiny::sidebarPanel(
- width = 3,
- id = "sidebar",
- shiny::h5("Step 5: Visualise overlap"),
- shinyWidgets::prettyRadioButtons(
- inputId = "comp_type",
- label = "Choose a comparison",
- inline = TRUE,
- choices = c(
- "sources",
- "labels", "strings"
- ),
- status = "primary"
- ),
- selectInput(
- inputId = "sources_visual",
- "Sources to include",
- list(),
- multiple = TRUE,
- selectize = TRUE
- ),
- selectInput(
- inputId = "labels_visual",
- "Labels to include",
- list(),
- multiple = TRUE,
- selectize = TRUE
- ),
- selectInput(
- inputId = "strings_visual",
- "Strings to include",
- list(),
- multiple = TRUE,
- selectize = TRUE
- )
- ),
-
- # Main panel for displaying outputs ----
- shiny::mainPanel(
- shiny::tabsetPanel(
- shiny::tabPanel(
- "Plot overlap as a heatmap matrix",
- shiny::downloadButton("downloadHeatPlot"),
- plotly::plotlyOutput("plotgraph1")
- ),
- shiny::tabPanel(
- "Plot overlap as an upset plot",
- shiny::downloadButton("downloadUpsetPlot"),
- shiny::plotOutput("plotgraph2")
- ),
- shiny::tabPanel(
- "Phase Analysis", # New Tab for Phase Analysis
- shiny::downloadButton("downloadPhasePlot"),
- shiny::plotOutput("phasePlot")
- )
- )
- )
- )
- ),
-
- shiny::tabPanel(
- "Tables",
-
- shiny::sidebarLayout(
-
- shiny::sidebarPanel(
- id = "sidebar",
- width = 3,
- shiny::h5("Step 6: Summary tables"),
- selectInput(
- inputId = "sources_tables",
- "Sources to include",
- list(),
- multiple = TRUE,
- selectize = TRUE
- ),
- selectInput(
- inputId = "labels_tables",
- "Labels to include",
- list(),
- multiple = TRUE,
- selectize = TRUE
- ),
- selectInput(
- inputId = "strings_tables",
- "Strings to include",
- list(),
- multiple = TRUE,
- selectize = TRUE
- )
- ),
-
- shiny::mainPanel(
- shiny::tabsetPanel(
-
- shiny::tabPanel(
- "Initial Records Table",
- shiny::div("View the initial record counts and deduplication results."),
- shinyWidgets::actionBttn(
- "generateInitialRecordTable", "Generate Initial Records Table",
- style = "jelly",
- icon = shiny::icon("table"),
- color = "primary") %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
- shiny::br(),
- shiny::br(),
- gt::gt_output("initialRecordTab")
- ),
-
- shiny::tabPanel(
- "Detailed Record Table",
- shiny::div("Summary of unique and non-unique records by source."),
- shinyWidgets::actionBttn(
- "generateDetailedRecordTable", "Generate Detailed Record Table",
- style = "jelly",
- icon = shiny::icon("table"),
- color = "primary") %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
- shiny::br(),
- shiny::br(),
- gt::gt_output("summaryRecordTab")
- ),
-
- shiny::tabPanel(
- "Precision/Sensitivity Table",
- shiny::div("Precision and Sensitivity of records across screening phases."),
- shinyWidgets::actionBttn(
- "generatePrecisionTable", "Generate Precision/Sensitivity Table",
- style = "jelly",
- icon = shiny::icon("table"),
- color = "primary") %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
- shiny::br(),
- shiny::br(),
- gt::gt_output("summaryPrecTab")
- ),
-
- shiny::tabPanel(
- "Review individual records",
- shiny::div("Note that the record table will take a long time to create if you include more than a few hundred references ... so you might want to filter your data first."),
- shiny::br(),
- shinyWidgets::actionBttn(
- "generateRecordTable", "Generate the table",
- style = "jelly",
- icon = shiny::icon("table"),
- color = "primary") %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
-
- shiny::br(),
- shiny::br(" "),
- DT::dataTableOutput("reviewTab")
- )
- )
- )
- )
- ),
-
- shiny::tabPanel(
- "Export",
- shiny::fluidRow(
- shiny::column(
- 12,
- shiny::mainPanel(
- shiny::h5("Step 7: Export citations"),
- shiny::h6("Note that you can only download the data after you have run the deduplication. Also, you are only able to re-upload CSV and RIS files to continue with CiteSource, so please use these formats if you want that option."),
- shiny::downloadButton("downloadCsv", "Download csv"),
- shiny::downloadButton("downloadRis", "Download RIS"),
- shiny::downloadButton("downloadBib", "Download BibTex")
- )
- )
- )
- )
+
+ )
+ )
+ ),
+ shiny::tabPanel(
+ "Visualise",
+
+ # Sidebar layout ----
+ shiny::sidebarLayout(
+
+ # Sidebar panel for inputs ----
+ shiny::sidebarPanel(
+ width = 3,
+ id = "sidebar",
+ shiny::h5("Step 5: Visualise overlap"),
+ shinyWidgets::prettyRadioButtons(
+ inputId = "comp_type",
+ label = "Choose a comparison",
+ inline = TRUE,
+ choices = c(
+ "sources",
+ "labels",
+ "strings"
+ ),
+ status = "primary"
+ ),
+ selectInput(
+ inputId = "sources_visual",
+ "Sources to include",
+ list(),
+ multiple = TRUE,
+ selectize = TRUE
+ ),
+ selectInput(
+ inputId = "labels_visual",
+ "Labels to include",
+ list(),
+ multiple = TRUE,
+ selectize = TRUE
+ ),
+ selectInput(
+ inputId = "strings_visual",
+ "Strings to include",
+ list(),
+ multiple = TRUE,
+ selectize = TRUE
+ )
+ ),
+
+ # Main panel for displaying outputs ----
+ shiny::mainPanel(
+ shiny::tabsetPanel(
+ shiny::tabPanel(
+ "Plot overlap as a heatmap matrix",
+ shiny::downloadButton("downloadHeatPlot"),
+ plotly::plotlyOutput("plotgraph1")
+ ),
+ shiny::tabPanel(
+ "Plot overlap as an upset plot",
+ shiny::downloadButton("downloadUpsetPlot"),
+ shiny::plotOutput("plotgraph2")
+ ),
+ shiny::tabPanel(
+ "Phase Analysis", # New Tab for Phase Analysis
+ shiny::downloadButton("downloadPhasePlot"),
+ shiny::plotOutput("phasePlot")
+ )
+ )
+ )
+ )
+ ),
+
+ shiny::tabPanel(
+ "Tables",
+
+ shiny::sidebarLayout(
+
+ shiny::sidebarPanel(
+ id = "sidebar",
+ width = 3,
+ shiny::h5("Step 6: Summary tables"),
+ selectInput(
+ inputId = "sources_tables",
+ "Sources to include",
+ list(),
+ multiple = TRUE,
+ selectize = TRUE
+ ),
+ selectInput(
+ inputId = "labels_tables",
+ "Labels to include",
+ list(),
+ multiple = TRUE,
+ selectize = TRUE
+ ),
+ selectInput(
+ inputId = "strings_tables",
+ "Strings to include",
+ list(),
+ multiple = TRUE,
+ selectize = TRUE
+ )
+ ),
+
+ shiny::mainPanel(
+ shiny::tabsetPanel(
+ shiny::tabPanel(
+ "Detailed Record Table",
+ shiny::div("Summary of unique and non-unique records by source."),
+ shinyWidgets::actionBttn(
+ "generateDetailedRecordTable", "Generate Detailed Record Table",
+ style = "jelly",
+ icon = shiny::icon("table"),
+ color = "primary") %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
+ shiny::br(),
+ shiny::br(),
+ gt::gt_output("detailedRecordTab")
+ ),
+
+ shiny::tabPanel(
+ "Precision/Sensitivity Table",
+ shiny::div("Precision and Sensitivity of records across screening phases."),
+ shinyWidgets::actionBttn(
+ "generatePrecisionTable", "Generate Precision/Sensitivity Table",
+ style = "jelly",
+ icon = shiny::icon("table"),
+ color = "primary") %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
+ shiny::br(),
+ shiny::br(),
+ gt::gt_output("summaryPrecTab")
+ ),
+
+ shiny::tabPanel(
+ "Review individual records",
+ shiny::br(),
+ shinyWidgets::actionBttn(
+ "generateRecordTable", "Generate the table",
+ style = "jelly",
+ icon = shiny::icon("table"),
+ color = "primary") %>% htmltools::tagAppendAttributes(style = "background-color: #23395B"),
+
+ shiny::br(),
+
+ shiny::wellPanel(
+ style = "background-color: #f0f8ff; border-color: #bce8f1; margin-top: 15px; margin-bottom: 15px; padding: 15px;", # Style
+ shiny::tags$h5(" Using the Interactive Record Table", style = "margin-top: 0; color: #31708f;"), # Title
+ shiny::tags$p("After clicking 'Generate the table', you can explore the records using these features:"), # Introduction
+
+ # Performance Note
+ shiny::tags$p(
+ style = "margin-bottom: 12px;",
+ shiny::tags$strong(" Performance Note:"),
+ " The record table may take a long time to generate if you include more than a few hundred references. Consider filtering your data first using the sidebar selectors before generating."
+ ),
+
+ # Instruction 1: Expand/Collapse
+ shiny::tags$p(
+ style = "margin-bottom: 12px;",
+ shiny::tags$strong(" Expand/Collapse Row:"),
+ " Click the ", shiny::tags$code(HTML("⊕")), " symbol in a row to view the full APA reference. Click ", shiny::tags$code(HTML("⊖")), " to hide it again."
+ ),
+
+ # Instruction 2: Single Sort
+ shiny::tags$p(
+ style = "margin-bottom: 12px;",
+ shiny::tags$strong(" Sort by Single Column:"),
+ " Click any column header (like 'Citation' or a source name) to sort the table by that column's values. Click the header again to reverse the sort order."
+ ),
+
+ # Instruction 3: Multi Sort
+ shiny::tags$p(
+ style = "margin-bottom: 12px;",
+ shiny::tags$strong(" Sort by Multiple Columns:"),
+ " Click the primary column header you want to sort by. Then, hold down the ", shiny::tags$strong("Shift"), " key on your keyboard and click a second column header. You can repeat this for more sorting levels."
+ ),
+
+ # Instruction 4: Filter/Search
+ shiny::tags$p(
+ style = "margin-bottom: 12px;",
+ shiny::tags$strong(" Filter/Search:"),
+ " Type into the search box located at the top-right of the table to dynamically filter records based on any information displayed."
+ ),
+
+ # Instruction 5: Download
+ shiny::tags$p(
+ shiny::tags$strong(" Download Data:"),
+ " Click the 'Download CSV' button (located above the table, next to 'Print') to save the data currently shown in the table (including applied filters) as a CSV file."
+ )
+ ),
+ DT::dataTableOutput("reviewTab")
+ )
+ )
+ )
+ )
+ ),
+
+ shiny::tabPanel(
+ "Export",
+ shiny::fluidRow(
+ shiny::column(
+ 12,
+ shiny::mainPanel(
+ shiny::h5("Step 7: Export citations"),
+ shiny::h6("Note that you can only download the data after you have run the deduplication. Also, you are only able to re-upload CSV and RIS files to continue with CiteSource, so please use these formats if you want that option."),
+ shiny::downloadButton("downloadCsv", "Download csv"),
+ shiny::downloadButton("downloadRis", "Download RIS"),
+ shiny::downloadButton("downloadBib", "Download BibTex")
+ )
+ )
+ )
+ )
)
# Define server logic to read selected file ----
server <- function(input, output, session) {
+
+ # --- Reactive Values ---
+ # Used to store data that changes during the session
rv <- shiny::reactiveValues()
rv$df <- data.frame()
- #for original uploads
- rv$upload_df <- data.frame()
- #for reimported data
- rv$latest_unique <- data.frame()
- #for potential duplicates/manual dedup
- rv$pairs_to_check <- data.frame()
- #for removed records
- rv$pairs_removed <- data.frame()
+ rv$upload_df <- data.frame()#for original uploads
+ rv$latest_unique <- data.frame()#for reimported data
+ rv$pairs_to_check <- data.frame()#for potential duplicates/manual dedup
+ rv$pairs_removed <- data.frame()#for removed records
+
+ # --- Google Analytics Integration ---
+ # Flag to ensure GA script is inserted only once per session
+ ga_script_inserted <- reactiveVal(FALSE)
+
+ # Use observeEvent on session$clientData which becomes available early
+ observeEvent(session$clientData, {
+ # Only proceed if the script hasn't been inserted yet for this session
+ if (!ga_script_inserted()) {
+ # Get the application's path from the URL (e.g., /CiteSource_latest/)
+ app_path <- session$clientData$url_pathname
+ ga_include_file <- NULL # Variable to hold the GA HTML filename
+
+ # --- Determine GA HTML filename based on the application path ---
+ # Check if the path ends with '_latest' or '_latest/' (case-insensitive)
+ if (grepl("_latest/?$", app_path, ignore.case = TRUE)) {
+ # Development version
+ message("GA: Detected DEV environment based on URL path: ", app_path) # Logging
+ # *** SET the DEV Google Analytics HTML filename ***
+ ga_include_file <- "google_analytics_dev.html" # file is in same directory as app.R
+
+ }
+ # Check if the path corresponds to the production app name (e.g., /CiteSource/ or /CiteSource)
+ # Adjust '/CiteSource/?$' if your production app name is different
+ else if (grepl("/CiteSource/?$", app_path, ignore.case = TRUE)) {
+ # Production version
+ message("GA: Detected PROD environment based on URL path: ", app_path) # Logging
+ # *** SET the PROD Google Analytics HTML filename ***
+ ga_include_file <- "google_analytics_main.html" # file is in same directory as app.R
+
+ } else {
+ # Path didn't match known patterns
+ message("GA: Could not determine environment from URL path: ", app_path) # Logging
+ }
+
+ # --- Insert the GA HTML file content if a filename was determined and file exists ---
+ if (!is.null(ga_include_file) && nzchar(ga_include_file)) {
+ # Check if the determined file actually exists in the app directory
+ if (file.exists(ga_include_file)) {
+ # Insert the content of the HTML file into the document's
+ insertUI(
+ selector = "head", # Target the tag
+ where = "beforeEnd", # Add the script at the end of the head's content
+ # Use includeHTML to read and insert the file content
+ ui = includeHTML(ga_include_file),
+ immediate = TRUE # Attempt to insert as soon as possible
+ )
+ # Set the flag to TRUE to prevent this code running again for this session
+ ga_script_inserted(TRUE)
+ message("GA: Inserted script from file: ", ga_include_file) # Logging
+ } else {
+ # Log an error if the file is missing
+ message("GA Error: HTML file not found: ", ga_include_file)
+ # Optionally set the flag anyway to prevent repeated checks for missing file
+ ga_script_inserted(TRUE)
+ }
+ } else {
+ # If no file was determined (e.g., path didn't match), set flag to prevent re-check
+ ga_script_inserted(TRUE)
+ }
+ }
+ }, ignoreNULL = TRUE, once = FALSE) # Trigger when clientData is available, but flag prevents re-run
+ # --- End Google Analytics Integration ---
#### Upload files tab section ------
# upload on click
@@ -376,23 +466,15 @@ server <- function(input, output, session) {
else {
# upload files one-by-one
path_list <- input$file$datapath
-
- # Increment the upload number
- if (is.null(rv$upload_number)) {
- rv$upload_number <- 1
- } else {
- rv$upload_number <- rv$upload_number + 1
- }
-
suggested_source <- stringr::str_replace_all(input$file$name, "\\.(ris|bib|txt)$", "")
-
+ suggested_label <- rep("search", length(input$file$datapath))
empty_strings <- rep("", length(input$file$datapath))
# Read the uploaded citations
upload_df <- CiteSource::read_citations(
files = path_list,
cite_sources = suggested_source,
- cite_labels = empty_strings,
+ cite_labels = suggested_label,
cite_strings = empty_strings,
only_key_fields = FALSE
@@ -408,7 +490,7 @@ server <- function(input, output, session) {
df <- data.frame(
"file" = input$file,
"suggested_source" = suggested_source,
- "label" = empty_strings,
+ "label" = suggested_label,
"string" = empty_strings
)
@@ -435,18 +517,25 @@ server <- function(input, output, session) {
## display summary input table - summary of files added
output$tbl_out <- DT::renderDataTable({
if (is.null(input$file_reimport)) {
- DT::datatable(rv$df,
- editable = TRUE,
- options = list(paging = FALSE,
- searching = FALSE,
- columnDefs = list(list(visible = FALSE, targets = c(0)))),
- rownames = FALSE)
+ DT::datatable(
+ rv$df,
+ options = list(
+ paging = FALSE,
+ searching = FALSE,
+ columnDefs = list(list(visible = FALSE, targets = c(0)))
+ ),
+ editable = list(
+ target = 'column',
+ disable = list(columns = c(1, 2))
+ ),
+ rownames = FALSE
+ )
}
})
shiny::observeEvent(input$file_reimport, {
file_extension <- tolower(tools::file_ext(input$file_reimport$datapath))
-
+
if (file_extension == "csv") {
rv$latest_unique <- reimport_csv(input$file_reimport$datapath)
} else if (file_extension == "ris") {
@@ -457,93 +546,213 @@ server <- function(input, output, session) {
rv$n_unique <- count_unique(rv$latest_unique)
- shinyalert::shinyalert("Re-import successful",
- paste("Imported", nrow(rv$latest_unique), "citations. You can now proceed to visualisation and tables."),
- type = "success"
- )
-
+ shinyalert::shinyalert("Re-import successful",
+ paste("Imported", nrow(rv$latest_unique), "citations. You can now proceed to visualisation and tables."),
+ type = "success"
+ )
+
})
-
+
## Update filters
shiny::observe({
- if (nrow(rv$latest_unique) > 0) {
+ # Make sure rv$latest_unique is populated and is a data frame
+ if (is.data.frame(rv$latest_unique) && nrow(rv$latest_unique) > 0) {
- # Handle cite_source
- sources <- rv$latest_unique$cite_source
- if (all(is.na(sources) | sources == "")) {
- sources <- NULL # Leave it as NULL or NA
- } else {
- sources <- unique(sources[!is.na(sources) & sources != ""]) %>%
- stringr::str_split(", ") %>%
+ # --- Handle cite_source ---
+ sources_raw <- rv$latest_unique$cite_source
+ sources_choices <- NULL # Initialize choices list
+
+ if (!all(is.na(sources_raw) | sources_raw == "")) {
+ sources_choices <- sources_raw[!is.na(sources_raw) & sources_raw != ""] %>%
+ stringr::str_split(",\\s*") %>% # Use regex for robustness
unlist() %>%
unique() %>%
sort()
}
- # Handle cite_label
- labels <- rv$latest_unique$cite_label
- if (all(is.na(labels) | labels == "")) {
- labels <- NULL # Leave it as NULL or NA
- } else {
- labels <- unique(labels[!is.na(labels) & labels != ""]) %>%
- stringr::str_split(", ") %>%
+ # *** Calculate the default selection ONLY for sources_visual (exclude "unknown") ***
+ sources_visual_selected_default <- NULL
+ if (!is.null(sources_choices)) {
+ sources_visual_selected_default <- sources_choices[sources_choices != "unknown"]
+ # Handle edge case where only "unknown" was present
+ if (length(sources_visual_selected_default) == 0 && "unknown" %in% sources_choices) {
+ sources_visual_selected_default <- NULL
+ }
+ }
+ # For sources_tables, the default remains all available choices (sources_choices)
+
+
+ # --- Handle cite_label ---
+ labels_raw <- rv$latest_unique$cite_label
+ labels_choices <- NULL
+ if (!all(is.na(labels_raw) | labels_raw == "")) {
+ labels_choices <- unique(labels_raw[!is.na(labels_raw) & labels_raw != ""]) %>%
+ stringr::str_split(",\\s*") %>%
unlist() %>%
unique() %>%
sort()
-
}
+ labels_selected_default <- labels_choices # Default: select all valid labels
- # Handle cite_string
- strings <- rv$latest_unique$cite_string
- if (all(is.na(strings) | strings == "")) {
- strings <- NULL # Leave it as NULL or NA
- } else {
- strings <- unique(strings[!is.na(strings) & strings != ""]) %>%
- stringr::str_split(", ") %>%
+ # --- Handle cite_string ---
+ strings_raw <- rv$latest_unique$cite_string
+ strings_choices <- NULL
+ if (!all(is.na(strings_raw) | strings_raw == "")) {
+ strings_choices <- unique(strings_raw[!is.na(strings_raw) & strings_raw != ""]) %>%
+ stringr::str_split(",\\s*") %>%
unlist() %>%
unique() %>%
sort()
}
+ strings_selected_default <- strings_choices # Default: select all valid strings
- # Update select inputs
- shiny::updateSelectInput(inputId = "sources_visual", choices = sources, selected = sources)
- shiny::updateSelectInput(inputId = "labels_visual", choices = labels, selected = labels)
- shiny::updateSelectInput(inputId = "strings_visual", choices = strings, selected = strings)
-
- shiny::updateSelectInput(inputId = "sources_tables", choices = sources, selected = sources)
- shiny::updateSelectInput(inputId = "labels_tables", choices = labels, selected = labels)
- shiny::updateSelectInput(inputId = "strings_tables", choices = strings, selected = strings)
+
+ # --- Update select inputs ---
+ # Use the specific default (excluding "unknown") for sources_visual
+ shiny::updateSelectInput(session, inputId = "sources_visual", choices = sources_choices, selected = sources_visual_selected_default)
+ shiny::updateSelectInput(session, inputId = "labels_visual", choices = labels_choices, selected = labels_selected_default)
+ shiny::updateSelectInput(session, inputId = "strings_visual", choices = strings_choices, selected = strings_selected_default)
+
+ # Use the original default (all choices) for sources_tables
+ shiny::updateSelectInput(session, inputId = "sources_tables", choices = sources_choices, selected = sources_choices) # Reverted to selecting all
+ shiny::updateSelectInput(session, inputId = "labels_tables", choices = labels_choices, selected = labels_selected_default)
+ shiny::updateSelectInput(session, inputId = "strings_tables", choices = strings_choices, selected = strings_selected_default)
+
+ } else {
+ # Optional: Clear the inputs if rv$latest_unique is empty or not a data frame
+ shiny::updateSelectInput(session, inputId = "sources_visual", choices = character(0), selected = character(0))
+ shiny::updateSelectInput(session, inputId = "labels_visual", choices = character(0), selected = character(0))
+ shiny::updateSelectInput(session, inputId = "strings_visual", choices = character(0), selected = character(0))
+ shiny::updateSelectInput(session, inputId = "sources_tables", choices = character(0), selected = character(0))
+ shiny::updateSelectInput(session, inputId = "labels_tables", choices = character(0), selected = character(0))
+ shiny::updateSelectInput(session, inputId = "strings_tables", choices = character(0), selected = character(0))
}
- })
-
- # when file upload table is edited, edit reactive value upload df
+ }) # End update filters observe
+
+ # Robust Observer for Cell Edits in tbl_out
shiny::observeEvent(input$tbl_out_cell_edit, {
- # make sure not blank to avoid blanks in output
-
+ # This observer handles edits made to the summary table (rv$df)
+ # and propagates relevant changes (source, label, string)
+ # to the corresponding records in the detailed table (rv$upload_df).
+
info <- input$tbl_out_cell_edit
- val <- info$value
-
- if (val == "") {
- val <- NA
+
+ # Ensure rv$df and rv$upload_df are valid data frames before proceeding
+ if (!is.data.frame(rv$df) || nrow(rv$df) == 0) {
+ # Silently return if summary data isn't ready (e.g., during initial load)
+ return()
+ }
+ if (!is.data.frame(rv$upload_df)) {
+ # Log warning if detailed data structure is missing, but allow proceeding
+ # if only rv$df needs update (though propagation will fail later)
+ warning("rv$upload_df is not a valid data frame. Edits cannot be propagated.")
+ # Depending on desired behavior, could 'return()' here too.
}
-
- rv$df[info$row, info$col + 1] <- val
- # get rownames for file
- row_indexes <- rv$upload_df %>%
- dplyr::mutate(rowname = dplyr::row_number()) %>%
- dplyr::group_by(file.datapath) %>%
- dplyr::summarise(min_row = dplyr::first(rowname), max_row = dplyr::last(rowname))
-
- rows <- row_indexes[row_indexes$file.datapath == rv$df[info$row, 1], 2:3]
- col <- paste0("cite_", names(rv$df[info$col + 1]))
- file <- rv$df[info$row, 1]
-
- rv$upload_df[c(rows$min_row:rows$max_row), col] <- val
+ # Get column names from the summary data frame
+ df_col_names <- names(rv$df)
+
+ # Determine the number of edits reported in this event
+ n_edits <- length(info$row)
+
+ # Process each reported edit individually
+ for (i in 1:n_edits) {
+ # Extract information for the current (i-th) edit
+ target_row_df <- as.integer(info$row[i]) # 1-based row index for rv$df
+ target_col_dt <- as.integer(info$col[i]) # 0-based column index from DT
+ target_col_df <- target_col_dt + 1 # Convert to 1-based R index for rv$df
+ val <- if (is.list(info$value)) info$value[[i]] else info$value[i] # Handle list/vector values
+
+ # Convert blank input ("") to logical NA
+ if (length(val) == 1 && !is.na(val) && val == "") {
+ val <- NA
+ }
+
+ # --- Validate indices against rv$df ---
+ if (target_row_df <= 0 || target_row_df > nrow(rv$df) ||
+ target_col_df <= 0 || target_col_df > ncol(rv$df)) {
+ warning(paste("Invalid row/column index received from DT edit. Row:",
+ target_row_df, "Col:", target_col_df, ". Skipping this edit."))
+ next # Skip to the next edit
+ }
+
+ # --- 1. Update rv$df (the summary table data) ---
+ # Use tryCatch to handle potential errors during assignment (e.g., type mismatch)
+ tryCatch({
+ rv$df[target_row_df, target_col_df] <- val
+ }, error = function(e) {
+ warning(paste("Error updating rv$df[", target_row_df, ",", target_col_df, "]:", e$message))
+ # Continue to the next edit even if this one failed
+ next
+ })
+
+ # --- 2. Propagate change to rv$upload_df (if applicable) ---
+
+ # Get the file.datapath associated with the edited row in rv$df
+ # This assumes column 1 of rv$df is 'file.datapath'
+ if (df_col_names[1] != "file.datapath") {
+ warning("Column 1 of rv$df is not 'file.datapath'. Cannot link edits to rv$upload_df.")
+ next # Skip propagation for this edit
+ }
+ edited_datapath <- rv$df[[target_row_df, 1]]
+
+ # Check if the datapath is valid for lookup
+ if (is.na(edited_datapath) || edited_datapath == "") {
+ # Don't warn every time, might be expected if datapath is missing
+ next # Cannot link without a valid datapath
+ }
+
+ # Check if rv$upload_df is ready for update
+ if (nrow(rv$upload_df) == 0 || !"file.datapath" %in% names(rv$upload_df)) {
+ # Silently skip if detailed data isn't ready or lacks the key column
+ next
+ }
+
+ # Find rows in rv$upload_df matching the datapath
+ target_rows_upload_idx <- which(rv$upload_df$file.datapath == edited_datapath)
+
+ if (length(target_rows_upload_idx) == 0) {
+ # No matching rows found in detailed data, nothing to propagate
+ next
+ }
+
+ # Determine the target column name in rv$upload_df based on the edited column in rv$df
+ col_name_df <- df_col_names[target_col_df] # Name of edited column in summary table
+ col_name_upload <- NULL # Target column name in detailed table
+
+ # Define the mapping for propagation
+ if (col_name_df == "source") {
+ col_name_upload <- "cite_source"
+ } else if (col_name_df == "label") {
+ col_name_upload <- "cite_label"
+ } else if (col_name_df == "string") {
+ col_name_upload <- "cite_string"
+ } else {
+ # If the edited column (e.g., 'records') shouldn't be propagated, skip
+ next
+ }
+
+ # Check if the target column exists in rv$upload_df
+ if (!col_name_upload %in% names(rv$upload_df)) {
+ warning(paste("Target column '", col_name_upload, "' not found in rv$upload_df. Cannot propagate edit."))
+ next
+ }
+
+ # Perform the update on all matching rows in the detailed data frame
+ tryCatch({
+ rv$upload_df[target_rows_upload_idx, col_name_upload] <- val
+ }, error = function(e) {
+ warning(paste("Error updating rv$upload_df rows for datapath", edited_datapath,
+ "Column:", col_name_upload, ":", e$message))
+ # Continue to the next edit even if propagation failed
+ })
+
+ } # End FOR loop iterating through edits reported by DT
+
})
-
-# Deduplication tab -----------------
-
+
+ # Deduplication tab -----------------
+
# when dedup button clicked, deduplicate
shiny::observeEvent(input$identify_dups, {
if (nrow(rv$upload_df) == 0) {
@@ -572,29 +781,24 @@ server <- function(input, output, session) {
# Generate a summary message based on deduplication results
n_citations <- nrow(rv$upload_df)
- n_distinct_records <- nrow(rv$n_unique)
- n_unique_records <- nrow(dedup_results$unique)
+ n_unique_records <- nrow(rv$n_unique) # Changed variable name to avoid conflict
n_pairs_manual <- nrow(rv$pairs_to_check)
message <- if (n_pairs_manual > 0) {
paste(
- "From the", n_citations, "records, that were uploaded, there were", n_distinct_records,
- "distinct records identified after internal source deduplication.
- Of these distinct records, there were", n_unique_records, "unique records.
- Head to the manual deduplication tab to check", n_pairs_manual, "potential duplicates."
+ "From a total of", n_citations, "citations added, there are", n_unique_records,
+ "unique citations. Head to the manual deduplication tab to check", n_pairs_manual, "potential duplicates."
)
} else {
paste(
- "From the", n_citations, "records, that were uploaded, there were", n_distinct_records,
- "distinct records identified after internal source deduplication.
- There were no potential duplicates identifid for manual review.
- You can proceed to the visualization tab."
+ "From a total of", n_citations, "citations added, there are", n_unique_records,
+ "unique citations. There are no potential duplicates for manual review. You can proceed to the visualization tab."
)
}
shinyalert::shinyalert("Auto-deduplication complete", message, type = "success")
})
-
+
## Manual deduplication -----
# Action button: remove manually selected duplicates [merged two segments into one]
@@ -616,25 +820,17 @@ server <- function(input, output, session) {
rv$latest_unique <- after
})
-
- observeEvent(input$completed_manual_dedup,{
-
- # provide shiny alert
- shinyalert::shinyalert("Manual deduplication complete",
- paste(
- "From a total of", nrow(rv$upload_df), "citations uploaded, there are", nrow(rv$latest_unique),
- "unique citations after automated and manual deduplication.
- Compare citations across sources, labels, and strings in the visualisation tab"
- ),
- type = "success"
- )
-
- })
-
observe({
- shinyWidgets::updatePickerInput(session = session, "manual_dedup_cols",
- choices = names(rv$pairs_to_check)[c(1,2,4,5,7,8,10,11,13,14,16,17,19,20,22,23,26,27,28,29,31,32,33,34,35,36)],
- selected = names(rv$pairs_to_check)[c(1,2,4,5,7,8,10,11,13,14,16,17,19,20,22,23,26,27,28,29,31,32,33,34,35,36)])
+ all_cols <- names(rv$pairs_to_check)
+ base_cols <- unique(gsub("(1|2)$", "", all_cols)) # Remove "1" or "2" suffix
+
+ # Initial selection
+ initial_base_selection <- c("year", "author", "title", "journal", "abstract",
+ "doi", "pages", "source", "label")
+
+ shinyWidgets::updatePickerInput(session = session, "manual_dedup_cols",
+ choices = base_cols,
+ selected = initial_base_selection)
})
@@ -647,7 +843,7 @@ server <- function(input, output, session) {
selected = "Visualise"
)
})
-
+
# if rows selected in manual dedup, make buttom appear
observe({
selected_rows <- input$manual_dedup_dt_rows_selected
@@ -662,17 +858,40 @@ server <- function(input, output, session) {
manual_dedup_data <- reactive({
data <- rv$pairs_to_check[,1:36]
- data <- data[,c(paste0(input$manual_dedup_cols))]
+ selected_cols <- input$manual_dedup_cols
+
+ # Define the desired base order
+ core_col_order <- c("author", "title", "year", "journal", "abstract","doi", "pages","volume","number","source","label","string")
+ # Create the desired interleaved order of columns to select
+
+ desired_table_order <- character(0)
+ for (base_col in core_col_order) {
+ col1 <- paste0(base_col, "1")
+ col2 <- paste0(base_col, "2")
+ desired_table_order <- c(desired_table_order, col1, col2)
+ }
+
+ # Intersect with the actual and selected columns to maintain order and presence
+ cols_to_show <- intersect(desired_table_order, colnames(data))
+ cols_to_show <- intersect(cols_to_show, paste0(selected_cols, rep(c("1", "2"), each = length(selected_cols))))
+ ordered_data <- data %>%
+ dplyr::select(any_of(cols_to_show))
+
+ # Define match_cols INSIDE the reactive expression
match_cols <- c("title", "author", "doi", "volume",
"pages", "number", "year", "abstract", "journal", "isbn")
- data <- data %>% dplyr::select(-any_of(match_cols))
- match_number_cols <- rv$pairs_to_check[,c(paste0(match_cols))]
-
- data <- cbind(data,match_number_cols)
-
+ # Add the match_number_cols at the end (if they exist)
+
+ match_number_cols_to_add <- intersect(paste0(match_cols), colnames(data))
+ if (length(match_number_cols_to_add) > 0) {
+ ordered_data <- cbind(ordered_data, data[, match_number_cols_to_add])
+ }
+
+ ordered_data
+
})
output$manual_dedup_dt <- DT::renderDataTable({
@@ -690,8 +909,9 @@ server <- function(input, output, session) {
datatable(data,
options = list(
- pageLength = 100, info = FALSE,
- lengthMenu = list(c(100, -1), c("100", "All")),
+ pageLength = 100,
+ info = FALSE,
+ lengthMenu = list(c(100, -1), c("100", "All")),
columnDefs =
list(
list(visible = FALSE,
@@ -707,54 +927,212 @@ server <- function(input, output, session) {
)
)
))
- # ) %>%
- # DT::formatStyle(
- # columns = format_cols,
- # backgroundColor = DT::styleInterval(c(0.95, 1), c("white", "#82d173", "#82d173")),
- # target = "row"
- # ) %>%
- # DT::formatStyle(
- # columns = format_cols,
- # backgroundColor = DT::styleInterval(c(0.95, 1), c("white", "#82d173", "#82d173")),
- # target = "cell",
- # color = JS("value >= 0.95 ? 'white' : null")
- # )
})
-
-
+
+
# ASySD manual dedup pre text
output$Manual_pretext <- shiny::renderText({
-
+
paste(nrow(rv$pairs_to_check), "pairs of citations require manual deduplication. Review the pairs in the table
below.")
-
+
})
-
-
+
+
#### Visualise tab ####
- # Reactive expression to filter the data for visualization
+ # Reactive expression to filter the data for visualization (used for Heatmap and Upset)
unique_filtered_visual <- shiny::reactive({
- sources <- input$sources_visual
- sources <- ifelse(sources == "_blank_", "unknown", sources)
- strings <- input$strings_visual
- strings <- ifelse(strings == "_blank_", "unknown", strings)
- labels <- input$labels_visual
- labels <- ifelse(labels == "_blank_", "unknown", labels)
-
- out <- rv$latest_unique %>%
- dplyr::group_by(duplicate_id) %>%
- tidyr::separate_rows(c(record_ids, cite_label, cite_source, cite_string), sep=", ") %>%
- dplyr::filter(length(sources) == 0 | cite_source %in% sources) %>%
- dplyr::filter(length(strings) == 0 | cite_string %in% strings) %>%
- dplyr::filter(length(labels) == 0 | cite_label %in% labels) %>%
- dplyr::summarise(across(c(record_ids, cite_label, cite_source, cite_string), ~ trimws(paste(na.omit(.), collapse = ', ')))) %>%
- dplyr::ungroup()
+ shiny::req(rv$latest_unique, is.data.frame(rv$latest_unique), nrow(rv$latest_unique) > 0)
+
+ data_in <- rv$latest_unique
+
+ sources_selected_in_input <- input$sources_visual
+ sources_selected_in_input <- sources_selected_in_input[!is.na(sources_selected_in_input) & sources_selected_in_input != ""]
+
+ labels_selected_in_input <- input$labels_visual
+ labels_selected_in_input <- labels_selected_in_input[!is.na(labels_selected_in_input) & labels_selected_in_input != ""]
+
+ strings_selected_in_input <- input$strings_visual
+ strings_selected_in_input <- strings_selected_in_input[!is.na(strings_selected_in_input) & strings_selected_in_input != ""]
+
+ # Step 1: Filter rows to ensure they contain at least one selected item from ANY category
+ # This pre-filters, but the main goal is to correctly process the strings in Step 2
+ data_candidate_rows <- data_in
+
+ # Apply row-level filtering if selections are made.
+ # If a category (e.g. sources) has selections, row must match one of them.
+ # If a category has NO selections, that category doesn't restrict rows.
+ if (length(sources_selected_in_input) > 0) {
+ pattern <- paste0("\\b(", paste(sources_selected_in_input, collapse = "|"), ")\\b")
+ if ("cite_source" %in% names(data_candidate_rows) && is.character(data_candidate_rows$cite_source)) {
+ data_candidate_rows <- data_candidate_rows %>%
+ dplyr::filter(stringr::str_detect(as.character(cite_source), pattern))
+ } else { data_candidate_rows <- data_candidate_rows %>% dplyr::slice(0) } # No relevant column, empty
+ }
+ # Only proceed if rows remain
+ if(nrow(data_candidate_rows) == 0) return(rv$latest_unique %>% dplyr::slice(0))
+
+
+ if (length(labels_selected_in_input) > 0) {
+ pattern <- paste0("\\b(", paste(labels_selected_in_input, collapse = "|"), ")\\b")
+ if ("cite_label" %in% names(data_candidate_rows) && is.character(data_candidate_rows$cite_label)) {
+ data_candidate_rows <- data_candidate_rows %>%
+ dplyr::filter(stringr::str_detect(as.character(cite_label), pattern))
+ } else { data_candidate_rows <- data_candidate_rows %>% dplyr::slice(0) }
+ }
+ if(nrow(data_candidate_rows) == 0) return(rv$latest_unique %>% dplyr::slice(0))
+
+
+ if (length(strings_selected_in_input) > 0) {
+ pattern <- paste0("\\b(", paste(strings_selected_in_input, collapse = "|"), ")\\b")
+ if ("cite_string" %in% names(data_candidate_rows) && is.character(data_candidate_rows$cite_string)) {
+ data_candidate_rows <- data_candidate_rows %>%
+ dplyr::filter(stringr::str_detect(as.character(cite_string), pattern))
+ } else { data_candidate_rows <- data_candidate_rows %>% dplyr::slice(0) }
+ }
+ if(nrow(data_candidate_rows) == 0) return(rv$latest_unique %>% dplyr::slice(0))
+
+
+ # Step 2: Mutate the columns to only contain selected items
+ data_processed_cols <- data_candidate_rows %>%
+ dplyr::mutate(
+ cite_source = if ("cite_source" %in% names(.)) {
+ sapply(as.character(cite_source), function(cs_val) {
+ if (is.na(cs_val) || cs_val == "") return("")
+ items <- stringr::str_split(cs_val, ",\\s*")[[1]]
+ items <- items[!is.na(items) & items != ""]
+
+ items_to_keep <- if (length(sources_selected_in_input) > 0) {
+ items[items %in% sources_selected_in_input]
+ } else { # If no specific sources were selected by user, keep all original (valid) items for this row
+ items
+ }
+ paste(unique(items_to_keep), collapse = ", ") # Ensure unique items are pasted
+ }, USE.NAMES = FALSE)
+ } else { NA_character_ },
+
+ cite_label = if ("cite_label" %in% names(.)) {
+ sapply(as.character(cite_label), function(cl_val) {
+ if (is.na(cl_val) || cl_val == "") return("")
+ items <- stringr::str_split(cl_val, ",\\s*")[[1]]
+ items <- items[!is.na(items) & items != ""]
+ items_to_keep <- if (length(labels_selected_in_input) > 0) {
+ items[items %in% labels_selected_in_input]
+ } else {
+ items
+ }
+ paste(unique(items_to_keep), collapse = ", ")
+ }, USE.NAMES = FALSE)
+ } else { NA_character_ },
+
+ cite_string = if ("cite_string" %in% names(.)) {
+ sapply(as.character(cite_string), function(cstr_val) {
+ if (is.na(cstr_val) || cstr_val == "") return("")
+ items <- stringr::str_split(cstr_val, ",\\s*")[[1]]
+ items <- items[!is.na(items) & items != ""]
+ items_to_keep <- if (length(strings_selected_in_input) > 0) {
+ items[items %in% strings_selected_in_input]
+ } else {
+ items
+ }
+ paste(unique(items_to_keep), collapse = ", ")
+ }, USE.NAMES = FALSE)
+ } else { NA_character_ }
+ )
+
+ # Step 3: Filter out rows where the column relevant to comp_type became empty
+ # This ensures that if comp_type is "sources", only rows with non-empty cite_source are passed.
+ data_final <- data_processed_cols
+ current_comp_type <- input$comp_type # Get the comparison type
+
+ if (current_comp_type == "sources") {
+ if ("cite_source" %in% names(data_final)) {
+ data_final <- data_final %>% dplyr::filter(!is.na(cite_source) & cite_source != "")
+ } else { # If cite_source column doesn't exist, return empty
+ return(rv$latest_unique %>% dplyr::slice(0))
+ }
+ } else if (current_comp_type == "labels") {
+ if ("cite_label" %in% names(data_final)) {
+ data_final <- data_final %>% dplyr::filter(!is.na(cite_label) & cite_label != "")
+ } else {
+ return(rv$latest_unique %>% dplyr::slice(0))
+ }
+ } else if (current_comp_type == "strings") {
+ if ("cite_string" %in% names(data_final)) {
+ data_final <- data_final %>% dplyr::filter(!is.na(cite_string) & cite_string != "")
+ } else {
+ return(rv$latest_unique %>% dplyr::slice(0))
+ }
+ }
+
+ return(data_final)
})
- # Heatmap plot
+ # REACTIVE for Phase Plot Data
+ unique_separated_phase <- shiny::reactive({
+ # Require rv$latest_unique to have data
+ shiny::req(nrow(rv$latest_unique) > 0)
+
+ # Get filter inputs
+ sources_filt <- input$sources_visual
+ sources_filt <- ifelse(sources_filt == "_blank_", "unknown", sources_filt)
+ labels_filt <- input$labels_visual
+ labels_filt <- ifelse(labels_filt == "_blank_", "unknown", labels_filt)
+
+ # Start with the base unique data, select columns needed
+ df <- rv$latest_unique %>%
+ dplyr::select(duplicate_id, cite_source, cite_label) # Add record_ids if needed
+
+ # Separate rows for source and label
+ df_long <- df %>%
+ tidyr::separate_rows(cite_source, sep = ",\\s*") %>%
+ tidyr::separate_rows(cite_label, sep = ",\\s*") %>%
+ dplyr::filter(!is.na(cite_source) & cite_source != "", # Ensure no blank/NA sources/labels after separation
+ !is.na(cite_label) & cite_label != "")
+
+ # Apply filtering based on selected sources and labels for the plot
+ df_filtered <- df_long %>%
+ dplyr::filter(length(sources_filt) == 0 | cite_source %in% sources_filt) %>%
+ dplyr::filter(length(labels_filt) == 0 | cite_label %in% labels_filt)
+
+ # Check if filtering resulted in empty data
+ if (nrow(df_filtered) == 0) {
+ # Return an empty tibble with correct columns/types if no data matches
+ return(tibble::tibble(
+ duplicate_id = character(),
+ cite_source = character(),
+ cite_label = character(),
+ type = factor(levels = c("unique", "duplicated"))
+ ))
+ }
+
+ # Calculate 'type' based on uniqueness *within* each phase (label) for the *filtered* set
+ # A record is 'unique' in a phase if it's found in only 1 source within that phase in the filtered data
+ df_typed <- df_filtered %>%
+ dplyr::group_by(duplicate_id, cite_label) %>%
+ dplyr::mutate(n_sources_in_phase = dplyr::n_distinct(cite_source)) %>%
+ dplyr::ungroup() %>%
+ dplyr::mutate(
+ type = factor(
+ ifelse(n_sources_in_phase == 1, "unique", "duplicated"),
+ levels = c("unique", "duplicated")
+ )
+ ) %>%
+ # Select relevant columns needed by plot_contributions
+ dplyr::select(duplicate_id, cite_source, cite_label, type)
+
+ # Return the long data frame, ensuring distinct rows
+ dplyr::distinct(df_typed)
+ })# End Phase Plot Reactive
+
+
+ # Heatmap plot (uses unique_filtered_visual)
plotHeat <- shiny::reactive({
- source_comparison <- compare_sources(unique_filtered_visual(), comp_type = input$comp_type)
+ # Add check if data is available
+ data_vis <- unique_filtered_visual()
+ shiny::req(nrow(data_vis) > 0)
+ source_comparison <- compare_sources(data_vis, comp_type = input$comp_type)
plot_source_overlap_heatmap(source_comparison, cells = stringr::str_sub(input$comp_type, end = -2))
})
@@ -766,24 +1144,38 @@ server <- function(input, output, session) {
)
shiny::req(FALSE)
}
-
+ # Add check specific to filtered data for this plot
+ shiny::req(nrow(unique_filtered_visual()) > 0, cancelOutput = TRUE)
print(plotHeat())
})
output$downloadHeatPlot <- shiny::downloadHandler(
filename = function() {
- paste("heatmap", ".png", sep = "")
+ paste("heatmap-overlap", Sys.Date(), ".png", sep = "") # Added date for uniqueness
},
content = function(file) {
- png(file)
- print(plotHeat())
- dev.off()
+ # Ensure data is available
+ shiny::req(nrow(unique_filtered_visual()) > 0)
+
+ # Generate the plot object
+ heat_plot_obj <- plotHeat()
+
+ # Check if plot object was created successfully
+ if (!is.null(heat_plot_obj)) {
+ # Save the ggplot object directly using ggsave
+ ggplot2::ggsave(filename = file, plot = heat_plot_obj, device = "png", width = 10, height = 8, dpi = 300) # Adjust size/dpi as needed
+ } else {
+ stop("Failed to generate heatmap plot for download.")
+ }
}
)
- # Upset plot
+ # Upset plot (uses unique_filtered_visual)
plotUpset <- shiny::reactive({
- source_comparison <- compare_sources(unique_filtered_visual(), comp_type = input$comp_type)
+ # Add check if data is available
+ data_vis <- unique_filtered_visual()
+ shiny::req(nrow(data_vis) > 0)
+ source_comparison <- compare_sources(data_vis, comp_type = input$comp_type)
plot_source_overlap_upset(source_comparison, groups = stringr::str_sub(input$comp_type, end = -2), decreasing = c(TRUE, TRUE))
})
@@ -795,117 +1187,405 @@ server <- function(input, output, session) {
)
shiny::req(FALSE)
}
+ # Add check specific to filtered data for this plot
+ shiny::req(nrow(unique_filtered_visual()) > 0, cancelOutput = TRUE)
print(plotUpset())
})
output$downloadUpsetPlot <- shiny::downloadHandler(
filename = function() {
- paste("upset", ".png", sep = "")
+ paste("upset-overlap", Sys.Date(), ".png", sep = "") # Added date
},
content = function(file) {
- png(file)
- print(plotUpset())
- dev.off()
+ # Ensure data is available
+ shiny::req(nrow(unique_filtered_visual()) > 0)
+
+ # Generate the plot object (we need it to print)
+ upset_plot_obj <- plotUpset() # plotUpset() returns the plot object
+
+ # Check if plot object was created successfully
+ if (!is.null(upset_plot_obj)) {
+ # Use png device for static plot
+ grDevices::png(file, width = 1200, height = 800, res = 100) # Adjust size/resolution
+ # Print the plot object to the device
+ print(upset_plot_obj)
+ # The device is automatically closed by downloadHandler
+ grDevices::dev.off() # Explicitly close device for clarity/safety
+ } else {
+ stop("Failed to generate upset plot for download.")
+
+ }
}
)
- # Phase Analysis plot
- # Update n_unique based on the filtered data
+ # Phase Analysis plot (uses unique_separated_phase reactive)
+ # Keep rv$n_unique definition as is for potential use in table functions,
+ # but note it relies on the potentially problematic unique_filtered_visual().
+ # If table functions are updated or don't rely on this specific structure,
+ # this reactive could be revisited or removed.
rv$n_unique <- shiny::reactive({
- filtered_data <- unique_filtered_visual()
- count_unique(filtered_data)
+ # Original logic based on unique_filtered_visual and count_unique
+ # Ensure unique_filtered_visual() is not empty
+ ufv <- unique_filtered_visual()
+ shiny::req(nrow(ufv) > 0)
+ count_unique(ufv) # Pass the wide, summarized, filtered data
})
+ # Phase plot output
output$phasePlot <- shiny::renderPlot({
- unique_citations <- unique_filtered_visual()
- rv$n_unique<- count_unique(unique_citations)
- plot_contributions(
- data = rv$n_unique,
+ # Initial check if any data has been processed
+ if (nrow(rv$latest_unique) == 0) {
+ shinyalert::shinyalert("Data needed",
+ "Please import and deduplicate your citations first.",
+ type = "error")
+ shiny::req(FALSE, cancelOutput = TRUE)
+ }
+
+ # Use the reactive data specifically prepared for this plot
+ plot_data <- unique_separated_phase()
+
+ # Check if the prepared data is empty after filtering
+ if (nrow(plot_data) == 0) {
+ # Optionally, display a message instead of just cancelling
+ plot.new()
+ mtext("No data matches the selected filters for Phase Analysis.")
+ shiny::req(FALSE, cancelOutput = TRUE)
+ }
+
+ # Call plot_contributions with the prepared data
+ CiteSource::plot_contributions( # Explicitly call from CiteSource if needed
+ data = plot_data, # Use the new reactive data
center = TRUE,
- bar_order = c("search", "screened", "final"),
- color_order = c("unique", "duplicated")
+ bar_order = c("search", "screened", "final"), # Keep or make dynamic?
+ color_order = c("unique", "duplicated"),
+ totals_in_legend = FALSE #legend total needs an update
)
})
+ # Phase plot download
output$downloadPhasePlot <- shiny::downloadHandler(
filename = function() {
- paste("phase_analysis", ".png", sep = "")
+ paste("phase-analysis", Sys.Date(), ".png", sep = "") # Added date
},
content = function(file) {
- png(file)
- print(
- plot_contributions(
- data = rv$n_unique,
- center = TRUE,
- bar_order = c("search", "screened", "final"),
- color_order = c("unique", "duplicated")
- )
+ # Use the NEW reactive data
+ plot_data <- unique_separated_phase()
+
+ # Add check if data is empty
+ if (nrow(plot_data) == 0) {
+ # Stop execution or create a plot with a message
+ stop("No data available to plot based on current filters.")
+ }
+
+ # Generate the plot object itself
+ phase_plot_obj <- CiteSource::plot_contributions( # Explicitly call from CiteSource if needed
+ data = plot_data, # Use the prepared reactive data
+ center = TRUE,
+ bar_order = c("search", "screened", "final"), # Make dynamic if needed
+ color_order = c("unique", "duplicated"),
+ totals_in_legend = FALSE
)
- dev.off()
+
+ # Check if plot object was created successfully
+ if (!is.null(phase_plot_obj)) {
+ grDevices::png(file, width = 1000, height = 700, res=100) # Adjust size/resolution
+ print(phase_plot_obj) # Print the generated plot object
+ grDevices::dev.off() # Explicitly close device
+ } else {
+ stop("Failed to generate phase plot for download.")
+ }
}
)
+
#### Table tab ####
# Event reactive for filtering the data used in the record table and summary table
unique_filtered_table <- shiny::eventReactive(
- c(input$generateRecordTable, input$generateSummaryTable,
- input$sources_tables, input$strings_tables, input$labels_tables,
- input$generateInitialRecordTable, input$generateDetailedRecordTable,
+ c(input$generateRecordTable,
+ input$sources_tables,
+ input$strings_tables,
+ input$labels_tables,
+ input$generateDetailedRecordTable,
input$generatePrecisionTable),
{
- sources <- input$sources_tables
- sources <- ifelse(sources == "_blank_", "unknown", sources)
- strings <- input$strings_tables
- strings <- ifelse(strings == "_blank_", "unknown", strings)
- labels <- input$labels_tables
- labels <- ifelse(labels == "_blank_", "unknown", labels)
-
- rv$latest_unique %>%
- dplyr::group_by(duplicate_id) %>%
- tidyr::separate_rows(c(record_ids, cite_label, cite_source, cite_string), sep=", ") %>%
- dplyr::filter(length(sources) == 0 | cite_source %in% sources) %>%
- dplyr::filter(length(strings) == 0 | cite_string %in% strings) %>%
- dplyr::filter(length(labels) == 0 | cite_label %in% labels) %>%
- dplyr::mutate(across(c(record_ids, cite_label, cite_source, cite_string), ~ trimws(paste(na.omit(.), collapse = ', ')))) %>%
- unique() %>%
- dplyr::ungroup()
- }
- )
+ shiny::req(rv$latest_unique, is.data.frame(rv$latest_unique), nrow(rv$latest_unique) > 0)
+
+ data_in <- rv$latest_unique
+
+ # Get current selections from table filters
+ sources_sel_tbl <- input$sources_tables
+ sources_sel_tbl <- sources_sel_tbl[!is.na(sources_sel_tbl) & sources_sel_tbl != ""] # Clean selections
+
+ labels_sel_tbl <- input$labels_tables
+ labels_sel_tbl <- labels_sel_tbl[!is.na(labels_sel_tbl) & labels_sel_tbl != ""]
+
+ strings_sel_tbl <- input$strings_tables
+ strings_sel_tbl <- strings_sel_tbl[!is.na(strings_sel_tbl) & strings_sel_tbl != ""]
+
+ # Step 1: Filter rows based on selections.
+ # A row must match selections in each category that HAS selections.
+ data_candidate_rows <- data_in
+
+ if (length(sources_sel_tbl) > 0) { # Only filter by source if sources are selected in the input
+ pattern <- paste0("\\b(", paste(sources_sel_tbl, collapse = "|"), ")\\b")
+ if ("cite_source" %in% names(data_candidate_rows) && is.character(data_candidate_rows$cite_source)) {
+ data_candidate_rows <- data_candidate_rows %>%
+ dplyr::filter(stringr::str_detect(as.character(cite_source), pattern))
+ } else { # If cite_source column is missing, no rows can match this criteria
+ data_candidate_rows <- data_candidate_rows %>% dplyr::slice(0)
+ }
+ }
+ # If no rows remain after source filtering (and sources were selected), return empty
+ if(nrow(data_candidate_rows) == 0 && length(sources_sel_tbl) > 0) return(rv$latest_unique %>% dplyr::slice(0))
+
+
+ if (length(labels_sel_tbl) > 0) { # Only filter by label if labels are selected
+ pattern <- paste0("\\b(", paste(labels_sel_tbl, collapse = "|"), ")\\b")
+ if ("cite_label" %in% names(data_candidate_rows) && is.character(data_candidate_rows$cite_label)) {
+ data_candidate_rows <- data_candidate_rows %>%
+ dplyr::filter(stringr::str_detect(as.character(cite_label), pattern))
+ } else {
+ data_candidate_rows <- data_candidate_rows %>% dplyr::slice(0)
+ }
+ }
+ if(nrow(data_candidate_rows) == 0 && length(labels_sel_tbl) > 0) return(rv$latest_unique %>% dplyr::slice(0))
+
+
+ if (length(strings_sel_tbl) > 0) { # Only filter by string if strings are selected
+ pattern <- paste0("\\b(", paste(strings_sel_tbl, collapse = "|"), ")\\b")
+ if ("cite_string" %in% names(data_candidate_rows) && is.character(data_candidate_rows$cite_string)) {
+ data_candidate_rows <- data_candidate_rows %>%
+ dplyr::filter(stringr::str_detect(as.character(cite_string), pattern))
+ } else {
+ data_candidate_rows <- data_candidate_rows %>% dplyr::slice(0)
+ }
+ }
+ # If, after all row filtering, no candidates remain, return an empty frame
+ if(nrow(data_candidate_rows) == 0) return(rv$latest_unique %>% dplyr::slice(0))
+
+
+ # Step 2: For the remaining rows, mutate their cite_source, cite_label, cite_string
+ # to only contain the items that were actually selected in the input filters.
+ data_processed_cols <- data_candidate_rows %>%
+ dplyr::mutate(
+ cite_source = if ("cite_source" %in% names(.)) {
+ sapply(as.character(cite_source), function(cs_val) {
+ if (is.na(cs_val) || cs_val == "") return("")
+ items <- stringr::str_split(cs_val, ",\\s*")[[1]]
+ items <- items[!is.na(items) & items != ""] # Clean items
+
+ # If user selected specific sources for tables, filter by that selection
+ # Otherwise (if input$sources_tables was empty), keep all original items for this record
+ items_to_keep <- if (length(sources_sel_tbl) > 0) {
+ items[items %in% sources_sel_tbl]
+ } else {
+ items
+ }
+ paste(unique(items_to_keep), collapse = ", ") # Ensure unique items are pasted
+ }, USE.NAMES = FALSE) # Prevent sapply from naming the vector
+ } else { NA_character_ }, # Column didn't exist
+
+ cite_label = if ("cite_label" %in% names(.)) {
+ sapply(as.character(cite_label), function(cl_val) {
+ if (is.na(cl_val) || cl_val == "") return("")
+ items <- stringr::str_split(cl_val, ",\\s*")[[1]]
+ items <- items[!is.na(items) & items != ""]
+ items_to_keep <- if (length(labels_sel_tbl) > 0) {
+ items[items %in% labels_sel_tbl]
+ } else {
+ items
+ }
+ paste(unique(items_to_keep), collapse = ", ")
+ }, USE.NAMES = FALSE)
+ } else { NA_character_ },
+
+ cite_string = if ("cite_string" %in% names(.)) {
+ sapply(as.character(cite_string), function(cstr_val) {
+ if (is.na(cstr_val) || cstr_val == "") return("")
+ items <- stringr::str_split(cstr_val, ",\\s*")[[1]]
+ items <- items[!is.na(items) & items != ""]
+ items_to_keep <- if (length(strings_sel_tbl) > 0) {
+ items[items %in% strings_sel_tbl]
+ } else {
+ items
+ }
+ paste(unique(items_to_keep), collapse = ", ")
+ }, USE.NAMES = FALSE)
+ } else { NA_character_ }
+ ) # End mutate
+
+ # Step 3: Filter out rows that might have become "empty" in all key identifier fields
+ # (cite_source, cite_label, cite_string) after the transformation.
+ # This prevents passing rows that are no longer meaningful based on these common categorizations.
+ data_final <- data_processed_cols %>%
+ dplyr::filter(
+ !( (is.na(cite_source) | cite_source == "") &
+ (is.na(cite_label) | cite_label == "") &
+ (is.na(cite_string) | cite_string == "") )
+ )
+
+ # If, after all processing, the dataframe is empty, return an empty version
+ # of the original structure to avoid downstream errors with missing columns.
+ if(nrow(data_final) == 0) {
+ return(rv$latest_unique %>% dplyr::slice(0))
+ }
+
+ return(data_final)
+ } # End eventReactive logic
+ ) # End unique_filtered_table
- # Rendering the initial record table
- output$initialRecordTab <- gt::render_gt({
- if (nrow(rv$latest_unique) == 0) {
- shinyalert::shinyalert("Data needed",
- "Please import and deduplicate your citations first.",
- type = "error"
+ detailed_table_data <- reactive({
+ # Require base data to proceed
+ shiny::req(is.data.frame(rv$latest_unique), nrow(rv$latest_unique) > 0)
+
+ # Get current filter selections from the UI
+ sources_filt <- input$sources_tables
+ sources_filt <- ifelse(sources_filt == "_blank_", "unknown", sources_filt)
+ labels_filt <- input$labels_tables
+ labels_filt <- ifelse(labels_filt == "_blank_", "unknown", labels_filt)
+ strings_filt <- input$strings_tables
+ strings_filt <- ifelse(strings_filt == "_blank_", "unknown", strings_filt)
+
+ # Create filter patterns (ensure robust handling of empty/NA filter values)
+ labels_filt_cleaned <- labels_filt[!is.na(labels_filt) & labels_filt != ""]
+ labels_pattern <- if (length(labels_filt_cleaned) > 0) paste0("\\b(", paste(labels_filt_cleaned, collapse = "|"), ")\\b") else NULL
+
+ strings_filt_cleaned <- strings_filt[!is.na(strings_filt) & strings_filt != ""]
+ strings_pattern <- if (length(strings_filt_cleaned) > 0) paste0("\\b(", paste(strings_filt_cleaned, collapse = "|"), ")\\b") else NULL
+
+ # Apply initial filters for labels and strings only
+ df_filtered_wide <- rv$latest_unique %>%
+ dplyr::filter(
+ (is.null(labels_pattern) | stringr::str_detect(as.character(cite_label), labels_pattern)),
+ (is.null(strings_pattern) | stringr::str_detect(as.character(cite_string), strings_pattern))
)
- shiny::req(FALSE)
- }
- unique_citations <- unique_filtered_table()
- initial_records <- calculate_initial_records(unique_citations, "search")
- create_initial_record_table(initial_records)
- }) %>% shiny::bindEvent(input$generateInitialRecordTable)
-
- # Rendering the detailed record table
- output$summaryRecordTab <- gt::render_gt({
- if (nrow(rv$latest_unique) == 0) {
- shinyalert::shinyalert("Data needed",
- "Please import and deduplicate your citations first.",
- type = "error"
+ empty_result_df <- tibble::tibble( # Define structure for empty returns
+ Source = character(), `Records Imported` = integer(), `Distinct Records` = integer(),
+ `Unique Records` = integer(), `Non-unique Records` = integer(),
+ `Source Contribution %` = character(), `Source Unique Contribution %` = character(),
+ `Source Unique %` = character() )
+
+ if (nrow(df_filtered_wide) == 0) { return(empty_result_df) }
+
+ # Separate cite_source column
+ df_long_source <- df_filtered_wide %>%
+ dplyr::select(duplicate_id, cite_source, cite_label, cite_string) %>%
+ tidyr::separate_rows(cite_source, sep = ",\\s*") %>%
+ dplyr::mutate(cite_source = trimws(cite_source)) %>%
+ dplyr::filter(!is.na(cite_source) & cite_source != "")
+
+ # Apply source filter
+ sources_filt_cleaned <- sources_filt[!is.na(sources_filt) & sources_filt != ""]
+ df_long_source_filtered <- df_long_source %>%
+ dplyr::filter(length(sources_filt_cleaned) == 0 | cite_source %in% sources_filt_cleaned)
+
+ if (nrow(df_long_source_filtered) == 0) { return(empty_result_df) }
+
+ # Calculate 'Records Imported' and 'Distinct Records' per source
+ source_base_counts <- df_long_source_filtered %>%
+ dplyr::group_by(cite_source) %>%
+ dplyr::summarise(
+ `Records Imported` = dplyr::n(),
+ `Distinct Records` = dplyr::n_distinct(duplicate_id), # 'Distinct Records' for this source
+ .groups = 'drop'
)
- shiny::req(FALSE)
- }
- unique_citations <- unique_filtered_table()
- detailed_count <- calculate_detailed_records(unique_citations, rv$n_unique, "search")
- create_detailed_record_table(detailed_count)
+ if (nrow(source_base_counts) == 0) { return(empty_result_df) } # Ensure source_base_counts has rows for sum below
+
+ # Calculate 'Unique Records' per source
+ record_source_counts <- df_long_source_filtered %>%
+ dplyr::group_by(duplicate_id) %>%
+ dplyr::summarise(n_sources_for_id = dplyr::n_distinct(cite_source), .groups = 'drop')
+
+ unique_record_sources <- df_long_source_filtered %>% # Records found in only one of the *currently filtered* sources
+ dplyr::inner_join(record_source_counts, by = "duplicate_id") %>%
+ dplyr::filter(n_sources_for_id == 1) %>%
+ dplyr::distinct(duplicate_id, cite_source) # Get the source for these unique records
+
+ source_unique_counts <- unique_record_sources %>%
+ dplyr::group_by(cite_source) %>%
+ dplyr::summarise(`Unique Records` = dplyr::n_distinct(duplicate_id), .groups = 'drop')
+
+ # Combine counts
+ detailed_counts_per_source <- source_base_counts %>%
+ dplyr::left_join(source_unique_counts, by = "cite_source") %>%
+ dplyr::mutate(
+ `Unique Records` = tidyr::replace_na(`Unique Records`, 0),
+ `Non-unique Records` = `Distinct Records` - `Unique Records`
+ )
+
+ # Denominator for 'Source Contribution %' should be the sum of 'Distinct Records' from each source.
+ denominator_source_contribution <- sum(detailed_counts_per_source$`Distinct Records`, na.rm = TRUE)
+ denominator_source_contribution_safe <- ifelse(denominator_source_contribution == 0, 1, denominator_source_contribution)
+
+ # Denominator for 'Source Unique Contribution %' (total unique records overall from *these filtered sources*)
+ total_overall_unique_records = dplyr::n_distinct(unique_record_sources$duplicate_id) # Count unique IDs from records that are unique to some source
+ denominator_source_unique_contribution_safe <- ifelse(total_overall_unique_records == 0, 1, total_overall_unique_records)
+
+
+ # Calculate percentages
+ detailed_counts_final <- detailed_counts_per_source %>%
+ dplyr::mutate(
+ perc_contr = `Distinct Records` / denominator_source_contribution_safe, # MODIFIED DENOMINATOR
+ perc_unique_contr = `Unique Records` / denominator_source_unique_contribution_safe,
+ perc_source_unique = ifelse(`Distinct Records` == 0, 0, `Unique Records` / `Distinct Records`)
+ ) %>%
+ dplyr::mutate(
+ `Source Contribution %` = scales::percent(perc_contr, accuracy = 0.1),
+ `Source Unique Contribution %` = scales::percent(perc_unique_contr, accuracy = 0.1),
+ `Source Unique %` = scales::percent(perc_source_unique, accuracy = 0.1)
+ ) %>%
+ dplyr::select(
+ cite_source, `Records Imported`, `Distinct Records`, `Unique Records`,
+ `Non-unique Records`, `Source Contribution %`,
+ `Source Unique Contribution %`, `Source Unique %`
+ )
+
+ # --- TOTAL ROW ---
+ # 'Total Distinct Records' in the total row should be the overall number of unique duplicate_ids found.
+ overall_total_distinct_records <- dplyr::n_distinct(df_long_source_filtered$duplicate_id)
+
+ total_row <- tibble::tibble(
+ cite_source = "Total",
+ `Records Imported` = sum(detailed_counts_final$`Records Imported`, na.rm = TRUE),
+ `Distinct Records` = overall_total_distinct_records, # Overall unique items
+ `Unique Records` = sum(detailed_counts_final$`Unique Records`, na.rm = TRUE),
+ `Non-unique Records` = sum(detailed_counts_final$`Non-unique Records`, na.rm = TRUE),
+ `Source Contribution %` = scales::percent(1.0, accuracy = 0.1), # Sum of these per-source % should now be 100%
+ `Source Unique Contribution %` = if(total_overall_unique_records > 0) scales::percent(1.0, accuracy = 0.1) else scales::percent(0.0, accuracy = 0.1), # Sum of these should be 100% if any uniques
+ `Source Unique %` = scales::percent(sum(detailed_counts_final$`Unique Records`, na.rm = TRUE) / ifelse(overall_total_distinct_records == 0, 1, overall_total_distinct_records), accuracy = 0.1)
+ )
+
+ detailed_counts_final <- dplyr::bind_rows(detailed_counts_final, total_row) %>%
+ dplyr::rename(Source = cite_source)
+
+ return(detailed_counts_final)
+ })
+
+ # Rendering the detailed record table
+ output$detailedRecordTab <- gt::render_gt({
+ # Check if base data is loaded
+ if (!is.data.frame(rv$latest_unique) || nrow(rv$latest_unique) == 0) {
+ shinyalert::shinyalert("Data needed", "Please import and deduplicate your citations first.", type = "error")
+ shiny::req(FALSE) # Stop execution
+ }
+ # Get the data from the new reactive
+ table_data <- detailed_table_data()
+ # Check if the reactive returned any data (e.g., after filtering)
+ shiny::validate(
+ shiny::need(is.data.frame(table_data) && nrow(table_data) > 0,
+ "No records match the current filter selections for the Detailed Record Table.")
+ )
+ # Pass the prepared data frame to the formatting function
+ create_detailed_record_table(table_data)
+ # Bind to the same button trigger
}) %>% shiny::bindEvent(input$generateDetailedRecordTable)
- # Rendering the precision and sensitivity table
+ # Rendering the precision and sensitivity table ----
output$summaryPrecTab <- gt::render_gt({
-
+
unique_citations <- unique_filtered_table()
# The table is only for phase comparison, include "final" in labels for comparison
@@ -919,15 +1599,15 @@ server <- function(input, output, session) {
}) %>% shiny::bindEvent(input$generatePrecisionTable)
- # Rendering the record-level table
+ # Rendering the record-level table ----
output$reviewTab <- DT::renderDataTable({
-
- if (nrow(rv$latest_unique) == 0) {
+
+ if (nrow(rv$latest_unique) == 0) {
shinyalert::shinyalert("Data needed",
"Please import and deduplicate your citations first.",
type = "error"
)
- shiny::req(FALSE)
+ shiny::req(FALSE)
}
citations <- unique_filtered_table()
@@ -936,10 +1616,9 @@ server <- function(input, output, session) {
}) %>% shiny::bindEvent(input$generateRecordTable)
-
+
#### Export tab ####
-
- # # Downloadable bibtex ----
+
# Downloadable bibtex ----
output$downloadCsv <- shiny::downloadHandler(
filename = function() {
@@ -962,7 +1641,7 @@ server <- function(input, output, session) {
export_bib(rv$latest_unique, file)
}
)
-
+
output$downloadRis <- shiny::downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".ris", sep = "")
diff --git a/inst/shiny-app/CiteSource/google_analytics_dev.html b/inst/shiny-app/CiteSource/google_analytics_dev.html
new file mode 100644
index 00000000..f31c3d31
--- /dev/null
+++ b/inst/shiny-app/CiteSource/google_analytics_dev.html
@@ -0,0 +1,9 @@
+
+
+
\ No newline at end of file
diff --git a/inst/shiny-app/CiteSource/google_analytics_main.html b/inst/shiny-app/CiteSource/google_analytics_main.html
new file mode 100644
index 00000000..eb4691bd
--- /dev/null
+++ b/inst/shiny-app/CiteSource/google_analytics_main.html
@@ -0,0 +1,9 @@
+
+
+
\ No newline at end of file
diff --git a/inst/shiny-app/CiteSource/www/CS.gif b/inst/shiny-app/CiteSource/www/CS.gif
new file mode 100644
index 00000000..0ff34c11
Binary files /dev/null and b/inst/shiny-app/CiteSource/www/CS.gif differ
diff --git a/inst/shiny-app/CiteSource/www/about.md b/inst/shiny-app/CiteSource/www/about.md
index ac710c33..5fd3fe85 100644
--- a/inst/shiny-app/CiteSource/www/about.md
+++ b/inst/shiny-app/CiteSource/www/about.md
@@ -1,9 +1,80 @@
-
+## About CiteSource
-CiteSource was developed in order to provide researchers the ability to examine the utility and efficacy of literature resources and search methodologies. The idea behind CiteSource is simply allowing users to deduplicate citation records, while maintaining customizable metadata about the citation.
+
-Customizable metadata can include anything from a resource name (ex.Web of Science, LENS.org, PubMed), a method (database search, handsearching, citation chasing/ snowballing), a variation used within a method (WoS string #1, Wos string #2, WoS string #3), a research phase (search, TI/AB screening, Full-text Screening), or a unique group of citations (benchmarking articles, articles from a previous review, articles with a specific author affiliation).
-The CiteSource deduplication process is better described as record merging process due to the fact that the customizable metadata from duplicate records is maintained through the creation of a single, primary record. Beyond the merging of customizable metadata, the primary record is created by using the most complete metadata available between duplicate records (currently DOI and Abstract fields).
+CiteSource is an R package and accompanying Shiny web application designed to support evidence data-driven decision-making during search strategy development. CiteSource also allows users to analyze and report on the impact of information sources and search methods.
-Once records are deduplicated, users are able to easily create plots and tables in order to answer specific questions or to simply explore the data to an effort to develop new hypotheses. Examples of analysis may include how many unique records a specific source contributed or how traditional methods of searching fare against a new AI discovery tool in discovering relevant articles. Users may want to understand the overlap in records between two different search strings or evaluate the impact of including Google Scholar in a review. Before searching, a user may even develop a targeted search to better understand the topical coverage across databases that they intend to search, and once the search has been developed, how particular source, string, or method performed in discovering benchmarking articles.
+CiteSource was developed as part of the [Evidence Synthesis Hackathon](https://www.eshackathon.org/) initiative.
+
+---
+
+### Key Features:
+
+
+ Flexible Metadata for Provenance Tracking:
+
+> * A core strength of CiteSource is its ability to assign and retain custom metadata to track the *provenance* of each citation – precisely where and how it was found. Users can tag records using three key fields:
+> * `cite_source`: Identify the origin database ('Web of Science', 'Scopus'), platform ('Lens.org'), or the specific search method used ('Citation Searching', 'String_1').
+> * `cite_label`: Track citations through screening phases using standardized terms: `search` (for initial results, benchmarks), `screened` (for records passing title/abstract review), and `final` (for records included in the synthesis after full-text review).
+> * `cite_string`: Add further detail, such as variations in search string syntax tested ('String_1a_truncation'), specific supplementary methods ('Handsearching_JournalX'), or other custom categories relevant to analysis.
+> * This detailed tagging enables rigorous analysis of the performance and contribution of each component of your overall search strategy.
+
+
+
+
+ Advanced Deduplication & Intelligent Merging:
+
+> * CiteSource employs the [`ASySD` (Automated Systematic Search Deduplicator) R package](https://github.com/camaradesuk/ASySD) to perform robust identification and merging of duplicate records.
+> * It conducts both *internal deduplication* (identifying duplicates within a single uploaded file/source, resulting in *distinct* records) and *external deduplication* (identifying duplicates across all uploaded files/sources, resulting in the set of *unique* citations).
+> * The process uses *intelligent merging*: custom metadata tags (`source`, `label`, `string`) from all identified duplicates are combined onto the primary record, preserving the full discovery history.
+> * The most complete bibliographic data (prioritizing DOI, Abstract) across duplicates is retained in the primary record.
+> * An optional *manual review* stage presents potential duplicates that fall below the automatic matching threshold, allowing users to confirm or reject merges for maximum accuracy.
+
+
+
+
+ Data-Driven Analysis & Visualization:
+
+> * Once deduplication is complete, CiteSource offers a suite of analysis and visualization tools designed specifically to speed up the *iterative process* of developing, testing, and validating search strategies:
+> * Visualize Overlap: Use interactive **Heatmaps** (pairwise overlap) and **Upset Plots** (multi-set intersections) to understand shared and unique records across sources, labels, or strings.
+> * Track Phase Progression: Employ the **Phase Analysis plot** (bar chart) to see the flow of unique and duplicate records through screening stages (`search` -> `screened` -> `final`).
+> * Generate Summary Tables: Access quantitative insights via automated tables detailing:
+> * Initial Record counts (showing the impact of internal deduplication).
+> * Record Summaries (detailing unique/overlapping records contributed by each source/method).
+> * Precision/Sensitivity calculations (evaluating source/method performance against the `final` included set).
+> * A detailed, interactive **Record Level Table** for quickly examining and linking to citations .
+
+
+
+
+ Enhanced Reporting & Transparent Export:
+
+> * CiteSource facilitates *transparent reporting* of search methods and results, aligning with guidelines like PRISMA.
+> * Export your final, deduplicated dataset in standard bibliographic formats (`.csv`, `.ris`, `.bib`).
+> * The custom metadata is embedded directly into standard fields within the export files (e.g., using C1, C2, C7, C8, DB fields in `.ris` format), providing a clear and reproducible audit trail for your methodology.
+
+
+
+---
+
+### Why use CiteSource for Evidence Synthesis?
+
+CiteSource is built for anyone involved in evidence synthesis. It helps you:
+
+* **Evaluate and optimize** information source selection based on unique record contributions.
+* **Refine and optimize** search strings by quickly testing variations.
+* **Analyze and report** the added value of different search methods, including supplementary searching techniques.
+* **Perform benchmark testing** to ensure key articles are captured by your strategy.
+* **Increase transparency and effectiveness** of your search strategy and processess through built-in tables for reporting.
+* **Save time** during the iterative search development.
+
+### What Other Applications does CiteSource Serve ?
+
+* Training in evidence synthesis search methods - MLIS classroom use for skill/knowledge development.
+* Methods research & development - large-scale methods testing, quick/live updates to analysis.
+* Library collection development - analyzing coverage of new databases compared to current subscriptions.
+
+---
+
+*CiteSource is available both as this interactive Shiny application and as a full R package with detailed vignettes. For more information on the R package, visit the [CiteSource Website](https://www.eshackathon.org/CiteSource/).*
\ No newline at end of file
diff --git a/inst/shiny-app/CiteSource/www/favicon.png b/inst/shiny-app/CiteSource/www/favicon.png
new file mode 100644
index 00000000..fae19f1f
Binary files /dev/null and b/inst/shiny-app/CiteSource/www/favicon.png differ
diff --git a/inst/shiny-app/CiteSource/www/use-cases.md b/inst/shiny-app/CiteSource/www/use-cases.md
index 5617fa4c..a66e1d09 100644
--- a/inst/shiny-app/CiteSource/www/use-cases.md
+++ b/inst/shiny-app/CiteSource/www/use-cases.md
@@ -1,50 +1,107 @@
-
+## CiteSource Use Cases: Overview
+
-**Source & Method Analysis**
+CiteSource provides a suite of tools to support data-driven decision-making throughout the evidence synthesis process. Its applications generally fall into two main categories: **Optimizing Search Strategies** (typically during protocol development and iterative searching) and **Analyzing Search Impact** (often after screening is complete, for reporting and methodological insights). Additional applications extend to training and resource management.
-When teams are selecting databases for inclusion in a review it can be difficult to determine the best resources and determine the ROI in terms of the time it takes to apply searches. This is especially true in environmental or social science research, where research is often cross-disciplinary. By tracking where/how each citation was found, the evidence synthesis community could in turn track the efficacy of various databases and identify the most relevant resources as it relates to their research topic. This idea can be extended to search string comparison as well as strategy and methodology comparison and hedge validation.
+---
--Database/Platform/Index
--Methodology
--Search string/strategy
--Hedge validation
+### I. Optimizing Search Strategies
-Examples:
-Databases/Database: GreenFile vs. CAB Direct vs. Aquatic Sciences and Fisheries Abstracts (ASFA) vs. Water Resources Abstracts
-Platform/Indexes: Web of Science- Science Citation Index Expanded (YR-YR) vs. Core Collection vs. "ALL Databases" (YR-YR)
-Search Engine/Database: Google scholar vs. Web of Science
-Methodology/Methodology: Database search vs. citation chasing vs. novel discovery tools
-String/strategy: ASFA string 1 vs. ASFA string 2 vs. ASFA string 3
+CiteSource enables researchers to move beyond reliance on experience or potentially outdated guidance by providing empirical data specific to their project *during* the search development phase.
+
+ Information Source/Method Selection & Optimization
+> Choosing the most effective and efficient set of databases, platforms, or indexes (e.g., Web of Science, Scopus, ASFA, Dimensions, OATD) can be challenging, especially for interdisciplinary topics where overlap and unique contributions are unknown. CiteSource addresses this by allowing users to empirically compare potential sources *before* committing significant time. After uploading initial search results and tagging them using the `cite_source` field (e.g., `Web of Science`, `Scopus`), deduplication the overlapping and unique records across sources and methods. This analysis enables informed, data-driven decisions about which sources and methods provide the best return on investment and helps optimize the selection, potentially reducing redundancy. Key CiteSource features used include:
+> * Tagging records with `cite_source` metadata.
+> * Robust internal and external deduplication (using `ASySD`).
+> * Visualization of overlap using interactive **Heatmaps** and **Upset Plots**.
+> * Quick analysis of individual citations using the interactive **Record Level Table**
-**Stage/Topic Analysis**
+
-Once the title and absract screening has been complete OR once the final papers the final literature has been selected, users can analyze the contributions of each Source/Method to better understand its impact on the review. By using the "Source" data along with the "label" data, users can analyze the number of overlapping/unique records from each source or method and how each one fared during the screening proces. This stage analysis can also include benchmark testing as users are able to analyze how various search strings fared in capturing known literature, this ability to quickly assess search strings provides users with the ability to iterate on these strings as it relates to their findings.
+
+ Search String Development & Optimization
-Examples:
-Databases/Database & (Stage Analysis): GreenFile (Search, Screen, Final) Aquatic Sciences and Fisheries Abstracts (Search, Screen, Final)
-Databases/Database & (Topic Analysis): GreenFile (life history, genetics, stock dynamics) Aquatic Sciences and Fisheries Abstracts (life history, genetics, stock dynamics)
-Benchmark Testing: (Search Stage): String #1 vs. String #2 vs. Benchmarking articles
+> Developing effective search strings is an iterative process involving testing terms, syntax variations, Boolean logic, proximity operators, field codes, etc. Comparing the impact of these subtle changes across potentially multiple databases is time-consuming. CiteSource assists by streamlining the analysis of string effectiveness. Users can upload results from different string variations, tag them using `cite_source` and `cite_string` (e.g., `String_1`, `String_2_proximity`), and visualize the impact on retrieval after deduplication. This allows for rapid assessment of how changes affect results, speeding up refinement for an optimal balance of sensitivity and precision and helping identify errors in logic or syntax. CiteSource facilitates this via:
+> * Tagging result sets with `cite_source` and `cite_string` metadata.
+> * Deduplication to compare results accurately.
+> * Visualization of unique/overlapping records retrieved by different strings using **Upset Plots**.
+> * Quick examination of individual citations using the interactive **Record Level Table**.
+
+
+ Benchmark Testing
-**Metadata Enhancement**
+> Ensuring a search strategy retrieves known, key relevant articles (benchmark or reference articles) is crucial for assessing sensitivity. CiteSource facilitates this by comparing search results against a predefined benchmark set. After uploading search results and the benchmark set (tagging each appropriately using `cite_source`, `cite_string`, and `cite_label`), deduplication allows for direct comparison. This provides a quantitative assessment of how well different strings or sources capture the benchmark articles, highlighting potential weaknesses or indexing gaps. While benchmark sets should be used cautiously due to potential bias, this process aids refinement and is useful for updates or developing standardized protocols. Key functionalities include:
+> * Tagging benchmark sets and search results distinctly using `cite_source` and `cite_label`.
+> * Deduplication to identify matches between search results and the benchmark set.
+> * Using **Upset Plots** to visualize captured vs. missed benchmark articles across different strings/sources.
+> * Investigating specific missed articles using the interactive **Record Level Table**.
-Beyond the ability to analyze and track an idividual citations' Source/Methods. The functions behind CiteSource provides users with the ability to create a single record that uses prefered metadata in selecte metadata fields. Selection is based on metadata attributes (filled or empty, length). This function alone will help to resolve many hours of metadata entry and ensure that each record is as complete as possible. At some point in the future users may be able to select Source data as prefered over these rules.
+
-Basic logic for metadata selection (Filled/Empty + Length)
+
+ Efficient Iterative Testing (Overarching Benefit)
-**IF** metadata from one record’s DOI field contains text and the others’ do not **THEN** the metadata from the record with text will be used for the merge record
+> The entire process of testing variations in sources, strings, and methods is inherently iterative. CiteSource significantly compresses this cycle by providing rapid analysis and visualization (**Heatmaps**, **Upset Plots**, **Summary Tables**) immediately after deduplication. This drastic reduction in the time needed to evaluate the impact of each iteration saves researcher time and allows for more thorough testing and validation, leading to a more optimized and well-documented strategy.
-**IF** metadata from one record’s ABSTRACT field contains more text and the other records with ABSTRACT text **THEN** the metadata from the record with more text will be used for the merge record
+
+---
+### II. Analyzing Search Impact (Post-Screening / Reporting)
-**Library Collection Development**
+After screening is complete, CiteSource analyzes the *actual* contribution of different search components to the final set of included studies and enhances reporting.
-As the community continues to apply this analysis to resources, this information would be extremely valuable to researchers and librarians outside of the Evidence Synthesis community. From the library's perspective this tool could have a substantial impact on collection development decisions and resource recommendations.
+
+ Analyzing Information Source & Search Method Contribution
-Examples:
-Database Coverage: Compare coverage of databases on specific research topics - What percent of results are duplicated in current subscriptions? What percent are unique?
\ No newline at end of file
+> Understanding which sources or methods were most effective in identifying the studies ultimately included in the synthesis is crucial for methodological reflection and reporting. CiteSource enables this analysis by tracking records through screening phases. By tagging records with `cite_source`/`cite_string` and progressively updating the `cite_label` (`search` -> `screened` -> `final`), users can quantify the "true impact" or ROI of each component. This identifies high-yield sources/methods versus those contributing mostly irrelevant records, providing valuable data for reporting and future strategy refinement. Analysis tools include:
+> * Tracking records using `cite_source`, `cite_string`, and `cite_label` tags.
+> * Visualizing the flow through screening stages with the **Bar Chart (Phase Analysis Plot)**.
+> * Quantifying performance using the **Precision/Sensitivity Table** (calculating precision and recall against the `final` set).
+> * Examining contributions at each stage using the **Record Summary Table**.
+
+
+
+
+ Enhanced Reporting & Transparency
+
+> Reporting guidelines like PRISMA require transparent and detailed documentation of the search process. CiteSource directly supports this by generating clear outputs and ensuring provenance is maintained. The plots and tables offer visual and quantitative summaries of the search process, outcomes, and source/method contributions. Furthermore, exporting the final dataset embeds the custom metadata tags (`cite_source`, `cite_label`, `cite_string`) into standard bibliographic fields (e.g., C1, C2, C7, C8, DB in `.ris` format), providing a clear, reproducible audit trail. This enhances transparency and allows reviewers/readers to scrutinize the methodology effectively. Key outputs for reporting include:
+> * Ready-to-use **plots** (**Heatmaps**, **Upset Plots**, **Bar Charts**).
+> * Summary **tables** (**Initial Record**, **Record Summary**, **Precision/Sensitivity**, **Record Level**).
+> * Exported datasets (`.csv`, `.ris`, `.bib`) with embedded provenance metadata.
+
+
+
+---
+
+### III. Broader Applications
+
+Beyond individual reviews, CiteSource has wider utility:
+
+
+ Training & Education
+
+> CiteSource serves as an effective training tool for evidence synthesis methods. Its interactive visualizations provide a hands-on way for students and early-career researchers to understand abstract concepts like database overlap, string variation impacts, and benchmark testing. Instructors can use it to demonstrate best practices in real-time, building practical skills and competence in systematic searching.
+
+
+
+
+ Library Collection Development
+
+> Librarians can leverage CiteSource to support collection development decisions. By analyzing search results from institutional researchers or targeted test searches, they can gain empirical data on database coverage and overlap for specific research topics. This helps justify subscription costs, compare existing resources with potential new ones, and make effective recommendations based on demonstrated value and uniqueness.
+
+
+
+
+ Methodological Research
+
+> CiteSource facilitates methodological research on searching itself. When researchers use the tool and report their quantitative findings on source/method performance (e.g., precision/sensitivity, unique contributions), they contribute valuable empirical data to the wider evidence synthesis community. Aggregating such findings across studies can inform the development and refinement of evidence-based search guidelines and best practices, potentially supporting "Studies Within A Review" (SWAR) focused on search methodology.
+
+
+
+---
\ No newline at end of file
diff --git a/inst/shiny-app/CiteSource/www/user_guide.md b/inst/shiny-app/CiteSource/www/user_guide.md
new file mode 100644
index 00000000..01197c29
--- /dev/null
+++ b/inst/shiny-app/CiteSource/www/user_guide.md
@@ -0,0 +1,108 @@
+## CiteSource User Guide
+
+
+
+> CiteSource has a number of applications. This guide walks users through the step-wise process of uploading, deduplicating and analyzing data > within the shiny application. For step by step instructions for running CiteSource in R, [check out our vignettes](https://www.eshackathon.org/CiteSource/articles/)
+---
+
+### Using CiteSource: Step-by-Step
+
+
+ Step 1: File Upload, Labeling, & Re-importing
+
+> **Standard Upload:**
+>
+> * Navigate to the 'File upload' tab.
+> * Use the 'Set Label for Uploaded File(s)' dropdown to select the appropriate stage for the file(s) you are about to upload (e.g., `search`, `screened`, or `final`). This label helps organize records, especially for phase analysis and some summary tables.
+> * Click the file input area ('Browse...') to select one or more citation files from your computer. Supported formats are `.ris`, `.bib`, and `.txt`.
+> * The label you selected will be applied to all citation records within the file(s) uploaded in that specific action.
+>
+> **Re-importing Previously Processed Data:**
+>
+> * If you have previously exported data from CiteSource as a `.ris` or `.csv` file (these exported files contain special `cite_` columns), you can re-upload this file directly.
+> * On the 'File upload' tab, use the 'OR: Re-upload an .ris or .csv exported from CiteSource' file input.
+> * This bypasses the initial upload processing and deduplication steps (Steps 3 & 4), allowing you to proceed directly to the 'Visualise' and 'Tables' tabs with your previously processed data.
+>
+> * **NOTE**: Raw citation exports from some platforms (e.g.OVID) may be incompatible due to abnormal .ris field use or structuring. If you are having issues, please be sure to try importing them using citation software (e.g. Zotero, EndNote) and exporting them before uploading to CiteSource.*
+
+
+
+
+ Step 2: Review Uploads & Edit
+
+> * After uploading citations, a summary table appears in the main panel showing each file, its detected record count, and the assigned source name, label, and string.
+> * To correct the auto-assigned source name, or to change the label or string for *all* records from a specific file after upload, you can double-click the corresponding cell in the table and type the new value.
+
+
+
+
+ Step 3: Automated Deduplication
+
+> * Navigate to the 'Deduplicate' tab and ensure you are on the 'Automated deduplication' sub-tab.
+> * Click the 'Find duplicates' button.
+> * CiteSource will process all the records you've uploaded. It compares metadata fields (like DOI, title, authors, journal, year, volume, pages) to identify potential duplicates both *within* the same source file (internal deduplication) and *across* different source files (external deduplication).
+> * A pop-up message will summarize the results, indicating the number of unique records found and if any potential duplicates require manual review.
+
+
+
+
+ Step 4: Manual Deduplication (If Needed)
+
+> * If the summary message from Step 3 indicates potential duplicates need review, or if you want to manually inspect potential matches, go to the 'Manual deduplication' sub-tab.
+> * Pairs of records identified as potential duplicates are displayed. Each row represents a pair, showing selected metadata side-by-side (e.g., Title 1 vs. Title 2).
+> * Use the 'Choose columns' filter dropdown (filter icon) above the table to select which metadata fields (e.g., author, year, abstract) you want to see for comparison.
+> * Carefully review each pair. If you determine a pair represents the *same* underlying citation, click on that row to select it.
+> * After selecting all rows that are true duplicates, click the 'Remove additional duplicates' button (this button only appears after you select at least one row). This merges the selected pairs, keeping only one unique record with combined metadata.
+> * If you finish reviewing or decide no manual merging is needed, click 'Go to visualisations'.
+
+
+
+
+ Step 5: Visualise Overlap
+
+> * Navigate to the 'Visualise' tab.
+> * Use the sidebar controls to tailor the analysis:
+> * **Choose comparison type:** Select whether you want to compare overlap based on 'sources' (original files/databases), 'labels' (e.g., search vs screened), or 'strings' (if used).
+> * **Filter data:** Select specific sources, labels, or strings to include in the visualizations.
+> * Explore the generated plots:
+> * **Heatmap:** This matrix shows pairwise overlap. Each cell represents the number of citations shared between two groups (the groups depend on your chosen comparison type). Darker cells indicate higher overlap. Hover over cells to see exact counts. It helps quickly identify pairs with significant commonality.
+> * **Upset Plot:** This plot visualizes intersections among multiple groups simultaneously. The large bottom bar chart shows the number of citations unique to specific combinations of groups (e.g., found only in Source A, or found in both Source A and B but not C). The smaller top bar chart shows the total number of unique citations in each individual group. It's excellent for understanding complex overlap patterns involving more than two groups.
+> * **Phase Analysis Plot:** This plot is most useful when comparing by 'labels' representing stages (e.g., `search`, `screened`, `final`). It shows the total number of records at each stage, broken down into those that are unique (first identified at that stage) versus those that were already found in a previous stage (duplicates relative to earlier stages). It helps visualize the yield and deduplication effectiveness across a review workflow.
+> * Use the 'Download' buttons above each plot to save them as image files.
+
+
+
+
+ Step 6: Summary Tables & Record Review
+
+> * Navigate to the 'Tables' tab.
+> * Use the sidebar filters (Sources, Labels, Strings) to select the subset of data you want summarized.
+> * Generate specific summary tables by clicking the corresponding 'Generate...' button:
+> * **Initial Records Table:** Provides a high-level count based on the earliest phase (typically records labeled `search`). Shows the total uploaded records for that phase. This table distinguishes between the number of uploaded records andduplicates found *within* the each source file.
+> * **Detailed Record Table:** Breaks down the citation counts by individual source/method (within your selected filters). For each set of records, it shows how many citations were unique to that set and how many were also found in other sets. This helps identify which sources/methods contributed the most unique records and which have a high level of overlap.
+> * **Precision/Sensitivity Table:** Calculates performance metrics, requiring data labeled as `final` to be present and selected. It compares each source, method, or search string against this 'final' set. 'Precision' tells you what proportion of records retrieved by a source were actually relevant ('final' records). 'Sensitivity' (or Recall) tells you what proportion of all relevant ('final') records were found by that specific source. Useful for evaluating search strategy performance.
+> * **Review individual records:** Click 'Generate the table' on the "Review individual records" sub-tab to view the detailed, deduplicated citation list. This table may take a while to load if you have a large number of records.
+>
+> **Using the Interactive Record Table:**
+>
+> * **Expand/Collapse Row:** Click the `⊕` symbol in a row to view the full APA reference. Click `⊖` to hide it again.
+> * **Sort by Single Column:** Click any column header (like 'Citation' or a source name) to sort the table by that column's values. Click the header again to reverse the sort order.
+> * **Sort by Multiple Columns:** Click the primary column header you want to sort by. Then, hold down the **Shift** key on your keyboard and click a second column header. You can repeat this for more sorting levels.
+> * **Filter/Search:** Type into the search box located at the top-right of the table to dynamically filter records based on any information displayed.
+> * **Download Data:** Click the 'Download CSV' button (located above the table, next to 'Print') to save the data currently shown in the table (including applied filters) as a CSV file.
+
+
+
+
+ Step 7: Export Results
+
+> * Navigate to the 'Export' tab.
+> * This tab becomes active after you have run the deduplication process (Step 3).
+> * Click the button corresponding to your desired file format: 'Download csv', 'Download RIS', or 'Download BibTex'.
+> * The custom metadata is embedded directly into fields within the export files (e.g., using C1, C2, C7, C8, DB fields in `.ris` format)
+> * This will save the final dataset of unique citations (after both automated and any manual deduplication).
+> * **Note:** Only `.csv` and `.ris` files can be re-imported later.
+
+
+
+---
\ No newline at end of file
diff --git a/man/plot_contributions.Rd b/man/plot_contributions.Rd
index ef9f945d..c4bd3835 100644
--- a/man/plot_contributions.Rd
+++ b/man/plot_contributions.Rd
@@ -13,7 +13,7 @@ plot_contributions(
bar_order = "keep",
facet_order = "keep",
color_order = "keep",
- totals_in_legend = TRUE
+ totals_in_legend = FALSE
)
}
\arguments{
diff --git a/renv/.gitignore b/renv/.gitignore
new file mode 100644
index 00000000..0ec0cbba
--- /dev/null
+++ b/renv/.gitignore
@@ -0,0 +1,7 @@
+library/
+local/
+cellar/
+lock/
+python/
+sandbox/
+staging/
diff --git a/renv/activate.R b/renv/activate.R
new file mode 100644
index 00000000..d13f9932
--- /dev/null
+++ b/renv/activate.R
@@ -0,0 +1,1220 @@
+
+local({
+
+ # the requested version of renv
+ version <- "1.0.7"
+ attr(version, "sha") <- NULL
+
+ # the project directory
+ project <- Sys.getenv("RENV_PROJECT")
+ if (!nzchar(project))
+ project <- getwd()
+
+ # use start-up diagnostics if enabled
+ diagnostics <- Sys.getenv("RENV_STARTUP_DIAGNOSTICS", unset = "FALSE")
+ if (diagnostics) {
+ start <- Sys.time()
+ profile <- tempfile("renv-startup-", fileext = ".Rprof")
+ utils::Rprof(profile)
+ on.exit({
+ utils::Rprof(NULL)
+ elapsed <- signif(difftime(Sys.time(), start, units = "auto"), digits = 2L)
+ writeLines(sprintf("- renv took %s to run the autoloader.", format(elapsed)))
+ writeLines(sprintf("- Profile: %s", profile))
+ print(utils::summaryRprof(profile))
+ }, add = TRUE)
+ }
+
+ # figure out whether the autoloader is enabled
+ enabled <- local({
+
+ # first, check config option
+ override <- getOption("renv.config.autoloader.enabled")
+ if (!is.null(override))
+ return(override)
+
+ # if we're being run in a context where R_LIBS is already set,
+ # don't load -- presumably we're being run as a sub-process and
+ # the parent process has already set up library paths for us
+ rcmd <- Sys.getenv("R_CMD", unset = NA)
+ rlibs <- Sys.getenv("R_LIBS", unset = NA)
+ if (!is.na(rlibs) && !is.na(rcmd))
+ return(FALSE)
+
+ # next, check environment variables
+ # TODO: prefer using the configuration one in the future
+ envvars <- c(
+ "RENV_CONFIG_AUTOLOADER_ENABLED",
+ "RENV_AUTOLOADER_ENABLED",
+ "RENV_ACTIVATE_PROJECT"
+ )
+
+ for (envvar in envvars) {
+ envval <- Sys.getenv(envvar, unset = NA)
+ if (!is.na(envval))
+ return(tolower(envval) %in% c("true", "t", "1"))
+ }
+
+ # enable by default
+ TRUE
+
+ })
+
+ # bail if we're not enabled
+ if (!enabled) {
+
+ # if we're not enabled, we might still need to manually load
+ # the user profile here
+ profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
+ if (file.exists(profile)) {
+ cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE")
+ if (tolower(cfg) %in% c("true", "t", "1"))
+ sys.source(profile, envir = globalenv())
+ }
+
+ return(FALSE)
+
+ }
+
+ # avoid recursion
+ if (identical(getOption("renv.autoloader.running"), TRUE)) {
+ warning("ignoring recursive attempt to run renv autoloader")
+ return(invisible(TRUE))
+ }
+
+ # signal that we're loading renv during R startup
+ options(renv.autoloader.running = TRUE)
+ on.exit(options(renv.autoloader.running = NULL), add = TRUE)
+
+ # signal that we've consented to use renv
+ options(renv.consent = TRUE)
+
+ # load the 'utils' package eagerly -- this ensures that renv shims, which
+ # mask 'utils' packages, will come first on the search path
+ library(utils, lib.loc = .Library)
+
+ # unload renv if it's already been loaded
+ if ("renv" %in% loadedNamespaces())
+ unloadNamespace("renv")
+
+ # load bootstrap tools
+ `%||%` <- function(x, y) {
+ if (is.null(x)) y else x
+ }
+
+ catf <- function(fmt, ..., appendLF = TRUE) {
+
+ quiet <- getOption("renv.bootstrap.quiet", default = FALSE)
+ if (quiet)
+ return(invisible())
+
+ msg <- sprintf(fmt, ...)
+ cat(msg, file = stdout(), sep = if (appendLF) "\n" else "")
+
+ invisible(msg)
+
+ }
+
+ header <- function(label,
+ ...,
+ prefix = "#",
+ suffix = "-",
+ n = min(getOption("width"), 78))
+ {
+ label <- sprintf(label, ...)
+ n <- max(n - nchar(label) - nchar(prefix) - 2L, 8L)
+ if (n <= 0)
+ return(paste(prefix, label))
+
+ tail <- paste(rep.int(suffix, n), collapse = "")
+ paste0(prefix, " ", label, " ", tail)
+
+ }
+
+ heredoc <- function(text, leave = 0) {
+
+ # remove leading, trailing whitespace
+ trimmed <- gsub("^\\s*\\n|\\n\\s*$", "", text)
+
+ # split into lines
+ lines <- strsplit(trimmed, "\n", fixed = TRUE)[[1L]]
+
+ # compute common indent
+ indent <- regexpr("[^[:space:]]", lines)
+ common <- min(setdiff(indent, -1L)) - leave
+ paste(substring(lines, common), collapse = "\n")
+
+ }
+
+ startswith <- function(string, prefix) {
+ substring(string, 1, nchar(prefix)) == prefix
+ }
+
+ bootstrap <- function(version, library) {
+
+ friendly <- renv_bootstrap_version_friendly(version)
+ section <- header(sprintf("Bootstrapping renv %s", friendly))
+ catf(section)
+
+ # attempt to download renv
+ catf("- Downloading renv ... ", appendLF = FALSE)
+ withCallingHandlers(
+ tarball <- renv_bootstrap_download(version),
+ error = function(err) {
+ catf("FAILED")
+ stop("failed to download:\n", conditionMessage(err))
+ }
+ )
+ catf("OK")
+ on.exit(unlink(tarball), add = TRUE)
+
+ # now attempt to install
+ catf("- Installing renv ... ", appendLF = FALSE)
+ withCallingHandlers(
+ status <- renv_bootstrap_install(version, tarball, library),
+ error = function(err) {
+ catf("FAILED")
+ stop("failed to install:\n", conditionMessage(err))
+ }
+ )
+ catf("OK")
+
+ # add empty line to break up bootstrapping from normal output
+ catf("")
+
+ return(invisible())
+ }
+
+ renv_bootstrap_tests_running <- function() {
+ getOption("renv.tests.running", default = FALSE)
+ }
+
+ renv_bootstrap_repos <- function() {
+
+ # get CRAN repository
+ cran <- getOption("renv.repos.cran", "https://cloud.r-project.org")
+
+ # check for repos override
+ repos <- Sys.getenv("RENV_CONFIG_REPOS_OVERRIDE", unset = NA)
+ if (!is.na(repos)) {
+
+ # check for RSPM; if set, use a fallback repository for renv
+ rspm <- Sys.getenv("RSPM", unset = NA)
+ if (identical(rspm, repos))
+ repos <- c(RSPM = rspm, CRAN = cran)
+
+ return(repos)
+
+ }
+
+ # check for lockfile repositories
+ repos <- tryCatch(renv_bootstrap_repos_lockfile(), error = identity)
+ if (!inherits(repos, "error") && length(repos))
+ return(repos)
+
+ # retrieve current repos
+ repos <- getOption("repos")
+
+ # ensure @CRAN@ entries are resolved
+ repos[repos == "@CRAN@"] <- cran
+
+ # add in renv.bootstrap.repos if set
+ default <- c(FALLBACK = "https://cloud.r-project.org")
+ extra <- getOption("renv.bootstrap.repos", default = default)
+ repos <- c(repos, extra)
+
+ # remove duplicates that might've snuck in
+ dupes <- duplicated(repos) | duplicated(names(repos))
+ repos[!dupes]
+
+ }
+
+ renv_bootstrap_repos_lockfile <- function() {
+
+ lockpath <- Sys.getenv("RENV_PATHS_LOCKFILE", unset = "renv.lock")
+ if (!file.exists(lockpath))
+ return(NULL)
+
+ lockfile <- tryCatch(renv_json_read(lockpath), error = identity)
+ if (inherits(lockfile, "error")) {
+ warning(lockfile)
+ return(NULL)
+ }
+
+ repos <- lockfile$R$Repositories
+ if (length(repos) == 0)
+ return(NULL)
+
+ keys <- vapply(repos, `[[`, "Name", FUN.VALUE = character(1))
+ vals <- vapply(repos, `[[`, "URL", FUN.VALUE = character(1))
+ names(vals) <- keys
+
+ return(vals)
+
+ }
+
+ renv_bootstrap_download <- function(version) {
+
+ sha <- attr(version, "sha", exact = TRUE)
+
+ methods <- if (!is.null(sha)) {
+
+ # attempting to bootstrap a development version of renv
+ c(
+ function() renv_bootstrap_download_tarball(sha),
+ function() renv_bootstrap_download_github(sha)
+ )
+
+ } else {
+
+ # attempting to bootstrap a release version of renv
+ c(
+ function() renv_bootstrap_download_tarball(version),
+ function() renv_bootstrap_download_cran_latest(version),
+ function() renv_bootstrap_download_cran_archive(version)
+ )
+
+ }
+
+ for (method in methods) {
+ path <- tryCatch(method(), error = identity)
+ if (is.character(path) && file.exists(path))
+ return(path)
+ }
+
+ stop("All download methods failed")
+
+ }
+
+ renv_bootstrap_download_impl <- function(url, destfile) {
+
+ mode <- "wb"
+
+ # https://bugs.r-project.org/bugzilla/show_bug.cgi?id=17715
+ fixup <-
+ Sys.info()[["sysname"]] == "Windows" &&
+ substring(url, 1L, 5L) == "file:"
+
+ if (fixup)
+ mode <- "w+b"
+
+ args <- list(
+ url = url,
+ destfile = destfile,
+ mode = mode,
+ quiet = TRUE
+ )
+
+ if ("headers" %in% names(formals(utils::download.file)))
+ args$headers <- renv_bootstrap_download_custom_headers(url)
+
+ do.call(utils::download.file, args)
+
+ }
+
+ renv_bootstrap_download_custom_headers <- function(url) {
+
+ headers <- getOption("renv.download.headers")
+ if (is.null(headers))
+ return(character())
+
+ if (!is.function(headers))
+ stopf("'renv.download.headers' is not a function")
+
+ headers <- headers(url)
+ if (length(headers) == 0L)
+ return(character())
+
+ if (is.list(headers))
+ headers <- unlist(headers, recursive = FALSE, use.names = TRUE)
+
+ ok <-
+ is.character(headers) &&
+ is.character(names(headers)) &&
+ all(nzchar(names(headers)))
+
+ if (!ok)
+ stop("invocation of 'renv.download.headers' did not return a named character vector")
+
+ headers
+
+ }
+
+ renv_bootstrap_download_cran_latest <- function(version) {
+
+ spec <- renv_bootstrap_download_cran_latest_find(version)
+ type <- spec$type
+ repos <- spec$repos
+
+ baseurl <- utils::contrib.url(repos = repos, type = type)
+ ext <- if (identical(type, "source"))
+ ".tar.gz"
+ else if (Sys.info()[["sysname"]] == "Windows")
+ ".zip"
+ else
+ ".tgz"
+ name <- sprintf("renv_%s%s", version, ext)
+ url <- paste(baseurl, name, sep = "/")
+
+ destfile <- file.path(tempdir(), name)
+ status <- tryCatch(
+ renv_bootstrap_download_impl(url, destfile),
+ condition = identity
+ )
+
+ if (inherits(status, "condition"))
+ return(FALSE)
+
+ # report success and return
+ destfile
+
+ }
+
+ renv_bootstrap_download_cran_latest_find <- function(version) {
+
+ # check whether binaries are supported on this system
+ binary <-
+ getOption("renv.bootstrap.binary", default = TRUE) &&
+ !identical(.Platform$pkgType, "source") &&
+ !identical(getOption("pkgType"), "source") &&
+ Sys.info()[["sysname"]] %in% c("Darwin", "Windows")
+
+ types <- c(if (binary) "binary", "source")
+
+ # iterate over types + repositories
+ for (type in types) {
+ for (repos in renv_bootstrap_repos()) {
+
+ # retrieve package database
+ db <- tryCatch(
+ as.data.frame(
+ utils::available.packages(type = type, repos = repos),
+ stringsAsFactors = FALSE
+ ),
+ error = identity
+ )
+
+ if (inherits(db, "error"))
+ next
+
+ # check for compatible entry
+ entry <- db[db$Package %in% "renv" & db$Version %in% version, ]
+ if (nrow(entry) == 0)
+ next
+
+ # found it; return spec to caller
+ spec <- list(entry = entry, type = type, repos = repos)
+ return(spec)
+
+ }
+ }
+
+ # if we got here, we failed to find renv
+ fmt <- "renv %s is not available from your declared package repositories"
+ stop(sprintf(fmt, version))
+
+ }
+
+ renv_bootstrap_download_cran_archive <- function(version) {
+
+ name <- sprintf("renv_%s.tar.gz", version)
+ repos <- renv_bootstrap_repos()
+ urls <- file.path(repos, "src/contrib/Archive/renv", name)
+ destfile <- file.path(tempdir(), name)
+
+ for (url in urls) {
+
+ status <- tryCatch(
+ renv_bootstrap_download_impl(url, destfile),
+ condition = identity
+ )
+
+ if (identical(status, 0L))
+ return(destfile)
+
+ }
+
+ return(FALSE)
+
+ }
+
+ renv_bootstrap_download_tarball <- function(version) {
+
+ # if the user has provided the path to a tarball via
+ # an environment variable, then use it
+ tarball <- Sys.getenv("RENV_BOOTSTRAP_TARBALL", unset = NA)
+ if (is.na(tarball))
+ return()
+
+ # allow directories
+ if (dir.exists(tarball)) {
+ name <- sprintf("renv_%s.tar.gz", version)
+ tarball <- file.path(tarball, name)
+ }
+
+ # bail if it doesn't exist
+ if (!file.exists(tarball)) {
+
+ # let the user know we weren't able to honour their request
+ fmt <- "- RENV_BOOTSTRAP_TARBALL is set (%s) but does not exist."
+ msg <- sprintf(fmt, tarball)
+ warning(msg)
+
+ # bail
+ return()
+
+ }
+
+ catf("- Using local tarball '%s'.", tarball)
+ tarball
+
+ }
+
+ renv_bootstrap_download_github <- function(version) {
+
+ enabled <- Sys.getenv("RENV_BOOTSTRAP_FROM_GITHUB", unset = "TRUE")
+ if (!identical(enabled, "TRUE"))
+ return(FALSE)
+
+ # prepare download options
+ pat <- Sys.getenv("GITHUB_PAT")
+ if (nzchar(Sys.which("curl")) && nzchar(pat)) {
+ fmt <- "--location --fail --header \"Authorization: token %s\""
+ extra <- sprintf(fmt, pat)
+ saved <- options("download.file.method", "download.file.extra")
+ options(download.file.method = "curl", download.file.extra = extra)
+ on.exit(do.call(base::options, saved), add = TRUE)
+ } else if (nzchar(Sys.which("wget")) && nzchar(pat)) {
+ fmt <- "--header=\"Authorization: token %s\""
+ extra <- sprintf(fmt, pat)
+ saved <- options("download.file.method", "download.file.extra")
+ options(download.file.method = "wget", download.file.extra = extra)
+ on.exit(do.call(base::options, saved), add = TRUE)
+ }
+
+ url <- file.path("https://api.github.com/repos/rstudio/renv/tarball", version)
+ name <- sprintf("renv_%s.tar.gz", version)
+ destfile <- file.path(tempdir(), name)
+
+ status <- tryCatch(
+ renv_bootstrap_download_impl(url, destfile),
+ condition = identity
+ )
+
+ if (!identical(status, 0L))
+ return(FALSE)
+
+ renv_bootstrap_download_augment(destfile)
+
+ return(destfile)
+
+ }
+
+ # Add Sha to DESCRIPTION. This is stop gap until #890, after which we
+ # can use renv::install() to fully capture metadata.
+ renv_bootstrap_download_augment <- function(destfile) {
+ sha <- renv_bootstrap_git_extract_sha1_tar(destfile)
+ if (is.null(sha)) {
+ return()
+ }
+
+ # Untar
+ tempdir <- tempfile("renv-github-")
+ on.exit(unlink(tempdir, recursive = TRUE), add = TRUE)
+ untar(destfile, exdir = tempdir)
+ pkgdir <- dir(tempdir, full.names = TRUE)[[1]]
+
+ # Modify description
+ desc_path <- file.path(pkgdir, "DESCRIPTION")
+ desc_lines <- readLines(desc_path)
+ remotes_fields <- c(
+ "RemoteType: github",
+ "RemoteHost: api.github.com",
+ "RemoteRepo: renv",
+ "RemoteUsername: rstudio",
+ "RemotePkgRef: rstudio/renv",
+ paste("RemoteRef: ", sha),
+ paste("RemoteSha: ", sha)
+ )
+ writeLines(c(desc_lines[desc_lines != ""], remotes_fields), con = desc_path)
+
+ # Re-tar
+ local({
+ old <- setwd(tempdir)
+ on.exit(setwd(old), add = TRUE)
+
+ tar(destfile, compression = "gzip")
+ })
+ invisible()
+ }
+
+ # Extract the commit hash from a git archive. Git archives include the SHA1
+ # hash as the comment field of the tarball pax extended header
+ # (see https://www.kernel.org/pub/software/scm/git/docs/git-archive.html)
+ # For GitHub archives this should be the first header after the default one
+ # (512 byte) header.
+ renv_bootstrap_git_extract_sha1_tar <- function(bundle) {
+
+ # open the bundle for reading
+ # We use gzcon for everything because (from ?gzcon)
+ # > Reading from a connection which does not supply a 'gzip' magic
+ # > header is equivalent to reading from the original connection
+ conn <- gzcon(file(bundle, open = "rb", raw = TRUE))
+ on.exit(close(conn))
+
+ # The default pax header is 512 bytes long and the first pax extended header
+ # with the comment should be 51 bytes long
+ # `52 comment=` (11 chars) + 40 byte SHA1 hash
+ len <- 0x200 + 0x33
+ res <- rawToChar(readBin(conn, "raw", n = len)[0x201:len])
+
+ if (grepl("^52 comment=", res)) {
+ sub("52 comment=", "", res)
+ } else {
+ NULL
+ }
+ }
+
+ renv_bootstrap_install <- function(version, tarball, library) {
+
+ # attempt to install it into project library
+ dir.create(library, showWarnings = FALSE, recursive = TRUE)
+ output <- renv_bootstrap_install_impl(library, tarball)
+
+ # check for successful install
+ status <- attr(output, "status")
+ if (is.null(status) || identical(status, 0L))
+ return(status)
+
+ # an error occurred; report it
+ header <- "installation of renv failed"
+ lines <- paste(rep.int("=", nchar(header)), collapse = "")
+ text <- paste(c(header, lines, output), collapse = "\n")
+ stop(text)
+
+ }
+
+ renv_bootstrap_install_impl <- function(library, tarball) {
+
+ # invoke using system2 so we can capture and report output
+ bin <- R.home("bin")
+ exe <- if (Sys.info()[["sysname"]] == "Windows") "R.exe" else "R"
+ R <- file.path(bin, exe)
+
+ args <- c(
+ "--vanilla", "CMD", "INSTALL", "--no-multiarch",
+ "-l", shQuote(path.expand(library)),
+ shQuote(path.expand(tarball))
+ )
+
+ system2(R, args, stdout = TRUE, stderr = TRUE)
+
+ }
+
+ renv_bootstrap_platform_prefix <- function() {
+
+ # construct version prefix
+ version <- paste(R.version$major, R.version$minor, sep = ".")
+ prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-")
+
+ # include SVN revision for development versions of R
+ # (to avoid sharing platform-specific artefacts with released versions of R)
+ devel <-
+ identical(R.version[["status"]], "Under development (unstable)") ||
+ identical(R.version[["nickname"]], "Unsuffered Consequences")
+
+ if (devel)
+ prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r")
+
+ # build list of path components
+ components <- c(prefix, R.version$platform)
+
+ # include prefix if provided by user
+ prefix <- renv_bootstrap_platform_prefix_impl()
+ if (!is.na(prefix) && nzchar(prefix))
+ components <- c(prefix, components)
+
+ # build prefix
+ paste(components, collapse = "/")
+
+ }
+
+ renv_bootstrap_platform_prefix_impl <- function() {
+
+ # if an explicit prefix has been supplied, use it
+ prefix <- Sys.getenv("RENV_PATHS_PREFIX", unset = NA)
+ if (!is.na(prefix))
+ return(prefix)
+
+ # if the user has requested an automatic prefix, generate it
+ auto <- Sys.getenv("RENV_PATHS_PREFIX_AUTO", unset = NA)
+ if (is.na(auto) && getRversion() >= "4.4.0")
+ auto <- "TRUE"
+
+ if (auto %in% c("TRUE", "True", "true", "1"))
+ return(renv_bootstrap_platform_prefix_auto())
+
+ # empty string on failure
+ ""
+
+ }
+
+ renv_bootstrap_platform_prefix_auto <- function() {
+
+ prefix <- tryCatch(renv_bootstrap_platform_os(), error = identity)
+ if (inherits(prefix, "error") || prefix %in% "unknown") {
+
+ msg <- paste(
+ "failed to infer current operating system",
+ "please file a bug report at https://github.com/rstudio/renv/issues",
+ sep = "; "
+ )
+
+ warning(msg)
+
+ }
+
+ prefix
+
+ }
+
+ renv_bootstrap_platform_os <- function() {
+
+ sysinfo <- Sys.info()
+ sysname <- sysinfo[["sysname"]]
+
+ # handle Windows + macOS up front
+ if (sysname == "Windows")
+ return("windows")
+ else if (sysname == "Darwin")
+ return("macos")
+
+ # check for os-release files
+ for (file in c("/etc/os-release", "/usr/lib/os-release"))
+ if (file.exists(file))
+ return(renv_bootstrap_platform_os_via_os_release(file, sysinfo))
+
+ # check for redhat-release files
+ if (file.exists("/etc/redhat-release"))
+ return(renv_bootstrap_platform_os_via_redhat_release())
+
+ "unknown"
+
+ }
+
+ renv_bootstrap_platform_os_via_os_release <- function(file, sysinfo) {
+
+ # read /etc/os-release
+ release <- utils::read.table(
+ file = file,
+ sep = "=",
+ quote = c("\"", "'"),
+ col.names = c("Key", "Value"),
+ comment.char = "#",
+ stringsAsFactors = FALSE
+ )
+
+ vars <- as.list(release$Value)
+ names(vars) <- release$Key
+
+ # get os name
+ os <- tolower(sysinfo[["sysname"]])
+
+ # read id
+ id <- "unknown"
+ for (field in c("ID", "ID_LIKE")) {
+ if (field %in% names(vars) && nzchar(vars[[field]])) {
+ id <- vars[[field]]
+ break
+ }
+ }
+
+ # read version
+ version <- "unknown"
+ for (field in c("UBUNTU_CODENAME", "VERSION_CODENAME", "VERSION_ID", "BUILD_ID")) {
+ if (field %in% names(vars) && nzchar(vars[[field]])) {
+ version <- vars[[field]]
+ break
+ }
+ }
+
+ # join together
+ paste(c(os, id, version), collapse = "-")
+
+ }
+
+ renv_bootstrap_platform_os_via_redhat_release <- function() {
+
+ # read /etc/redhat-release
+ contents <- readLines("/etc/redhat-release", warn = FALSE)
+
+ # infer id
+ id <- if (grepl("centos", contents, ignore.case = TRUE))
+ "centos"
+ else if (grepl("redhat", contents, ignore.case = TRUE))
+ "redhat"
+ else
+ "unknown"
+
+ # try to find a version component (very hacky)
+ version <- "unknown"
+
+ parts <- strsplit(contents, "[[:space:]]")[[1L]]
+ for (part in parts) {
+
+ nv <- tryCatch(numeric_version(part), error = identity)
+ if (inherits(nv, "error"))
+ next
+
+ version <- nv[1, 1]
+ break
+
+ }
+
+ paste(c("linux", id, version), collapse = "-")
+
+ }
+
+ renv_bootstrap_library_root_name <- function(project) {
+
+ # use project name as-is if requested
+ asis <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT_ASIS", unset = "FALSE")
+ if (asis)
+ return(basename(project))
+
+ # otherwise, disambiguate based on project's path
+ id <- substring(renv_bootstrap_hash_text(project), 1L, 8L)
+ paste(basename(project), id, sep = "-")
+
+ }
+
+ renv_bootstrap_library_root <- function(project) {
+
+ prefix <- renv_bootstrap_profile_prefix()
+
+ path <- Sys.getenv("RENV_PATHS_LIBRARY", unset = NA)
+ if (!is.na(path))
+ return(paste(c(path, prefix), collapse = "/"))
+
+ path <- renv_bootstrap_library_root_impl(project)
+ if (!is.null(path)) {
+ name <- renv_bootstrap_library_root_name(project)
+ return(paste(c(path, prefix, name), collapse = "/"))
+ }
+
+ renv_bootstrap_paths_renv("library", project = project)
+
+ }
+
+ renv_bootstrap_library_root_impl <- function(project) {
+
+ root <- Sys.getenv("RENV_PATHS_LIBRARY_ROOT", unset = NA)
+ if (!is.na(root))
+ return(root)
+
+ type <- renv_bootstrap_project_type(project)
+ if (identical(type, "package")) {
+ userdir <- renv_bootstrap_user_dir()
+ return(file.path(userdir, "library"))
+ }
+
+ }
+
+ renv_bootstrap_validate_version <- function(version, description = NULL) {
+
+ # resolve description file
+ #
+ # avoid passing lib.loc to `packageDescription()` below, since R will
+ # use the loaded version of the package by default anyhow. note that
+ # this function should only be called after 'renv' is loaded
+ # https://github.com/rstudio/renv/issues/1625
+ description <- description %||% packageDescription("renv")
+
+ # check whether requested version 'version' matches loaded version of renv
+ sha <- attr(version, "sha", exact = TRUE)
+ valid <- if (!is.null(sha))
+ renv_bootstrap_validate_version_dev(sha, description)
+ else
+ renv_bootstrap_validate_version_release(version, description)
+
+ if (valid)
+ return(TRUE)
+
+ # the loaded version of renv doesn't match the requested version;
+ # give the user instructions on how to proceed
+ dev <- identical(description[["RemoteType"]], "github")
+ remote <- if (dev)
+ paste("rstudio/renv", description[["RemoteSha"]], sep = "@")
+ else
+ paste("renv", description[["Version"]], sep = "@")
+
+ # display both loaded version + sha if available
+ friendly <- renv_bootstrap_version_friendly(
+ version = description[["Version"]],
+ sha = if (dev) description[["RemoteSha"]]
+ )
+
+ fmt <- heredoc("
+ renv %1$s was loaded from project library, but this project is configured to use renv %2$s.
+ - Use `renv::record(\"%3$s\")` to record renv %1$s in the lockfile.
+ - Use `renv::restore(packages = \"renv\")` to install renv %2$s into the project library.
+ ")
+ catf(fmt, friendly, renv_bootstrap_version_friendly(version), remote)
+
+ FALSE
+
+ }
+
+ renv_bootstrap_validate_version_dev <- function(version, description) {
+ expected <- description[["RemoteSha"]]
+ is.character(expected) && startswith(expected, version)
+ }
+
+ renv_bootstrap_validate_version_release <- function(version, description) {
+ expected <- description[["Version"]]
+ is.character(expected) && identical(expected, version)
+ }
+
+ renv_bootstrap_hash_text <- function(text) {
+
+ hashfile <- tempfile("renv-hash-")
+ on.exit(unlink(hashfile), add = TRUE)
+
+ writeLines(text, con = hashfile)
+ tools::md5sum(hashfile)
+
+ }
+
+ renv_bootstrap_load <- function(project, libpath, version) {
+
+ # try to load renv from the project library
+ if (!requireNamespace("renv", lib.loc = libpath, quietly = TRUE))
+ return(FALSE)
+
+ # warn if the version of renv loaded does not match
+ renv_bootstrap_validate_version(version)
+
+ # execute renv load hooks, if any
+ hooks <- getHook("renv::autoload")
+ for (hook in hooks)
+ if (is.function(hook))
+ tryCatch(hook(), error = warnify)
+
+ # load the project
+ renv::load(project)
+
+ TRUE
+
+ }
+
+ renv_bootstrap_profile_load <- function(project) {
+
+ # if RENV_PROFILE is already set, just use that
+ profile <- Sys.getenv("RENV_PROFILE", unset = NA)
+ if (!is.na(profile) && nzchar(profile))
+ return(profile)
+
+ # check for a profile file (nothing to do if it doesn't exist)
+ path <- renv_bootstrap_paths_renv("profile", profile = FALSE, project = project)
+ if (!file.exists(path))
+ return(NULL)
+
+ # read the profile, and set it if it exists
+ contents <- readLines(path, warn = FALSE)
+ if (length(contents) == 0L)
+ return(NULL)
+
+ # set RENV_PROFILE
+ profile <- contents[[1L]]
+ if (!profile %in% c("", "default"))
+ Sys.setenv(RENV_PROFILE = profile)
+
+ profile
+
+ }
+
+ renv_bootstrap_profile_prefix <- function() {
+ profile <- renv_bootstrap_profile_get()
+ if (!is.null(profile))
+ return(file.path("profiles", profile, "renv"))
+ }
+
+ renv_bootstrap_profile_get <- function() {
+ profile <- Sys.getenv("RENV_PROFILE", unset = "")
+ renv_bootstrap_profile_normalize(profile)
+ }
+
+ renv_bootstrap_profile_set <- function(profile) {
+ profile <- renv_bootstrap_profile_normalize(profile)
+ if (is.null(profile))
+ Sys.unsetenv("RENV_PROFILE")
+ else
+ Sys.setenv(RENV_PROFILE = profile)
+ }
+
+ renv_bootstrap_profile_normalize <- function(profile) {
+
+ if (is.null(profile) || profile %in% c("", "default"))
+ return(NULL)
+
+ profile
+
+ }
+
+ renv_bootstrap_path_absolute <- function(path) {
+
+ substr(path, 1L, 1L) %in% c("~", "/", "\\") || (
+ substr(path, 1L, 1L) %in% c(letters, LETTERS) &&
+ substr(path, 2L, 3L) %in% c(":/", ":\\")
+ )
+
+ }
+
+ renv_bootstrap_paths_renv <- function(..., profile = TRUE, project = NULL) {
+ renv <- Sys.getenv("RENV_PATHS_RENV", unset = "renv")
+ root <- if (renv_bootstrap_path_absolute(renv)) NULL else project
+ prefix <- if (profile) renv_bootstrap_profile_prefix()
+ components <- c(root, renv, prefix, ...)
+ paste(components, collapse = "/")
+ }
+
+ renv_bootstrap_project_type <- function(path) {
+
+ descpath <- file.path(path, "DESCRIPTION")
+ if (!file.exists(descpath))
+ return("unknown")
+
+ desc <- tryCatch(
+ read.dcf(descpath, all = TRUE),
+ error = identity
+ )
+
+ if (inherits(desc, "error"))
+ return("unknown")
+
+ type <- desc$Type
+ if (!is.null(type))
+ return(tolower(type))
+
+ package <- desc$Package
+ if (!is.null(package))
+ return("package")
+
+ "unknown"
+
+ }
+
+ renv_bootstrap_user_dir <- function() {
+ dir <- renv_bootstrap_user_dir_impl()
+ path.expand(chartr("\\", "/", dir))
+ }
+
+ renv_bootstrap_user_dir_impl <- function() {
+
+ # use local override if set
+ override <- getOption("renv.userdir.override")
+ if (!is.null(override))
+ return(override)
+
+ # use R_user_dir if available
+ tools <- asNamespace("tools")
+ if (is.function(tools$R_user_dir))
+ return(tools$R_user_dir("renv", "cache"))
+
+ # try using our own backfill for older versions of R
+ envvars <- c("R_USER_CACHE_DIR", "XDG_CACHE_HOME")
+ for (envvar in envvars) {
+ root <- Sys.getenv(envvar, unset = NA)
+ if (!is.na(root))
+ return(file.path(root, "R/renv"))
+ }
+
+ # use platform-specific default fallbacks
+ if (Sys.info()[["sysname"]] == "Windows")
+ file.path(Sys.getenv("LOCALAPPDATA"), "R/cache/R/renv")
+ else if (Sys.info()[["sysname"]] == "Darwin")
+ "~/Library/Caches/org.R-project.R/R/renv"
+ else
+ "~/.cache/R/renv"
+
+ }
+
+ renv_bootstrap_version_friendly <- function(version, shafmt = NULL, sha = NULL) {
+ sha <- sha %||% attr(version, "sha", exact = TRUE)
+ parts <- c(version, sprintf(shafmt %||% " [sha: %s]", substring(sha, 1L, 7L)))
+ paste(parts, collapse = "")
+ }
+
+ renv_bootstrap_exec <- function(project, libpath, version) {
+ if (!renv_bootstrap_load(project, libpath, version))
+ renv_bootstrap_run(version, libpath)
+ }
+
+ renv_bootstrap_run <- function(version, libpath) {
+
+ # perform bootstrap
+ bootstrap(version, libpath)
+
+ # exit early if we're just testing bootstrap
+ if (!is.na(Sys.getenv("RENV_BOOTSTRAP_INSTALL_ONLY", unset = NA)))
+ return(TRUE)
+
+ # try again to load
+ if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) {
+ return(renv::load(project = getwd()))
+ }
+
+ # failed to download or load renv; warn the user
+ msg <- c(
+ "Failed to find an renv installation: the project will not be loaded.",
+ "Use `renv::activate()` to re-initialize the project."
+ )
+
+ warning(paste(msg, collapse = "\n"), call. = FALSE)
+
+ }
+
+ renv_json_read <- function(file = NULL, text = NULL) {
+
+ jlerr <- NULL
+
+ # if jsonlite is loaded, use that instead
+ if ("jsonlite" %in% loadedNamespaces()) {
+
+ json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity)
+ if (!inherits(json, "error"))
+ return(json)
+
+ jlerr <- json
+
+ }
+
+ # otherwise, fall back to the default JSON reader
+ json <- tryCatch(renv_json_read_default(file, text), error = identity)
+ if (!inherits(json, "error"))
+ return(json)
+
+ # report an error
+ if (!is.null(jlerr))
+ stop(jlerr)
+ else
+ stop(json)
+
+ }
+
+ renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
+ text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
+ jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
+ }
+
+ renv_json_read_default <- function(file = NULL, text = NULL) {
+
+ # find strings in the JSON
+ text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
+ pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
+ locs <- gregexpr(pattern, text, perl = TRUE)[[1]]
+
+ # if any are found, replace them with placeholders
+ replaced <- text
+ strings <- character()
+ replacements <- character()
+
+ if (!identical(c(locs), -1L)) {
+
+ # get the string values
+ starts <- locs
+ ends <- locs + attr(locs, "match.length") - 1L
+ strings <- substring(text, starts, ends)
+
+ # only keep those requiring escaping
+ strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE)
+
+ # compute replacements
+ replacements <- sprintf('"\032%i\032"', seq_along(strings))
+
+ # replace the strings
+ mapply(function(string, replacement) {
+ replaced <<- sub(string, replacement, replaced, fixed = TRUE)
+ }, strings, replacements)
+
+ }
+
+ # transform the JSON into something the R parser understands
+ transformed <- replaced
+ transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE)
+ transformed <- gsub("[[{]", "list(", transformed, perl = TRUE)
+ transformed <- gsub("[]}]", ")", transformed, perl = TRUE)
+ transformed <- gsub(":", "=", transformed, fixed = TRUE)
+ text <- paste(transformed, collapse = "\n")
+
+ # parse it
+ json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]]
+
+ # construct map between source strings, replaced strings
+ map <- as.character(parse(text = strings))
+ names(map) <- as.character(parse(text = replacements))
+
+ # convert to list
+ map <- as.list(map)
+
+ # remap strings in object
+ remapped <- renv_json_read_remap(json, map)
+
+ # evaluate
+ eval(remapped, envir = baseenv())
+
+ }
+
+ renv_json_read_remap <- function(json, map) {
+
+ # fix names
+ if (!is.null(names(json))) {
+ lhs <- match(names(json), names(map), nomatch = 0L)
+ rhs <- match(names(map), names(json), nomatch = 0L)
+ names(json)[rhs] <- map[lhs]
+ }
+
+ # fix values
+ if (is.character(json))
+ return(map[[json]] %||% json)
+
+ # handle true, false, null
+ if (is.name(json)) {
+ text <- as.character(json)
+ if (text == "true")
+ return(TRUE)
+ else if (text == "false")
+ return(FALSE)
+ else if (text == "null")
+ return(NULL)
+ }
+
+ # recurse
+ if (is.recursive(json)) {
+ for (i in seq_along(json)) {
+ json[i] <- list(renv_json_read_remap(json[[i]], map))
+ }
+ }
+
+ json
+
+ }
+
+ # load the renv profile, if any
+ renv_bootstrap_profile_load(project)
+
+ # construct path to library root
+ root <- renv_bootstrap_library_root(project)
+
+ # construct library prefix for platform
+ prefix <- renv_bootstrap_platform_prefix()
+
+ # construct full libpath
+ libpath <- file.path(root, prefix)
+
+ # run bootstrap code
+ renv_bootstrap_exec(project, libpath, version)
+
+ invisible()
+
+})
diff --git a/renv/settings.json b/renv/settings.json
new file mode 100644
index 00000000..ffdbb320
--- /dev/null
+++ b/renv/settings.json
@@ -0,0 +1,19 @@
+{
+ "bioconductor.version": null,
+ "external.libraries": [],
+ "ignored.packages": [],
+ "package.dependency.fields": [
+ "Imports",
+ "Depends",
+ "LinkingTo"
+ ],
+ "ppm.enabled": null,
+ "ppm.ignored.urls": [],
+ "r.version": null,
+ "snapshot.type": "implicit",
+ "use.cache": true,
+ "vcs.ignore.cellar": true,
+ "vcs.ignore.library": true,
+ "vcs.ignore.local": true,
+ "vcs.manage.ignores": true
+}