diff --git a/.Rbuildignore b/.Rbuildignore index 27758da..d6bf5b2 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -5,3 +5,5 @@ ^_pkgdown\.yml$ ^docs$ ^pkgdown$ +^\.claude$ +^claude\.md$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index b1f9cd1..f055199 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -11,6 +11,7 @@ env: jobs: document: + if: github.event_name != 'pull_request' runs-on: ubuntu-latest steps: @@ -47,10 +48,11 @@ jobs: run: | git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" - git pull + git fetch origin ${{ github.ref_name }} + git checkout ${{ github.ref_name }} git add -f man/\* NAMESPACE - git commit -m 'Documentation' || echo "No changes to commit" - git push origin || echo "No changes to commit" + git commit -m 'Documentation [automated]' || echo "No changes to commit" + git push origin ${{ github.ref_name }} || echo "No changes to commit" R-CMD-check: if: ${{ always() }} diff --git a/.github/workflows/document-and-deploy.yml b/.github/workflows/document-and-deploy.yml index cd0a5c3..c73d731 100644 --- a/.github/workflows/document-and-deploy.yml +++ b/.github/workflows/document-and-deploy.yml @@ -40,12 +40,13 @@ jobs: " - name: commit + if: github.event_name != 'pull_request' run: | git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" git add -f man/\* NAMESPACE - git commit -m 'Documentation' || echo "No changes to commit" - git push origin || echo "No changes to commit" + git commit -m 'Documentation [automated]' || echo "No changes to commit" + git push origin HEAD:${{ github.ref_name }} || echo "No changes to commit" - name: Create pkgdown env: @@ -72,7 +73,6 @@ jobs: R -e " remotes::install_github('${{ github.repository }}', ref = '${{ github.ref_name }}', force = TRUE); rsconnect::setAccountInfo(name='forrt-replications', token=${{secrets.SHINYAPPS_TOKEN}}, secret=${{secrets.SHINYAPPS_SECRET}}); - rsconnect::deployApp(appName = 'fred_annotator', appDir = './inst/fred_annotator', forceUpdate = TRUE); rsconnect::deployApp(appName = 'fred_explorer', appDir = './inst/fred_explorer', forceUpdate = TRUE); " @@ -81,5 +81,4 @@ jobs: run: | R -e " rsconnect::deployApp(appName = 'fred_explorer_release', appDir = './inst/fred_explorer', forceUpdate = TRUE); - rsconnect::deployApp(appName = 'fred_annotator_release', appDir = './inst/fred_annotator', forceUpdate = TRUE); " diff --git a/DESCRIPTION b/DESCRIPTION index 1f4b302..d367332 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: FReD Title: Interfaces to the FORRT Replication Database -Version: 0.0.0.9002 +Version: 0.2.0 Authors@R: c( person("Lukas", "Röseler", , "lukas.roeseler@uni-muenster.de", role = "aut", comment = c(ORCID = "0000-0002-6446-1901")), diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..075035e --- /dev/null +++ b/LICENSE @@ -0,0 +1,2 @@ +YEAR: 2024 +COPYRIGHT HOLDER: FReD authors diff --git a/NEWS.md b/NEWS.md index d06ccca..b16c58f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,15 @@ This version history contains noteworthy changes. For a full history of changes, see the [commit history](https://github.com/forrtproject/FReD/commits/main/) +# FReD 0.2.0 + +## Breaking Changes +- **New data source URL**: The package now uses a new data source with updated variable naming conventions +- **Variable naming convention**: All variable names now use `_o` suffix for original study variables and `_r` suffix for replication study variables (e.g., `es_original` → `es_o`, `n_replication` → `n_r`, `ref_original` → `ref_o`, `doi_replication` → `doi_r`) +- **`run_annotator()` deprecated**: The local annotator app has been removed. `run_annotator()` now opens the web version at forrt.org instead + +## Notes +- If you have code that references old variable names, you will need to update it to use the new `_o`/`_r` suffixes + # FReD 0.1.0 ## New features diff --git a/R/data_management.R b/R/data_management.R index 6687012..f32bd4d 100644 --- a/R/data_management.R +++ b/R/data_management.R @@ -94,37 +94,26 @@ read_fred <- function(data = get_param("FRED_DATA_FILE"), retain_es_as_character tryCatch({ - red <- safe_read_xl(data, url = get_param("FRED_DATA_URL"), sheet = "Data") # .xlsx file - red <- red[-(1:2), ] # exclude labels and "X" column - - forrt <- safe_read_xl(data, url = get_param("FRED_DATA_URL"), sheet = "FORRT R&R (editable)", startRow = 1) - forrt <- forrt[-(1:2), ] # exclude labels and "X" column - forrt <- forrt[!(forrt$doi_original %in% red$doi_original), ] # exclude forrt entries of original study that already appear in FReD (based on DOIs) - - # additional studies - as <- safe_read_xl(data, url = get_param("FRED_DATA_URL"), sheet = "Additional Studies to be added", startRow = 2) - as$id <- paste("uncoded_studies_", rownames(as), sep = "") - as <- as[as$`Study.listed.in.ReD?` != "1.0", ] # exclude additional studies that are already listed in the main dataset - as <- as[!is.na(as$doi_original), ] # exclude studies for which doi_original is unavailable because they will not be findable in the annotator anyway - - numeric_variables <- c("n_original", "n_replication", "es_orig_value", "es_rep_value", - "validated", "published_rep", "same_design", "same_test", - "original_authors", - "significant_original", "significant_replication", "power") - - - if (!retain_es_as_character) { - numeric_variables <- c(numeric_variables, "es_orig_RRR", "es_rep_RRR") + # New data format: single sheet with all data + fred_data <- safe_read_xl(data, url = get_param("FRED_DATA_URL"), sheet = 1) + + # Add id column if not present (use fred_id or row number) + if (!"id" %in% names(fred_data)) { + if ("fred_id" %in% names(fred_data)) { + fred_data$id <- fred_data$fred_id + } else { + fred_data$id <- seq_len(nrow(fred_data)) + } } + numeric_variables <- c("n_o", "n_r", "es_value_o", "es_value_r", "pval_value_o", "pval_value_r") + # Only coerce variables that exist in the dataset + numeric_variables <- intersect(numeric_variables, names(fred_data)) - # Assuming 'red' and 'forrt' have a unique ID column named "id" - red <- coerce_to_numeric(red, numeric_variables, id_var = "id", verbose = verbose) - forrt <- coerce_to_numeric(forrt, numeric_variables, id_var = "id", verbose = verbose) + fred_data <- coerce_to_numeric(fred_data, numeric_variables, id_var = "id", verbose = verbose) - # merge the data, aligning column types where one is character (as empty colums are imported as numeric) - return(bind_rows_with_characters(red, forrt, as)) + return(fred_data) }, error = function(e) { return(return_inbuilt("data")) @@ -149,6 +138,7 @@ coerce_to_numeric <- function(df, numeric_vars, id_var, verbose = TRUE) { problematic_entries <- list() for (var in numeric_vars) { + # Suppress "NAs introduced by coercion" warnings - we detect and report these ourselves below problematic_rows <- which(!is.na(df[[var]]) & is.na(suppressWarnings(as.numeric(df[[var]])))) if (length(problematic_rows) > 0) { @@ -187,50 +177,75 @@ coerce_to_numeric <- function(df, numeric_vars, id_var, verbose = TRUE) { clean_variables <- function(fred_data) { + # Initialize columns that may not exist in new data format + if (!"description" %in% names(fred_data)) fred_data$description <- "" + if (!"tags" %in% names(fred_data)) fred_data$tags <- NA + if (!"contributors" %in% names(fred_data)) fred_data$contributors <- NA + if (!"result" %in% names(fred_data)) fred_data$result <- NA + if (!"notes" %in% names(fred_data)) fred_data$notes <- NA + if (!"exclusion" %in% names(fred_data)) fred_data$exclusion <- NA + if (!"validated" %in% names(fred_data)) fred_data$validated <- 1 + if (!"osf_link" %in% names(fred_data)) { + fred_data$osf_link <- ifelse(!is.na(fred_data$url_r), fred_data$url_r, NA) + } + if (!"source" %in% names(fred_data)) fred_data$source <- NA + if (!"orig_journal" %in% names(fred_data)) { + fred_data$orig_journal <- if ("journal_o" %in% names(fred_data)) fred_data$journal_o else NA + } + # recode variables for app to work - fred_data$pc_tags <- NA - fred_data$pc_contributors <- NA fred_data$description <- ifelse(is.na(fred_data$description), "", fred_data$description) - fred_data$contributors <- ifelse(is.na(fred_data$contributors), fred_data$pc_contributors, fred_data$contributors) - fred_data$tags <- ifelse(is.na(fred_data$tags), fred_data$pc_tags, fred_data$tags) - fred_data$subjects <- NA - fred_data$description <- ifelse(is.na(fred_data$description), fred_data$pc_title, fred_data$description) fred_data$closeness <- NA - fred_data$result <- ifelse(fred_data$result == "0", NA, fred_data$result) + fred_data$result <- ifelse(!is.na(fred_data$result) & fred_data$result == "0", NA, fred_data$result) - fred_data$result - - # compute year the original study was published (match 1800-2099 only, and require consecutive numbers) - fred_data$orig_year <- as.numeric(gsub(".*((18|19|20)\\d{2}).*", "\\1", fred_data$ref_original)) + # compute year the original study was published - use year_o if available, otherwise extract from ref_o + if ("year_o" %in% names(fred_data)) { + fred_data$orig_year <- as.numeric(fred_data$year_o) + } else { + fred_data$orig_year <- as.numeric(gsub(".*((18|19|20)\\d{2}).*", "\\1", fred_data$ref_o)) + } - # # delete duplicates and non-replication studies - fred_data <- fred_data[fred_data$notes != "duplicate" | is.na(fred_data$notes), ] # ADDED: study exclusions due to duplicates - fred_data <- fred_data[fred_data$notes != "No actual replication conducted" | is.na(fred_data$notes), ] # ADDED: some registrations had no corresponding replication study + # delete duplicates and non-replication studies (only if notes column exists and has values) + if ("notes" %in% names(fred_data)) { + fred_data <- fred_data[is.na(fred_data$notes) | fred_data$notes != "duplicate", ] + fred_data <- fred_data[is.na(fred_data$notes) | fred_data$notes != "No actual replication conducted", ] + } - # remove entries with reasons for exclusions - fred_data <- fred_data[is.na(fred_data$exclusion), ] + # remove entries with reasons for exclusions (only if exclusion column exists) + if ("exclusion" %in% names(fred_data)) { + fred_data <- fred_data[is.na(fred_data$exclusion), ] + } # Collapse validated categories (# 2: error detected and corrected) - fred_data$validated <- ifelse(fred_data$validated == 1 | fred_data$validated == 2, 1, fred_data$validated) - + if ("validated" %in% names(fred_data)) { + fred_data$validated <- ifelse(fred_data$validated == 1 | fred_data$validated == 2, 1, fred_data$validated) + } # Strip DOIs by removing everything before first 10. - fred_data$doi_original <- gsub("^.*?(10\\.\\d+/.*$)", "\\1", fred_data$doi_original) %>% str_trim_base() - fred_data$doi_replication <- gsub("^.*?(10\\.\\d+/.*$)", "\\1", fred_data$doi_replication) %>% str_trim_base() + if ("doi_o" %in% names(fred_data)) { + fred_data$doi_o <- gsub("^.*?(10\\.\\d+/.*$)", "\\1", fred_data$doi_o) %>% str_trim_base() + } + if ("doi_r" %in% names(fred_data)) { + fred_data$doi_r <- gsub("^.*?(10\\.\\d+/.*$)", "\\1", fred_data$doi_r) %>% str_trim_base() + } # Remove DOIs from references - fred_data$ref_original <- fred_data$ref_original %>% - stringr::str_remove_all("https?://(dx\\.)?doi\\.org/10\\.[^ >,]+") %>% - stringr::str_remove_all("doi:10\\.[^ >,]+") %>% - stringr::str_remove_all("10\\.[^ >,]+") %>% - str_trim_base() - - fred_data$ref_replication <- fred_data$ref_replication %>% - stringr::str_remove_all("https?://(dx\\.)?doi\\.org/10\\.[^ >,]+") %>% - stringr::str_remove_all("doi:10\\.[^ >,]+") %>% - stringr::str_remove_all("10\\.[^ >,]+") %>% - str_trim_base() + if ("ref_o" %in% names(fred_data)) { + fred_data$ref_o <- fred_data$ref_o %>% + stringr::str_remove_all("https?://(dx\\.)?doi\\.org/10\\.[^ >,]+") %>% + stringr::str_remove_all("doi:10\\.[^ >,]+") %>% + stringr::str_remove_all("10\\.[^ >,]+") %>% + str_trim_base() + } + + if ("ref_r" %in% names(fred_data)) { + fred_data$ref_r <- fred_data$ref_r %>% + stringr::str_remove_all("https?://(dx\\.)?doi\\.org/10\\.[^ >,]+") %>% + stringr::str_remove_all("doi:10\\.[^ >,]+") %>% + stringr::str_remove_all("10\\.[^ >,]+") %>% + str_trim_base() + } fred_data } diff --git a/R/effect_size_transformations.R b/R/effect_size_transformations.R index 932e795..bcc1f00 100644 --- a/R/effect_size_transformations.R +++ b/R/effect_size_transformations.R @@ -350,8 +350,8 @@ as_numeric_verbose <- function(x, quiet = FALSE) { #' @param coalesce_values Logical. Should existing values in es_type_columns be retained? #' @return FReD dataset with additional columns for common effect sizes -add_common_effect_sizes <- function(fred_data, es_value_columns = c("es_orig_value", "es_rep_value"), - es_type_columns = c("es_orig_estype", "es_rep_estype"), es_common_names = c("es_original", "es_replication"), +add_common_effect_sizes <- function(fred_data, es_value_columns = c("es_value_o", "es_value_r"), + es_type_columns = c("es_type_o", "es_type_r"), es_common_names = c("es_o", "es_r"), coalesce_values = TRUE) { if (!all.equal(length(es_value_columns), length(es_type_columns), length(es_common_names))) { stop("Length of es_value_columns, es_type_columns, and es_common_names must be equal") @@ -399,7 +399,7 @@ add_common_effect_sizes <- function(fred_data, es_value_columns = c("es_orig_val #' @param es_replication Character. Name of replication effect size column. #' @return Augmented FReD dataset with aligned effect directions. -align_effect_direction <- function(fred_data, es_original = "es_original", es_replication = "es_replication") { +align_effect_direction <- function(fred_data, es_original = "es_o", es_replication = "es_r") { orig_direction <- sign(fred_data[, es_original]) fred_data[, es_original] <- abs(fred_data[, es_original]) fred_data[, es_replication] <- fred_data[, es_replication] * orig_direction @@ -421,16 +421,16 @@ align_effect_direction <- function(fred_data, es_original = "es_original", es_re #' #' @noRd #' @examples -#' fred_data <- data.frame(es_original = c(0.3, 0.5), es_replication = c(0.4, 0.6), -#' n_original = c(30, 40), n_replication = c(50, 60)) +#' fred_data <- data.frame(es_o = c(0.3, 0.5), es_r = c(0.4, 0.6), +#' n_o = c(30, 40), n_r = c(50, 60)) #' add_uncertainty(fred_data) -add_uncertainty <- function(fred_data, es_value_columns = c("es_original", "es_replication"), - N_columns = c("n_original", "n_replication"), - vi_columns = c("vi_original", "vi_replication"), - ci_lower_columns = c("ci.lower_original", "ci.lower_replication"), - ci_upper_columns = c("ci.upper_original", "ci.upper_replication"), - p_values = c("p_value_original", "p_value_replication")) { +add_uncertainty <- function(fred_data, es_value_columns = c("es_o", "es_r"), + N_columns = c("n_o", "n_r"), + vi_columns = c("vi_o", "vi_r"), + ci_lower_columns = c("ci.lower_o", "ci.lower_r"), + ci_upper_columns = c("ci.upper_o", "ci.upper_r"), + p_values = c("p_value_o", "p_value_r")) { if (!all.equal(length(es_value_columns), length(N_columns), length(vi_columns), length(ci_lower_columns), length(ci_upper_columns))) { stop("Length of all column character vectors must be equal") } @@ -476,12 +476,12 @@ add_uncertainty <- function(fred_data, es_value_columns = c("es_original", "es_r #' @importFrom dplyr mutate case_when code_replication_outcomes <- function(fred_data, - es_original = "es_original", - p_original = "p_value_original", - p_replication = "p_value_replication", - ci_lower_replication = "ci.lower_replication", - ci_upper_replication = "ci.upper_replication", - es_replication = "es_replication") { + es_original = "es_o", + p_original = "p_value_o", + p_replication = "p_value_r", + ci_lower_replication = "ci.lower_r", + ci_upper_replication = "ci.upper_r", + es_replication = "es_r") { # Convert column names to symbols for dplyr evaluation es_original_sym <- dplyr::sym(es_original) @@ -529,7 +529,7 @@ code_replication_outcomes <- function(fred_data, #' @param power_column Character. Name of target column for power. #' @return Augmented FReD dataset with power column. -add_replication_power <- function(fred_data, es_original = "es_original", N_replication = "n_replication", power_column = "power_r") { +add_replication_power <- function(fred_data, es_original = "es_o", N_replication = "n_r", power_column = "power_r") { # NA where N_replication is missing fred_data[, power_column] <- NA # Return 0 where sample_replication < 4, as pwr.r.test does not work for n < 4 @@ -587,8 +587,8 @@ p_from_r <- function(r, N) { #' @param vi_columns Character vector of target columns for sampling variances #' @return FReD dataset with additional columns for sampling variances (metafor's `vi`) -add_sampling_variances <- function(fred_data, es_value_columns = c("es_original", "es_replication"), - N_columns = c("n_original", "n_replication"), vi_columns = c("vi_original", "vi_replication")) { +add_sampling_variances <- function(fred_data, es_value_columns = c("es_o", "es_r"), + N_columns = c("n_o", "n_r"), vi_columns = c("vi_o", "vi_r")) { if (!all.equal(length(es_value_columns), length(N_columns))) { stop("Length of es_value_columns, N_columns and vi_columns must be equal") } @@ -619,19 +619,19 @@ add_sampling_variances <- function(fred_data, es_value_columns = c("es_original" augment_for_zcurve <- function(fred_data) { # Ensure fred_data has required columns - if (!all(c("es_original", "n_original") %in% names(fred_data))) { - stop("fred_data must contain es_original and n_original columns") + if (!all(c("es_o", "n_o") %in% names(fred_data))) { + stop("fred_data must contain es_o and n_o columns") } # Initialize se and z as NA fred_data$se <- fred_data$z <- NA - valid_indices <- !(is.na(fred_data$es_original) | is.na(fred_data$n_original) | fred_data$n_original <= 3) + valid_indices <- !(is.na(fred_data$es_o) | is.na(fred_data$n_o) | fred_data$n_o <= 3) if (any(valid_indices)) { # Fisher's z transformation - z <- 0.5 * (log(1 + fred_data$es_original[valid_indices]) - log(1 - fred_data$es_original[valid_indices])) - fred_data$se[valid_indices] <- 1 / sqrt(fred_data$n_original[valid_indices] - 3) + z <- 0.5 * (log(1 + fred_data$es_o[valid_indices]) - log(1 - fred_data$es_o[valid_indices])) + fred_data$se[valid_indices] <- 1 / sqrt(fred_data$n_o[valid_indices] - 3) fred_data$z[valid_indices] <- z / fred_data$se[valid_indices] } diff --git a/R/run_apps.R b/R/run_apps.R index c24c639..1505b35 100644 --- a/R/run_apps.R +++ b/R/run_apps.R @@ -143,18 +143,22 @@ run_explorer <- function(offer_install = interactive(), in_background = NULL, au #' Run the Replication Annotator #' -#' Running this function will launch the FReD Replication Annotator shiny app +#' @description +#' `r lifecycle::badge("deprecated")` #' -#' @return Replication Annotator shiny app -#' @inheritParams run_app +#' This function previously launched a local Shiny app but now opens the +#' hosted web version of the FReD Annotator. +#' +#' @return Opens the web annotator in the default browser (invisibly returns NULL). #' @export #' @examples #' if (interactive()) { -#' # To run the Replication Annotator app: #' run_annotator() #' } -run_annotator <- function(offer_install = interactive(), in_background = NULL, auto_close = interactive(), port = 3839, timeout = 30) { - run_app(offer_install = offer_install, app = "fred_annotator", in_background = in_background, auto_close = auto_close, port = port, timeout = timeout) +run_annotator <- function() { + .Deprecated(msg = "The local annotator app has been deprecated. Opening the web version.") + utils::browseURL("http://forrt.org/apps/fred_annotator.html") + invisible(NULL) } #' Get the date of last modification diff --git a/R/zzz_parameters.R b/R/zzz_parameters.R index a4a5051..f9993f4 100644 --- a/R/zzz_parameters.R +++ b/R/zzz_parameters.R @@ -9,7 +9,7 @@ #' - `FRED_DATA_FILE`: The path to the .xlsx file, if you have downloaded it already (or want it to be saved to a particular location). If the file exists, it will be used - otherwise, the file will be downloaded and saved there. #' - `RETRACTIONWATCH_DATA_FILE`: The path to the RetractionWatch database, if you have downloaded it already (or want it to be saved to a particular location). If the file exists, it will be used - otherwise, the file will be downloaded and saved there. #' - `RETRACTIONWATCH_URL`: The URL to download the RetractionWatch database. Needs to return the .csv file. -#' - `FRED_OFFLINE`: Should FReD work offline (TRUE) or online (FALSE). If TRUE, FReD will not download the latest data every time it is loaded. Defaults to FALSE. +#' - `FRED_OFFLINE`: Should FReD work offline (TRUE) or online (FALSE). If TRUE, FReD will not download the latest data every time it is loaded. Defaults to TRUE. #' - `FRED_SUPPRESS_STARTUP_MENU`: Should the interactive menu checking for data updates be suppressed (TRUE) or shown (FALSE). If TRUE, all startup messages and interactive prompts related to offline data updates will be suppressed. Defaults to FALSE. #' #' @examples @@ -22,7 +22,7 @@ NULL .onLoad <- function(libname, pkgname) { parameters <- list( - "FRED_DATA_URL" = "https://osf.io/z5u9b/download", + "FRED_DATA_URL" = "https://osf.io/2tbvd/download", "FRED_DATA_FILE" = tempfile(fileext = ".xlsx"), "RETRACTIONWATCH_DATA_FILE" = tempfile(fileext = ".csv"), "RETRACTIONWATCH_URL" = "https://api.labs.crossref.org/data/retractionwatch?lukas.wallrich@gmail.com", @@ -44,7 +44,7 @@ NULL .onAttach <- function(libname, pkgname) { - is_offline <- isTRUE(as.logical(Sys.getenv("FRED_OFFLINE", "FALSE"))) + is_offline <- isTRUE(as.logical(Sys.getenv("FRED_OFFLINE"))) suppress_menu <- isTRUE(as.logical(Sys.getenv("FRED_SUPPRESS_STARTUP_MENU", "FALSE"))) if (is_offline && interactive() && !suppress_menu) { diff --git a/README.md b/README.md index 61595de..5fdd694 100644 --- a/README.md +++ b/README.md @@ -8,9 +8,8 @@ experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](h The goal of the FReD package is to provide various interfaces to the -FORRT Replication Database. The package includes two shiny apps - the -FReD Explorer and the FReD Annotator - as well as functions to directly -access and analyse the dataset. +FORRT Replication Database. The package includes a shiny app - the +FReD Explorer - as well as functions to directly access and analyse the dataset. ## FReD Explorer @@ -25,8 +24,7 @@ The FReD Annotator allows users to annotate lists of articles (e.g. reading list for classes, or reference lists for draft articles) with any replication findings. This is intended to make it easier to use replications in teaching and research, and to thus ensure that claims are based on the best available evidence. -You can access the FReD Annotator [online](https://forrt-replications.shinyapps.io/fred_annotator/) or by calling `run_annotator()` in your -R console after you have loaded the package. +You can access the FReD Annotator [online](https://forrt-replications.shinyapps.io/fred_annotator/). ## Installation @@ -41,7 +39,6 @@ devtools::install_github("forrtproject/FReD") ``` r library(FReD) run_explorer() -run_annotator() ``` ## Accessing the data diff --git a/inst/NEWS.md b/inst/NEWS.md index d06ccca..b16c58f 100644 --- a/inst/NEWS.md +++ b/inst/NEWS.md @@ -1,5 +1,15 @@ This version history contains noteworthy changes. For a full history of changes, see the [commit history](https://github.com/forrtproject/FReD/commits/main/) +# FReD 0.2.0 + +## Breaking Changes +- **New data source URL**: The package now uses a new data source with updated variable naming conventions +- **Variable naming convention**: All variable names now use `_o` suffix for original study variables and `_r` suffix for replication study variables (e.g., `es_original` → `es_o`, `n_replication` → `n_r`, `ref_original` → `ref_o`, `doi_replication` → `doi_r`) +- **`run_annotator()` deprecated**: The local annotator app has been removed. `run_annotator()` now opens the web version at forrt.org instead + +## Notes +- If you have code that references old variable names, you will need to update it to use the new `_o`/`_r` suffixes + # FReD 0.1.0 ## New features diff --git a/inst/extdata/snapshot/citation.RDS b/inst/extdata/snapshot/citation.RDS index ac2f377..b720a63 100644 Binary files a/inst/extdata/snapshot/citation.RDS and b/inst/extdata/snapshot/citation.RDS differ diff --git a/inst/extdata/snapshot/data.RDS b/inst/extdata/snapshot/data.RDS index 4dcabe5..2b8adfe 100644 Binary files a/inst/extdata/snapshot/data.RDS and b/inst/extdata/snapshot/data.RDS differ diff --git a/inst/extdata/snapshot/data_changelog.RDS b/inst/extdata/snapshot/data_changelog.RDS index dc857e8..f31f3ee 100644 Binary files a/inst/extdata/snapshot/data_changelog.RDS and b/inst/extdata/snapshot/data_changelog.RDS differ diff --git a/inst/extdata/snapshot/data_description.RDS b/inst/extdata/snapshot/data_description.RDS index 8127022..cf1282f 100644 Binary files a/inst/extdata/snapshot/data_description.RDS and b/inst/extdata/snapshot/data_description.RDS differ diff --git a/inst/fred_annotator/changelog.md b/inst/fred_annotator/changelog.md deleted file mode 100644 index 1004868..0000000 --- a/inst/fred_annotator/changelog.md +++ /dev/null @@ -1,5 +0,0 @@ -# Changelog - -## [0.0.1] - 2021-01-01 - -* Alpha version - basic interface & first annotations diff --git a/inst/fred_annotator/global.R b/inst/fred_annotator/global.R deleted file mode 100644 index 899b3dc..0000000 --- a/inst/fred_annotator/global.R +++ /dev/null @@ -1,74 +0,0 @@ -library(shiny) -library(shinyjs) -library(bslib) -library(dplyr) -library(ggplot2) -library(DT) - -if (FALSE) library(FReD) - -options(shiny.maxRequestSize = 20 * 1024^2) - -if (!exists("create_citation")) { - message("Attaching FReD namespace.") - attach(getNamespace("FReD")) # To enable use of un-exported functions -} - -if (!exists("create_citation")) stop("Failed to attach FReD namespace.") - -df <- load_fred_data() - -df_display <- df[, c("description", "es_original", "es_replication", "n_original", "n_replication", "osf_link", "contributors", "result", "result2", "ref_original", "ref_replication")] -df_display$es_original <- round(df_display$es_original, 3) -df_display$es_replication <- round(df_display$es_replication, 3) - - -dataset_variables <- load_variable_descriptions() - -df$ref_original <- gsub("(.{70,}?)\\s", "\\1\n", df$ref_original) # line breaks - -# WEBSITE TEXT -------------------------------------------------------------- - -source("website_text.R", local = TRUE) # Evaluate in calling environment, otherwise fails on app start - -source("replication_outcome_styles.R", local = TRUE) # Evaluate in calling environment, otherwise fails on app start - -## Add custom theme (formatting) -custom_css <- (" -.tab-pane { - padding: 0px 20px; -} -.tab-pane-narrow { - width: 100%; - max-width: 30cm; -} - .navbar-default .navbar-brand {color:black;} - .navbar-default .navbar-brand:hover {color:black;} - .navbar { background-color:#EAEAEA;} - .navbar-default .navbar-nav > li > a {color: dark grey;} - .navbar-default .navbar-nav > .active > a, - .navbar-default .navbar-nav > .active > a:focus, - .navbar-default .navbar-nav > .active > a:hover {color:black;background-color:#fc2d2d;} - .navbar-default .navbar-nav > li > a:hover {color:black;background-color:#A6A6A6;text-decoration} - .page-like { - background-color: white; - padding: 20px; - margin: 20px auto; - border-radius: 8px; - box-shadow: 0 4px 8px rgba(0, 0, 0, 0.1); - max-width: 800px; - } -") - -custom_theme <- bs_theme( - version = 5, - bg = "#FFFFFF", - fg = "#382f2f", - primary = "#a62828", - secondary = "#FF374B", - base_font = "Calibri" - ) - - - - diff --git a/inst/fred_annotator/red.png b/inst/fred_annotator/red.png deleted file mode 100644 index 40ef090..0000000 Binary files a/inst/fred_annotator/red.png and /dev/null differ diff --git a/inst/fred_annotator/replication_outcome_styles.R b/inst/fred_annotator/replication_outcome_styles.R deleted file mode 100644 index 1fe9238..0000000 --- a/inst/fred_annotator/replication_outcome_styles.R +++ /dev/null @@ -1,70 +0,0 @@ -success_criteria_colors <- tibble::tribble( - ~criterion, ~label, ~color, - - # significance_r outcome_report labels - "significance_r", "OS not significant", "#D3D3D3", - "significance_r", "failure", "#FF7F7F", - "significance_r", "success", "#8FBC8F", - "significance_r", "failure (reversal)", "darkred", - - # significance_agg outcome_report labels - "significance_agg", "success", "#8FBC8F", - "significance_agg", "failure", "#FF7F7F", - "significance_agg", "failure (reversal)", "darkred", - - # consistency_ci outcome_report labels - "consistency_ci", "success", "#8FBC8F", - "consistency_ci", "failure", "#FF7F7F", - - # consistency_pi outcome_report labels - "consistency_pi", "success", "#8FBC8F", - "consistency_pi", "failure", "#FF7F7F", - - # homogeneity outcome_report labels - "homogeneity", "success", "#8FBC8F", - "homogeneity", "failure", "#FF7F7F", - - # homogeneity_significance outcome_report labels - "homogeneity_significance", "OS not significant", "#D3D3D3", - "homogeneity_significance", "success (homogeneous and jointly significantly above 0)", "#8FBC8F", - "homogeneity_significance", "failure (not homogeneous but jointly significantly above 0)", "#efa986", - "homogeneity_significance", "failure (not homogeneous and not significant)", "darkred", - "homogeneity_significance", "failure (homogeneous but not significant)", "#FF7F7F", - - # small_telescopes outcome_report labels - "small_telescopes", "success", "#8FBC8F", - "small_telescopes", "failure", "#FF7F7F" -) - -success_criterion_note <- c( - significance_r = "Success was based on whether the replication effect was statistically significant and in the same direction as the original. Beware: *p*-values are calculated from raw effect sizes and sample sizes, and may differ from those reported in studies that adjusted for covariates or clustering.", - - significance_agg = "Success was based on whether a meta-analytic combination of original and replication effects was statistically significant. Beware: *p*-values are calculated from raw effect sizes and sample sizes, and may differ from those reported in studies that adjusted for covariates.", - - consistency_ci = "Success was based on whether the original effect size fell within the confidence interval of the replication. Beware: confidence intervals are based on raw effect sizes and sample sizes, and may differ from those reported in adjusted models.", - - consistency_pi = "Success was based on whether the replication effect size fell within the prediction interval from the original study. Beware: prediction intervals are based on raw effect sizes and sample sizes, and may differ from those reported in adjusted models.", - - homogeneity = "Success was based on a test of heterogeneity (Q-test) between original and replication effects. Beware: test statistics are based on raw effect sizes and sample sizes, and may differ from those reported in adjusted analyses in the original reports.", - - homogeneity_significance = "Success was based on both effect homogeneity and statistical significance. Replications where the effects were homogeneous and jointly significantly different from zero were considered as successes, while those that were either not homogeneous or not significantly different from zero were considered as failures. Beware: all values are based on raw effect sizes and sample sizes, and may differ from those reported in adjusted models.", - - small_telescopes = "Success was based on whether the replication effect exceeded the threshold that would give 33% power in the original study. Beware: power was calculated based on a simple test of a correlation, thus not accounting for any specific design features relevant to the study." -) - -success_criterion_o_ns <- c( - significance_r = TRUE, - - significance_agg = TRUE, - - consistency_ci = FALSE, - - consistency_pi = FALSE, - - homogeneity = FALSE, - - homogeneity_significance = TRUE, - - small_telescopes = FALSE -) - diff --git a/inst/fred_annotator/server.R b/inst/fred_annotator/server.R deleted file mode 100644 index ff7d781..0000000 --- a/inst/fred_annotator/server.R +++ /dev/null @@ -1,759 +0,0 @@ - -# ANNOTATOR --------------------------------------------------------------- - -server <- function(input, output, session) { - doi_vector <- reactiveValues(dois = c(), selected_rows = NULL) - retracted_dois <- reactiveVal(NULL) - - - session$onSessionEnded(function() { - if (Sys.getenv("SHINY_FRED_AUTOCLOSE") == "TRUE") { - message("App has ended because the session was ended.") - stopApp() - } - }) - - # Disclaimer -------------------------------------------------------------- - - showModal(modalDialog( - title = welcome_title, - welcome_text, - size = "l", - easyClose = TRUE - )) - - reactive_df <- reactiveVal(df) - selected_refs <- reactiveVal() - - observe({ - selected_refs( - reactive_df() %>% - filter(doi_original %in% doi_vector$dois) - ) - }) - - # Recalculate replication success based on criterion - assess_success <- function(result, success_criterion) { - assess_replication_outcome(result$es_original, result$n_original, result$es_replication, result$n_replication, - criterion = success_criterion)$outcome_report - } - - observeEvent({input$success_criterion; selected_refs()}, { - if (nrow(selected_refs()) > 0) { - updated_df <- selected_refs() %>% - arrange(ref_original) %>% - filter(if (input$validated == "TRUE") validated == 1 else TRUE) %>% - mutate( - result = assess_success(., input$success_criterion) %>% cap_first_letter(), - result = factor( - result, - levels = rev(c( - "not coded", - unique(result[grepl("success", result, ignore.case = TRUE)]), - unique(result[grepl("failure", result, ignore.case = TRUE)]), - unique(result[!(result %in% c("not coded", "OS not significant")) & - !grepl("success|failure", result, ignore.case = TRUE)]), - "OS not significant" - )) - ) - ) - - selected_refs(updated_df) - } - }, ignoreNULL = TRUE) - - - - outcome_colors <- reactive({ - criterion_colors <- success_criteria_colors %>% - dplyr::filter(criterion == input$success_criterion) - - outcome_colors <- setNames(criterion_colors$color, criterion_colors$label %>% cap_first_letter()) - c(outcome_colors, "Not coded" = "#C8C8C8") - }) - - observeEvent(input$load_retractions, { - showModal(modalDialog( - title = "Loading Retraction Database", - "Please wait while the retraction database is being loaded.", - easyClose = FALSE, - footer = modalButton("Cancel") # so that button does not say "Dismiss" - )) - retracted_dois(load_retractionwatch() %>% - dplyr::filter(RetractionNature == "Retraction") %>% - dplyr::select(OriginalPaperDOI)) - updated_df <- reactive_df() %>% - dplyr::left_join(retracted_dois() %>% mutate(retracted_replication = TRUE), retraction_data(), - by = c("doi_replication" = "OriginalPaperDOI"), na_matches = "never") %>% - dplyr::left_join(retracted_dois() %>% mutate(retracted_original = TRUE), retraction_data(), - by = c("doi_original" = "OriginalPaperDOI"), na_matches = "never") %>% - dplyr::mutate(retracted_replication = dplyr::coalesce(retracted_replication, FALSE), - retracted_original = dplyr::coalesce(retracted_original, FALSE), - ref_original = ifelse( - retracted_original & !grepl("^RETRACTED", ref_original, ignore.case = TRUE), - paste("RETRACTED:", ref_original), - ref_original - ), - ref_replication = ifelse( - retracted_replication & !grepl("^RETRACTED", ref_replication, ignore.case = TRUE), - paste("RETRACTED:", ref_replication), - ref_replication - )) - reactive_df(updated_df) - removeModal() - showNotification(shiny::HTML(paste("Retraction database loaded successfully.
FReD contains ", sum(updated_df$retracted_original), - " retracted original studies and ", sum(updated_df$retracted_replication), " retracted replication studies."))) - shinyjs::disable("load_retractions") - }) - - reactive_distinct_fred_entries <- reactive({ - df <- reactive_df() %>% - arrange(desc(validated == 1)) %>% - filter(if (input$validated == "TRUE") validated == 1 else TRUE) %>% - select(doi_original, ref_original) - - dplyr::bind_rows( - df %>% dplyr::filter(!is.na(doi_original)) %>% dplyr::group_by(doi_original) %>% dplyr::slice(1) %>% dplyr::ungroup(), - df %>% dplyr::filter(is.na(doi_original)) - ) %>% - distinct() - }) - - output$button_area <- renderUI({ - if (length(doi_vector$dois) == 0) { - - actionButton("process_button", "Process References") - - } else { - tagList( - - actionButton("add_button", "Add references"), - - br(), HTML(" "), br(), - - actionButton("replace_button", "Replace references") - ) - } - }) - - parse_dois <- function() { - - # Check if both text box and file are provided - if (nchar(input$references) > 0 && is.null(input$upload) == FALSE) { - showNotification("Both text box and file will be processed.") - } - - dois <- c() - - # Process text box input - if (nchar(input$references) > 0) { - text_dois <- extract_dois_from_text(input$references, report = TRUE) - dois <- c(dois, text_dois) - } - - # Process uploaded file - if (is.null(input$upload) == FALSE) { - file_dois <- extract_dois_from_file(input$upload$datapath) - dois <- c(dois, file_dois) - } - - if (input$navbar == "Introduction") { - nav_select("navbar", "Study Selection") - } - - out <- unique(dois) - - if (length(out) == 0) { - showModal(modalDialog( - title = "No DOIs found", - "Please check the format of the input", - easyClose = TRUE - )) - } - - out - - } - - - observe({ - if (input$navbar == "Report") { - if (!length(doi_vector$dois > 0)) { - showModal(modalDialog( - title = "No DOIs selected", - "Please select DOIs before proceeding to the report.", - easyClose = TRUE - )) - nav_select("navbar", "Study Selection") - } - } - }) - - - observeEvent(input$process_button, { - doi_vector$dois <- parse_dois() - }) - - observeEvent(input$add_button, { - doi_vector$dois <- union(doi_vector$dois, parse_dois()) - }) - - observeEvent(input$replace_button, { - doi_vector$dois <- parse_dois() - }) - - - visible <- reactiveVal(FALSE) - - output$doi_display <- renderText({ - paste(doi_vector$dois, collapse = "\n") - }) - - output$collapsible_dois <- renderUI({ - if (length(doi_vector$dois) > 0) { - tags$div( - id = "doi_display_container", - style = if (visible()) "display: block;" else "display: none;", - verbatimTextOutput("doi_display"), - actionButton("copy_btn", "Copy DOIs", onclick = "copyText()") - ) - } - }) - - observeEvent(input$hidden_toggle_btn, { - visible(!visible()) - }) - - output$showToggle <- reactive({ - length(doi_vector$dois) > 0 - }) - - # Need to be active in background to allow toggling of DOI display - outputOptions(output, "showToggle", suspendWhenHidden = FALSE) - outputOptions(output, "doi_display", suspendWhenHidden = FALSE) - - - extract_dois_from_text <- function(text, report = FALSE) { - - pattern <- "10(?:\\.[0-9]{4,})?\\/[^\\s]*[^\\s\\.,]" # based on pattern used by Zotero Chrome plugin - - # Find DOIs in each element; returns a list (each element: DOIs found in input string) - matched <- regmatches(text, gregexpr(pattern, text, perl = TRUE)) - dois <- unlist(matched) - dois <- sub("\\s*([,;.])*$", "", dois) # remove trailing punctuation - - - # Keep only the actual DOI (removing prefix) - dois_clean <- sub("(?i)(doi:(?:\\/\\/)?\\s*|https?://doi\\.org/)\\s*", "", dois, perl=TRUE) - dois_clean - - # If a DOI ends with a closing parenthesis and there are more ')' than '(', remove trailing ')' - dois <- sapply(dois, function(x) { - if (substr(x, nchar(x), nchar(x)) == ")" && sum(strsplit(x, "")[[1]] == "(") < sum(strsplit(x, "")[[1]] == ")")) { - substr(x, 1, nchar(x) - 1) - } else { - x - } - }) - - - # deduplicate - dois <- unique(unname(dois)) - - if (report) { - # Count number of non-blank lines - n_lines <- sum(nzchar(trimws(unlist(strsplit(text, "\n"))))) - - showNotification(paste("Found and added", length(dois), ifelse(length(dois) == 1, "DOI", " distinct DOIs"), - "from", n_lines, ifelse(n_lines == 1, "line", "lines"), "of text input."), - type = "message", duration = 10) - - } - - dois - - } - - - extract_dois_from_file <- function(file_path) { - dois <- c() - if (file_path != "") { - if (grepl("\\.pdf$", file_path)) { - # Extract DOIs from PDF file - pdf_text <- pdftools::pdf_text(file_path) - dois <- extract_dois_from_text(pdf_text) - } else if (grepl("\\.bib$", file_path)) { - # Extract DOIs from BibTeX file - bib_text <- readLines(file_path) - dois <- extract_dois_from_text(bib_text) - } - } - - dois <- unique(unname(dois)) - - showNotification(paste("Found and added", length(dois), ifelse(length(dois) == 1, "DOI", " distinct DOIs"), - "from your file."), - type = "message", duration = 10) - - dois - - } - - - # Initial rendering of the DataTable - output$selected_references <- renderDT({ - data <- datatable( - data.frame(doi_original = character(0), doi_replication = character(0), - description = character(0), es_original = numeric(0), - es_replication = numeric(0), result = character(0)), - escape = FALSE, options = list(pageLength = 10), filter = "none" - ) - formatRound(data, columns = c('es_original', 'es_replication'), digits = 2) - - }, server = TRUE) - - # Observer to update data reactively - observe({ - proxy <- dataTableProxy('selected_references', deferUntilFlush = FALSE) - - if (length(doi_vector$dois) == 0) { - replaceData(proxy, data.frame(doi_original = character(0), doi_replication = character(0), - description = character(0), es_original = numeric(0), - es_replication = numeric(0), result = character(0)), resetPaging = TRUE) - return() - } - - if (length(doi_vector$dois) > 0) { - - data <- data.frame(doi_original = doi_vector$dois) %>% - left_join(reactive_df(), by = c("doi_original")) %>% - mutate( - in_FReD = doi_original %in% reactive_df()$doi_original, - doi_original = purrr::map_chr(doi_original, ~sprintf('%s', .x, .x)), - doi_replication = purrr::map_chr(doi_replication, ~if (!is.na(.x)) sprintf('%s', .x, .x) else NA_character_) - ) %>% - arrange(!in_FReD, is.na(doi_replication)) %>% - select(doi_original, doi_replication, description, es_original, es_replication, result) - - replaceData(proxy, data, resetPaging = TRUE) - updateFilters(proxy, data) - } - - }) - - - output$database_search <- renderDT({ - reactive_distinct_fred_entries() %>% - datatable(selection = 'multiple', options = list(pageLength = 10)) - }, server = TRUE) - - observe({ - selected_rows <- which(reactive_distinct_fred_entries()$doi_original %in% doi_vector$dois) - proxy <- dataTableProxy('database_search') - selectRows(proxy, selected_rows) - doi_vector$selected_rows <- selected_rows - }) - - # Observe changes in selected rows - with debounce to avoid loops - debounced_rows_selected <- debounce(reactive(input$database_search_rows_selected), 250) - - observeEvent(debounced_rows_selected(), ignoreNULL = FALSE, { - current_rows <- input$database_search_rows_selected - - # Determine newly selected and deselected rows - newly_selected_rows <- setdiff(current_rows, doi_vector$selected_rows) - deselected_rows <- setdiff(doi_vector$selected_rows, current_rows) - - # Handle deselection - if (length(deselected_rows) > 0) { - remove_dois <- reactive_distinct_fred_entries()$doi_original[deselected_rows] - duplicate_rows <- which(reactive_distinct_fred_entries()$doi_original %in% remove_dois) - current_rows <- setdiff(current_rows, duplicate_rows) - doi_vector$dois <- setdiff(doi_vector$dois, remove_dois) - } - - # Handle new selections - if (length(newly_selected_rows) > 0) { - add_dois <- reactive_distinct_fred_entries()$doi_original[newly_selected_rows] - duplicate_rows <- which(reactive_distinct_fred_entries()$doi_original %in% add_dois) - current_rows <- union(current_rows, duplicate_rows) - doi_vector$dois <- union(doi_vector$dois, add_dois) - } - doi_vector$selected_rows <- current_rows - - # Re-select rows in the DT to reflect any changes - proxy <- dataTableProxy('database_search') - selectRows(proxy, current_rows) - }) - - - # Need to be active in background to stay synced with DOI list - outputOptions(output, "selected_references", suspendWhenHidden = FALSE) - outputOptions(output, "database_search", suspendWhenHidden = FALSE) - - output$references_barplot <- plotly::renderPlotly({ - - df <- tibble(doi_original = doi_vector$dois, in_FReD = doi_original %in% reactive_df()$doi_original) %>% - mutate(in_FReD = ifelse(in_FReD, "yes", "no")) - - # Calculate the counts and proportions - df_summary <- df %>% - count(in_FReD) %>% - mutate(proportion = n / sum(n), - label = paste(in_FReD, "\n(", scales::percent(proportion, accuracy = 1), ")")) - - color_values = c("no" = "#FF7F7F", "yes" = "#8FBC8F") - - - - # Create the plot - p <- df_summary %>% - ggplot(aes(y = "", x = proportion, fill = in_FReD)) + - geom_bar(stat = "identity", position = "fill") + - geom_text(aes(label = label), position = position_fill(vjust = 0.5), size = 3) + # Adjust size as needed - theme_minimal() + - labs(y = "", x = "Share", title = "Are replications for references in FReD?") + - scale_x_continuous(labels = scales::percent) + - scale_fill_manual(values = color_values) + - guides(fill = "none") + theme_void() - - plotly::ggplotly(p, tooltip = NULL, height = 150) %>% - plotly::layout(xaxis = list(fixedrange = TRUE), yaxis = list(fixedrange = TRUE)) %>% - plotly::config(displayModeBar = FALSE) - - }) - - output$outcomes_barplot <- plotly::renderPlotly({ - - df <- selected_refs() - - message("Selected refs: ", nrow(df)) - - if (any(df$retracted_replication)) { - message("any") - count_retracted_replications <- sum(df$retracted_replication) - df <- df %>% dplyr::filter(!retracted_replication) - } else { - message("none") - count_retracted_replications <- 0 - } - - message(count_retracted_replications) - - validate( - need(nrow(df) > 0, "", label = "No replications found") - ) - - retraction_note <- ifelse( - count_retracted_replications > 0, - paste0( - "Note: ", count_retracted_replications, - " retracted replication stud", - ifelse(count_retracted_replications == 1, "y was", "ies were"), - " excluded from the plot." - ), - "" - ) - - p <- df %>% - mutate(result = result %>% forcats::fct_na_value_to_level("not coded")) %>% - ggplot(aes(y = result, fill = result)) + - geom_bar() + - theme_minimal() + - labs(y = "", x = "Count", title = "Outcomes of replication attempts", caption = retraction_note, fill = "") + - scale_fill_manual(values = outcome_colors()) - - plotly::ggplotly(p, tooltip = NULL) %>% - plotly::config(displayModeBar = FALSE) %>% - plotly::layout(xaxis = list(fixedrange = TRUE), yaxis = list(fixedrange = TRUE)) - - }) - - # Functions to generate markdown - - - assess_outcome <- function(replications, ..., success_criterion = c("consistency", "significance_r"), return_html = TRUE) { - - ref_original <- replications$ref_original[1] - - replications %>% - mutate(assess_replication_outcome(.data$es_original, .data$n_original, .data$es_replication, - .data$n_replication, criterion = success_criterion)) %>% - # Remove uncoded duplicates - arrange(desc(validated == 1), is.na(outcome_report)) %>% - filter(!(!is.na(doi_replication) & duplicated(doi_replication) & is.na(outcome_report))) %>% - filter(!(duplicated(ref_replication) & is.na(outcome_report))) %>% - group_by(ref_replication) %>% - summarise( - outcome_report = if(length(unique(outcome_report)) == 1) unique(outcome_report) else paste(outcome_report, collapse = ", "), - outcome = case_when( - all(is.na(outcome)) ~ "not coded", - all(outcome == "success") ~ " success", - all(outcome == "failure") ~ "failure", - all(outcome == "OS not significant") ~ "OS not significant", - .default = "mixed"), - ref_original = first(ref_original) - ) %>% - ungroup() %>% - summarise( - replications = paste0(" - **", cap_first_letter(dplyr::coalesce(outcome_report, "not coded")), ":** ", ref_replication, collapse = "\n"), - overall_outcome = case_when( - all(outcome == "not coded") ~ if (return_html) "✏" else "[NC]", - all(outcome == "success") ~ if (return_html) "✔" else "[Re]", - all(outcome == "failure") ~ if (return_html) "✖" else "[¬Re]", - all(outcome == "OS not significant") ~ if (return_html) "❔" else "[N/A]", # Using a dash for N/A - .default = if (return_html) "❓" else "[?Re]" - ) - ) %>% - mutate(ref_original = ref_original) - } - - - generate_markdown <- function(df_filtered, ...) { - # Call the new legend function - legend <- generate_legend_markdown(input$success_criterion) - - extra_args <- list(...) - extra_args["success_criterion"] <- input$success_criterion - - # The main body of the report is generated here - report_body <- if (nrow(df_filtered) > 0) { - df_filtered %>% - mutate( - ref_original = stringr::str_replace_all(ref_original, "\n", " "), - ref_original = ifelse(stringr::str_detect(ref_original, stringr::fixed("doi.org")), - ref_original, - paste0(ref_original, " [https://doi.org/", doi_original, "](https://doi.org/", doi_original, ")")), - doi_urls = ifelse(!is.na(doi_replication), - paste0("https://doi.org/", doi_replication), - ifelse(!is.na(osf_link), osf_link, "")), - ref_replication = stringr::str_replace_all(ref_replication, "\n", " "), - ref_replication = ifelse(stringr::str_detect(ref_replication, stringr::fixed("doi.org")) | doi_urls == "", - ref_replication, - paste0(ref_replication, " [", doi_urls, "](", doi_urls, ")")), - id_original = coalesce(doi_original, ref_original) - ) %>% - group_by(id_original) %>% - group_modify(~do.call(assess_outcome, c(list(.x), extra_args))) %>% - ungroup() %>% - mutate( - markdown = paste0( - "##### ", overall_outcome, " ", ref_original, "\n\n", - replications, "\n\n" - ) - ) %>% - pull(markdown) %>% - paste(collapse = "\n") - } else { - "" # Return empty string if no data - } - - # Combine the legend and the report body - final_report <- paste0( - legend, - "\n## Replication Outcomes\n\n", - report_body - ) - - return(final_report) - } - - - #' Generate Markdown for the Report Legend - #' - #' Creates a markdown table explaining the symbols used in the report, - #' dynamically including the note for the selected success criterion. - #' - #' @param success_criterion The currently selected success criterion from the UI. - #' @return A character string containing the markdown for the legend. - generate_legend_markdown <- function(success_criterion) { - criterion_explanation <- success_criterion_note[success_criterion] - - - - legend_md <- glue::glue( - "**Note:** {criterion_explanation}\n\n", - "### Legend\n\n", - - "|   |   |\n", - - "|:------:|:----------------------------------------------------------|\n", - - "| ✔ | *Success*: All replications of the original study were successful. |\n", - "| ✖ | *Failure*: All replications of the original study failed. |\n", - "| ❓ | *Mixed Results*: The replications of the original study had mixed outcomes (e.g., some succeeded, some failed). |\n", - - if (success_criterion_o_ns[success_criterion]) { - "| ❔ | *Original Not Significant*: The original study's p-value was >= .05, so 'success' is not applicable. |\n" - } else { - "" - }, - - "| ✏ | *Not Coded*: The outcome of the replication(s) has not yet been coded. |" - - ) - return(legend_md) - } - - markdown_output <- reactive({ - generate_markdown(selected_refs()) - }) - - output$refs_annotated <- renderUI({ - # Validate that there are selected references - validate( - need(nrow(selected_refs()) > 0, "", label = "No replications found") - ) - - # Render the markdown from the reactive expression - tags$div( - class = "page-like", - style = "white-space: pre-wrap; overflow-y: auto; max-height: 800px;", - HTML(markdown::markdownToHTML(text = paste("# Replication Report\n", markdown_output()), fragment.only = TRUE)) - ) - }) - - - - # observe({ - # df <- reactive_df() %>% - # filter(doi_original %in% doi_vector$dois) - # - # if (nrow(df) == 0) { - # shinyjs::disable("downloadPdf") - # } else { - # shinyjs::enable("downloadPdf") - # } - # }) - # - # output$downloadPdf <- downloadHandler( - # filename = function() { - # paste("reading_list", Sys.Date(), ".pdf", sep = "") - # }, - # content = function(file) { - # tempReport <- tempfile(fileext = ".Rmd") - # - # df <- reactive_df() %>% - # filter(doi_original %in% doi_vector$dois) - # - # markdown_output <- generate_markdown(df, return_html = FALSE) - # - # # Create the Rmd content - # rmd_content <- paste0( - # "---\n", - # "title: \"Annotated Reading List\"\n", - # "output:\n pdf_document:\n latex_engine: xelatex\n", - # "---\n\n", - # markdown_output - # ) - # - # writeLines(rmd_content, con = tempReport) - # - # out <- rmarkdown::render(tempReport, quiet = TRUE) - # file.rename(out, file) - # } - # ) - - output$downloadWord <- downloadHandler( - filename = function() { - paste("reading_list", Sys.Date(), ".docx", sep = "") - }, - content = function(file) { - tempReport <- tempfile(fileext = ".Rmd") - - # Create the Rmd content - rmd_content <- paste0( - "---\n", - "title: \"Annotated Reading List\"\n", - "output:\n word_document:\n reference_docx: null\n", - "---\n\n", - "*NB: This contains bookmarks that are likely displayed as []. You can change your Word settings to hide those; we are still working to remove them when creating the file.* \n\n", - markdown_output() %>% stringr::str_remove(".*\n") - ) - - - writeLines(rmd_content, con = tempReport) - - out <- rmarkdown::render(tempReport, quiet = TRUE) - - # # Pandoc inserts unnecessary bookmarks that are displayed and look like errors - so remove them - # remove_bookmarks <- function(doc_path, output_path) { - # doc <- officer::read_docx(doc_path) - # - # # Get all bookmarks in the document - # bookmarks <- officer::docx_bookmarks(doc) - # - # # Iterate over all bookmarks and remove them - # for (bookmark in bookmarks) { - # cursor <- officer::cursor_bookmark(doc, bookmark) - # doc <- officer::cursor_reach(cursor) - # doc <- officer::body_remove(cursor) - # } - # - # # Save the modified document to the output path - # print(doc, target = output_path) - # } - # - # remove_bookmarks(out, out) - - file.rename(out, file) - } - ) - - - output$replicability_plot <- plotly::renderPlotly({ - - df <- selected_refs() - - validate( - need(nrow(df) > 0, "", label = "No replications found") - ) - - df$significant_original <- c("Not significant", "Significant")[(df$p_value_original < .05) + 1] %>% - factor(levels = c("Not significant", "Significant")) - df$significant_replication <- c("Not significant", "Significant")[(df$p_value_replication < .05) + 1] %>% - factor(levels = c("Not significant", "Significant")) - - - df$scatterplotdescription <- paste(stringr::str_wrap(df$description, 50), "\nr(original) = ", - round(df$es_original, 3), - ", r(replication) = ", - round(df$es_replication, 3), - sep = "" - ) - - pointsize <- ifelse(nrow(df) < 10, 5, ifelse(nrow(df) < 100, 4, 3)) - - df <- df %>% filter(!is.na(es_replication)) - - scatterplot <- - ggplot(df, aes(x = es_original, y = es_replication, text = scatterplotdescription)) + - geom_hline(aes(yintercept = 0), linetype = 2) + - geom_abline(intercept = 0, slope = 1, color = "Grey60") + - geom_point(aes(fill = result), size = pointsize, color = "Grey30", shape = 21, alpha = .8) + - # geom_point(data = df_temp[s3, ], fill = "#0077d9", color = "#f2ef1b", shape = 4) + - geom_rug(data = df[df$significant_original == "Significant", ], - color = "#4DCCD0", linewidth = 1, sides = "b", alpha = .6) + - geom_rug(data = df[df$significant_original == "Not significant", ], - color = "#FA948C", linewidth = 1, sides = "b", alpha = .6) + - geom_rug(data = df[df$significant_replication == "Significant", ], - color = "#4DCCD0", linewidth = 1, sides = "l", alpha = .6) + - geom_rug(data = df[df$significant_replication == "Not significant", ], - color = "#FA948C", linewidth = 1, sides = "l", alpha = .6) + - scale_x_continuous(name = "Original Effect Size", limits = c(0, 1), breaks = c(0, .25, .5, .75, 1)) + - scale_y_continuous(name = "Replication Effect Size", limits = c(-.5, 1), breaks = c(-.5, -.25, 0, .25, .5, .75, 1)) + - # ggtitle("") + #xlab("") + ylab("") + - # scale_size_continuous(name="Power",range=c(.5,3.5)) + - #scale_color_discrete(guide = "none") + - scale_fill_manual(values = outcome_colors(), drop = FALSE) + - theme_bw() + - labs(fill = "Replication Outcome", color = "Significance") - #theme(legend.position = "inside", plot.margin = unit(c(-2,-1.5,2,2), "lines")) - #theme(legend.position = "none") - - plotly::ggplotly(scatterplot, tooltip = "text") %>% - plotly::config(displayModeBar = FALSE) %>% - plotly::layout(xaxis = list(fixedrange = TRUE), yaxis = list(fixedrange = TRUE)) - }) - -} diff --git a/inst/fred_annotator/ui.R b/inst/fred_annotator/ui.R deleted file mode 100644 index 308ef2c..0000000 --- a/inst/fred_annotator/ui.R +++ /dev/null @@ -1,149 +0,0 @@ -# ANNOTATOR --------------------------------------------------------------- - -# UI definition - -sidebar_contents <- sidebar( - id = "mySidebar", - padding = 10, - width = 300, - textAreaInput("references", "Paste references with DOIs", placeholder = "Paste references here...", width = '95%', height = '200px'), - fileInput("upload", HTML('Or upload reference list (PDF, citation or text file). Must contain DOIs; otherwise process it with Crossref first. Copying references from PDF generally works better than PDF upload. Linebreaks within DOIs prevent DOI recognition - preprocessing via an LLM is recommended.'), accept = c("application/pdf", " text/plain", ".bib", ".ris")), - uiOutput("button_area"), - checkboxInput("validated", "Use validated database entries only", value = TRUE), - actionButton("load_retractions", "Load Retraction Database", icon = icon("database")), - hr(), - radioButtons("success_criterion", - label = popover( - trigger = list( - "Success criterion", - icon(c("info-circle")) - ), - "Check our ", - a("vignette", href = "https://forrt.org/FReD/articles/success_criteria.html", target = "_blank"), - "for details on the different success criteria." - ), - choices = c("Significance of Replication" = "significance_r", - "Aggregated Significance" = "significance_agg", - "Consistency with CI" = "consistency_ci", - "Consistency with PI" = "consistency_pi", - "Homogeneity" = "homogeneity", - "Homogeneity & Significance" = "homogeneity_significance", - "Small Telescopes" = "small_telescopes"), - selected = "significance_r"), - div( - HTML("NB: The success criteria (e.g., p-values, CIs) are calculated from raw effect and sample sizes. They may differ from original reports that used adjusted models.") - ), - conditionalPanel( - condition = "output.showToggle", # This JavaScript condition reacts to Shiny output - tags$a(id = "toggle_link", "Show/Hide DOIs >", href = "#", class = "btn btn-link"), - actionButton("hidden_toggle_btn", "Toggle", style = "display: none;") - ), - uiOutput("collapsible_dois"), - tags$script(HTML(" - $(document).on('click', '#toggle_link', function(event) { - event.preventDefault(); - $('#doi_display_container').toggle(); // Toggle visibility of the DOI display container - $('#hidden_toggle_btn').click(); // Trigger the hidden button click - }); - function copyText() { - const element = document.getElementById('doi_display'); - navigator.clipboard.writeText(element.textContent); - alert('Copied to clipboard!'); - } - ")) - ) - - -# Define content for each panel -introduction_content <- nav_panel( - "Introduction", - class = "tab-pane-narrow", - includeMarkdown("www/introduction.md") - -) - -study_selection_content <- nav_panel( - "Study Selection", - h2("Selected studies"), - HTML(paste("Please report potential issues with DOI processing.", collapse = "")), - DTOutput("selected_references", fill = FALSE), - h2("Available studies in FReD"), - HTML(paste("Select/unselect rows to add/remove studies from the report. You can search by DOI, reference or description. - At present, only studies where the DOI is listed in FReD can be used in the annotator, rows without DOIs will - be ignored here, but can be retrieved from the FReD dataset."), sep = ""), # the FReD dataset - DTOutput("database_search", fill = FALSE) - ) - - -report_content <- nav_panel( - "Report", - div( - style = "max-width: 1000px; margin: auto;", - plotly::plotlyOutput("references_barplot", height = 150), - br(), - uiOutput("success_note"), - plotly::plotlyOutput("outcomes_barplot"), - br(), - plotly::plotlyOutput("replicability_plot", height = "600px"), - scatterplot_explanation - ), - div( - style = "max-width: 450px; margin: auto; display: flex; gap: 10px; align-items: center; !important", - downloadButton("downloadWord", "Download annotated Word file"), - # downloadButton("downloadPdf", "Download annotated PDF") - ), - shinycssloaders::withSpinner(uiOutput("refs_annotated")) -) - -about_content <- nav_panel("About", - class = "tab-pane-narrow", - - markdown(about_page), - markdown(paste0("#", get_dataset_changelog())), - h2("Package changelog"), - includeMarkdown(system.file("NEWS.md", package = "FReD")), - img(src = "fred.png", height = 80), - tags$style(HTML(" - - ")) -) - -replicationhub_link <- nav_item(a("FORRT Replication Hub", href = "https://www.forrt.org/replication-hub/", target = "_blank")) - -ui <- tagList( - tags$head( - tags$style(HTML(" - .navbar-brand { - display: flex; - align-items: center; - margin-left: 15px; - height: 50px; - } - .navbar-brand img { - margin-right: 10px; - } - .navbar-nav > li > a { - line-height: 50px !important; - } - .dark-mode-nav { - margin-left: auto; - } - ")) - ), - page_navbar( - theme = custom_theme, - id = "navbar", - title = tags$a( - class = "navbar-brand", - href = "#", - tags$img(src = "fred.png", height = "40") - ), - sidebar = sidebar_contents, - introduction_content, - study_selection_content, - report_content, - about_content, - replicationhub_link, - nav_item(input_dark_mode(), class = "dark-mode-nav") - ) -) diff --git a/inst/fred_annotator/website_text.R b/inst/fred_annotator/website_text.R deleted file mode 100644 index 6932488..0000000 --- a/inst/fred_annotator/website_text.R +++ /dev/null @@ -1,80 +0,0 @@ -### ANNOTATOR ### - -about_page <- glue::glue(" - -## FORRT Replication Database Annotator {packageVersion('FReD')} - -**Last Code Update:** {get_last_modified('fred_annotator')} - -**Data citation:** {create_citation()} - -**Data and Materials:** https://osf.io/9r62x/ - -**Contribute:** Please send an e-mail to lukas.roeseler(at)uni-muenster.de - -**License:** _Data:_ CC-By Attribution 4.0 International, _Code:_ MIT License - -**Acknowledgements:** We thank all researchers who have invested resources in conducting replication research, researchers who have submitted their replication studies, and researchers who used the Replication Recipe Post-Completion template to register their results. FORRT Replication Database is supported through the University of Bamberg's Interne Forschungsförderung, by the University of Münster, by the Nederlandse Organisatie voor Wetenschappelijk's (NWO) Open Science Fund, and by the Leuphana University Lüneburg. - -**Important note:** This is work in progress. Please beware that there might be bugs or errors in the dataset. If you spot any, please let us know by email, or on GitHub. - -_Thanks to our funders:_ - - -") - - -welcome_title <- HTML("Welcome to the FORRT Replication Database!") -welcome_text <- HTML("

The FReD is a collection of crowdsourced findings from replication studies (i.e., studies that investigated one or more previously tested hypotheses using new data). The aims of this project are: -
(1) to document replication attempts across many areas of science and make replications findable and -
(2) to provide meta-scientists with a database for research on replicability. -

This is the FReD Annotator. The annotator reads references (DOIs) from a list and returns replication studies for these references based on the FReD entries. You can go to the online version of the FReD Explorer here. -

We advise researchers to carefully investigate replication findings before making judgments about the robustness of research findings. Note that many entries are not yet validated - if you care more about accuracy than coverage, please select the option to only use validated entries. -

You can find more information on the FORRT Replication Hub. If you would like to contribute replication findings, please check out our call for results or send us an e-mail.


") - - -dataset_info <- HTML(paste("

Replication Rate" - , "


There are currently " - , nrow(df) - , " replication findings entered into the database. Of these, " - , length(unique(df$ref_replication)) - , " replication findings are independent (i.e., use different samples/stem from different studies). Note that the following analyses treat all studies as independent. Apart from the table and bar chart, only studies for which sample sizes and effect sizes are available (for original study and replication) are considered here. The others can be viewed in the Dataset." - , " In total, " - , length(unique(df$ref_original)) - , " different original studies have been replicated." - # , "According to the original researchers' assessments, there have been " - # , sum(red$pc05 == "informative failure to replicate", na.rm = TRUE) - # , " informative failures to replicate and " - # , sum(red$pc05 == "success", na.rm = TRUE) - # , " successes. " - # , sum(red$pc05 == "inconclusive", na.rm = TRUE) - # , " replications have yielded inconclusive results and " - # , sum(red$pc05 == "practical failure to replicate", na.rm = TRUE) - # , " were practical failures to replicate." - , "

" - , sep = "")) - -packages_info <- HTML(paste("


R-packages used for this App

" - , sep = "")) - -packages_list <- HTML(paste("

- ", names(sessionInfo()[["otherPkgs"]]), sep = "")) - -rc_info <- HTML(paste(" -



References-Checker
" - , "

Paste your entire lists of references or DOIs here. In order to identify replication studies, there need to be DOIs. Please note that not all studies entered in ReD feature a DOI or that some papers may even have no or more than one DOI. Finally, ReD does not contain all replications. That means, if there are no replications listed in ReD, this does not mean that nobody has ever attempted to replicate the entered studies.

" - , sep = "")) - - - -packages_headline <- HTML(paste("


R-packages used for the FReD Apps

Note that many will only be used for the FReD Explorer that presents meta-analytic summaries." - , sep = "")) - -packages_list <- HTML(paste("

- ", names(sessionInfo()[["otherPkgs"]]), sep = "")) - -breaks <- HTML(paste("

", sep = "")) - - -scatterplot_explanation <- HTML(paste(" -
Note. This plot is based on the code used for the main plot of Open Science Collaboration (2015). Here you can see for each replication study the original effect and the replication effect. Significant replication effects (p < .05) are highlighted in blue. If all studies were perfectly replicable, the dots would be on the solid grey line. If no study was replicable, the dots would be at the dashed line (= null effects). Hover over the plot to see the exact effect sizes and the study. If there are registered replication reports (RRRs) among the selected study, you will see 'columns' of effect sizes because all studies from a RRR have the same 'original effect size' but replication effect sizes vary." - , "

" - , sep = "")) diff --git a/inst/fred_annotator/www/FORRT.svg b/inst/fred_annotator/www/FORRT.svg deleted file mode 100644 index 0bed5ef..0000000 --- a/inst/fred_annotator/www/FORRT.svg +++ /dev/null @@ -1,153 +0,0 @@ - - - - - - - - - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - FORRT - - - - - - - - - - - - - - - diff --git a/inst/fred_annotator/www/UB.svg b/inst/fred_annotator/www/UB.svg deleted file mode 100644 index 8d9647a..0000000 --- a/inst/fred_annotator/www/UB.svg +++ /dev/null @@ -1,375 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/inst/fred_annotator/www/forrt_thumbnail.svg b/inst/fred_annotator/www/forrt_thumbnail.svg deleted file mode 100644 index 0bed5ef..0000000 --- a/inst/fred_annotator/www/forrt_thumbnail.svg +++ /dev/null @@ -1,153 +0,0 @@ - - - - - - - - - - - - - - - - - - - - image/svg+xml - - - - - - - - - - - FORRT - - - - - - - - - - - - - - - diff --git a/inst/fred_annotator/www/fred.jpg b/inst/fred_annotator/www/fred.jpg deleted file mode 100644 index 4209658..0000000 Binary files a/inst/fred_annotator/www/fred.jpg and /dev/null differ diff --git a/inst/fred_annotator/www/fred.png b/inst/fred_annotator/www/fred.png deleted file mode 100644 index da84581..0000000 Binary files a/inst/fred_annotator/www/fred.png and /dev/null differ diff --git a/inst/fred_annotator/www/fred_logo_calibri.jpg b/inst/fred_annotator/www/fred_logo_calibri.jpg deleted file mode 100644 index bccf98a..0000000 Binary files a/inst/fred_annotator/www/fred_logo_calibri.jpg and /dev/null differ diff --git a/inst/fred_annotator/www/introduction.md b/inst/fred_annotator/www/introduction.md deleted file mode 100644 index 649bca8..0000000 --- a/inst/fred_annotator/www/introduction.md +++ /dev/null @@ -1,15 +0,0 @@ -## Welcome to the FReD Reference Annotator - -The FReD Reference Annotator can help you annotate any list of references with replication findings. This is intended to make it easier to use replications in teaching and research, and to thus ensure that claims are based on the best available evidence. This is based on the FORRT Replication Database, which is a crowd-sources database covering the social sciences. If you notice that the annotations produced here are missing a replication, please consider contributing to the database. If you spot any other issue with the data or app, please let us know on GitHub or by email. - -### Step 1: Select references - -You can paste a list of references into the text box, or upload a file with references. Currently, only DOIs will be extracted - and then used to search the FORRT Replication Database. You can also directly search the database on the "Study Selection" tab and thereby add and remove studies from the list. If you have a list of references without DOIs, Crossref offers a handy online tool to add DOIs. - -### Step 1a: Decide whether to also check for retractions - -This app can also check whether any of the references have been retracted, using the Retraction Watch database. As this requires the download of that database from Crossref, it is optional - if you want to add this information, click on the button below the reference upload. - -### Step 2: Explore or download reports - -Go to the "Report" tab to see visual summaries of replicability across your references, and to view/download an annotated reading list. diff --git a/inst/fred_annotator/www/nwo.png b/inst/fred_annotator/www/nwo.png deleted file mode 100644 index 1f1cc07..0000000 Binary files a/inst/fred_annotator/www/nwo.png and /dev/null differ diff --git a/inst/fred_annotator/www/red.png b/inst/fred_annotator/www/red.png deleted file mode 100644 index 40ef090..0000000 Binary files a/inst/fred_annotator/www/red.png and /dev/null differ diff --git a/inst/fred_annotator/www/red.svg b/inst/fred_annotator/www/red.svg deleted file mode 100644 index da0eeec..0000000 --- a/inst/fred_annotator/www/red.svg +++ /dev/null @@ -1 +0,0 @@ - \ No newline at end of file diff --git a/inst/fred_annotator/www/ub.png b/inst/fred_annotator/www/ub.png deleted file mode 100644 index 6525fc8..0000000 Binary files a/inst/fred_annotator/www/ub.png and /dev/null differ diff --git a/inst/fred_annotator/www/um.png b/inst/fred_annotator/www/um.png deleted file mode 100644 index 44ce884..0000000 Binary files a/inst/fred_annotator/www/um.png and /dev/null differ diff --git a/inst/fred_explorer/global.R b/inst/fred_explorer/global.R index ae84503..305ed0a 100644 --- a/inst/fred_explorer/global.R +++ b/inst/fred_explorer/global.R @@ -14,14 +14,14 @@ if (!exists("create_citation")) stop("Failed to attach FReD namespace.") df <- load_fred_data() -df_display <- df[, c("description", "es_original", "es_replication", "n_original", "n_replication", "osf_link", "contributors", "result", "result2", "ref_original", "ref_replication")] -df_display$es_original <- round(df_display$es_original, 3) -df_display$es_replication <- round(df_display$es_replication, 3) +df_display <- df[, c("description", "es_o", "es_r", "n_o", "n_r", "osf_link", "contributors", "result", "result2", "ref_o", "ref_r")] +df_display$es_o <- round(df_display$es_o, 3) +df_display$es_r <- round(df_display$es_r, 3) dataset_variables <- load_variable_descriptions() -df$ref_original <- gsub("(.{70,}?)\\s", "\\1\n", df$ref_original) # line breaks +df$ref_o <- gsub("(.{70,}?)\\s", "\\1\n", df$ref_o) # line breaks forestplotheight <- "28000px" diff --git a/inst/fred_explorer/server.R b/inst/fred_explorer/server.R index 1d10126..7ce1cc1 100644 --- a/inst/fred_explorer/server.R +++ b/inst/fred_explorer/server.R @@ -67,14 +67,14 @@ server <- function(input, output, session) { # Recalculate replication success based on criterion assess_success <- function(result, success_criterion) { - assess_replication_outcome(result$es_original, result$n_original, result$es_replication, result$n_replication, + assess_replication_outcome(result$es_o, result$n_o, result$es_r, result$n_r, criterion = success_criterion)$outcome_report } observeEvent({input$success_criterion; df_temp()}, { if (nrow(df_temp()) > 1) { updated_df <- df_temp() %>% - arrange(ref_original) %>% + arrange(ref_o) %>% filter(if (input$validated == "TRUE") validated == 1 else TRUE) %>% mutate( result = assess_success(., input$success_criterion) %>% cap_first_letter(), @@ -115,8 +115,8 @@ server <- function(input, output, session) { df_temp_filtered <- df_temp[, c( "description", "tags", "osf_link" # link to project site of the replication (url_r) - # , "es_original", "es_replication" - , "result", "ref_original", "ref_replication" + # , "es_o", "es_r" + , "result", "ref_o", "ref_r" )] DT::datatable( @@ -153,9 +153,9 @@ server <- function(input, output, session) { validate(need(nrow(df_temp) > 0, "Plot cannot be created if no studies are selected")) df_temp$scatterplotdescription <- paste(df_temp$description, "\nr(original) = ", - round(df_temp$es_original, 3), + round(df_temp$es_o, 3), ", r(replication) = ", - round(df_temp$es_replication, 3), + round(df_temp$es_r, 3), sep = "" ) @@ -164,15 +164,15 @@ server <- function(input, output, session) { s3 <- input$table_rows_selected - df_temp$significant_original <- c("Not significant", "Significant")[(df_temp$p_value_original < .05) + 1] %>% + df_temp$significant_original <- c("Not significant", "Significant")[(df_temp$p_value_o < .05) + 1] %>% factor( levels = c("Not significant", "Significant")) - df_temp$significant_replication <- c("Not significant", "Significant")[(df_temp$p_value_replication < .05) + 1] %>% + df_temp$significant_replication <- c("Not significant", "Significant")[(df_temp$p_value_r < .05) + 1] %>% factor(levels = c("Not significant", "Significant")) df_temp$result <- factor(df_temp$result, levels = names(outcome_colors())) scatterplot <- - ggplot(df_temp, aes(x = es_original, y = es_replication, text = scatterplotdescription)) + + ggplot(df_temp, aes(x = es_o, y = es_r, text = scatterplotdescription)) + geom_hline(aes(yintercept = 0), linetype = 2) + geom_abline(intercept = 0, slope = 1, color = "Grey60") + geom_point(aes(fill = result), size = pointsize, color = "Grey30", shape = 21, alpha = .8) + @@ -215,7 +215,7 @@ server <- function(input, output, session) { df_temp <- df_temp_DT() - return(length(unique(df_temp$ref_original)) * 100) + return(length(unique(df_temp$ref_o)) * 100) }) output$forestplot <- plotly::renderPlotly({ @@ -224,41 +224,41 @@ server <- function(input, output, session) { df_temp <- df_temp[rev(row.names(df_temp)), ] # use only studies with a replication effect size - df_temp <- df_temp[!is.na(df_temp$es_replication), ] + df_temp <- df_temp[!is.na(df_temp$es_r), ] # use only studies with a reference for the original finding - df_temp <- df_temp[!is.na(df_temp$ref_original), ] + df_temp <- df_temp[!is.na(df_temp$ref_o), ] # make descriptions shorter df_temp$description <- gsub("(.{70,}?)\\s", "\\1\n", df_temp$description) # line breaks # make reference shorter - df_temp$ref_original <- gsub("(.{70,}?)\\s", "\\1\n", df_temp$ref_original) # line breaks + df_temp$ref_o <- gsub("(.{70,}?)\\s", "\\1\n", df_temp$ref_o) # line breaks red_temp_selected <- df_temp xlims <- seq(from = -1, 1, .25) - df_temp$description <- factor(df_temp$description, levels = unique(df_temp$description[order(df_temp$es_replication)])) + df_temp$description <- factor(df_temp$description, levels = unique(df_temp$description[order(df_temp$es_r)])) - forest <- ggplot(data = df_temp, aes(x = es_replication, y = ref_original)) + + forest <- ggplot(data = df_temp, aes(x = es_r, y = ref_o)) + geom_vline(xintercept = 0, col = "dark grey", lwd = 1) + # Replication effect sizes geom_point() + - geom_errorbar(aes(xmin = ci.lower_replication, xmax = ci.upper_replication)) + + geom_errorbar(aes(xmin = ci.lower_r, xmax = ci.upper_r)) + # Original effect sizes - geom_point(aes(x = es_original, y = ref_original), color = "dark grey", alpha = .5) + - geom_errorbar(aes(xmin = ci.lower_original, xmax = ci.upper_original), color = "dark grey") + + geom_point(aes(x = es_o, y = ref_o), color = "dark grey", alpha = .5) + + geom_errorbar(aes(xmin = ci.lower_o, xmax = ci.upper_o), color = "dark grey") + # highlighted studies - # geom_point(data = red_temp_selected, aes(x = es_replication, y = ref_original), color = ifelse(nrow(df_temp) == nrow(red_temp_selected), "black", "df")) + + # geom_point(data = red_temp_selected, aes(x = es_r, y = ref_o), color = ifelse(nrow(df_temp) == nrow(red_temp_selected), "black", "df")) + # Theme and formatting theme_classic() + geom_vline(xintercept = xlims, col = rgb(0, 0, 0, .05), lwd = 0.5, lty = 1) + theme(text = element_text(size = 14)) + - xlim(c(floor(min(df_temp$ci.lower_original)), ceiling(max(df_temp$ci.upper_original, na.rm = TRUE)))) + + xlim(c(floor(min(df_temp$ci.lower_o)), ceiling(max(df_temp$ci.upper_o, na.rm = TRUE)))) + xlab("r") + ylab("") + theme(legend.position = "none") + @@ -266,9 +266,9 @@ server <- function(input, output, session) { scale_y_discrete(limits = rev) + ggtitle(paste( "Blobbogram\n", - sum(!is.na(df_temp$es_original)), + sum(!is.na(df_temp$es_o)), "Effect sizes selected.\nGrey dots represent original effect sizes. Black dots represent replication effect sizes." - # , length(unique(df_temp$ref_original)) + # , length(unique(df_temp$ref_o)) # , "Original studies were examined in replication studies." )) @@ -462,9 +462,9 @@ server <- function(input, output, session) { output$correlate_decade <- plotly::renderPlotly({ - red_agg <- aggregate_results(df_temp_DT(), ref_original) + red_agg <- aggregate_results(df_temp_DT(), ref_o) - red_agg$year_orig <- as.numeric(substr(gsub("\\D", "", red_agg$ref_original), 1, 4)) + red_agg$year_orig <- as.numeric(substr(gsub("\\D", "", red_agg$ref_o), 1, 4)) # Remove implausible years current_year <- as.numeric(format(Sys.Date(), "%Y")) @@ -495,7 +495,7 @@ server <- function(input, output, session) { }) output$correlate_journal <- plotly::renderPlotly({ - red_agg <- aggregate_results(df_temp_DT(), ref_original, orig_journal) + red_agg <- aggregate_results(df_temp_DT(), ref_o, orig_journal) @@ -540,8 +540,8 @@ server <- function(input, output, session) { es <- df_temp_DT() es$mod <- es[, input$moderator] es <- es[!is.na(es$mod), ] - es <- es[!is.na(es$ref_original), ] - es$se <- sqrt((1 - abs(es$es_original)^2) / (es$n_original - 2)) + es <- es[!is.na(es$ref_o), ] + es$se <- sqrt((1 - abs(es$es_o)^2) / (es$n_o - 2)) es }) @@ -549,9 +549,9 @@ server <- function(input, output, session) { es <- preprocessed_data() message("Estimate metafor") mod <- metafor::rma.mv( - yi = es_replication, + yi = es_r, V = se^2, - random = ~ 1 | ref_original, + random = ~ 1 | ref_o, tdist = TRUE, data = es, mods = ~ mod - 1, @@ -568,7 +568,7 @@ server <- function(input, output, session) { output$flexibleplot <- plotly::renderPlotly({ es <- preprocessed_data() mod <- es$mod - p <- ggplot2::ggplot(data = es, aes(y = es_replication, color = ref_original)) + + p <- ggplot2::ggplot(data = es, aes(y = es_r, color = ref_o)) + geom_hline(yintercept = 0, linetype = "dashed") + theme_bw() + labs(x = input$moderator, y = "Replication Effect Size (r)", color = "Reference") @@ -576,7 +576,7 @@ server <- function(input, output, session) { if (is.numeric(mod)) { p <- p + aes(x = mod) + geom_point() + geom_smooth(aes(color = NULL), formula = y ~ x) } else { - p <- p + aes(x = fct_rev(mod)) + geom_violin(fill = NA) + geom_jitter(aes(color = ref_original), width = .1) + coord_flip() + p <- p + aes(x = fct_rev(mod)) + geom_violin(fill = NA) + geom_jitter(aes(color = ref_o), width = .1) + coord_flip() } plotly::ggplotly(p) %>% plotly::config(displayModeBar = FALSE) @@ -615,9 +615,9 @@ server <- function(input, output, session) { rownames(modtable) <- substring(input$moderator, first = 4) modtable[, 2:6] <- round(as.data.frame(modtable)[, 2:6], digits = 2) modelbeta <- metafor::rma.mv( - yi = es_replication, + yi = es_r, V = se^2, - random = ~ 1 | ref_original, + random = ~ 1 | ref_o, tdist = TRUE, data = es, mods = ~mod, @@ -664,11 +664,11 @@ server <- function(input, output, session) { df[is.na(df$result), "result"] <- "Not coded yet" # Check which entries exist in the df - intersection <- dois[dois %in% df$doi_original] + intersection <- dois[dois %in% df$doi_o] # df subset - df_temp <- df[(tolower(df$doi_original) %in% dois), ] - df_temp <- df_temp[!is.na(df_temp$doi_original), ] + df_temp <- df[(tolower(df$doi_o) %in% dois), ] + df_temp <- df_temp[!is.na(df_temp$doi_o), ] bardata <- as.data.frame(base::table(df_temp$result, useNA = "always") / nrow(df_temp)) names(bardata) <- c("Result", "Proportion") @@ -683,7 +683,7 @@ server <- function(input, output, session) { xlab("") + coord_flip() + scale_fill_manual("Result", values = outcome_colors()) + - ggtitle(paste(nrow(df_temp), "Replication findings were identified. These stem from", length(unique(df_temp$doi_original)), "different publication(s).")) + ggtitle(paste(nrow(df_temp), "Replication findings were identified. These stem from", length(unique(df_temp$doi_o)), "different publication(s).")) p <- plotly::ggplotly(barchart, tooltip = "text") %>% plotly::config(displayModeBar = FALSE) %>% @@ -702,14 +702,14 @@ server <- function(input, output, session) { df[is.na(df$result), "result"] <- "Not coded yet" # Check which entries exist in the df - intersection <- dois[dois %in% df$doi_original] + intersection <- dois[dois %in% df$doi_o] # df subset - df_temp <- df[(tolower(df$doi_original) %in% dois), ] - df_temp <- df_temp[!is.na(df_temp$doi_original), ] + df_temp <- df[(tolower(df$doi_o) %in% dois), ] + df_temp <- df_temp[!is.na(df_temp$doi_o), ] - df_temp$original <- df_temp$ref_original # paste(df_temp$ref_original, df_temp$doi_original, sep = " ") # ADD DOIs if they are not already part of the reference - df_temp$replication <- df_temp$ref_replication # paste(df_temp$ref_replication, df_temp$doi_replication, sep = " ") + df_temp$original <- df_temp$ref_o # paste(df_temp$ref_o, df_temp$doi_o, sep = " ") # ADD DOIs if they are not already part of the reference + df_temp$replication <- df_temp$ref_r # paste(df_temp$ref_r, df_temp$doi_r, sep = " ") print(df_temp[, c("original", "description", "replication", "result")]) }) @@ -728,11 +728,11 @@ server <- function(input, output, session) { df_temp <- df_temp() - # df_temp_filtered <- df_temp[, c("description", "n_original", "n_replication", "power", "result")] - # df_temp_filtered <- df_temp[, c("description", "tags", "contributors", "result", "ref_original", "ref_replication")] + # df_temp_filtered <- df_temp[, c("description", "n_o", "n_r", "power", "result")] + # df_temp_filtered <- df_temp[, c("description", "tags", "contributors", "result", "ref_o", "ref_r")] DT::datatable( - df_temp[, c("description", "tags", "result", "ref_original", "ref_replication")], + df_temp[, c("description", "tags", "result", "ref_o", "ref_r")], extensions = "Buttons", options = list( scrollX = TRUE, @@ -775,15 +775,15 @@ server <- function(input, output, session) { # df_temp <- df_temp[!is.na(df_temp$result), ] # # # compute se - # df_temp$se_original <- sqrt((1-abs(as.numeric(df_temp$es_original))^2)/(as.numeric(df_temp$n_original)-2)) - # df_temp$se_replication <- sqrt((1-abs(as.numeric(df_temp$es_replication))^2)/(as.numeric(df_temp$n_replication)-2)) + # df_temp$se_o <- sqrt((1-abs(as.numeric(df_temp$es_o))^2)/(as.numeric(df_temp$n_o)-2)) + # df_temp$se_r <- sqrt((1-abs(as.numeric(df_temp$es_r))^2)/(as.numeric(df_temp$n_r)-2)) # - # redlong_original <- df_temp[, c("es_original", "ref_original", "n_original", "se_original")] + # redlong_original <- df_temp[, c("es_o", "ref_o", "n_o", "se_o")] # redlong_original$type = "Original" # names(redlong_original) <- c("es", "ref", "n", "se", "type") # redlong_original <- redlong_original[!duplicated(redlong_original), ] # - # redlong_replication <- df_temp[ , c("es_replication", "ref_replication", "n_replication", "se_replication")] + # redlong_replication <- df_temp[ , c("es_r", "ref_r", "n_r", "se_r")] # redlong_replication$type = "Replication" # names(redlong_replication) <- c("es", "ref", "n", "se", "type") # @@ -826,15 +826,15 @@ server <- function(input, output, session) { # df_temp <- df_temp[!is.na(df_temp$result), ] # # # compute se - # df_temp$se_original <- sqrt((1-abs(as.numeric(df_temp$es_original))^2)/(as.numeric(df_temp$n_original)-2)) - # df_temp$se_replication <- sqrt((1-abs(as.numeric(df_temp$es_replication))^2)/(as.numeric(df_temp$n_replication)-2)) + # df_temp$se_o <- sqrt((1-abs(as.numeric(df_temp$es_o))^2)/(as.numeric(df_temp$n_o)-2)) + # df_temp$se_r <- sqrt((1-abs(as.numeric(df_temp$es_r))^2)/(as.numeric(df_temp$n_r)-2)) # - # redlong_original <- df_temp[, c("es_original", "ref_original", "n_original", "se_original")] + # redlong_original <- df_temp[, c("es_o", "ref_o", "n_o", "se_o")] # redlong_original$type = "Original" # names(redlong_original) <- c("es", "ref", "n", "se", "type") # redlong_original <- redlong_original[!duplicated(redlong_original), ] # - # redlong_replication <- df_temp[ , c("es_replication", "ref_replication", "n_replication", "se_replication")] + # redlong_replication <- df_temp[ , c("es_r", "ref_r", "n_r", "se_r")] # redlong_replication$type = "Replication" # names(redlong_replication) <- c("es", "ref", "n", "se", "type") # @@ -946,15 +946,15 @@ server <- function(input, output, session) { df_temp <- df_temp[!is.na(df_temp$result), ] # compute se - df_temp$se_original <- sqrt((1 - abs(as.numeric(df_temp$es_original))^2) / (as.numeric(df_temp$n_original) - 2)) - df_temp$se_replication <- sqrt((1 - abs(as.numeric(df_temp$es_replication))^2) / (as.numeric(df_temp$n_replication) - 2)) + df_temp$se_o <- sqrt((1 - abs(as.numeric(df_temp$es_o))^2) / (as.numeric(df_temp$n_o) - 2)) + df_temp$se_r <- sqrt((1 - abs(as.numeric(df_temp$es_r))^2) / (as.numeric(df_temp$n_r) - 2)) - redlong_original <- df_temp[, c("es_original", "ref_original", "n_original", "se_original")] + redlong_original <- df_temp[, c("es_o", "ref_o", "n_o", "se_o")] redlong_original$type <- "Original" names(redlong_original) <- c("es", "ref", "n", "se", "type") redlong_original <- redlong_original[!duplicated(redlong_original), ] - redlong_replication <- df_temp[, c("es_replication", "ref_replication", "n_replication", "se_replication")] + redlong_replication <- df_temp[, c("es_r", "ref_r", "n_r", "se_r")] redlong_replication$type <- "Replication" names(redlong_replication) <- c("es", "ref", "n", "se", "type") @@ -1007,15 +1007,15 @@ server <- function(input, output, session) { df_temp <- df_temp[!is.na(df_temp$result), ] # compute se - df_temp$se_original <- sqrt((1 - abs(as.numeric(df_temp$es_original))^2) / (as.numeric(df_temp$n_original) - 2)) - df_temp$se_replication <- sqrt((1 - abs(as.numeric(df_temp$es_replication))^2) / (as.numeric(df_temp$n_replication) - 2)) + df_temp$se_o <- sqrt((1 - abs(as.numeric(df_temp$es_o))^2) / (as.numeric(df_temp$n_o) - 2)) + df_temp$se_r <- sqrt((1 - abs(as.numeric(df_temp$es_r))^2) / (as.numeric(df_temp$n_r) - 2)) - redlong_original <- df_temp[, c("es_original", "ref_original", "n_original", "se_original")] + redlong_original <- df_temp[, c("es_o", "ref_o", "n_o", "se_o")] redlong_original$type <- "Original" names(redlong_original) <- c("es", "ref", "n", "se", "type") redlong_original <- redlong_original[!duplicated(redlong_original), ] - redlong_replication <- df_temp[, c("es_replication", "ref_replication", "n_replication", "se_replication")] + redlong_replication <- df_temp[, c("es_r", "ref_r", "n_r", "se_r")] redlong_replication$type <- "Replication" names(redlong_replication) <- c("es", "ref", "n", "se", "type") diff --git a/inst/fred_explorer/ui.R b/inst/fred_explorer/ui.R index 3a3cfa6..203cee2 100644 --- a/inst/fred_explorer/ui.R +++ b/inst/fred_explorer/ui.R @@ -33,7 +33,7 @@ large_scale_project_choices <- list( ) moderator_choices <- list( - "Original Effect Size" = "es_original", + "Original Effect Size" = "es_o", "Journal" = "orig_journal", "Year of Original Publication" = "orig_year", "Power of Replication Study" = "power" diff --git a/inst/fred_explorer/website_text.R b/inst/fred_explorer/website_text.R index 5b1a84e..72f1d96 100644 --- a/inst/fred_explorer/website_text.R +++ b/inst/fred_explorer/website_text.R @@ -64,10 +64,10 @@ dataset_info <- HTML(paste("

Replication Rate" , "


There are currently " , nrow(df) , " replication findings entered into the database. By default, only validated and coded findings are selected. Of all findings, " - , length(unique(df$ref_replication)) + , length(unique(df$ref_r)) , " are independent (i.e., use different samples/stem from different studies). Note that the following analyses treat all studies as independent. Apart from the table and bar chart, only studies for which sample sizes and effect sizes are available (for original study and replication) are considered here. The others can be viewed in the Dataset." , " In total, " - , length(unique(df$ref_original)) + , length(unique(df$ref_o)) , " different original studies have been replicated." # , "According to the original researchers' assessments, there have been " # , sum(red$pc05 == "informative failure to replicate", na.rm = TRUE) @@ -85,7 +85,7 @@ forest_info <- HTML(paste("

Study Overview" , "


Currently, " , nrow(df) , " replication findings are entered into the database. These stem from " - , length(unique(df$ref_original)) + , length(unique(df$ref_o)) , " independent original studies. This is an overview of these studies." , "

" , sep = "")) diff --git a/man/add_common_effect_sizes.Rd b/man/add_common_effect_sizes.Rd index 9531754..122042e 100644 --- a/man/add_common_effect_sizes.Rd +++ b/man/add_common_effect_sizes.Rd @@ -6,9 +6,9 @@ \usage{ add_common_effect_sizes( fred_data, - es_value_columns = c("es_orig_value", "es_rep_value"), - es_type_columns = c("es_orig_estype", "es_rep_estype"), - es_common_names = c("es_original", "es_replication"), + es_value_columns = c("es_value_o", "es_value_r"), + es_type_columns = c("es_type_o", "es_type_r"), + es_common_names = c("es_o", "es_r"), coalesce_values = TRUE ) } diff --git a/man/add_replication_power.Rd b/man/add_replication_power.Rd index b348dfb..a55b896 100644 --- a/man/add_replication_power.Rd +++ b/man/add_replication_power.Rd @@ -6,8 +6,8 @@ \usage{ add_replication_power( fred_data, - es_original = "es_original", - N_replication = "n_replication", + es_original = "es_o", + N_replication = "n_r", power_column = "power_r" ) } diff --git a/man/add_sampling_variances.Rd b/man/add_sampling_variances.Rd index 11083b1..bb37479 100644 --- a/man/add_sampling_variances.Rd +++ b/man/add_sampling_variances.Rd @@ -6,9 +6,9 @@ \usage{ add_sampling_variances( fred_data, - es_value_columns = c("es_original", "es_replication"), - N_columns = c("n_original", "n_replication"), - vi_columns = c("vi_original", "vi_replication") + es_value_columns = c("es_o", "es_r"), + N_columns = c("n_o", "n_r"), + vi_columns = c("vi_o", "vi_r") ) } \arguments{ diff --git a/man/align_effect_direction.Rd b/man/align_effect_direction.Rd index 2f6bba6..26142c1 100644 --- a/man/align_effect_direction.Rd +++ b/man/align_effect_direction.Rd @@ -6,8 +6,8 @@ \usage{ align_effect_direction( fred_data, - es_original = "es_original", - es_replication = "es_replication" + es_original = "es_o", + es_replication = "es_r" ) } \arguments{ diff --git a/man/code_replication_outcomes.Rd b/man/code_replication_outcomes.Rd index 259f364..b2fa989 100644 --- a/man/code_replication_outcomes.Rd +++ b/man/code_replication_outcomes.Rd @@ -6,12 +6,12 @@ \usage{ code_replication_outcomes( fred_data, - es_original = "es_original", - p_original = "p_value_original", - p_replication = "p_value_replication", - ci_lower_replication = "ci.lower_replication", - ci_upper_replication = "ci.upper_replication", - es_replication = "es_replication" + es_original = "es_o", + p_original = "p_value_o", + p_replication = "p_value_r", + ci_lower_replication = "ci.lower_r", + ci_upper_replication = "ci.upper_r", + es_replication = "es_r" ) } \arguments{ diff --git a/man/run_annotator.Rd b/man/run_annotator.Rd index 5764f2c..781b4fd 100644 --- a/man/run_annotator.Rd +++ b/man/run_annotator.Rd @@ -4,34 +4,19 @@ \alias{run_annotator} \title{Run the Replication Annotator} \usage{ -run_annotator( - offer_install = interactive(), - in_background = NULL, - auto_close = interactive(), - port = 3839, - timeout = 30 -) -} -\arguments{ -\item{offer_install}{Should user be prompted to install required packages if they are missing?} - -\item{in_background}{Should the app be run in the background (i.e. not block the R console)? Default to TRUE if RStudio is used.} - -\item{auto_close}{Should the app be automatically ended when the browser is closed (or refreshed)?} - -\item{port}{The port to run the app on (can usually be left at the default value)} - -\item{timeout}{The timeout for waiting for the app to become available if launched in background (in seconds)} +run_annotator() } \value{ -Replication Annotator shiny app +Opens the web annotator in the default browser (invisibly returns NULL). } \description{ -Running this function will launch the FReD Replication Annotator shiny app +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} + +This function previously launched a local Shiny app but now opens the +hosted web version of the FReD Annotator. } \examples{ if (interactive()) { - # To run the Replication Annotator app: run_annotator() } } diff --git a/man/setting-parameters.Rd b/man/setting-parameters.Rd index c999c10..e499c13 100644 --- a/man/setting-parameters.Rd +++ b/man/setting-parameters.Rd @@ -15,7 +15,7 @@ The following environment variables can be set (before loading the package): \item \code{FRED_DATA_FILE}: The path to the .xlsx file, if you have downloaded it already (or want it to be saved to a particular location). If the file exists, it will be used - otherwise, the file will be downloaded and saved there. \item \code{RETRACTIONWATCH_DATA_FILE}: The path to the RetractionWatch database, if you have downloaded it already (or want it to be saved to a particular location). If the file exists, it will be used - otherwise, the file will be downloaded and saved there. \item \code{RETRACTIONWATCH_URL}: The URL to download the RetractionWatch database. Needs to return the .csv file. -\item \code{FRED_OFFLINE}: Should FReD work offline (TRUE) or online (FALSE). If TRUE, FReD will not download the latest data every time it is loaded. Defaults to FALSE. +\item \code{FRED_OFFLINE}: Should FReD work offline (TRUE) or online (FALSE). If TRUE, FReD will not download the latest data every time it is loaded. Defaults to TRUE. \item \code{FRED_SUPPRESS_STARTUP_MENU}: Should the interactive menu checking for data updates be suppressed (TRUE) or shown (FALSE). If TRUE, all startup messages and interactive prompts related to offline data updates will be suppressed. Defaults to FALSE. } } diff --git a/vignettes/success_criteria.Rmd b/vignettes/success_criteria.Rmd index 0747794..860c611 100644 --- a/vignettes/success_criteria.Rmd +++ b/vignettes/success_criteria.Rmd @@ -128,24 +128,24 @@ assess_replication_outcome(es_o = .5, n_o = 30, es_r = .2, n_r = 100, To compare the different criteria, we plot the aggregate outcomes based on the FReD dataset. For this, we ignore studies that have not been coded. ```{r fig.width = 12, fig.height = 6, warning=FALSE, message=FALSE} -df <- load_fred_data() %>% - filter(!is.na(es_replication) & !is.na(es_original)) +df <- load_fred_data() %>% + filter(!is.na(es_r) & !is.na(es_o)) criteria <- tribble( - ~criterion, ~name, - "significance_r", "Significance\n(replication)", - "significance_agg", "Significance\n(aggregated)", - "consistency_ci", "Consistency\n(confidence interval)", - "consistency_pi", "Consistency\n(prediction interval)", - "homogeneity", "Homogeneity", + ~criterion, ~name, + "significance_r", "Significance\n(replication)", + "significance_agg", "Significance\n(aggregated)", + "consistency_ci", "Consistency\n(confidence interval)", + "consistency_pi", "Consistency\n(prediction interval)", + "homogeneity", "Homogeneity", "homogeneity_significance", "Homogeneity +\nSignificance", "small_telescopes", "Small Telescopes" ) results <- lapply(criteria$criterion, function(criterion) { - df %>% - mutate(assess_replication_outcome(es_original, n_original, es_replication, n_replication, criterion = criterion)) %>% - count(outcome, outcome_detailed) %>% + df %>% + mutate(assess_replication_outcome(es_o, n_o, es_r, n_r, criterion = criterion)) %>% + count(outcome, outcome_detailed) %>% mutate(criterion = criterion) })