TMRC2 Comprehensive Data Analysis: 202108

sample_sheet <- glue::glue("sample_sheets/tmrc2_samples_20210817.xlsx")

1 Introduction

This document is intended to provide a general overview of the TMRC2 samples which have thus far been sequenced. In some cases, this includes only those samples starting in 2019; in other instances I am including our previous (2015-2016) samples.

In all cases the processing performed was:

1. Default trimming was performed.
2. Hisat2 was used to map the remaining reads against the Leishmania panamensis genome revision 36.
3. The alignments from hisat2 were used to count reads/gene against the revision 36 annotations with htseq.
4. These alignments were also passed to the pileup functionality of samtools and the vcf/bcf utilities in order to make a matrix of all observed differences between each sample with respect to the reference.

The analyses in this document use the matrices of counts/gene from #3 and variants/position from #4 in order to provide some images and metrics describing the samples we have sequenced so far.

2 Annotations

Everything which follows depends on the Existing TriTrypDB annotations revision 46, circa 2019. The following block loads a database of these annotations and turns it into a matrix where the rows are genes and columns are all the annotation types provided by TriTrypDB.

The same database was used to create a matrix of orthologous genes between L.panamensis and all of the other species in the TriTrypDB.

tt <- sm(library(EuPathDB))
tt <- sm(library(org.Lpanamensis.MHOMCOL81L13.v46.eg.db))
pan_db <- org.Lpanamensis.MHOMCOL81L13.v46.eg.db
all_fields <- columns(pan_db)

all_lp_annot <- sm(load_orgdb_annotations(
    pan_db,
    keytype = "gid",
    fields = c("annot_gene_entrez_id", "annot_gene_name",
               "annot_strand", "annot_chromosome", "annot_cds_length",
               "annot_gene_product")))$genes

lp_go <- sm(load_orgdb_go(pan_db))
lp_lengths <- all_lp_annot[, c("gid", "annot_cds_length")]
colnames(lp_lengths)  <- c("ID", "length")
all_lp_annot[["annot_gene_product"]] <- tolower(all_lp_annot[["annot_gene_product"]])
orthos <- sm(EuPathDB::extract_eupath_orthologs(db = pan_db))

hisat_annot <- all_lp_annot
## rownames(hisat_annot) <- paste0("exon_", rownames(hisat_annot), ".E1")

3 Load a genome

meta <- EuPathDB::download_eupath_metadata(webservice="tritrypdb")
lp_entry <- EuPathDB::get_eupath_entry(species="Leishmania panamensis", metadata=meta)

## Found the following hits: Leishmania panamensis MHOM/COL/81/L13, Leishmania panamensis strain MHOM/PA/94/PSC-1, choosing the first.

## Using: Leishmania panamensis MHOM/COL/81/L13.

lp_entry

##   AnnotationVersion AnnotationSource BiocVersion DataProvider
## 6      Dec 16, 2014           GeneDB        3.13    TriTrypDB
##                                 Genome GenomeSource   GenomeVersion
## 6 TriTrypDB-54_LpanamensisMHOMCOL81L13      GenBank GCA_000340495.1
##   NumArrayGene NumChipChipGene NumChromosome NumCodingGene NumCommunity
## 6         <NA>            <NA>            36          8665           12
##   NumContig NumEC NumEST NumGene NumGO NumOrtholog NumOtherGene NumPopSet
## 6         0    62   <NA>    8778  3930        8665          113     37300
##   NumProteomics NumPseudogene NumRNASeq NumRTPCR NumSNP NumTFBS Organellar
## 6          <NA>             0      <NA>       NA   5337      NA         no
##   ReferenceStrain   MegaBP                            PrimaryKey ProjectID
## 6             yes    31.26 Leishmania panamensis MHOM/COL/81/L13 TriTrypDB
##                             RecordClassName          SourceID SourceVersion
## 6 OrganismRecordClasses.OrganismRecordClass NCBITAXON_1055687            54
##   TaxonomyID                          TaxonomyName
## 6    1295824 Leishmania panamensis MHOM/COL/81/L13
##                                                                                                                               URLGenome
## 6 http://TriTrypDB.org/common/downloads/release-54/LpanamensisMHOMCOL81L13/fasta/data/TriTrypDB-54_LpanamensisMHOMCOL81L13_Genome.fasta
##                                                                                                                       URLGFF
## 6 http://TriTrypDB.org/common/downloads/release-54/LpanamensisMHOMCOL81L13/gff/data/TriTrypDB-54_LpanamensisMHOMCOL81L13.gff
##                                                                                                                                         URLProtein
## 6 http://TriTrypDB.org/common/downloads/release-54/LpanamensisMHOMCOL81L13/fasta/data/TriTrypDB-54_LpanamensisMHOMCOL81L13_AnnotatedProteins.fasta
##   Coordinate_1_based                       Maintainer
## 6               TRUE Keith Hughitt <khughitt@umd.edu>
##                                                                                                                    SourceUrl
## 6 http://TriTrypDB.org/common/downloads/release-54/LpanamensisMHOMCOL81L13/gff/data/TriTrypDB-54_LpanamensisMHOMCOL81L13.gff
##                                                                                   Tags
## 6 Annotation:EuPathDB:Eukaryote:Pathogen:Parasite:Trypanosome:Kinetoplastid:Leishmania
##                                       BsgenomePkg
## 6 BSGenome.Leishmania.panamensis.MHOMCOL81L13.v54
##                                           GrangesPkg
## 6 GRanges.Leishmania.panamensis.MHOMCOL81L13.v54.rda
##                                     OrganismdbiPkg
## 6 tritrypdb.Leishmania.panamensis.MHOMCOL81L13.v54
##                                 OrgdbPkg
## 6 org.Lpanamensis.MHOMCOL81L13.v54.eg.db
##                                                 TxdbPkg
## 6 TxDb.Leishmania.panamensis.MHOMCOL81L13.TriTrypDB.v54
##                                Taxon      Genus    Species       Strain
## 6 Leishmania panamensis MHOMCOL81L13 Leishmania panamensis MHOMCOL81L13
##                                                                                   BsgenomeFile
## 6 EuPathDB/BSgenome/3.13/BSGenome.Leishmania.panamensis.MHOMCOL81L13.v54/single_sequences.2bit
##                                                                GrangesFile
## 6 EuPathDB/GRanges/3.13/GRanges.Leishmania.panamensis.MHOMCOL81L13.v54.rda
##                                                                            OrganismdbiFile
## 6 EuPathDB/OrganismDbi/3.13/tritrypdb.Leishmania.panamensis.MHOMCOL81L13.v54/graphInfo.rda
##                                                        OrgdbFile
## 6 EuPathDB/OrgDb/3.13/org.Lpanamensis.MHOMCOL81L13.v54.eg.sqlite
##                                                                          TxdbFile
## 6 EuPathDB/TxDb/3.13/TxDb.Leishmania.panamensis.MHOMCOL81L13.TriTrypDB.v54.sqlite
##            GenusSpecies                       TaxonUnmodified
## 6 Leishmania panamensis Leishmania panamensis MHOM/COL/81/L13
##                          TaxonCanonical                             TaxonXref
## 6 Leishmania panamensis MHOM/COL/81/L13 Leishmania panamensis MHOM/COL/81/L13

## testing_panamensis <- EuPathDB::make_eupath_bsgenome(entry=lp_entry)
library(as.character(testing_panamensis), character.only=TRUE)

## Error in library(as.character(testing_panamensis), character.only = TRUE): object 'testing_panamensis' not found

genome <- get0(as.character(testing_panamensis))

## Error in get0(as.character(testing_panamensis)): object 'testing_panamensis' not found

4 TODO:

Resequence samples: TMRC20002, TMRC20006, TMRC20004 (maybe TMRC20008 and TMRC20029)

5 Generate Expressionsets and Sample Estimation

The process of sample estimation takes two primary inputs:

1. The sample sheet, which contains all the metadata we currently have on hand, including filenames for the outputs of #3 and #4 above.
2. The gene annotations.

An expressionset is a data structure used in R to examine RNASeq data. It is comprised of annotations, metadata, and expression data. In the case of our processing pipeline, the location of the expression data is provided by the filenames in the metadata.

The first lines of the following block create the Expressionset. All of the following lines perform various normalizations and generate plots from it.

5.1 Notes

The following samples are much lower coverage:

• TMRC20002
• TMRC20006
• TMRC20007
• TMRC20008

