Purpose:

This analysis resulted from an idea in a comment here. In short we were seeing particularly low VAF for Lancet TCGA data and were wondering whether this had to do with the data being WXS instead of WGS.

Conclusion:

Lancet was doing poorly with WXS samples when compared on a within participant basis.

Declare names of input and output directories.

# magrittr pipe
`%>%` <- dplyr::`%>%`

data_dir <- file.path("..", "..", "..", "data")
scratch_dir <- file.path("..", "..", "..", "scratch")

Read in the metadata.

metadata <- readr::read_tsv(file.path(data_dir, "pbta-histologies.tsv"))
Parsed with column specification:
cols(
  .default = col_character(),
  OS_days = col_double(),
  age_last_update_days = col_double(),
  normal_fraction = col_double(),
  tumor_fraction = col_double(),
  tumor_ploidy = col_double(),
  molecular_subtype = col_logical()
)
See spec(...) for full column specifications.
493 parsing failures.
 row               col           expected actual                                 file
2334 molecular_subtype 1/0/T/F/TRUE/FALSE Group3 '../../../data/pbta-histologies.tsv'
2335 molecular_subtype 1/0/T/F/TRUE/FALSE Group4 '../../../data/pbta-histologies.tsv'
2336 molecular_subtype 1/0/T/F/TRUE/FALSE Group3 '../../../data/pbta-histologies.tsv'
2337 molecular_subtype 1/0/T/F/TRUE/FALSE Group3 '../../../data/pbta-histologies.tsv'
2338 molecular_subtype 1/0/T/F/TRUE/FALSE Group3 '../../../data/pbta-histologies.tsv'
.... ................. .................. ...... ....................................
See problems(...) for more details.

Retrieve all the participant IDs for participants that have both WGS and WXS data.

matched_participants <- metadata %>%
  dplyr::filter(experimental_strategy != "RNA-Seq") %>%
  dplyr::group_by(Kids_First_Participant_ID) %>%
  dplyr::summarize(strategies = paste0(experimental_strategy, collapse = ",")) %>%
  dplyr::filter(grepl("WXS", strategies) & grepl("WGS", strategies)) %>%
  dplyr::pull(Kids_First_Participant_ID)

Get the biospecimen IDS for these participants.

biospecimens <- metadata %>%
  dplyr::filter(Kids_First_Participant_ID %in% matched_participants) %>%
  dplyr::pull(Kids_First_Biospecimen_ID)

Connect to SQLite database.

# Start up connection
con <- DBI::dbConnect(
  RSQLite::SQLite(),
  file.path(scratch_dir, "v11_snv_db.sqlite")
)

Make a list of columns we will keep.

cols_to_keep <- c(
  "Chromosome",
  "Start_Position",
  "End_Position",
  "Reference_Allele",
  "Allele",
  "Tumor_Sample_Barcode",
  "Variant_Classification",
  "VAF"
)

Set up the Lancet data from the SQL database and only keep the biospecimens we identified.

lancet <- dplyr::tbl(con, "lancet") %>%
  dplyr::select(cols_to_keep) %>%
  dplyr::inner_join(
    dplyr::tbl(con, "samples") %>%
      dplyr::select(
        Tumor_Sample_Barcode = Kids_First_Biospecimen_ID,
        experimental_strategy, short_histology,
        Kids_First_Participant_ID
      )
  ) %>%
  dplyr::filter(Tumor_Sample_Barcode %in% biospecimens) %>%
  as.data.frame()
Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
Joining, by = "Tumor_Sample_Barcode"

Plot this as a violin plot

vaf_plot <- ggplot2::ggplot(lancet, ggplot2::aes(
  x = experimental_strategy,
  y = VAF,
  fill = experimental_strategy
)) +
  ggplot2::geom_violin() +
  ggplot2::theme_classic() +
  ggplot2::ggtitle("Lancet participants with WXS and WGS")

Print out plot with all participants together.

vaf_plot

Split up data by participant.

vaf_plot + ggplot2::facet_wrap(~ Kids_First_Participant_ID)

Session Info

sessionInfo()
R version 3.6.0 (2019-04-26)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Debian GNU/Linux 9 (stretch)

Matrix products: default
BLAS/LAPACK: /usr/lib/libopenblasp-r0.2.19.so

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8       
 [4] LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8    LC_MESSAGES=C             
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C              
[10] LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.1       dbplyr_1.4.2     pillar_1.4.2     compiler_3.6.0   base64enc_0.1-3 
 [6] tools_3.6.0      digest_0.6.20    bit_1.1-14       jsonlite_1.6     RSQLite_2.1.1   
