In populationgenomics/cpgr: Centre for Population Genomics R stuff

knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE)

require(fs, include.only = "dir_ls")
require(glue)
require(here)
require(jsonlite, include.only = "read_json")
require(kableExtra, include.only = c("kable_minimal", "kable_material"))
require(knitr)
require(tidyverse)

# for interactive debugging
params <- rmarkdown::yaml_front_matter(here("inst/rmd/str/expansionhunter_reviewer.Rmd"))$params

Introduction

Below we show the main output from ExpansionHunter (selected fields from output JSON) and the Read Alignments from REViewer. The loci were selected based on the variant catalog available at the ExpansionHunter GitHub repo.

jsons <- dir_ls(params$indir, glob = "*.json", recurse = TRUE) |>
  as_tibble_col("fname") |>
  mutate(sample = basename(dirname(fname)))

pluck_json <- function(fname, sname) {
  pluck_locus_results <- function(j, sname) {
    sex <- j[["SampleParameters"]][["Sex"]]
    x <- j[["LocusResults"]]
    map(x, function(l) {
      list(
        Sex = sex,
        Locus = l$LocusId,
        ReferenceRegion = l$Variants[[1]][["ReferenceRegion"]],
        Repeat = l$Variants[[1]][["RepeatUnit"]],
        GT = l$Variants[[1]][["Genotype"]],
        Cov = l$Coverage,
        FragLen = l$FragmentLength
      )
    }) |>
      bind_rows() |>
      mutate(Sample = sname, Cov = floor(Cov)) |>
      select(Sample, everything())
  }

  read_json(fname) |>
    pluck_locus_results(sname) |>
    bind_rows()
}

x <- vector("list", length = nrow(jsons))
names(x) <- jsons$sample
for (i in seq_len(nrow(jsons))) {
  x[[jsons$sample[i]]] <- pluck_json(jsons$fname[i], jsons$sample[i])
}
d <- bind_rows(x)

# find SVG files in indir
svg <- dir_ls(params$indir, glob = "*.svg", recurse = TRUE) |>
  as_tibble_col("fname") |>
  mutate(bname = basename(fname)) |>
  tidyr::separate(bname, into = c("sample", "locus", "svg"), sep = "\\.") |>
  select(-svg)

samples <- unique(svg$sample)
loci <- unique(svg$locus)
svg_sample_locus <- function(svg, s, l) {
  svg |> filter(sample == s, locus == l) |> pull(fname)
}
kable(as_tibble_col(samples, "samples")) |>
  kable_minimal()

Results {.tabset .tabset-pills}

cat('\n\n')
for (l in loci) {
  cat(glue("### {l}"), "\n")
  print(d |> filter(Locus == l) |> kable() |> kable_material())
  for (s in samples) {
    cat(glue("#### {s}"), "\n")
    cat(glue("![]({svg_sample_locus(svg, s, l)})"), "\n")
    cat('\n\n')
    cat('---')
    cat('\n\n')
  }
  cat('\n\n')
}