20210610: I made some manual changes to the sample sheet which I downloaded, filling in some zymodeme with ‘unknown’

5.2 TODO:

1. Do the multi-gene family removal right here instead of way down at the bottom
2. Add zymodeme snps to the annotation later.
3. Start phylogenetic analysis of variant table.

sanitize_columns <- c("passagenumber", "clinicalresponse", "clinicalcategorical",
                      "zymodemecategorical", "phenotypiccharacteristics")
lp_expt <- sm(create_expt(sample_sheet,
                          gene_info = hisat_annot,
                          id_column = "hpglidentifier",
                          file_column = "lpanamensisv36hisatfile")) %>%
  set_expt_conditions(fact = "zymodemecategorical") %>%
  subset_expt(nonzero = 8550) %>%
  subset_expt(coverage = 5000000) %>%
  semantic_expt_filter(semantic = c("amastin", "gp63", "leishmanolysin"),
                       semantic_column = "annot_gene_product") %>%
  sanitize_expt_metadata(columns = sanitize_columns) %>%
  set_expt_factors(columns = sanitize_columns, class = "factor")

## The samples (and read coverage) removed when filtering 8550 non-zero genes are:

## TMRC20002 TMRC20006 
##  11681227   6670348

## subset_expt(): There were 74, now there are 72 samples.

## The samples removed (and read coverage) when filtering samples with less than 5e+06 reads are:

## TMRC20004 TMRC20029 
##    564812   1658096

## subset_expt(): There were 72, now there are 70 samples.

## semantic_expt_filter(): Removed 68 genes.

libsizes <- plot_libsize(lp_expt)
pp(file = "images/lp_expt_libsizes.png", image = libsizes$plot, width = 14, height = 9)

## I think samples 7,10 should be removed at minimum, probably also 9,11
nonzero <- plot_nonzero(lp_expt)
pp(file = "images/lp_nonzero.png", image = nonzero$plot, width = 9, height = 9)

## Warning: ggrepel: 49 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

## Warning: ggrepel: 53 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

lp_box <- plot_boxplot(lp_expt)

## 5252 entries are 0.  We are on a log scale, adding 1 to the data.

pp(file = "images/lp_expt_boxplot.png", image = lp_box, width = 12, height = 9)

filter_plot <- plot_libsize_prepost(lp_expt)
filter_plot$lowgene_plot

## Warning: Using alpha for a discrete variable is not advised.

filter_plot$count_plot

5.3 Distribution Visualization

Najib’s favorite plots are of course the PCA/TNSE. These are nice to look at in order to get a sense of the relationships between samples. They also provide a good opportunity to see what happens when one applies different normalizations, surrogate analyses, filters, etc. In addition, one may set different experimental factors as the primary ‘condition’ (usually the color of plots) and surrogate ‘batches’.

5.4 By Susceptilibity

Column ‘Q’ in the sample sheet, make a categorical version of it with these parameters:

• 0 <= x <= 35 is resistant
• 36 <= x <= 48 is ambiguous
• 49 <= x is sensitive

starting <- as.numeric(pData(lp_expt)[["susceptibilityinfectionreduction32ugmlsbvhistoricaldata"]])
sus_categorical <- starting
na_idx <- is.na(starting)
sus_categorical[na_idx] <- "unknown"

resist_idx <- starting <= 0.35
sus_categorical[resist_idx] <- "resistant"
indeterminant_idx <- starting >= 0.36 & starting <= 0.48
sus_categorical[indeterminant_idx] <- "ambiguous"
susceptible_idx <- starting >= 0.49
sus_categorical[susceptible_idx] <- "sensitive"

pData(lp_expt$expressionset)[["sus_category"]] <- sus_categorical

clinical_colors <- list(
    "z2.3" = "#874400",
    "z2.2" = "#df7000",
    "unknown" = "#cbcbcb",
    "null" = "#000000")
clinical_samples <- lp_expt %>%
  set_expt_batches(fact = sus_categorical) %>%
  set_expt_colors(clinical_colors)

clinical_norm <- sm(normalize_expt(clinical_samples, norm = "quant", transform = "log2",
                                   convert = "cpm", batch = FALSE, filter = TRUE))
zymo_pca <- plot_pca(clinical_norm, plot_title = "PCA of parasite expression values",
                     plot_labels = FALSE)
pp(file = "images/zymo_pca_sus_shape.png", image = zymo_pca$plot)

zymo_3dpca <- plot_3d_pca(zymo_pca)
zymo_3dpca$plot

clinical_n <- sm(normalize_expt(clinical_samples, transform = "log2",
                                convert = "cpm", batch = FALSE, filter = TRUE))
zymo_tsne <- plot_tsne(clinical_n, plot_title = "TSNE of parasite expression values")
zymo_tsne$plot

clinical_nb <- normalize_expt(clinical_samples, convert = "cpm", transform = "log2",
                         filter = TRUE, batch = "svaseq")

## Removing 142 low-count genes (8568 remaining).

## batch_counts: Before batch/surrogate estimation, 989 entries are x==0: 0%.

## batch_counts: Before batch/surrogate estimation, 3326 entries are 0<x<1: 1%.

## Setting 335 low elements to zero.

## transform_counts: Found 335 values equal to 0, adding 1 to the matrix.

clinical_nb_pca <- plot_pca(clinical_nb, plot_title = "PCA of parasite expression values",
                            plot_labels = FALSE)
pp(file = "images/clinical_nb_pca_sus_shape.png", image = clinical_nb_pca$plot)

clinical_nb_tsne <- plot_tsne(clinical_nb, plot_title = "TSNE of parasite expression values")
clinical_nb_tsne$plot

## Warning in MASS::cov.trob(data[, vars]): Probable convergence failure

## Warning in MASS::cov.trob(data[, vars]): Probable convergence failure

## Warning: ggrepel: 70 unlabeled data points (too many overlaps). Consider
## increasing max.overlaps

