R/summary_rbind_report.R

In tidypopgen: Tidy Population Genetics

#' Print a summary of a merge report
#'
#' This function creates a summary of the merge report generated by
#' [rbind_dry_run()]
#'
#' @param object a list generated by [rbind_dry_run()]
#' @param ... unused (necessary for compatibility with generic function)
#' @param ref_label the label for the reference dataset (defaults to
#'   "reference")
#' @param target_label the label for the target dataset (defaults to "target")
#' @returns NULL (prints a summary to the console)
#' @rdname summary_rbind_dry_run
#' @aliases summary_rbind_report
#' @method summary rbind_report
#' @export
#' @examples
#' example_gt <- load_example_gt("gen_tbl")
#'
#' # Create a second gen_tibble to merge
#' test_indiv_meta <- data.frame(
#'   id = c("x", "y", "z"),
#'   population = c("pop1", "pop1", "pop2")
#' )
#' test_genotypes <- rbind(
#'   c(1, 1, 0, 1, 1, 0),
#'   c(2, 1, 0, 0, 0, 0),
#'   c(2, 2, 0, 0, 1, 1)
#' )
#' test_loci <- data.frame(
#'   name = paste0("rs", 1:6),
#'   chromosome = paste0("chr", c(1, 1, 1, 1, 2, 2)),
#'   position = as.integer(c(3, 5, 65, 343, 23, 456)),
#'   genetic_dist = as.double(rep(0, 6)),
#'   allele_ref = c("A", "T", "C", "G", "C", "T"),
#'   allele_alt = c("T", "C", NA, "C", "G", "A")
#' )
#'
#' test_gt <- gen_tibble(
#'   x = test_genotypes,
#'   loci = test_loci,
#'   indiv_meta = test_indiv_meta,
#'   valid_alleles = c("A", "T", "C", "G"),
#'   quiet = TRUE
#' )
#'
#' # Merge the datasets using rbind
#' report <- rbind_dry_run(
#'   ref = example_gt, target = test_gt,
#'   flip_strand = TRUE, quiet = TRUE
#' )
#'
#' # Get the summary
#' summary(report)
summary.rbind_report <- function(
    object,
    ...,
    ref_label = "reference",
    target_label = "target") {
  cat("harmonising loci between two datasets\n")
  cat(
    "flip_strand = ",
    attr(object, "flip_strand"),
    " ; remove_ambiguous = ",
    attr(object, "remove_ambiguous"),
    "\n"
  )
  cat("-----------------------------\n")
  cat("dataset:", ref_label, "\n")
  cat(
    "number of SNPs:",
    nrow(object$ref),
    "reduced to",
    sum(!is.na(object$ref$new_id)),
    "\n"
  )
  cat(
    "(",
    sum(object$ref$ambiguous),
    "are ambiguous, of which",
    (sum(object$ref$ambiguous & is.na(object$ref$new_id))),
    " were removed)\n"
  )
  cat("-----------------------------\n")
  cat("dataset:", target_label, "\n")
  cat(
    "number of SNPs:",
    nrow(object$target),
    "reduced to",
    sum(!is.na(object$target$new_id)),
    "\n"
  )
  cat(
    "(",
    sum(object$target$to_flip),
    "were flipped to match the reference set)\n"
  )
  cat(
    "(",
    sum(object$target$ambiguous),
    "are ambiguous, of which",
    (sum(object$target$ambiguous & is.na(object$target$new_id))),
    "were removed)"
  )
}