[11] evaluate_0.14    memoise_1.1.0    tibble_2.1.3     gtable_0.3.0     pkgconfig_2.0.2 
[16] rlang_0.4.0      DBI_1.0.0        rstudioapi_0.10  xfun_0.8         dplyr_0.8.3     
[21] knitr_1.23       hms_0.4.2        bit64_0.9-7      grid_3.6.0       tidyselect_0.2.5
[26] glue_1.3.1       R6_2.4.0         rmarkdown_1.13   readr_1.3.1      purrr_0.3.2     
[31] ggplot2_3.2.0    blob_1.1.1       magrittr_1.5     scales_1.0.0     htmltools_0.3.6 
[36] rsconnect_0.8.13 assertthat_0.2.1 colorspace_1.4-1 labeling_0.3     lazyeval_0.2.2  
[41] munsell_0.5.0    crayon_1.3.4    
LS0tCnRpdGxlOiAiTGFuY2V0IHBhaXJlZCBXWFMgYW5kIFdHUyBkYXRhIgpvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6CiAgICB0b2M6IFRSVUUKICAgIHRvY19mbG9hdDogVFJVRQphdXRob3I6IEMuIFNhdm9uZW4gZm9yIEFMU0YgQ0NETApkYXRlOiAyMDIwCi0tLQoKIyMjIyBQdXJwb3NlOiAKVGhpcyBhbmFseXNpcyByZXN1bHRlZCBmcm9tIGFuIFtpZGVhIGluIGEgY29tbWVudCBoZXJlXShodHRwczovL2dpdGh1Yi5jb20vQWxleHNMZW1vbmFkZS9PcGVuUEJUQS1hbmFseXNpcy9wdWxsLzU0OCNpc3N1ZWNvbW1lbnQtNTg5NzQ5MzU1KS4KSW4gc2hvcnQgd2Ugd2VyZSBzZWVpbmcgcGFydGljdWxhcmx5IGxvdyBWQUYgZm9yIExhbmNldCBUQ0dBIGRhdGEgYW5kIHdlcmUgd29uZGVyaW5nIAp3aGV0aGVyIHRoaXMgaGFkIHRvIGRvIHdpdGggdGhlIGRhdGEgYmVpbmcgV1hTIGluc3RlYWQgb2YgV0dTLiAKCiMjIyBDb25jbHVzaW9uOiAKTGFuY2V0IHdhcyBkb2luZyBwb29ybHkgd2l0aCBXWFMgc2FtcGxlcyB3aGVuIGNvbXBhcmVkIG9uIGEgd2l0aGluIHBhcnRpY2lwYW50IApiYXNpcy4gCgpEZWNsYXJlIG5hbWVzIG9mIGlucHV0IGFuZCBvdXRwdXQgZGlyZWN0b3JpZXMuCgpgYGB7cn0KIyBtYWdyaXR0ciBwaXBlCmAlPiVgIDwtIGRwbHlyOjpgJT4lYAoKZGF0YV9kaXIgPC0gZmlsZS5wYXRoKCIuLiIsICIuLiIsICIuLiIsICJkYXRhIikKc2NyYXRjaF9kaXIgPC0gZmlsZS5wYXRoKCIuLiIsICIuLiIsICIuLiIsICJzY3JhdGNoIikKYGBgCgpSZWFkIGluIHRoZSBtZXRhZGF0YS4gCgpgYGB7cn0KbWV0YWRhdGEgPC0gcmVhZHI6OnJlYWRfdHN2KGZpbGUucGF0aChkYXRhX2RpciwgInBidGEtaGlzdG9sb2dpZXMudHN2IikpCmBgYAoKUmV0cmlldmUgYWxsIHRoZSBwYXJ0aWNpcGFudCBJRHMgZm9yIHBhcnRpY2lwYW50cyB0aGF0IGhhdmUgYm90aCBXR1MgYW5kIFdYUyBkYXRhLiAKCmBgYHtyfQptYXRjaGVkX3BhcnRpY2lwYW50cyA8LSBtZXRhZGF0YSAlPiUKICBkcGx5cjo6ZmlsdGVyKGV4cGVyaW1lbnRhbF9zdHJhdGVneSAhPSAiUk5BLVNlcSIpICU+JQogIGRwbHlyOjpncm91cF9ieShLaWRzX0ZpcnN0X1BhcnRpY2lwYW50X0lEKSAlPiUKICBkcGx5cjo6c3VtbWFyaXplKHN0cmF0ZWdpZXMgPSBwYXN0ZTAoZXhwZXJpbWVudGFsX3N0cmF0ZWd5LCBjb2xsYXBzZSA9ICIsIikpICU+JQogIGRwbHlyOjpmaWx0ZXIoZ3JlcGwoIldYUyIsIHN0cmF0ZWdpZXMpICYgZ3JlcGwoIldHUyIsIHN0cmF0ZWdpZXMpKSAlPiUKICBkcGx5cjo6cHVsbChLaWRzX0ZpcnN0X1BhcnRpY2lwYW50X0lEKQpgYGAKCkdldCB0aGUgYmlvc3BlY2ltZW4gSURTIGZvciB0aGVzZSBwYXJ0aWNpcGFudHMuIAoKYGBge3J9CmJpb3NwZWNpbWVucyA8LSBtZXRhZGF0YSAlPiUKICBkcGx5cjo6ZmlsdGVyKEtpZHNfRmlyc3RfUGFydGljaXBhbnRfSUQgJWluJSBtYXRjaGVkX3BhcnRpY2lwYW50cykgJT4lCiAgZHBseXI6OnB1bGwoS2lkc19GaXJzdF9CaW9zcGVjaW1lbl9JRCkKYGBgCgpDb25uZWN0IHRvIFNRTGl0ZSBkYXRhYmFzZS4KCmBgYHtyfQojIFN0YXJ0IHVwIGNvbm5lY3Rpb24KY29uIDwtIERCSTo6ZGJDb25uZWN0KAogIFJTUUxpdGU6OlNRTGl0ZSgpLAogIGZpbGUucGF0aChzY3JhdGNoX2RpciwgInNudl9kYi5zcWxpdGUiKQopCmBgYAoKTWFrZSBhIGxpc3Qgb2YgY29sdW1ucyB3ZSB3aWxsIGtlZXAuCgpgYGB7cn0KY29sc190b19rZWVwIDwtIGMoCiAgIkNocm9tb3NvbWUiLAogICJTdGFydF9Qb3NpdGlvbiIsCiAgIkVuZF9Qb3NpdGlvbiIsCiAgIlJlZmVyZW5jZV9BbGxlbGUiLAogICJBbGxlbGUiLAogICJUdW1vcl9TYW1wbGVfQmFyY29kZSIsCiAgIlZhcmlhbnRfQ2xhc3NpZmljYXRpb24iLAogICJWQUYiCikKYGBgCgpTZXQgdXAgdGhlIExhbmNldCBkYXRhIGZyb20gdGhlIFNRTCBkYXRhYmFzZSBhbmQgb25seSBrZWVwIHRoZSBiaW9zcGVjaW1lbnMgd2UKaWRlbnRpZmllZC4gCgpgYGB7cn0KbGFuY2V0IDwtIGRwbHlyOjp0YmwoY29uLCAibGFuY2V0IikgJT4lCiAgZHBseXI6OnNlbGVjdChjb2xzX3RvX2tlZXApICU+JQogIGRwbHlyOjppbm5lcl9qb2luKAogICAgZHBseXI6OnRibChjb24sICJzYW1wbGVzIikgJT4lCiAgICAgIGRwbHlyOjpzZWxlY3QoCiAgICAgICAgVHVtb3JfU2FtcGxlX0JhcmNvZGUgPSBLaWRzX0ZpcnN0X0Jpb3NwZWNpbWVuX0lELAogICAgICAgIGV4cGVyaW1lbnRhbF9zdHJhdGVneSwgc2hvcnRfaGlzdG9sb2d5LAogICAgICAgIEtpZHNfRmlyc3RfUGFydGljaXBhbnRfSUQKICAgICAgKQogICkgJT4lCiAgZHBseXI6OmZpbHRlcihUdW1vcl9TYW1wbGVfQmFyY29kZSAlaW4lIGJpb3NwZWNpbWVucykgJT4lCiAgYXMuZGF0YS5mcmFtZSgpCmBgYAoKUGxvdCB0aGlzIGFzIGEgdmlvbGluIHBsb3QKCmBgYHtyfQp2YWZfcGxvdCA8LSBnZ3Bsb3QyOjpnZ3Bsb3QobGFuY2V0LCBnZ3Bsb3QyOjphZXMoCiAgeCA9IGV4cGVyaW1lbnRhbF9zdHJhdGVneSwKICB5ID0gVkFGLAogIGZpbGwgPSBleHBlcmltZW50YWxfc3RyYXRlZ3kKKSkgKwogIGdncGxvdDI6Omdlb21fdmlvbGluKCkgKwogIGdncGxvdDI6OnRoZW1lX2NsYXNzaWMoKSArCiAgZ2dwbG90Mjo6Z2d0aXRsZSgiTGFuY2V0IHBhcnRpY2lwYW50cyB3aXRoIFdYUyBhbmQgV0dTIikKYGBgCgpQcmludCBvdXQgcGxvdCB3aXRoIGFsbCBwYXJ0aWNpcGFudHMgdG9nZXRoZXIuIAoKYGBge3J9CnZhZl9wbG90CmBgYAoKU3BsaXQgdXAgZGF0YSBieSBwYXJ0aWNpcGFudC4gCgpgYGB7cn0KdmFmX3Bsb3QgKyBnZ3Bsb3QyOjpmYWNldF93cmFwKH4gS2lkc19GaXJzdF9QYXJ0aWNpcGFudF9JRCkKYGBgCgojIyMgU2Vzc2lvbiBJbmZvCgpgYGB7cn0Kc2Vzc2lvbkluZm8oKQpgYGAK