R/provenance_reporting.R

In imedR: Guarded Evidence Synthesis for the Indian Microplastics Evidence Database

#' Primary study citations for a subset
#' @param x An `imed_db` object, as returned by `imed_data()`.
#' @param study_id Optional character vector of `Study_ID` values used to restrict the records.
#' @return A `tibble` with one row per study and the citation fields that are available
#'   (`Study_ID`, `Authors`, `Year`, `Title`, `Journal`, `DOI`).
#' @examples
#' db <- imed_data(tables = "STUDIES", validate = FALSE)
#' head(imed_cite(db))
#' @export
imed_cite <- function(x,study_id=NULL) {
  s=.imed_table(x,"STUDIES")
  if (!is.null(study_id)) s=s[s$Study_ID %in% study_id,,drop=FALSE]
  s[,intersect(c("Study_ID","Authors","Year","Title","Journal","DOI"),names(s)),drop=FALSE]
}

#' Provenance records for studies or target records
#' @param x An `imed_db` object, as returned by `imed_data()`.
#' @param study_id Optional character vector of `Study_ID` values used to restrict the records.
#' @param record_id Optional character vector of `Target_Record_ID` values to retrieve.
#' @return A `tibble` with the provenance records (the PROVENANCE table), restricted to
#'   the requested studies or target records when these are supplied.
#' @examples
#' db <- imed_data(tables = "PROVENANCE", validate = FALSE)
#' head(imed_provenance(db))
#' @export
imed_provenance <- function(x,study_id=NULL,record_id=NULL) {
  p=.imed_table(x,"PROVENANCE")
  if (!is.null(study_id)) p=p[p$Study_ID %in% study_id,,drop=FALSE]
  if (!is.null(record_id)) p=p[p$Target_Record_ID %in% record_id,,drop=FALSE]
  tibble::as_tibble(p)
}

#' Study-characteristics table for manuscripts
#' @param x An `imed_db` object, as returned by `imed_data()`.
#' @param study_id Optional character vector of `Study_ID` values used to restrict the records.
#' @return A `tibble` with one row per study and the descriptive fields that are
#'   available (`Study_ID`, `Authors`, `Year`, `States_UTs`, `Matrices_Studied`,
#'   `Journal`, `DOI`, `Entry_Status`).
#' @examples
#' db <- imed_data(tables = "STUDIES", validate = FALSE)
#' head(imed_manuscript_table(db))
#' @export
imed_manuscript_table <- function(x,study_id=NULL) {
  s=.imed_table(x,"STUDIES")
  if (!is.null(study_id)) s=s[s$Study_ID %in% study_id,,drop=FALSE]
  keep=intersect(c("Study_ID","Authors","Year","States_UTs","Matrices_Studied",
    "Journal","DOI","Entry_Status"),names(s))
  tibble::as_tibble(s[,keep,drop=FALSE])
}

#' Tidy a statistical result object for manuscript reporting
#' @param x A result object: an `imed_stats` result or a fitted `metafor` `rma` object.
#' @return A `tibble`. For an `imed_stats` object, the data-frame components of the
#'   result are stacked and labelled in a `section` column. For a `metafor` `rma`
#'   object, a single row with the pooled `estimate`, its standard error `se`,
#'   the confidence limits `ci_lb` and `ci_ub`, the test statistic `z`, `p_value`,
#'   the heterogeneity measures `tau2`, `I2` and `H2`, and the number of effects
#'   `k`. Other objects cause an error.
#' @examples
#' toy <- data.frame(
#'   Study_ID = paste0("S", 1:12),
#'   Comparability_Class = "CLASS_A",
#'   Reported_Unit = "items/L",
#'   Metric_Type = "Abundance",
#'   Strict_Synthesis_Eligibility = "YES",
#'   Group = rep(c("g1", "g2"), 6),
#'   Mean = c(2.1, 3.4, 1.8, 4.0, 2.9, 3.1, 2.4, 3.8, 1.9, 3.3, 2.7, 4.2),
#'   SD = rep(c(0.6, 0.9), 6),
#'   N = rep(c(10, 12, 8), 4)
#' )
#' res <- imed_stats(toy, group = "Group", test = "welch")
#' imed_results_table(res)
#' @export
imed_results_table <- function(x) {
  if (inherits(x,"imed_stats")) return(dplyr::bind_rows(
    lapply(names(x),function(nm) {
      z=x[[nm]]
      if (is.data.frame(z)) dplyr::mutate(z,section=nm,.before=1) else NULL
    })))
  if (inherits(x,"rma")) return(tibble::tibble(
    estimate=as.numeric(x$b),se=x$se,ci_lb=x$ci.lb,ci_ub=x$ci.ub,
    z=x$zval,p_value=x$pval,tau2=x$tau2,I2=x$I2,H2=x$H2,k=x$k))
  .imed_stop("Unsupported result object.")
}

#' Evidence-quality/reporting profile
#' @param x An `imed_db` object, as returned by `imed_data()`.
#' @return A one-row `tibble` with the number of QA/QC records (`n_records`) and the
#'   numbers that report a procedural blank (`procedural_blank_yes`), a recovery
#'   test (`recovery_test_reported`) and chemical confirmation
#'   (`chemical_confirmation_reported`).
#' @examples
#' db <- imed_data(tables = "METHODS_QAQC", validate = FALSE)
#' imed_evidence_profile(db)
#' @export
imed_evidence_profile <- function(x) {
  q=.imed_table(x,"METHODS_QAQC")
  tibble::tibble(
    n_records=nrow(q),
    procedural_blank_yes=sum(tolower(as.character(q$Procedural_Blank))=="yes",na.rm=TRUE),
    recovery_test_reported=sum(.imed_nonmissing(q$Recovery_Test) &
      !tolower(as.character(q$Recovery_Test)) %in% c("not reported","nr"),na.rm=TRUE),
    chemical_confirmation_reported=sum(.imed_nonmissing(q$Chemical_Confirmation),na.rm=TRUE)
  )
}