corheat <- plot_corheat(clinical_norm, plot_title = "Correlation heatmap of parasite
                 expression values
")
corheat$plot

plot_sm(clinical_norm)$plot

## Performing correlation.

5.5 By Cure/Fail status

cf_colors <- list(
    "cure" = "#006f00",
    "fail" = "#9dffa0",
    "unknown" = "#cbcbcb",
    "notapplicable" = "#000000")
cf_expt <- set_expt_conditions(lp_expt, fact = "clinicalcategorical") %>%
  set_expt_batches(fact = sus_categorical) %>%
  set_expt_colors(cf_colors)

cf_norm <- normalize_expt(cf_expt, convert = "cpm", transform = "log2",
                          norm = "quant", filter = TRUE)

## Removing 142 low-count genes (8568 remaining).

## transform_counts: Found 2 values equal to 0, adding 1 to the matrix.

start_cf <- plot_pca(cf_norm, plot_title = "PCA of parasite expression values",
                     plot_labels = FALSE)
pp(file = "images/cf_sus_shape.png", image = start_cf$plot)

cf_nb <- normalize_expt(cf_expt, convert = "cpm", transform = "log2",
                        norm = "quant", filter = TRUE, batch = "svaseq")

## Warning in normalize_expt(cf_expt, convert = "cpm", transform = "log2", :
## Quantile normalization and sva do not always play well together.

## Removing 142 low-count genes (8568 remaining).

## batch_counts: Before batch/surrogate estimation, 2 entries are x==0: 0%.

## batch_counts: Before batch/surrogate estimation, 4074 entries are 0<x<1: 1%.

## Setting 181 low elements to zero.

## transform_counts: Found 181 values equal to 0, adding 1 to the matrix.

cf_nb_pca <- plot_pca(cf_nb, plot_title = "PCA of parasite expression values",
                      plot_labels = FALSE)
pp(file = "images/cf_sus_share_nb.png", image = cf_nb_pca$plot)

cf_norm <- normalize_expt(cf_expt, transform = "log2", convert = "cpm",
                          filter = TRUE, norm = "quant")

## Removing 142 low-count genes (8568 remaining).

## transform_counts: Found 2 values equal to 0, adding 1 to the matrix.

test <- pca_information(cf_norm,
                        expt_factors = c("clinicalcategorical", "zymodemecategorical",
                                         "pathogenstrain", "passagenumber"),
                        num_components = 6, plot_pcas = TRUE)
test$anova_p

##                           PC1       PC2    PC3       PC4     PC5       PC6
## clinicalcategorical 0.2746798 0.0762058 0.3880 2.535e-04 0.34372 8.192e-01
## zymodemecategorical 0.0004562 0.8405440 0.4855 1.353e-01 0.33859 5.403e-02
## pathogenstrain      0.7985483 0.9035654 0.7089 6.322e-06 0.01760 5.689e-01
## passagenumber       0.6040298 0.0001338 0.9479 1.223e-02 0.07891 8.438e-05

test$cor_heatmap

sus_colors <- list(
    "resistant" = "#8563a7",
    "sensitive" = "#8d0000",
    "ambiguous" = "#cbcbcb",
    "unknown" = "#000000")
sus_expt <- set_expt_conditions(lp_expt, fact = "sus_category") %>%
  set_expt_batches(fact = "zymodemecategorical") %>%
  set_expt_colors(colors = sus_colors)

sus_norm <- normalize_expt(sus_expt, transform = "log2", convert = "cpm",
                           norm = "quant", filter = TRUE)

## Removing 142 low-count genes (8568 remaining).

## transform_counts: Found 2 values equal to 0, adding 1 to the matrix.

sus_pca <- plot_pca(sus_norm, plot_title = "PCA of parasite expression values",
                    plot_labels = FALSE)
pp(file = "images/sus_norm_pca.png", image = sus_pca[["plot"]])

sus_nb <- normalize_expt(sus_expt, transform = "log2", convert = "cpm",
                         batch = "svaseq", filter = TRUE)

## Removing 142 low-count genes (8568 remaining).

## batch_counts: Before batch/surrogate estimation, 989 entries are x==0: 0%.

## batch_counts: Before batch/surrogate estimation, 3326 entries are 0<x<1: 1%.

## Setting 222 low elements to zero.

## transform_counts: Found 222 values equal to 0, adding 1 to the matrix.

sus_nb_pca <- plot_pca(sus_nb, plot_title = "PCA of parasite expression values",
                       plot_labels = FALSE)
pp(file = "images/sus_nb_pca.png", image = sus_nb_pca[["plot"]])

At this time, we do not have very many samples, so the set of metrics/plots is fairly limited. There is really only one factor in the metadata which we can use for performing differential expression analyses, the ‘zymodeme’.

6 Zymodeme analyses

The following sections perform a series of analyses which seek to elucidate differences between the zymodemes 2.2 and 2.3 either through differential expression or variant profiles.

6.1 Differential expression

6.1.1 With respect to zymodeme attribution

TODO: Do this with and without sva and compare the results.

zy_expt <- subset_expt(lp_expt, subset = "condition=='z2.2'|condition=='z2.3'")

## subset_expt(): There were 70, now there are 34 samples.

zy_norm <- normalize_expt(zy_expt, filter = TRUE, convert = "cpm", norm = "quant")

## Removing 166 low-count genes (8544 remaining).

zy_de_nobatch <- sm(all_pairwise(zy_expt, filter = TRUE, model_batch = "svaseq"))
zy_de <- sm(all_pairwise(zy_expt, filter = TRUE, model_batch = "svaseq"))
zy_table <- sm(combine_de_tables(zy_de, excel = glue::glue("excel/zy_tables-v{ver}.xlsx")))

## Error in write_combined_legend(wb, excel_basename, plot_dim, apr, limma, : object 'found_names' not found

zy_sig <- sm(extract_significant_genes(zy_table, excel = glue::glue("excel/zy_sig-v{ver}.xlsx")))

## Error in extract_significant_genes(zy_table, excel = glue::glue("excel/zy_sig-v{ver}.xlsx")): object 'zy_table' not found

6.1.2 Images of zymodeme DE

pp(file = "images/zymo_ma.png", image = zy_table[["plots"]][["z23_vs_z22"]][["deseq_ma_plots"]][["plot"]])

## Error in pp(file = "images/zymo_ma.png", image = zy_table[["plots"]][["z23_vs_z22"]][["deseq_ma_plots"]][["plot"]]): object 'zy_table' not found

6.2 With respect to cure/failure

In contrast, we can search for genes which are differentially expressed with respect to cure/failure status.

cf_de <- sm(all_pairwise(cf_expt, filter = TRUE, model_batch = "svaseq"))

cf_table <- sm(combine_de_tables(cf_de, excel = glue::glue("excel/cf_tables-v{ver}.xlsx")))

## Error in write_combined_legend(wb, excel_basename, plot_dim, apr, limma, : object 'found_names' not found

cf_sig <- sm(extract_significant_genes(cf_table, excel = glue::glue("excel/cf_sig-v{ver}.xlsx")))

## Error in extract_significant_genes(cf_table, excel = glue::glue("excel/cf_sig-v{ver}.xlsx")): object 'cf_table' not found

6.3 With respect to susceptibility

Finally, we can use our category of susceptibility and look for genes which change from sensitive to resistant. Keep in mind, though, that for the moment we have a lot of ambiguous and unknown strains.

sus_de <- sm(all_pairwise(sus_expt, filter = TRUE, model_batch = "svaseq"))

sus_table <- sm(combine_de_tables(sus_de, excel = glue::glue("excel/sus_tables-v{ver}.xlsx")))

## Error in write_combined_legend(wb, excel_basename, plot_dim, apr, limma, : object 'found_names' not found

sus_sig <- sm(extract_significant_genes(sus_table, excel = glue::glue("excel/sus_sig-v{ver}.xlsx")))

## Error in extract_significant_genes(sus_table, excel = glue::glue("excel/sus_sig-v{ver}.xlsx")): object 'sus_table' not found

knitr::kable(head(sus_sig$deseq$ups$sensitive_vs_resistant, n = 20))

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'head': object 'sus_sig' not found

knitr::kable(head(sus_sig$deseq$downs$sensitive_vs_resistant, n = 20))

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'head': object 'sus_sig' not found

sus_ma <- sus_table[["plots"]][["sensitive_vs_resistant"]][["deseq_ma_plots"]][["plot"]]

## Error in eval(expr, envir, enclos): object 'sus_table' not found

pp(file = "images/sus_ma.png", image = sus_ma)

## Error in pp(file = "images/sus_ma.png", image = sus_ma): object 'sus_ma' not found

## test <- ggplt(sus_ma)

6.4 Ontology searches

Now let us look for ontology categories which are increased in the 2.3 samples followed by the 2.2 samples.

## Gene categories more represented in the 2.3 group.
zy_go_up <- sm(simple_goseq(sig_genes = zy_sig[["deseq"]][["ups"]][[1]],
                            go_db = lp_go, length_db = lp_lengths))

## Error in simple_goseq(sig_genes = zy_sig[["deseq"]][["ups"]][[1]], go_db = lp_go, : object 'zy_sig' not found

## Gene categories more represented in the 2.2 group.
zy_go_down <- sm(simple_goseq(sig_genes = zy_sig[["deseq"]][["downs"]][[1]],
                              go_db = lp_go, length_db = lp_lengths))

## Error in simple_goseq(sig_genes = zy_sig[["deseq"]][["downs"]][[1]], go_db = lp_go, : object 'zy_sig' not found

6.4.1 A couple plots from the differential expression

6.4.1.1 Number of genes in agreement among DE methods, 2.3 more than 2.2

In the function ‘combined_de_tables()’ above, one of the tasks performed is to look at the agreement among DESeq2, limma, and edgeR. The following show a couple of these for the set of genes observed with a fold-change >= |2| and adjusted p-value <= 0.05.

zy_table[["venns"]][[1]][["p_lfc1"]][["up_noweight"]]

## Error in eval(expr, envir, enclos): object 'zy_table' not found

6.4.1.2 Number of genes in agreement among DE methods, 2.2 more than 2.3

zy_table[["venns"]][[1]][["p_lfc1"]][["down_noweight"]]

## Error in eval(expr, envir, enclos): object 'zy_table' not found

6.4.1.3 goseq ontology plots of groups of genes, 2.3 more than 2.2

zy_go_up$pvalue_plots$bpp_plot_over

## Error in eval(expr, envir, enclos): object 'zy_go_up' not found

6.4.1.4 goseq ontology plots of groups of genes, 2.2 more than 2.3

zy_go_down$pvalue_plots$bpp_plot_over

## Error in eval(expr, envir, enclos): object 'zy_go_down' not found

6.5 Look for agreement between sensitivity and zymodemes

Remind myself, the data structures are (zy|sus)_(de|table|sig).

zy_df <- zy_table[["data"]][["z23_vs_z22"]]

## Error in eval(expr, envir, enclos): object 'zy_table' not found

sus_df <- sus_table[["data"]][["sensitive_vs_resistant"]]

## Error in eval(expr, envir, enclos): object 'sus_table' not found

both_df <- merge(zy_df, sus_df, by = "row.names")

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'merge': object 'zy_df' not found

plot_df <- both_df[, c("deseq_logfc.x", "deseq_logfc.y")]

## Error in eval(expr, envir, enclos): object 'both_df' not found

rownames(plot_df) <- both_df[["Row.names"]]

## Error in eval(expr, envir, enclos): object 'both_df' not found

colnames(plot_df) <- c("z23_vs_z22", "sensitive_vs_resistant")

## Error in colnames(plot_df) <- c("z23_vs_z22", "sensitive_vs_resistant"): object 'plot_df' not found

compare <- plot_linear_scatter(plot_df)

## Error in data.frame(df[, c(1, 2)]): object 'plot_df' not found

pp(file = "images/compare_sus_zy.png", image = compare$scatter)

## Error in compare$scatter: object of type 'closure' is not subsettable

compare$cor

## Error in compare$cor: object of type 'closure' is not subsettable

6.6 Zymodeme enzyme gene IDs

Najib read me an email listing off the gene names associated with the zymodeme classification. I took those names and cross referenced them against the Leishmania panamensis gene annotations and found the following:

They are:

1. ALAT: LPAL13_120010900 – alanine aminotransferase
2. ASAT: LPAL13_340013000 – aspartate aminotransferase
3. G6PD: LPAL13_000054100 – glucase-6-phosphate 1-dehydrogenase
4. NH: LPAL13_14006100, LPAL13_180018500 – inosine-guanine nucleoside hydrolase
5. MPI: LPAL13_320022300 (maybe) – mannose phosphate isomerase (I chose phosphomannose isomerase)

Given these 6 gene IDs (NH has two gene IDs associated with it), I can do some looking for specific differences among the various samples.

6.6.1 Expression levels of zymodeme genes

The following creates a colorspace (red to green) heatmap showing the observed expression of these genes in every sample.

my_genes <- c("LPAL13_120010900", "LPAL13_340013000", "LPAL13_000054100",
              "LPAL13_140006100", "LPAL13_180018500", "LPAL13_320022300",
              "other")
my_names <- c("ALAT", "ASAT", "G6PD", "NHv1", "NHv2", "MPI", "other")

zymo_expt <- exclude_genes_expt(zy_norm, ids = my_genes, method = "keep")

## Before removal, there were 8544 genes, now there are 6.

## There are 34 samples which kept less than 90 percent counts.

## TMRC20001 TMRC20065 TMRC20005 TMRC20066 TMRC20039 TMRC20037 TMRC20038 TMRC20067 
##    0.1313    0.1250    0.1325    0.1059    0.1303    0.1102    0.1129    0.1165 
## TMRC20068 TMRC20041 TMRC20015 TMRC20009 TMRC20010 TMRC20016 TMRC20011 TMRC20012 
##    0.1155    0.1181    0.1147    0.1137    0.1098    0.1059    0.1103    0.1207 
## TMRC20013 TMRC20017 TMRC20014 TMRC20018 TMRC20021 TMRC20022 TMRC20077 TMRC20074 
##    0.1205    0.1064    0.1089    0.1147    0.1063    0.1310    0.1221    0.1209 
## TMRC20063 TMRC20053 TMRC20052 TMRC20064 TMRC20075 TMRC20051 TMRC20050 TMRC20049 
##    0.1169    0.1184    0.1105    0.1140    0.1111    0.1285    0.1155    0.1400 
## TMRC20062 TMRC20054 
##    0.1288    0.1279

zymo_heatmap <- plot_sample_heatmap(zymo_expt, row_label = my_names)
zymo_heatmap

6.7 Empirically observed Zymodeme genes from differential expression analysis

In contrast, the following plots take the set of genes which are shared among all differential expression methods (|lfc| >= 1.0 and adjp <= 0.05) and use them to make categories of genes which are increased in 2.3 or 2.2.

shared_zymo <- intersect_significant(zy_table)

## Deleting the file excel/intersect_significant.xlsx before writing the tables.

## Error in is.data.frame(x): object 'zy_table' not found

up_shared <- shared_zymo[["ups"]][[1]][["data"]][["all"]]

## Error in eval(expr, envir, enclos): object 'shared_zymo' not found

rownames(up_shared)

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'rownames': object 'up_shared' not found

upshared_expt <- exclude_genes_expt(zy_norm, ids = rownames(up_shared), method = "keep")

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'rownames': object 'up_shared' not found

We can plot a quick heatmap to get a sense of the differences observed between the genes which are different between the two zymodemes.

6.7.1 Heatmap of zymodeme gene expression increased in 2.3 vs. 2.2

high_23_heatmap <- plot_sample_heatmap(upshared_expt, row_label = rownames(up_shared))

## Error in plot_sample_heatmap(upshared_expt, row_label = rownames(up_shared)): object 'upshared_expt' not found

high_23_heatmap

## Error in eval(expr, envir, enclos): object 'high_23_heatmap' not found

6.7.2 Heatmap of zymodeme gene expression increased in 2.2 vs. 2.3

down_shared <- shared_zymo[["downs"]][[1]][["data"]][["all"]]

## Error in eval(expr, envir, enclos): object 'shared_zymo' not found

downshared_expt <- exclude_genes_expt(zy_norm, ids = rownames(down_shared), method = "keep")

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'rownames': object 'down_shared' not found

high_22_heatmap <- plot_sample_heatmap(downshared_expt, row_label = rownames(down_shared))

## Error in plot_sample_heatmap(downshared_expt, row_label = rownames(down_shared)): object 'downshared_expt' not found

high_22_heatmap

## Error in eval(expr, envir, enclos): object 'high_22_heatmap' not found

7 SNP profiles

Now I will combine our previous samples and our new samples in the hopes of finding variant positions which help elucidate currently unknown aspects of either group via their clustering to known samples from the other group. In other words, we do not know the zymodeme annotations for the old samples nor the strain identities (or the shortcut ‘chronic vs. self-healing’) for the new samples. I hope to make educated guesses given the variant profiles. There are some differences in how the previous and current data sets were analyzed (though I have since redone the old samples so it should be trivial to remove those differences now).

I added our 2016 data to a specific TMRC2 sample sheet, dated 20191203. Thus I will load the data here. That previous data was mapped using tophat, so I will also need to make some changes to the gene names to accomodate the two mappings.

old_expt <- sm(create_expt("sample_sheets/tmrc2_samples_20191203.xlsx",
                           file_column = "tophat2file"))

tt <- lp_expt[["expressionset"]]
rownames(tt) <- gsub(pattern = "^exon_", replacement = "", x = rownames(tt))
rownames(tt) <- gsub(pattern = "\\.E1$", replacement = "", x = rownames(tt))
lp_expt$expressionset <- tt

tt <- old_expt$expressionset
rownames(tt) <- gsub(pattern = "^exon_", replacement = "", x = rownames(tt))
rownames(tt) <- gsub(pattern = "\\.1$", replacement = "", x = rownames(tt))
old_expt$expressionset <- tt
rm(tt)

7.1 Create the SNP expressionset

One other important caveat, we have a group of new samples which have not yet run through the variant search pipeline, so I need to remove them from consideration. Though it looks like they finished overnight…

## The next line drops the samples which are missing the SNP pipeline.
lp_snp <- subset_expt(lp_expt, subset="!is.na(pData(lp_expt)[['bcftable']])")

## subset_expt(): There were 70, now there are 66 samples.

new_snps <- sm(count_expt_snps(lp_snp, annot_column = "bcftable"))
old_snps <- sm(count_expt_snps(old_expt, annot_column = "bcftable", snp_column = 2))

both_snps <- combine_expts(new_snps, old_snps)
both_norm <- sm(normalize_expt(both_snps, transform = "log2", convert = "cpm", filter = TRUE))

## strains <- both_norm[["design"]][["strain"]]
both_strain <- set_expt_conditions(both_norm, fact = "strain")

The data structure ‘both_norm’ now contains our 2016 data along with the newer data collected since 2019.

7.2 Plot of SNP profiles for zymodemes

The following plot shows the SNP profiles of all samples (old and new) where the colors at the top show either the 2.2 strains (orange), 2.3 strains (green), the previous samples (purple), or the various lab strains (pink etc).

old_new_variant_heatmap <- plot_disheat(both_norm)
pp(file = "images/raw_snp_disheat.png", image = old_new_variant_heatmap,
   height = 12, width = 12)

The function get_snp_sets() takes the provided metadata factor (in this case ‘condition’) and looks for variants which are exclusive to each element in it. In this case, this is looking for differences between 2.2 and 2.3, as well as the set shared among them.

snp_sets <- get_snp_sets(both_snps, factor = "condition")

## The factor z2.3 has 18 rows.

## The factor z2.2 has 13 rows.

## The factor unknown has 16 rows.

## The factor null has 19 rows.

## The factor sh has 13 rows.

## The factor chr has 14 rows.

## The factor inf has 6 rows.

## Iterating over 727 elements.

both_expt <- combine_expts(lp_expt, old_expt)

snp_genes <- sm(snps_vs_genes(both_expt, snp_sets, expt_name_col = "chromosome"))
## I think we have some metrics here we can plot...
snp_subset <- sm(snp_subset_genes(
  both_expt, both_snps,
  genes = c("LPAL13_120010900", "LPAL13_340013000", "LPAL13_000054100",
            "LPAL13_140006100", "LPAL13_180018500", "LPAL13_320022300")))
zymo_heat <- plot_sample_heatmap(snp_subset, row_label = rownames(exprs(snp_subset)))
zymo_heat

Didn’t I create a set of densities by chromosome? Oh I think they come in from get_snp_sets()

7.3 SNPS associated with clinical response in the TMRC samples

clinical_sets <- get_snp_sets(new_snps, factor = "clinicalresponse")

## The factor cure has 26 rows.

## The factor failure has 21 rows.

## The factor laboratory line has only 1 row.

## The factor laboratory line miltefosine resistant has only 1 row.

## The factor nd has 4 rows.

## The factor notapplicable has 9 rows.

## The factor reference strain has 4 rows.

## Iterating over 695 elements.

density_vec <- clinical_sets[["density"]]
chromosome_idx <- grep(pattern = "LpaL", x = names(density_vec))
density_df <- as.data.frame(density_vec[chromosome_idx])
density_df[["chr"]] <- rownames(density_df)
colnames(density_df) <- c("density_vec", "chr")
ggplot(density_df, aes_string(x = "chr", y = "density_vec")) +
  ggplot2::geom_col() +
  ggplot2::theme(axis.text = ggplot2::element_text(size = 10, colour = "black"),
                 axis.text.x = ggplot2::element_text(angle = 90, vjust = 0.5))

## clinical_written <- write_variants(new_snps)

7.3.1 Cross reference these variants by gene

clinical_genes <- sm(snps_vs_genes(lp_expt, clinical_sets, expt_name_col = "chromosome"))

snp_density <- merge(as.data.frame(clinical_genes[["summary_by_gene"]]),
                     as.data.frame(fData(lp_expt)),
                     by = "row.names")
snp_density <- snp_density[, c(1, 2, 4, 15)]
colnames(snp_density) <- c("name", "snps", "product", "length")
snp_density[["product"]] <- tolower(snp_density[["product"]])
snp_density[["length"]] <- as.numeric(snp_density[["length"]])
snp_density[["density"]] <- snp_density[["snps"]] / snp_density[["length"]]
snp_idx <- order(snp_density[["density"]], decreasing = TRUE)
snp_density <- snp_density[snp_idx, ]

removers <- c("amastin", "gp63", "leishmanolysin")
for (r in removers) {
  drop_idx <- grepl(pattern = r, x = snp_density[["product"]])
  snp_density <- snp_density[!drop_idx, ]
}
## Filter these for [A|a]mastin gp63 Leishmanolysin

clinical_snps <- snps_intersections(lp_expt, clinical_sets, chr_column = "chromosome")

fail_ref_snps <- as.data.frame(clinical_snps[["inters"]][["failure, reference strain"]])
cure_snps <- as.data.frame(clinical_snps[["inters"]][["cure"]])

head(fail_ref_snps)

##                                           seqnames  start    end width strand
## chr_LpaL13-13_pos_167047_ref_G_alt_C     LpaL13-13 167047 167048     2      +
## chr_LpaL13-15_pos_42885_ref_A_alt_G      LpaL13-15  42885  42886     2      +
## chr_LpaL13-20.1_pos_111781_ref_T_alt_C LpaL13-20.1 111781 111782     2      +
## chr_LpaL13-25_pos_147406_ref_G_alt_C     LpaL13-25 147406 147407     2      +
## chr_LpaL13-29_pos_649951_ref_T_alt_C     LpaL13-29 649951 649952     2      +
## chr_LpaL13-30_pos_597834_ref_T_alt_G     LpaL13-30 597834 597835     2      +

head(cure_snps)

##                                           seqnames  start    end width strand
## chr_LpaL13-08_pos_184791_ref_T_alt_A     LpaL13-08 184791 184792     2      +
## chr_LpaL13-20.1_pos_369935_ref_C_alt_T LpaL13-20.1 369935 369936     2      +
## chr_LpaL13-20.1_pos_370282_ref_C_alt_T LpaL13-20.1 370282 370283     2      +
## chr_LpaL13-20.1_pos_371356_ref_T_alt_C LpaL13-20.1 371356 371357     2      +
## chr_LpaL13-20.1_pos_380785_ref_A_alt_G LpaL13-20.1 380785 380786     2      +
## chr_LpaL13-20.1_pos_382801_ref_A_alt_C LpaL13-20.1 382801 382802     2      +

annot <- fData(lp_expt)
clinical_interest <- as.data.frame(clinical_snps[["gene_summaries"]][["cure"]])
clinical_interest <- merge(clinical_interest,
                           as.data.frame(clinical_snps[["gene_summaries"]][["failure, reference strain"]]),
                           by = "row.names")
rownames(clinical_interest) <- clinical_interest[["Row.names"]]
clinical_interest[["Row.names"]] <- NULL
colnames(clinical_interest) <- c("cure_snps","fail_snps")
annot <- merge(annot, clinical_interest, by = "row.names")
rownames(annot) <- annot[["Row.names"]]
annot[["Row.names"]] <- NULL
fData(lp_expt$expressionset) <- annot

8 Zymodeme for new samples

The heatmap produced here should show the variants only for the zymodeme genes.

8.1 Hunt for snp clusters

I am thinking that if we find clusters of locations which are variant, that might provide some PCR testing possibilities.

new_sets <- get_snp_sets(new_snps, factor = "phenotypiccharacteristics")

## The factor 22 has 13 rows.

## The factor 23 has 18 rows.

## The factor laboratory line has only 1 row.

## The factor laboratory line miltefosine resistant has only 1 row.

## The factor notapplicable has 29 rows.

## The factor reference strain has 4 rows.

## Iterating over 695 elements.

summary(new_sets)

##               Length Class      Mode     
## medians         7    data.frame list     
## possibilities   6    -none-     character
## intersections  58    -none-     list     
## chr_data      695    -none-     list     
## set_names      64    -none-     list     
## invert_names   64    -none-     list     
## density       695    -none-     numeric

## 1000000: 2.2
## 0100000: 2.3

summary(new_sets[["intersections"]][["10000"]])

## Length  Class   Mode 
##      0   NULL   NULL

summary(new_sets[["intersections"]][["01000"]])

## Length  Class   Mode 
##      0   NULL   NULL

Thus we see that there are 511 variants associated with 2.2 and 49,790 associated with 2.3.

8.1.1 A small function for searching for potential PCR primers

The following function uses the positional data to look for sequential mismatches associated with zymodeme in the hopes that there will be some regions which would provide good potential targets for a PCR-based assay.

sequential_variants <- function(snp_sets, conditions = NULL, minimum = 3, maximum_separation = 3) {
  if (is.null(conditions)) {
    conditions <- 1
  }
  intersection_sets <- snp_sets[["intersections"]]
  intersection_names <- snp_sets[["set_names"]]
  chosen_intersection <- 1
  if (is.numeric(conditions)) {
    chosen_intersection <- conditions
  } else {
    intersection_idx <- intersection_names == conditions
    chosen_intersection <- names(intersection_names)[intersection_idx]
  }

  possible_positions <- intersection_sets[[chosen_intersection]]
  position_table <- data.frame(row.names = possible_positions)
  pat <- "^chr_(.+)_pos_(.+)_ref_.*$"
  position_table[["chr"]] <- gsub(pattern = pat, replacement = "\\1", x = rownames(position_table))
  position_table[["pos"]] <- as.numeric(gsub(pattern = pat, replacement = "\\2", x = rownames(position_table)))
  position_idx <- order(position_table[, "chr"], position_table[, "pos"])
  position_table <- position_table[position_idx, ]
  position_table[["dist"]] <- 0

  last_chr <- ""
  for (r in 1:nrow(position_table)) {
    this_chr <- position_table[r, "chr"]
    if (r == 1) {
      position_table[r, "dist"] <- position_table[r, "pos"]
      last_chr <- this_chr
      next
    }
    if (this_chr == last_chr) {
      position_table[r, "dist"] <- position_table[r, "pos"] - position_table[r - 1, "pos"]
    } else {
      position_table[r, "dist"] <- position_table[r, "pos"]
    }
    last_chr <- this_chr
  }

  ## Working interactively here.
  
  doubles <- position_table[["dist"]] == 1
  doubles <- position_table[doubles, ]
  write.csv(doubles, "doubles.csv")

  one_away <- position_table[["dist"]] == 2
  one_away <- position_table[one_away, ]
  write.csv(one_away, "one_away.csv")

  two_away <- position_table[["dist"]] == 3
  two_away <- position_table[two_away, ]
  write.csv(two_away, "two_away.csv")

  combined <- rbind(doubles, one_away)
  combined <- rbind(combined, two_away)
  position_idx <- order(combined[, "chr"], combined[, "pos"])
  combined <- combined[position_idx, ]
  
  this_chr <- ""
  for (r in 1:nrow(combined)) {
    this_chr <- combined[r, "chr"]
    if (r == 1) {
      combined[r, "dist_pair"] <- combined[r, "pos"]
      last_chr <- this_chr
      next
    }
    if (this_chr == last_chr) {
      combined[r, "dist_pair"] <- combined[r, "pos"] - combined[r - 1, "pos"]
    } else {
      combined[r, "dist_pair"] <- combined[r, "pos"]
    }
    last_chr <- this_chr
  }

  dist_pair_maximum <- 1000
  dist_pair_minimum <- 200
  dist_pair_idx <- combined[["dist_pair"]] <= dist_pair_maximum &
    combined[["dist_pair"]] >= dist_pair_minimum
  remaining <- combined[dist_pair_idx, ]
  no_weak_idx <- grepl(pattern="ref_(G|C)", x=rownames(remaining))
  remaining <- remaining[no_weak_idx, ]
  
  print(head(table(position_table[["dist"]])))
  sequentials <- position_table[["dist"]] <= maximum_separation
  message("There are ", sum(sequentials), " candidate regions.")

  ## The following can tell me how many runs of each length occurred, that is not quite what I want.
  ## Now use run length encoding to find the set of sequential sequentials!
  rle_result <- rle(sequentials)
  rle_values <- rle_result[["values"]]
  ## The following line is equivalent to just leaving values alone:
  ## true_values <- rle_result[["values"]] == TRUE
  rle_lengths <- rle_result[["lengths"]]
  true_sequentials <- rle_lengths[rle_values]
  rle_idx <- cumsum(rle_lengths)[which(rle_values)]

  position_table[["last_sequential"]] <- 0
  count <- 0
  for (r in rle_idx) {
    count <- count + 1
    position_table[r, "last_sequential"] <- true_sequentials[count]
  }
  message("The maximum sequential set is: ", max(position_table[["last_sequential"]]), ".")

  wanted_idx <- position_table[["last_sequential"]] >= minimum
  wanted <- position_table[wanted_idx, c("chr", "pos")]
  return(wanted)
}

zymo22_sequentials <- sequential_variants(new_sets, conditions = "22", minimum=1, maximum_separation=2)
dim(zymo22_sequentials)
## 7 candidate regions for zymodeme 2.2 -- thus I am betting that the reference strain is a 2.2
zymo23_sequentials <- sequential_variants(new_sets, conditions = "23",
                                          minimum = 2, maximum_separation = 2)
dim(zymo23_sequentials)
## In contrast, there are lots (587) of interesting regions for 2.3!

8.1.2 Extract a promising region from the genome

The first 4 candidate regions from my set of remaining: * Chr Pos. Distance * LpaL13-15 238433 448 * LpaL13-18 142844 613 * LpaL13-29 830342 252 * LpaL13-33 1331507 843

Lets define a couple of terms: * Third: Each of the 4 above positions. * Second: Third - Distance * End: Third + PrimerLen * Start: Second - Primerlen

In each instance, these are the last positions, so we want to grab three things:

• The entire region from End -> Start, this way we can have a quick sanity check.
• Start -> Second.
• (Third -> End) <- Reverse complemented

## * LpaL13-15 238433 448
first_candidate_chr <- genome[["LpaL13_15"]]
primer_length <- 22
amplicon_length <- 448
first_candidate_third <- 238433
first_candidate_second <- first_candidate_third - amplicon_length
first_candidate_start <- first_candidate_second - primer_length
first_candidate_end <- first_candidate_third + primer_length
first_candidate_region <- subseq(first_candidate_chr, first_candidate_start, first_candidate_end)
first_candidate_region
first_candidate_5p <- subseq(first_candidate_chr, first_candidate_start, first_candidate_second)
as.character(first_candidate_5p)
first_candidate_3p <- spgs::reverseComplement(subseq(first_candidate_chr, first_candidate_third, first_candidate_end))
first_candidate_3p


## * LpaL13-18 142844 613
second_candidate_chr <- genome[["LpaL13_18"]]
primer_length <- 22
amplicon_length <- 613
second_candidate_third <- 142844
second_candidate_second <- second_candidate_third - amplicon_length
second_candidate_start <- second_candidate_second - primer_length
second_candidate_end <- second_candidate_third + primer_length
second_candidate_region <- subseq(second_candidate_chr, second_candidate_start, second_candidate_end)
second_candidate_region
second_candidate_5p <- subseq(second_candidate_chr, second_candidate_start, second_candidate_second)
as.character(second_candidate_5p)
second_candidate_3p <- spgs::reverseComplement(subseq(second_candidate_chr, second_candidate_third, second_candidate_end))
second_candidate_3p


## * LpaL13-29 830342 252
third_candidate_chr <- genome[["LpaL13_29"]]
primer_length <- 22
amplicon_length <- 252
third_candidate_third <- 830342
third_candidate_second <- third_candidate_third - amplicon_length
third_candidate_start <- third_candidate_second - primer_length
third_candidate_end <- third_candidate_third + primer_length
third_candidate_region <- subseq(third_candidate_chr, third_candidate_start, third_candidate_end)
third_candidate_region
third_candidate_5p <- subseq(third_candidate_chr, third_candidate_start, third_candidate_second)
as.character(third_candidate_5p)
third_candidate_3p <- spgs::reverseComplement(subseq(third_candidate_chr, third_candidate_third, third_candidate_end))
third_candidate_3p
## You are a garbage polypyrimidine tract.
## Which is actually interesting if the mutations mess it up.


## * LpaL13-33 1331507 843
fourth_candidate_chr <- genome[["LpaL13_33"]]
primer_length <- 22
amplicon_length <- 843
fourth_candidate_third <- 1331507
fourth_candidate_second <- fourth_candidate_third - amplicon_length
fourth_candidate_start <- fourth_candidate_second - primer_length
fourth_candidate_end <- fourth_candidate_third + primer_length
fourth_candidate_region <- subseq(fourth_candidate_chr, fourth_candidate_start, fourth_candidate_end)
fourth_candidate_region
fourth_candidate_5p <- subseq(fourth_candidate_chr, fourth_candidate_start, fourth_candidate_second)
as.character(fourth_candidate_5p)
fourth_candidate_3p <- spgs::reverseComplement(subseq(fourth_candidate_chr, fourth_candidate_third, fourth_candidate_end))
fourth_candidate_3p

8.2 Go hunting for Sanger sequencing regions

I made a fun little function which should find regions which have lots of variants associated with a given experimental factor.

pheno <- subset_expt(lp_expt, subset = "condition=='z2.2'|condition=='z2.3'")
pheno <- subset_expt(pheno, subset = "!is.na(pData(pheno)[['bcftable']])")
pheno_snps <- sm(count_expt_snps(pheno, annot_column = "bcftable"))

fun_stuff <- snp_density_primers(pheno_snps,
                                 bsgenome="BSGenome.Leishmania.panamensis.MHOMCOL81L13.v53",
                                 gff="reference/TriTrypDB-53_LpanamensisMHOMCOL81L13.gff")
drop_scaffolds <- grepl(x = rownames(fun_stuff$favorites), pattern = "SCAF")
favorite_primer_regions <- fun_stuff[["favorites"]][!drop_scaffolds, ]
favorite_primer_regions[["bin"]] <- rownames(favorite_primer_regions)
library(dplyr)
favorite_primer_regions <- favorite_primer_regions %>%
  relocate(bin)

8.3 Combine this table with 2.2/2.3 genes

Here is my note from our meeting:

Cross reference primers to DE genes of 2.2/2.3 and/or resistance/suscpetible, add a column to the primer spreadsheet with the DE genes (in retrospect I am guessing this actually means to put the logFC as a column.

One nice thing, I did a semantic removal on the lp_expt, so the set of logFC/pvalues should not have any of the offending types; thus I should be able to automagically get rid of them in the merge.

logfc <- zy_table[["data"]][["z23_vs_z22"]]
logfc_columns <- logfc[, c("deseq_logfc", "deseq_adjp")]
colnames(logfc_columns) <- c("z23_logfc", "z23_adjp")
new_table <- merge(favorite_primer_regions, logfc_columns,
                   by.x = "closest_gene_before_id", by.y = "row.names")
sus <- sus_table[["data"]][["sensitive_vs_resistant"]]
sus_columns <- sus[, c("deseq_logfc", "deseq_adjp")]
colnames(sus_columns) <- c("sus_logfc", "sus_adjp")
new_table <- merge(new_table, sus_columns,
                   by.x = "closest_gene_before_id", by.y = "row.names") %>%
  relocate(bin)
written <- write_xlsx(data=new_table,
                      excel="excel/favorite_primers_xref_zy_sus.

## Error: <text>:13:29: unexpected INCOMPLETE_STRING
## 12: written <- write_xlsx(data=new_table,
## 13:                       excel="excel/favorite_primers_xref_zy_sus.
##                                 ^

8.4 Make a heatmap describing the clustering of variants

We can cross reference the variants against the zymodeme status and plot a heatmap of the results and hopefully see how they separate.

snp_genes <- sm(snps_vs_genes(lp_expt, new_sets, expt_name_col = "chromosome"))
new_zymo_norm <- normalize_expt(new_snps, filter = TRUE, convert = "cpm", norm = "quant", transform = TRUE)

## Removing 0 low-count genes (568413 remaining).

## transform_counts: Found 18767635 values equal to 0, adding 1 to the matrix.

new_zymo_norm <- set_expt_conditions(new_zymo_norm, fact = "phenotypiccharacteristics")

zymo_heat <- plot_disheat(new_zymo_norm)
zymo_heat[["plot"]]

8.4.1 Annotated heatmap of variants

Now let us try to make a heatmap which includes some of the annotation data.

des <- both_norm[["design"]]
undef_idx <- is.na(des[["strain"]])
des[undef_idx, "strain"] <- "unknown"

##hmcols <- colorRampPalette(c("yellow","black","darkblue"))(256)
correlations <- hpgl_cor(exprs(both_norm))

zymo_missing_idx <- is.na(des[["phenotypiccharacteristics"]])
des[["phenotypiccharacteristics"]] <- as.character(des[["phenotypiccharacteristics"]])
des[["clinicalcategorical"]] <- as.character(des[["clinicalcategorical"]])
des[zymo_missing_idx, "phenotypiccharacteristics"] <- "unknown"
mydendro <- list(
  "clustfun" = hclust,
  "lwd" = 2.0)
col_data <- as.data.frame(des[, c("phenotypiccharacteristics", "clinicalcategorical")])

unknown_clinical <- is.na(col_data[["clinicalcategorical"]])
row_data <- as.data.frame(des[, c("strain")])
colnames(col_data) <- c("zymodeme", "outcome")
col_data[unknown_clinical, "outcome"] <- "undefined"

colnames(row_data) <- c("strain")
myannot <- list(
  "Col" = list("data" = col_data),
  "Row" = list("data" = row_data))
myclust <- list("cuth" = 1.0,
                "col" = BrewerClusterCol)
mylabs <- list(
  "Row" = list("nrow" = 4),
  "Col" = list("nrow" = 4))
hmcols <- colorRampPalette(c("darkblue", "beige"))(240)
map1 <- annHeatmap2(
  correlations,
  dendrogram = mydendro,
  annotation = myannot,
  cluster = myclust,
  labels = mylabs,
  ## The following controls if the picture is symmetric
  scale = "none",
  col = hmcols)

## Warning in breakColors(breaks, col): more colors than classes: ignoring 29 last
## colors

pp(file = "images/dendro_heatmap.png", image = map1, height = 20, width = 20)

## annotated Heatmap
## 
## Rows: 'dendrogram' with 2 branches and 99 members total, at height 6.095 
##   11  annotation variable(s)
## Cols: 'dendrogram' with 2 branches and 99 members total, at height 6.095 
##   12  annotation variable(s)

Print the larger heatmap so that all the labels appear. Keep in mind that as we get more samples, this image needs to continue getting bigger.

big heatmap

xref_prop <- table(pheno_snps[["conditions"]])

## Error in eval(quote(list(...)), env): object 'pheno_snps' not found

pheno_snps$conditions

## Error in eval(expr, envir, enclos): object 'pheno_snps' not found

idx_tbl <- exprs(pheno_snps) > 5

## Error in h(simpleError(msg, call)): error in evaluating the argument 'object' in selecting a method for function 'exprs': object 'pheno_snps' not found

new_tbl <- data.frame(row.names = rownames(exprs(pheno_snps)))

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'rownames': error in evaluating the argument 'object' in selecting a method for function 'exprs': object 'pheno_snps' not found

for (n in names(xref_prop)) {
  new_tbl[[n]] <- 0
  idx_cols <- which(pheno_snps[["conditions"]] == n)
  prop_col <- rowSums(idx_tbl[, idx_cols]) / xref_prop[n]
  new_tbl[n] <- prop_col
}

## Error in eval(expr, envir, enclos): object 'xref_prop' not found

keepers <- grepl(x = rownames(new_tbl), pattern = "LpaL13")

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'grepl': error in evaluating the argument 'x' in selecting a method for function 'rownames': object 'new_tbl' not found

new_tbl <- new_tbl[keepers, ]

## Error in eval(expr, envir, enclos): object 'new_tbl' not found

new_tbl[["strong22"]] <- 1.001 - new_tbl[["z2.2"]]

## Error in eval(expr, envir, enclos): object 'new_tbl' not found

new_tbl[["strong23"]] <- 1.001 - new_tbl[["z2.3"]]

## Error in eval(expr, envir, enclos): object 'new_tbl' not found

s22_na <- new_tbl[["strong22"]] > 1

## Error in eval(expr, envir, enclos): object 'new_tbl' not found

new_tbl[s22_na, "strong22"] <- 1

## Error in new_tbl[s22_na, "strong22"] <- 1: object 'new_tbl' not found

s23_na <- new_tbl[["strong23"]] > 1

## Error in eval(expr, envir, enclos): object 'new_tbl' not found

new_tbl[s23_na, "strong23"] <- 1

## Error in new_tbl[s23_na, "strong23"] <- 1: object 'new_tbl' not found

new_tbl[["SNP"]] <- rownames(new_tbl)

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'rownames': object 'new_tbl' not found

new_tbl[["Chromosome"]] <- gsub(x = new_tbl[["SNP"]], pattern = "chr_(.*)_pos_.*", replacement = "\\1")

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'gsub': object 'new_tbl' not found

new_tbl[["Position"]] <- gsub(x = new_tbl[["SNP"]], pattern = ".*_pos_(\\d+)_.*", replacement = "\\1")

## Error in h(simpleError(msg, call)): error in evaluating the argument 'x' in selecting a method for function 'gsub': object 'new_tbl' not found

new_tbl <- new_tbl[, c("SNP", "Chromosome", "Position", "strong22", "strong23")]

## Error in eval(expr, envir, enclos): object 'new_tbl' not found

library(CMplot)

## Much appreciate for using CMplot.

## Full description, Bug report, Suggestion and the latest codes:

## https://github.com/YinLiLin/CMplot

simplify <- new_tbl

## Error in eval(expr, envir, enclos): object 'new_tbl' not found

simplify[["strong22"]] <- NULL

## Error in simplify[["strong22"]] <- NULL: object 'simplify' not found

CMplot(simplify, bin.size = 100000)

## Error in is.data.frame(x): object 'simplify' not found

CMplot(new_tbl, plot.type="m", multracks=TRUE, threshold = c(0.01, 0.05),
       threshold.lwd=c(1,1), threshold.col=c("black","grey"),
       amplify=TRUE, bin.size=10000,
       chr.den.col=c("darkgreen", "yellow", "red"),
       signal.col=c("red", "green", "blue"),
       signal.cex=1, file="jpg", memo="", dpi=300, file.output=TRUE, verbose=TRUE)

## Error in is.data.frame(x): object 'new_tbl' not found

8.5 Try out MatrixEQTL

This tool looks a little opaque, but provides sample data with things that make sense to me and should be pretty easy to recapitulate in our data.

1. covariates.txt: Columns are samples, rows are things from pData – the most likely ones of interest for our data would be zymodeme, sensitivity
2. geneloc.txt: columns are ‘geneid’, ‘chr’, ‘left’, ‘right’. I guess I can assume left and right are start/stop; in which case this is trivially acquirable from fData.
3. ge.txt: This appears to be a log(rpkm/cpm) table with rows as genes and columns as samples
4. snpsloc.txt: columns are ‘snpid’, ‘chr’, ‘pos’
5. snps.txt: columns are samples, rows are the ids from snsploc, values a 0,1,2. I assume 0 is identical and 1..12 are the various A->TGC T->AGC C->AGT G->ACT

## For this, let us use the 'new_snps' data structure.
## Caveat here: these need to be coerced to numbers.
my_covariates <- pData(new_snps)[, c("phenotypiccharacteristics", "clinicalcategorical")]
for (col in colnames(my_covariates)) {
  my_covariates[[col]] <- as.numeric(as.factor(my_covariates[[col]]))
}
my_covariates <- t(my_covariates)

my_geneloc <- fData(lp_expt)[, c("gid", "chromosome", "start", "end")]
colnames(my_geneloc) <- c("geneid", "chr", "left", "right")

my_ge <- exprs(normalize_expt(lp_expt, transform = "log2", filter = TRUE, convert = "cpm"))
used_samples <- tolower(colnames(my_ge)) %in% colnames(exprs(new_snps))
my_ge <- my_ge[, used_samples]

my_snpsloc <- data.frame(rownames = rownames(exprs(new_snps)))
## Oh, caveat here: Because of the way I stored the data,
## I could have duplicate rows which presumably will make matrixEQTL sad
my_snpsloc[["chr"]] <- gsub(pattern = "^chr_(.+)_pos(.+)_ref_.*$", replacement = "\\1",
                            x = rownames(my_snpsloc))
my_snpsloc[["pos"]] <- gsub(pattern = "^chr_(.+)_pos(.+)_ref_.*$", replacement = "\\2",
                            x = rownames(my_snpsloc))
test <- duplicated(my_snpsloc)
## Each duplicated row would be another variant at that position;
## so in theory we would do a rle to number them I am guessing
## However, I do not have different variants so I think I can ignore this for the moment
## but will need to make my matrix either 0 or 1.
if (sum(test) > 0) {
  message("There are: ", sum(duplicated), " duplicated entries.")
  keep_idx <- ! test
  my_snpsloc <- my_snpsloc[keep_idx, ]
}

my_snps <- exprs(new_snps)
one_idx <- my_snps > 0
my_snps[one_idx] <- 1

## Ok, at this point I think I have all the pieces which this method wants...
## Oh, no I guess not; it actually wants the data as a set of filenames...
library(MatrixEQTL)
write.table(my_snps, "eqtl/snps.tsv", na = "NA", col.names = TRUE, row.names = TRUE, sep = "\t", quote = TRUE)
## readr::write_tsv(my_snps, "eqtl/snps.tsv", )
write.table(my_snpsloc, "eqtl/snpsloc.tsv", na = "NA", col.names = TRUE, row.names = TRUE, sep = "\t", quote = TRUE)
## readr::write_tsv(my_snpsloc, "eqtl/snpsloc.tsv")
write.table(as.data.frame(my_ge), "eqtl/ge.tsv", na = "NA", col.names = TRUE, row.names = TRUE, sep = "\t", quote = TRUE)
## readr::write_tsv(as.data.frame(my_ge), "eqtl/ge.tsv")
write.table(as.data.frame(my_geneloc), "eqtl/geneloc.tsv", na = "NA", col.names = TRUE, row.names = TRUE, sep = "\t", quote = TRUE)
## readr::write_tsv(as.data.frame(my_geneloc), "eqtl/geneloc.tsv")
write.table(as.data.frame(my_covariates), "eqtl/covariates.tsv", na = "NA", col.names = TRUE, row.names = TRUE, sep = "\t", quote = TRUE)
## readr::write_tsv(as.data.frame(my_covariates), "eqtl/covariates.tsv")

useModel = modelLINEAR # modelANOVA, modelLINEAR, or modelLINEAR_CROSS

# Genotype file name
SNP_file_name = "eqtl/snps.tsv"
snps_location_file_name = "eqtl/snpsloc.tsv"
expression_file_name = "eqtl/ge.tsv"
gene_location_file_name = "eqtl/geneloc.tsv"
covariates_file_name = "eqtl/covariates.tsv"
# Output file name
output_file_name_cis = tempfile()
output_file_name_tra = tempfile()
# Only associations significant at this level will be saved
pvOutputThreshold_cis = 0.1
pvOutputThreshold_tra = 0.1
# Error covariance matrix
# Set to numeric() for identity.
errorCovariance = numeric()
# errorCovariance = read.table("Sample_Data/errorCovariance.txt");
# Distance for local gene-SNP pairs
cisDist = 1e6
## Load genotype data
snps = SlicedData$new()
snps$fileDelimiter = "\t"      # the TAB character
snps$fileOmitCharacters = "NA" # denote missing values;
snps$fileSkipRows = 1          # one row of column labels
snps$fileSkipColumns = 1       # one column of row labels
snps$fileSliceSize = 2000      # read file in slices of 2,000 rows
snps$LoadFile(SNP_file_name)
## Load gene expression data
gene = SlicedData$new()
gene$fileDelimiter = "\t"      # the TAB character
gene$fileOmitCharacters = "NA" # denote missing values;
gene$fileSkipRows = 1          # one row of column labels
gene$fileSkipColumns = 1       # one column of row labels
gene$fileSliceSize = 2000      # read file in slices of 2,000 rows
gene$LoadFile(expression_file_name)
## Load covariates
cvrt = SlicedData$new()
cvrt$fileDelimiter = "\t"      # the TAB character
cvrt$fileOmitCharacters = "NA" # denote missing values;
cvrt$fileSkipRows = 1          # one row of column labels
cvrt$fileSkipColumns = 1       # one column of row labels
if(length(covariates_file_name) > 0) {
  cvrt$LoadFile(covariates_file_name)
}
## Run the analysis
snpspos = read.table(snps_location_file_name, header = TRUE, stringsAsFactors = FALSE)
genepos = read.table(gene_location_file_name, header = TRUE, stringsAsFactors = FALSE)

me = Matrix_eQTL_main(
    snps = snps,
    gene = gene,
    cvrt = cvrt,
    output_file_name = output_file_name_tra,
    pvOutputThreshold = pvOutputThreshold_tra,
    useModel = useModel,
    errorCovariance = errorCovariance,
    verbose = TRUE,
    output_file_name.cis = output_file_name_cis,
    pvOutputThreshold.cis = pvOutputThreshold_cis,
    snpspos = snpspos,
    genepos = genepos,
    cisDist = cisDist,
    pvalue.hist = "qqplot",
    min.pv.by.genesnp = FALSE,
    noFDRsaveMemory = FALSE);

if (!isTRUE(get0("skip_load"))) {
  pander::pander(sessionInfo())
  message(paste0("This is hpgltools commit: ", get_git_commit()))
  message(paste0("Saving to ", savefile))
  tmp <- sm(saveme(filename = savefile))
}

## If you wish to reproduce this exact build of hpgltools, invoke the following:

## > git clone http://github.com/abelew/hpgltools.git

## > git reset 3126ec4ed453b24c357acd29c97436ef8d784005

## This is hpgltools commit: Thu Oct 7 19:29:41 2021 -0400: 3126ec4ed453b24c357acd29c97436ef8d784005

## Saving to tmrc2_02sample_estimation_v202108.rda.xz

tmp <- loadme(filename = savefile)