From f335502144cef1233532c5ad6292d48a44355637 Mon Sep 17 00:00:00 2001
From: CooberHoo <84345288+CooberHoo@users.noreply.github.com>
Date: Sat, 14 Aug 2021 23:51:41 -0400
Subject: [PATCH 01/20] App now displays extended mouse atlas data
Added extended mouse atlas dataset + quality of life changes for various plots
Note: Time-series tab currently non-functional as did not have access to binarized AUC matrix for extended dataset
Note: dendrogram tab still under construction
---
GRN/.gitignore | 10 +
GRN/data/data.json | 562 ++++++++++++++++++++++++++++++++++++++++++-
GRN/data/data_prep.R | 117 +++++++--
GRN/functions.R | 466 ++++++++++++-----------------------
GRN/global.R | 29 ++-
GRN/server.R | 228 +++++++++++++++---
GRN/ui.R | 56 ++++-
7 files changed, 1103 insertions(+), 365 deletions(-)
diff --git a/GRN/.gitignore b/GRN/.gitignore
index d4b7ad3..a2e915d 100644
--- a/GRN/.gitignore
+++ b/GRN/.gitignore
@@ -10,15 +10,25 @@ explore
data/shared
data/joint_cortex
data/joint_pons
+data/joint_cortex_extended
+data/joint_pons_extended
shiny_bookmarks
+data/ct_e10
data/ct_e12
data/ct_e12_not_needed
+data/ct_e13
data/ct_e15
+data/ct_e16
+data/ct_e18
data/ct_p0
data/ct_p3
data/ct_p6
+data/po_e10
data/po_e12
+data/po_e13
data/po_e15
+data/po_e16
+data/po_e18
data/po_p0
data/po_p3
data/po_p6
diff --git a/GRN/data/data.json b/GRN/data/data.json
index 7b5efc1..5d888df 100644
--- a/GRN/data/data.json
+++ b/GRN/data/data.json
@@ -7,6 +7,20 @@
"description": "The whole metadata with important columns as Cluster (matching all the data),Cell_type (the full name of the cell type),Age (the time point of the sample),Colour (a hex value to use as a colour for that cluster)",
"contents": "Dataframe with cluster metadata."
+ },
+ {
+ "file": "metadata_20210710_with_qc.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/metadata_extended/metadata_20210710_with_qc.tsv",
+ "description": "For extended mouse brain atlas (joint cortex and pons analysis uses these cluster labels as the latest labelling): the whole metadata with important columns as Cluster (matching all the data),Cell_type (the full name of the cell type),Age (the time point of the sample),Colour (a hex value to use as a colour for that cluster)",
+ "contents": "Dataframe with cluster metadata (extended mouse brain atlas)."
+
+ },
+ {
+ "file": "metadata_20201028_with_qc.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/metadata_extended/metadata_20201028_with_qc.tsv",
+ "description": "For extended mouse brain atlas (per sample analysis uses these cluster labels as the latest labelling): the whole metadata with important columns as Cluster (matching all the data),Cell_type (the full name of the cell type),Age (the time point of the sample),Colour (a hex value to use as a colour for that cluster)",
+ "contents": "Dataframe with cluster metadata (extended mouse brain atlas)."
+
},
{
"file": "Mus_musculus_TF_one_TF_per_line.txt",
@@ -14,6 +28,13 @@
"description": "TF input into the SCENIC pipeline. Actives TFs in each dataset represents a subset of this.",
"contents": "Text file with each TF on one line"
+ },
+ {
+ "file": "palette_ID_20210710_joint_clustering.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_mouse_extended/palette_ID_20210710_joint_clustering.Rds",
+ "description": "Colour palette for the joint clusters in the extended mouse dataset. Values are colour hex codes and names are the cluster labels.",
+ "contents": "Named vector"
+
},
{
"file": "common_prep.Rda",
@@ -21,6 +42,12 @@
"contents": "R object containing colour palettes, and heatmap annotations",
"script": "data_prep.R"
+ },
+ {
+ "file": "timeseries_proportion_plots.Rda",
+ "description": "Ribbon plot of the proportion of each cluster across developmental time, for forebrain and pons.",
+ "contents": "List of ggplot objects ",
+ "script": "data_prep.R"
}
],
@@ -100,6 +127,140 @@
}
],
+"joint_cortex_extended": [
+ {
+ "file": "cortex_extended_prep.Rda",
+ "description": "Rda file containing datasets generated in data_prep.R, to be loaded at the beginning of app.R to optimize run-time speed and efficiency. ",
+ "contents": "Several R objects generated in the script for visualising the joint cortex extended dataset in the app",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "joint_cortex_extended.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_cortex_extended/joint_cortex_extended.metadata.tsv",
+ "description": "Cell-level information for extended forebrain dataset, including corresponding clusters and UMAP/tSNE/PCA coordinates, used to plot scatterplots",
+ "contents": "Data frame with columns, 'Cell' 'Sample' 'Sample_cluster', followed by columns for embedding coordinates."
+
+ },
+ {
+
+ "file": "joint_cortex_extended.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_cortex_extended/joint_cortex_extended.regulon_target_info.Rds",
+ "description": "Rds file containing data specific for the first tab, where the table is generated from this data file and used for plotting the cytoscape network to see correlations of different tfs with different/same genes related, note that the tf contai",
+ "contents": "Rds data specific each transcription factor and its corresponding genes and activity data, weight, highconfAnnotation data, motifs."
+
+ },
+ {
+
+ "file": "joint_cortex_extended.regulon_activity_per_cluster.joint_extended.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_cortex_extended/joint_cortex_extended.regulon_activity_per_cluster.joint_extended.feather",
+ "description": "A feather file of tf activity with respect to each cluster in the joint space",
+ "contents": "A dataframe, the first column is cluster, subsequent columns correspond to active TF (TF_active) the values describe the NES(activity score of TF in each cluster),"
+
+ },
+ {
+
+ "file": "joint_cortex_extended.regulon_activity_per_cluster.per_sample.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_cortex_extended/joint_cortex_extended.regulon_activity_per_cluster.per_sample.feather",
+ "description": "A feather file of tf activity with respect to each cluster in the per sample space ",
+ "contents": "A dataframe, the first column is cluster, subsequent columns correspond to active TF (TF_active) the values describe the NES(activity score of TF in each cluster),"
+
+ },
+ {
+
+ "file": "joint_cortex_extended.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_cortex_extended/joint_cortex_extended.regulon_activity_per_cell.feather",
+ "description": "A feather file of tf activity with respect to each cell that is used for reading by a certain column to optimize speed, used for plotting tab2(clustering and heatmap) ",
+ "contents": "A dataframe, the first column is cluster, subsequent columns correspond to active TF (TF_active) the values describe the NES(activity score of TF in each cluster),"
+
+ },
+ {
+ "file": "joint_cortex_extended.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_cortex_extended/joint_cortex_extended.active_regulons.Rds",
+ "description": "Rds file that is read as tibble containing all tf names with suffix(extended and weight) in the dataset of the second/third tab, note that the tfs are not the same as the first tab data. This vector contains fewer tf than the data in the first tab",
+ "contents": "A character vector(read as tibble later) containing all tf names with suffix(extended and weight) in the dataset of the second/third tab."
+
+ },
+ {
+ "file": "joint_cortex_extended.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/joint_cortex_extended.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ },
+ {
+ "file": "dendrogram_order_joint_extended_forebrain.Rds",
+ "path": "howard.li/from_hydra/dendrograms/output/dendrogram_figures/dendrogram_order_joint_extended_forebrain.Rds",
+ "description": "vector of all clusters in the joint cortex extended dataset ordered in the order of the extended joint cortex dendrogram",
+ "contents": "A character vector of clusters"
+ }
+ ],
+"joint_pons_extended": [
+ {
+ "file": "pons_extended_prep.Rda",
+ "description": "Rda file containing datasets generated in data_prep.R, to be loaded at the beginning of app.R to optimize run-time speed and efficiency. ",
+ "contents": "Several R objects generated in the script for visualising the joint pons extended dataset in the app",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "joint_pons_extended.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_pons_extended/joint_pons_extended.metadata.tsv",
+ "description": "Cell-level information for extended pons dataset, including corresponding clusters and UMAP/tSNE/PCA coordinates, used to plot scatterplots",
+ "contents": "Data frame with columns, 'Cell' 'Sample' 'Sample_cluster', followed by columns for embedding coordinates."
+
+ },
+ {
+
+ "file": "joint_pons_extended.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_pons_extended/joint_pons_extended.regulon_target_info.Rds",
+ "description": "Rds file containing data specific for the first tab, where the table is generated from this data file and used for plotting the cytoscape network to see correlations of different tfs with different/same genes related, note that the tf contai",
+ "contents": "Rds data specific each transcription factor and its corresponding genes and activity data, weight, highconfAnnotation data, motifs."
+
+ },
+ {
+
+ "file": "joint_pons_extended.regulon_activity_per_cluster.joint_extended.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_pons_extended/joint_pons_extended.regulon_activity_per_cluster.joint_extended.feather",
+ "description": "A feather file of tf activity with respect to each cluster in the joint space",
+ "contents": "A dataframe, the first column is cluster, subsequent columns correspond to active TF (TF_active) the values describe the NES(activity score of TF in each cluster),"
+
+ },
+ {
+
+ "file": "joint_pons_extended.regulon_activity_per_cluster.per_sample.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_pons_extended/joint_pons_extended.regulon_activity_per_cluster.per_sample.feather",
+ "description": "A feather file of tf activity with respect to each cluster in the per sample space ",
+ "contents": "A dataframe, the first column is cluster, subsequent columns correspond to active TF (TF_active) the values describe the NES(activity score of TF in each cluster),"
+
+ },
+ {
+
+ "file": "joint_pons_extended.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_pons_extended/joint_pons_extended.regulon_activity_per_cell.feather",
+ "description": "A feather file of tf activity with respect to each cell that is used for reading by a certain column to optimize speed, used for plotting tab2(clustering and heatmap) ",
+ "contents": "A dataframe, the first column is cluster, subsequent columns correspond to active TF (TF_active) the values describe the NES(activity score of TF in each cluster),"
+
+ },
+ {
+ "file": "joint_pons_extended.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/joint_pons_extended/joint_pons_extended.active_regulons.Rds",
+ "description": "Rds file that is read as tibble containing all tf names with suffix(extended and weight) in the dataset of the second/third tab, note that the tfs are not the same as the first tab data. This vector contains fewer tf than the data in the first tab",
+ "contents": "A character vector(read as tibble later) containing all tf names with suffix(extended and weight) in the dataset of the second/third tab."
+
+ },
+ {
+ "file": "joint_pons_extended.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/joint_pons_extended.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ },
+ {
+ "file": "dendrogram_order_joint_extended_pons.Rds",
+ "path": "howard.li/from_hydra/dendrograms/output/dendrogram_figures/dendrogram_order_joint_extended_pons.Rds",
+ "description": "vector of all clusters in the joint cortex extended dataset ordered in the order of the extended joint cortex dendrogram",
+ "contents": "A character vector of clusters"
+ }
+ ],
"joint_pons": [
{
@@ -177,7 +338,56 @@
}
],
-
+"ct_e10": [
+ {
+ "file": "ct_e10.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e10/ct_e10.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "ct_e10.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e10/ct_e10.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "ct_e10.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e10/ct_e10.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "ct_e10.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e10/ct_e10.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e10.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e10/ct_e10.regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e10_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "ct_e10.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/ct_e10.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
"ct_e12": [
{
"file": "ct_e12.metadata.tsv",
@@ -228,6 +438,56 @@
"contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
}
],
+"ct_e13": [
+ {
+ "file": "ct_e13.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e13/ct_e13.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "ct_e13.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e13/ct_e13.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "ct_e13.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e13/ct_e13.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "ct_e13.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e13/ct_e13.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e13.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e13/ct_e13.regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e13_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "ct_e13.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/ct_e13.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
"ct_e15": [
{
"file": "ct_e15.metadata.tsv",
@@ -278,6 +538,106 @@
"contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
}
],
+"ct_e16": [
+ {
+ "file": "ct_e16.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e16/ct_e16.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "ct_e16.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e16/ct_e16.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "ct_e16.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e16/ct_e16.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "ct_e16.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e16/ct_e16.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e16.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e16/ct_e16.regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e16_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "ct_e16.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/ct_e16.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
+"ct_e18": [
+ {
+ "file": "ct_e18.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e18/ct_e18.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "ct_e18.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e18/ct_e18.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "ct_e18.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e18/ct_e18.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "ct_e18.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e18/ct_e18.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e18.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/ct_e18/ct_e18.regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "ct_e18_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "ct_e18.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/ct_e18.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
"ct_p0": [
{
"file": "ct_p0.metadata.tsv",
@@ -428,6 +788,56 @@
"contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
}
],
+"po_e10": [
+ {
+ "file": "po_e10.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e10/po_e10.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "po_e10.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e10/po_e10.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "po_e10.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e10/po_e10.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "po_e10.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e10/po_e10.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e10.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e10/po_e10.regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e10_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "po_e10.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/po_e10.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
"po_e12": [
{
"file": "po_e12.metadata.tsv",
@@ -478,6 +888,56 @@
"contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
}
],
+"po_e13": [
+ {
+ "file": "po_e13.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e13/po_e13.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "po_e13.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e13/po_e13.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "po_e13.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e13/po_e13.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "po_e13.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e13/po_e13.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e13.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e13/po_e13.regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e13_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "po_e13.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/po_e13.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
"po_e15": [
{
"file": "po_e15.metadata.tsv",
@@ -528,6 +988,106 @@
"contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
}
],
+"po_e16": [
+ {
+ "file": "po_e16.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e16/po_e16.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "po_e16.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e16/po_e16.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "po_e16.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e16/po_e16.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "po_e16.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e16/po_e16.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e16.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e16/po_e16.regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e16_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "po_e16.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/po_e16.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
+"po_e18": [
+ {
+ "file": "po_e18.metadata.tsv",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e18/po_e18.metadata.tsv",
+ "description": "Per cell metadata for this timepoint with cluster assignments and embedding coordinates",
+ "contents": "Dataframe with cell metadata. - Has multiple cluster assignments"
+
+ },
+ {
+ "file": "po_e18.active_regulons.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e18/po_e18.active_regulons.Rds",
+ "description": "Active TFs in this sample",
+ "contents": "Character list with TF names"
+
+ },
+ {
+ "file": "po_e18.regulon_target_info.Rds",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e18/po_e18.regulon_target_info.Rds",
+ "description": "Active TFs in this sample and their gene target information: number of motifs, GENIE3 weight, best motif, motif logo URL",
+ "contents": "data frame"
+
+ },
+ {
+ "file": "po_e18.regulon_activity_per_cell.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e18/po_e18.regulon_activity_per_cell.feather",
+ "description": "Activity of each TF in each cell in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e18.regulon_activity_per_cluster.feather",
+ "path": "selin.jessa/from_hydra/single_cell/scDev_data/data/po_e18/po_e18regulon_activity_per_cluster.feather",
+ "description": "Activity of each TF in each cluster in this sample",
+ "contents": "A feather file containing a data frame"
+
+ },
+ {
+ "file": "po_e18_prep.Rda",
+ "description": "Colour palettes and cluster annotations used for heatmaps, GRN, info table, dr-plots",
+ "contents": "R list object containing 3 tibbles and one vector; see details in data_prep.R",
+ "script": "data_prep.R"
+
+ },
+ {
+ "file": "po_e18.active_specific_tf.Rds",
+ "path": "howard.li/from_hydra/active_and_specific/data/po_e18.active_specific_tf.Rds",
+ "description": "data calculating the activity and specificity of each TF in each cluster in the sample, used to plot plots in the active and specific tab of the app",
+ "contents": "A list containing: a matrix with clusters as observations and AUC of tfs as variables, a matrix with clusters as observations and fold change of the average AUC of a tf in a given cluster compared to all other clusters, a large list the same length as the number of clusters in the sample with each element as a tibble containing AUC, and FC for that cluster"
+ }
+ ],
"po_p0": [
{
"file": "po_p0.metadata.tsv",
diff --git a/GRN/data/data_prep.R b/GRN/data/data_prep.R
index b4be2c7..969b38c 100644
--- a/GRN/data/data_prep.R
+++ b/GRN/data/data_prep.R
@@ -12,10 +12,20 @@ source("../functions.R")
# make color palette
metadata <- read_tsv("shared/metadata_20190716.tsv")
+metadata_extended <- read_tsv("shared/metadata_20210710_with_qc.tsv")
+
+metadata_per_sample <- read_tsv("shared/metadata_20201028_with_qc.tsv")
+
+colour_palette_per_sample <- metadata_per_sample %>% select(Label, Colour) %>% deframe()
+colour_palette_per_sample_space <- colour_palette_per_sample
+names(colour_palette_per_sample_space) <- gsub("_", " ", names(colour_palette_per_sample))
+
# color palette for heatmap
-colour_palette_cluster <- metadata %>%
+
+colour_palette_cluster <- metadata_extended %>%
+ mutate(Label_with_exclude = gsub("_EXCLUDE", "", Label_with_exclude)) %>%
# use gsub to change all contents in Cluster (cluster name format)
- mutate(Cluster = gsub("_", " ", Cluster)) %>%
+ mutate(Cluster = gsub("_", " ", Label_with_exclude)) %>%
# Get two columns
select(Cluster, Colour) %>%
# Convert to vector of colours, where the first column gives the names
@@ -28,8 +38,8 @@ names(colour_palette_cluster_underscore) <- gsub(" ", "_", names(colour_palette_
all_tf_list <- scan("shared/Mus_musculus_TF_one_TF_per_line.txt", character())
# color palette for timeseries plot, tab3
-colour_palette <- metadata %>%
- mutate(Cluster = gsub("_", " ", Cluster)) %>%
+colour_palette <- metadata_extended %>%
+ mutate(Cluster = gsub("_", " ", Label_with_exclude)) %>%
separate(Cluster, into = c("Prefix", "Cluster"), sep = " ") %>%
# Get two columns
select(Cluster, Colour) %>%
@@ -47,8 +57,84 @@ hm_anno_new <- makePheatmapAnno(colour_palette, "Cluster")
# this is used in: annotation_colors = hm_anno_new$side_colors, in both heatmaps (by cluster/cells)
+# -----------------------joint_cortex_extended-----------------------------------
+forebrain_data_extended <- read_tsv("joint_cortex_extended/joint_cortex_extended.metadata.tsv",
+ col_types = cols(.default = col_character(),
+ Joint_extended_PC_1 = col_double(),
+ Joint_extended_PC_2 = col_double(),
+ Joint_extended_tSNE_1 = col_double(),
+ Joint_extended_tSNE_2 = col_double(),
+ Joint_extended_UMAP_1 = col_double(),
+ Joint_extended_UMAP_2 = col_double())) %>%
+ transmute("Cell" = Cell_clean, "Sample" = Sample, "Sample_cluster" = ID_20210710_with_exclude,
+ "Joint_cluster_number" = Joint_extended_cluster, "Joint_cluster" = ID_20210710_joint_clustering,
+ "PC1" = Joint_extended_PC_1, "PC2" = Joint_extended_PC_2,
+ "tSNE_1" = Joint_extended_tSNE_1, "tSNE_2" = Joint_extended_tSNE_2,
+ "UMAP1" = Joint_extended_UMAP_1, "UMAP2" = Joint_extended_UMAP_2)
+
+TF_active_cortex_extended <- as_tibble(read_rds("joint_cortex_extended/joint_cortex_extended.active_regulons.Rds"))
+
+TF_target_gene_joint_cortex_extended <- as_tibble(read_rds(
+ "joint_cortex_extended/joint_cortex_extended.regulon_target_info.Rds")) %>%
+ select(-logo)
+
+unique_TF_cortex_extended <- unique(TF_target_gene_joint_cortex_extended[["TF"]])
+
+TF_and_ext_cortex_extended <- identify_tf(TF_active_cortex_extended)
+
+timeseries_input_meta_cortex_extended <- create_metadata_timeseries(forebrain_data_extended, "cortex")
+
+data_cortex_extended <- list(
+ "cell_metadata" = forebrain_data_extended,
+ "TF_and_ext" = TF_and_ext_cortex_extended,
+ "TF_target_gene_info" = TF_target_gene_joint_cortex_extended,
+ "unique_active_TFs_bare" = unique_TF_cortex_extended,
+ "active_TFs" = TF_active_cortex_extended,
+ "timeseries_input_meta" = timeseries_input_meta_cortex_extended
+
+)
-# ———————————————————————————————————Cortex data————————————————————————————————————————
+save(data_cortex_extended, file = "joint_cortex_extended/cortex_extended_prep.Rda")
+
+# -----------------------joint_pons_extended-----------------------------------
+pons_data_extended <- read_tsv("joint_pons_extended/joint_pons_extended.metadata.tsv",
+ col_types = cols(.default = col_character(),
+ Joint_extended_PC_1 = col_double(),
+ Joint_extended_PC_2 = col_double(),
+ Joint_extended_tSNE_1 = col_double(),
+ Joint_extended_tSNE_2 = col_double(),
+ Joint_extended_UMAP_1 = col_double(),
+ Joint_extended_UMAP_2 = col_double())) %>%
+ transmute("Cell" = Cell_clean, "Sample" = Sample, "Sample_cluster" = ID_20210710_with_exclude,
+ "Joint_cluster_number" = Joint_extended_cluster, "Joint_cluster" = ID_20210710_joint_clustering,
+ "PC1" = Joint_extended_PC_1, "PC2" = Joint_extended_PC_2,
+ "tSNE_1" = Joint_extended_tSNE_1, "tSNE_2" = Joint_extended_tSNE_2,
+ "UMAP1" = Joint_extended_UMAP_1, "UMAP2" = Joint_extended_UMAP_2)
+
+TF_active_pons_extended <- as_tibble(read_rds("joint_pons_extended/joint_pons_extended.active_regulons.Rds"))
+
+TF_target_gene_joint_pons_extended <- as_tibble(read_rds(
+ "joint_pons_extended/joint_pons_extended.regulon_target_info.Rds")) %>%
+ select(-logo)
+
+unique_TF_pons_extended <- unique(TF_target_gene_joint_pons_extended[["TF"]])
+
+TF_and_ext_pons_extended <- identify_tf(TF_active_pons_extended)
+
+timeseries_input_meta_pons_extended <- create_metadata_timeseries(pons_data_extended, "pons")
+
+data_pons_extended <- list(
+ "cell_metadata" = pons_data_extended,
+ "TF_and_ext" = TF_and_ext_pons_extended,
+ "TF_target_gene_info" = TF_target_gene_joint_pons_extended,
+ "unique_active_TFs_bare" = unique_TF_pons_extended,
+ "active_TFs" = TF_active_pons_extended,
+ "timeseries_input_meta" = timeseries_input_meta_pons_extended
+
+)
+save(data_pons_extended, file = "joint_pons_extended/pons_extended_prep.Rda")
+
+# --------------------Cortex data---------------------
forebrain_data <- read_tsv("joint_cortex/Forebrain_join.2D.tsv") %>% # for UMAP cluster
mutate(Sample_cluster = str_replace(Sample_cluster," ","_"))
# clean some samples with space in between ...
@@ -159,20 +245,23 @@ data_pons <- list(
"cluster_palette" = pons_cluster_palette
)
-
+extended_mouse_joint_cluster_palette <- readRDS("shared/palette_ID_20210710_joint_clustering.Rds")
master_palette <- c(hm_anno_new$side_colors$Cluster, # per-timepoint cluster with timepoint removed
colour_palette_cluster, # per-timepoint cluster, with spaces
colour_palette_cluster_underscore, # per-timepoint cluster, with underscores
forebrain_cluster_palette, # joint clustering, forebrain
- pons_cluster_palette) # joint clustering, pons
+ pons_cluster_palette, # joint clustering, pons
+ extended_mouse_joint_cluster_palette,
+ colour_palette_per_sample_space,
+ colour_palette_per_sample)
master_palette <- list("Cluster" = master_palette)
#---------------------time_point data----------------------------------------------
#use a loop for this
for (reg in c("ct", "po")){
- for(tp in c("e12", "e15", "p0", "p3", "p6")){
+ for(tp in c("e10", "e12", "e13", "e15", "e16", "e18", "p0", "p3", "p6")){
TF_target_gene_info <- as_tibble(read_rds(glue("{reg}_{tp}/{reg}_{tp}.regulon_target_info.Rds"))) %>%
select(-logo)
@@ -183,19 +272,19 @@ for (reg in c("ct", "po")){
cell_data <- read_tsv(glue("{reg}_{tp}/{reg}_{tp}.metadata.tsv"))
- black_list_cells <- cell_data %>% select(Cell, ID_20190715_with_blacklist) %>%
- filter(grepl("BLACKLISTED", ID_20190715_with_blacklist)) %>% select(Cell) %>%
+ black_list_cells <- cell_data %>% select(Cell, ID_20201028_with_exclude) %>%
+ filter(grepl("EXCLUDE", ID_20201028_with_exclude)) %>% select(Cell) %>%
deframe()
#print(black_list_cells)
- cell_data <- cell_data %>% filter(!grepl("BLACKLISTED", ID_20190715_with_blacklist))
+ cell_data <- cell_data %>% filter(!grepl("EXCLUDE", ID_20201028_with_exclude))
-
+ #can get rid of palette here and use master_palette in the DR plots
awoo <- switch(reg, "ct" = "F-", "po" = "P-")
- dr_palette <- metadata %>%
- separate(Cluster, into = c("Timepoint", "Cluster"), sep = "_") %>%
+ dr_palette <- metadata_extended %>%
+ separate(Label, into = c("Timepoint", "Cluster"), sep = "_") %>%
filter(Timepoint == glue("{awoo}{tp}")) %>%
unite(col = "Cluster", c("Timepoint", "Cluster"), sep = "_") %>%
select(Cluster, Colour) %>%
diff --git a/GRN/functions.R b/GRN/functions.R
index a04c2ec..ae0e210 100644
--- a/GRN/functions.R
+++ b/GRN/functions.R
@@ -41,169 +41,7 @@ addMotifPic <- function(subset_data){ #need to comment this and test to see if i
return(subset_data)
}
-#------------------------------Bubble plot--------------------------------------
-#' Prepare input for bubble_plot
-#'
-#' Load gene expression data from feather, tidy & optionally scale expression,
-#' and return the dataframe required as input for the bubble_plot() function
-#'
-#' @param gene Character vector, one or more genes of interest to plot
-#' @param scale Logical, whether or not to linearly scale gene expression across
-#' clusters to [0,1] to improve visualization. Default: TRUE
-#' @param show_mean Logical, whether or not to display the mean expression of
-#' given genes in a new bubble plot line. Default: FALSE
-#' TODO: Use this to provide an option to download the underlying data.
-#'
-#' @examples
-#' bubble_prep("Dlx1")
-#' bubble_prep <- function(tf,
-#' scale = TRUE,
-#' show_mean = FALSE,
-#' region) {
-#'
-#' # Load the mean expression of genes across clusters, given gene of interest
-#' file_path <- glue("data/joint_{region}/joint_cortex.regulon_activity_per_cluster.feather")
-#' exp <- read_feather(path = file_path,
-#' columns = c("Cluster", tf)) #%>%
-#' #dendogram_order from hydra file, commented out for now because no dendogram
-#' #filter(Cluster %in% dendrogram_order)
-#'
-#' # Scale expression of each gene linearly across clusters to [0, 1]
-#' if (scale) {
-#'
-#' exp <- exp %>%
-#' as.data.frame() %>%
-#' tibble::column_to_rownames(var = "Cluster") %>%
-#' apply(2, scales::rescale, to = c(0, 1)) %>%
-#' as.data.frame %>%
-#' tibble::rownames_to_column(var = "Cluster")
-#'
-#' }
-#'
-#' # Convert to long / tidy format with columns: Cluster, Gene, Expression
-#' exp <- exp %>%
-#' gather(., "TF", "Activity", 2:ncol(.))
-#'
-#' # Probably don't need this in the TF plot
-#' # # Load the proportion of cells in each cluster in which each gene was detected,
-#' # # and convert to long / tidy format with columns: Cluster, Gene, Pct1
-#' # pct1 <- read_feather("data/joint_mouse/pct1_per_ID_20190715_cluster.feather",
-#' # columns = c("Cluster", gene)) %>%
-#' # gather(., "Gene", "Pct1", 2:ncol(.))
-#'
-#' # # Join with cluster metadata
-#' # df <- left_join(exp, pct1, by = c("Cluster", "Gene")) %>%
-#' # left_join(metadata, by = c("Cluster" = "Cluster_nounderscore"))
-#'
-#' # Tidy data for plotting
-#' df <- df %>%
-#'
-#' # Order genes to match order input by user
-#' mutate(TF = factor(TF, levels = rev(TF))) %>%
-#' arrange(TF) %>%
-#'
-#' # Pad gene names so that the plot takes up a more standardized
-#' # width; to roughly the the # of characters in the gene w/ longest name
-#' # However, letters take up more pixels than spaces, so do less padding
-#' # for genes with longer names
-#' # TODO: Test the (commented) third line inside mutate() and adjust padding as required
-#' mutate(TF_padded = case_when(
-#' str_length(TF) <= 5 ~ str_pad(TF, 15, side = 'right', pad = " "),
-#' between(str_length(TF), 5, 8) ~ str_pad(TF, 12, side = 'right', pad = " ")
-#' #, str_length(Gene) > 8 ~ str_pad(Gene, 9, side = 'right', pad = " ")
-#' )
-#' ) %>%
-#' mutate(TF_padded = factor(TF_padded, levels = unique(.$TF_padded))) %>%
-#'
-#' # Order the clusters on the x-axis to match the dendrogram image
-#' mutate(Cluster = factor(Cluster, levels = dendrogram_order)) %>%
-#'
-#' filter(!is.na(Cluster)) %>%
-#'
-#' # Convert NAs (undetected genes) to 0s -- this ensures all
-#' # clusters have a value for all genes, so that all clusters are plot,
-#' # even if the gene was undetected
-#' replace_na(list(Expression = 0, Pct1 = 0)) %>%
-#'
-#' # Keep columns
-#' select(Gene, Cluster, Sample, Cell_type, Cell_class, N_cells, Expression, Pct1, Sample, Colour, Gene_padded)
-#'
-#' # Create & append set of rows containing mean expression over all selected genes
-#' if(show_mean) {
-#'
-#' # Create mean expression rows, preserving information for tooltip
-#' mean_exp <- df %>%
-#' group_by(Cluster, Sample, Cell_type, N_cells, Cell_class, Colour) %>%
-#' summarize(#Gene = "MEAN",
-#' #Cluster = Cluster,
-#' #Sample = Sample,
-#' #Cell_type = Cell_type,
-#' #Cell_class = Cell_class,
-#' #N_cells = N_cells,
-#' Expression = mean(Expression)
-#' #Pct1 = mean(Pct1),
-#' #Colour = Colour,
-#' #Gene_padded = "MEAN"
-#' ) %>%
-#' # Remove the Pct1 value from the mean expression
-#' # and label the mean expression
-#' mutate(Pct1 = 1, Gene = "MEAN", Gene_padded = "MEAN")
-#'
-#' # Add the rows containing mean expression to the original dataframe,
-#' # removing duplicate rows and ordering them once more by user input,
-#' # except the mean which is placed at the bottom
-#' gene_order_padded <- levels(df$Gene_padded)
-#' df <- bind_rows(df, mean_exp) %>%
-#' distinct(.) %>%
-#' mutate(Gene_padded = factor(Gene_padded, levels = c("MEAN", gene_order_padded)))
-#'
-#' }
-#'
-#' return(df)
-#'
-#' }
-#'
-#'
-#' #' Bubbleplot of gene expression
-#' #'
-#' #' Generate a bubble plot for genes of interest across clusters in the mouse
-#' #' dendrogram, where bubble colour encodes the mean expression in each cluster
-#' #' and bubble size encodes the proportion of cells where each gene is detected
-#' #'
-#' #' @param df Data frame as returned by bubble_prep(), with require columns Cluster,
-#' #' Gene_padded, Pct1, and Expression
-#' #'
-#' #' @return ggplot2 object
-#' #'
-#' #' @examples
-#' #' bubble_prep("Dlx1") %>% bubbleplot()
-#' #'
-#' #' @export
-#' bubble_plot <- function(df, max_point_size) {
-#'
-#' # Generate plot
-#' p1 <- df %>%
-#' ggplot(aes(x = Cluster, y = Gene_padded)) +
-#' geom_point(aes(size = Pct1, colour = Expression), alpha = 0.8) +
-#' scale_size_area(max_size = max_point_size) +
-#' scale_color_gradientn(colours = tail(rdbu, 70)) +
-#' theme_min() +
-#' ylab(NULL) +
-#' theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5,
-#' colour = joint_mouse_palette, size = rel(0.7)),
-#' panel.grid.major.x = element_line(colour = "grey90"),
-#' panel.border = element_blank(),
-#' axis.ticks.x = element_blank(),
-#' axis.ticks.y = element_blank(),
-#' # Do not show the legend because it is included in the static
-#' # dendrogram image displayed above the bubbleplot
-#' legend.position = "bottom") +
-#' # Put gene labels on the right hand side to improve alignment
-#' scale_y_discrete(position = "right")
-#'
-#' return(p1)
-#'
-#' }
+
#----------------------------ggNet visualisation---------------------------------------------
#function to create an igraph object
#' @param tf the user input vector of transcription factors
@@ -213,7 +51,7 @@ addMotifPic <- function(subset_data){ #need to comment this and test to see if i
make_network <- function(tf, tf_target_gene_info, gene_list){
#add a step to select only the transcription factors that are in the list
#create edgelist
- edges <- tf_target_gene_info %>% select(TF, gene, nMotifs, Genie3Weight.weight) %>%
+ edges <- tf_target_gene_info %>% select(TF, gene, nMotifs, starts_with("Genie3Weight")) %>%
#and filter it to only the transcription factors that are the input
filter(TF %in% tf)
#print(edges)
@@ -265,79 +103,7 @@ plot_network <- function(net, labelNodes, tf){
}
-# --------------------------OBSOLETE-cytoscape network visualization----------------------------------------------
-# function to create network
-
-#' Create rcytoscape network data
-#'
-#' Takes a vector input that contains user selected TFs and output a list of nodeData and edgeData
-#' which will be used for createCytoscapeJsNetwork
-#' A good to visualize correlations among multiple TFs
-#'
-#' @param tf one single tf name character
-#' @param TF_target_gene TF_target_gene data, specific for cortex/pon
-#' @param unique_TF unique_TF data, specific for cortex/pon
-#'
-#' @return a list of nodeData and edgeData that are required for generating a rcytoscapejs network object
-#'
-#' @examples
-#' TF <- c("Arx","Lef1")
-#' # Note that TF_target_gene and unique_TF will be saved in data_cortex list, by data_prep.R
-#' nodeData <- create_network(TF, TF_target_gene_pon, unique_TF)$nodes
-#' edgeData <- create_network(TF, TF_target_gene_pon, unique_TF)$edges
-#' network <- createCytoscapeJsNetwork(nodeData, edgeData)
-#' rcytoscapejs2(network$nodes, network$edges)
-#'
-# create_network <- function(tf, TF_target_gene, unique_TF, pathway_genes = c(),
-# shrink_gray = FALSE){
-# TF_interest <- filter(TF_target_gene, TF %in% tf)[["TF"]]
-# gene_target <- filter(TF_target_gene, TF %in% tf)[["gene"]]
-#
-# source <- TF_interest
-# target <- gene_target
-#
-# id <- c(TF_interest, gene_target)
-# name <- id
-# nodeData <- data.frame(id,name, stringsAsFactors = FALSE)
-# edgeData <- data.frame(source, target, stringsAsFactors = FALSE)
-#
-# #unique_TF <- unique(TF_target_gene[["TF"]])
-#
-# mutual_target <- edgeData %>%
-# # a character vector that indicates the nodes that are target of multiple selected TFs
-# count(target) %>%
-# filter(n > 1 & !target %in% tf ) %>%
-# .[[1]]
-#
-# nodeData <- nodeData %>%
-# # you can customize the color using the case_when structure easily,
-# # check the tfs in id column that exist in your vector, then you can control its size,
-# # shape and color easily
-# mutate(color = case_when(id %in% tf ~ "#9d4097", # orange
-# # orange nodes are tfs that are active in this region
-# id %in% pathway_genes ~ "green",
-# id %in% unique_TF ~ "#D6604D",
-# id %in% mutual_target ~ "#4fafc6",
-# TRUE ~ "lightgrey")) %>%
-# mutate(height = case_when(id %in% tf ~ "100",
-# TRUE ~ "70")) %>%
-# mutate(width = case_when(id %in% tf ~ "100",
-# TRUE ~ "70"))
-#
-# if(shrink_gray){
-# nodeData <- nodeData %>%
-# mutate(height = case_when(color %in% "lightgrey" ~ "40",
-# TRUE ~ "70")) %>%
-# mutate(width = case_when(color %in% "lightgrey" ~ "40",
-# TRUE ~ "70"))
-#
-# }
-#
-# return(list(nodes = nodeData,
-# edges = edgeData
-# ))
-# }
# --------------------------------Helper functions----------------------------------------------------
#' Identify transcription factor data type
#'
@@ -510,8 +276,8 @@ create_activity_data <- function(tf, method, region, TF_and_ext,
#building path of the feather object to read if the per sample toggle is on
#method should be joint if per_sample is true
- #print(per_sample)
- #print("ahhh")
+
+ # set up the path of the feather file to read dependingo on region and cluster or cell
if(per_sample == TRUE){
reg <- switch(region, "cortex" = "ct", "pons" = "po")
@@ -531,14 +297,17 @@ create_activity_data <- function(tf, method, region, TF_and_ext,
else{
if(!region %in% c("cortex", "pons")) return("Wrong usage: region should be either cortex/pons")
if(method == "joint"){
- method2 <- "joint_cluster"
+ path <- glue('data/joint_{region}_extended/joint_{region}_extended.regulon_activity_per_cluster.joint_extended.feather')
+ }
+ else if (method == "Cluster"){
+ path <- glue('data/joint_{region}_extended/joint_{region}_extended.regulon_activity_per_cluster.per_sample.feather')
}
else{
- method2 <- str_to_lower(method)
+ path <- glue('data/joint_{region}_extended/joint_{region}_extended.regulon_activity_per_cell.feather')
}
# set up the path of the feather file to read dependingo on region and cluster or cell
- path <- glue('data/joint_{region}/joint_{region}.regulon_activity_per_{method2}.feather')
+ #path <- glue('data/joint_{region}/joint_{region}.regulon_activity_per_{method2}.feather')
}
# case-insensitive checking and reading in the first column which corresponds to cell or cluster label
#why even do this if method2 object has all lowercase already?
@@ -546,7 +315,8 @@ create_activity_data <- function(tf, method, region, TF_and_ext,
cell_col <- read_feather(path, "Cell")
}
else if(str_detect(method,"(?i)Cluster")){
- cell_col <- read_feather(path,"Cluster")
+ cell_col <- read_feather(path,"ID_20210710")
+ colnames(cell_col) <- "Cluster"
}
else if(str_detect(method,"(?i)joint")){
if(per_sample){
@@ -556,7 +326,8 @@ create_activity_data <- function(tf, method, region, TF_and_ext,
method <- "Cluster"
}
else{
- cell_col <- read_feather(path, "Joint_cluster")
+ cell_col <- read_feather(path, "ID_20210710_joint_clustering")
+ colnames(cell_col) <- "Joint_cluster"
method <- "Joint_cluster"
}
}
@@ -598,9 +369,9 @@ create_activity_data <- function(tf, method, region, TF_and_ext,
if(identical(tp, "F-All") || identical(tp, "P-All")){
}
else{
- activity <- separate(activity, Cluster, into = c("Timepoint", "Cluster"), sep = " ")
+ activity <- separate(activity, Cluster, into = c("Timepoint", "Cluster"), sep = "_")
activity <- filter(activity, Timepoint == tp)
- activity <- unite(activity, Cluster, Timepoint, Cluster, sep = " ")
+ activity <- unite(activity, Cluster, Timepoint, Cluster, sep = "_")
}
}
else if(identical(method, "Cell") & per_sample){ #gets rid of blacklisted cells in the per sample data
@@ -660,47 +431,24 @@ plot_heatmap <- function(tf, method, region, TF_and_ext, #brain_data, cell_plot_
if(!region %in% c("cortex", "pons")) return("Wrong usage: region should be either cortex/pons")
if(!method %in% c("Cell","Cluster", "joint")) return("Wrong usage, method should be Cell/Cluster")
- # if(method == "Cell"){
- # # 1. create the activity data for plotting
- # act_cell <- create_activity_data(tf, "Cell",region, TF_and_ext) %>%
- # mutate(Cluster = gsub("_"," ",brain_data[["Sample_cluster"]])) %>%
- # filter(!grepl("BLACKLIST", Cluster)) %>% # filter out bad samples
- # sample_n(cell_plot_num) %>% # randomly sample it
- # tibble::column_to_rownames(var = "Cell") # make that column name as row name ...
- #
- # anno_row_cell <- select(act_cell, Cluster)
- # # change the anno_row, since we change the color palettes
- # new_anno_row_cell <- anno_row_cell %>%
- # mutate(Cluster = gsub(pattern = ".* ", replacement = "", Cluster))
- # rownames(new_anno_row_cell) <- rownames(anno_row_cell) # re-assign the rownames
- #
- # act <- select(act_cell, -Cluster) # must remove Cluster data before plotting
- #
- # # customized for plotting by cell
- # anno_col <- new_anno_row_cell # assign to the same variable for plotting
- # cell_width_plot <- 2
- # show_colname_plot <- FALSE
- # }
+
if(method == "Cluster"){
- act <- create_activity_data(tf, "Cluster",region, TF_and_ext, timepoint)
- #sample_n(cluster_plot_num) %>% # randomly sample it
+ act <- create_activity_data(tf, "Cluster",region, TF_and_ext, timepoint)
+
#str(act)
act <- column_to_rownames(act, var = "Cluster") # make that column name as row name ...
+ #print(act)
+
# change the anno_row, since we change the color palettes
- new_anno_row <- hm_anno$anno_row %>%
- mutate(Cluster = gsub(pattern = ".* ", replacement = "", Cluster))
- rownames(new_anno_row) <- rownames(hm_anno$anno_row) # re-assign the rownames
+ new_anno_row <- hm_anno$anno_row #%>%
+ #mutate(Cluster = gsub(pattern = ".* ", replacement = "", Cluster))
+ rownames(new_anno_row) <- gsub(" ", "_", rownames(hm_anno$anno_row)) # re-assign the rownames
# note that the rownames correspond to the col names of the matrix t(act_cluster)
# customized for plotting by cluster
+ # print(new_anno_row)
anno_col <- new_anno_row # this is loaded by data_prep.R
#print(anno_col)
- cell_width_plot <- 20
- cell_height_plot <- 20
- if (identical(timepoint, "F-All") || identical(timepoint, "P-All")){
- cell_width_plot <- 7
- cell_height_plot <- 10
- }
show_colname_plot <- TRUE
title <- glue('Transcription Factor Regulon Activity at Developmental Time: {timepoint}')
}
@@ -710,52 +458,42 @@ plot_heatmap <- function(tf, method, region, TF_and_ext, #brain_data, cell_plot_
timepoint = timepoint) #%>%
#filter(!grepl("BLACKLISTED", Cluster))
- print(act)
+ #print(act)
if(per_sample == TRUE){
#filter out the exclude clusters
act <- act %>% filter(!grepl("EXCLUDE", act$Cluster))
#print(act)
col_to_row <- "Cluster"
- new_anno_row <- hm_anno$anno_row %>%
- mutate(Cluster = gsub(pattern = ".* ", replacement = "", Cluster))
- rownames(new_anno_row) <- gsub(" ", "_", rownames(hm_anno$anno_row))
- # print(new_anno_row)
+ new_anno_row <- act %>% mutate(rownames = Cluster) %>%
+ column_to_rownames("rownames") %>% select(Cluster)
}
else{
col_to_row <- "Joint_cluster"
new_anno_row <- act %>% mutate(Cluster = Joint_cluster) %>%
column_to_rownames("Joint_cluster") %>% select(Cluster)
- #print(new_anno_row)
-
- #%>%
- # column_to_rownames("Cluster")
- #row.names(new_anno_row) <- new_anno_row$Cluster
}
act <- act %>%
column_to_rownames(var = col_to_row)
-
- # change the anno_row, since we change the color palettes
- # new_anno_row <- hm_anno$anno_row %>%
- # mutate(Cluster = gsub(pattern = ".* ", replacement = "", Cluster))
- # rownames(new_anno_row) <- rownames(hm_anno$anno_row) # re-assign the rownames
+
# note that the rownames correspond to the col names of the matrix t(act_cluster)
# customized for plotting by cluster
anno_col <- new_anno_row # this is loaded by data_prep.R
#print(anno_col)
- cell_width_plot <- 20
- cell_height_plot <- 20
show_colname_plot <- TRUE
title <- "Transcription Factor Regulon Activity per Cluster"
}
cluster_row <- FALSE
- #do not do row clustering if there is only one TF selected
+
+ #do not do row clustering if there is only one TF selected
if(length(tf) > 1){
cluster_row <- TRUE
}
+
+ #print(anno_col)
pheatmap::pheatmap(t(act),
show_colnames = show_colname_plot,
scale = "none",
@@ -767,8 +505,8 @@ plot_heatmap <- function(tf, method, region, TF_and_ext, #brain_data, cell_plot_
# change the default color annotation
annotation_colors = master_palette, # loaded by data_prep.R
annotation_legend = FALSE,
- cellwidth = cell_width_plot,
- cellheight = cell_height_plot)
+ cellwidth = 20,
+ cellheight = 20)
}
#----------------------------Dimension reduction---------------------------------------------
@@ -804,6 +542,8 @@ plot_UMAP <- function(tf_number, cell_metadata, cell_activity_data, dim_red_type
activity_tf <- cell_activity_data[,tf_plot][[1]] #extracts the TF activity from the cell_activity_data
#and appends it to the cell_metadata to make cell meta with activity to plot
+ TF <- colnames(cell_activity_data)[tf_plot]
+
cell_meta_with_activity <- mutate(cell_metadata, activity_tf = activity_tf)
x_axis <- switch(dim_red_type, "umap" = "UMAP1", "tsne" = "tSNE_1", "pca" = "PC1")
@@ -812,13 +552,13 @@ plot_UMAP <- function(tf_number, cell_metadata, cell_activity_data, dim_red_type
ggplot(data = cell_meta_with_activity, mapping = aes_string(x = x_axis, y = y_axis))+
geom_point(aes(color = activity_tf), alpha = 0.2)+
scale_color_gradient(low = "grey90", high = "red")+
- theme_min() + labs(color = 'TF Activity')
+ theme_min() + labs(color = 'TF Activity') + ggtitle(TF)
}
#if I want to include labeled clusters, then I need to map cells to the clusters
#place a label at the mean of the umap coordinates for the cells that belong in that cluster
-color_by_cluster <- function(cell_metadata, cluster_palette, dim_red_type, cluster_label,
+color_by_cluster <- function(cell_metadata, dim_red_type, cluster_label,
per_sample = FALSE){
x_axis <- switch(dim_red_type, "umap" = "UMAP1", "tsne" = "tSNE_1", "pca" = "PC1")
@@ -828,7 +568,7 @@ color_by_cluster <- function(cell_metadata, cluster_palette, dim_red_type, clust
var_group <- "Joint_cluster"
if(per_sample){
- var_group <- "ID_20190715_with_blacklist"
+ var_group <- "ID_20201028_with_exclude"
}
# centers <- cell_metadata %>%
# group_by(get(var_group)) %>%
@@ -840,7 +580,7 @@ color_by_cluster <- function(cell_metadata, cluster_palette, dim_red_type, clust
gg <- ggplot(data = cell_metadata, mapping = aes_string(x = x_axis,y = y_axis))+
geom_point(aes(color = get(var_group)), alpha = 0.2) + theme_min() + theme(legend.position="bottom") +
- guides(fill=guide_legend(nrow=5, byrow=TRUE)) + scale_color_manual(values = cluster_palette) +
+ guides(fill=guide_legend(nrow=5, byrow=TRUE)) + scale_color_manual(values = master_palette$Cluster) +
labs(color = 'Cluster Label')
# print("step2")
@@ -883,18 +623,27 @@ color_by_cluster <- function(cell_metadata, cluster_palette, dim_red_type, clust
#' cell_metadata_cortex <- create_cell_metadata(cell_metadata_cortex)
#'
create_metadata_timeseries <- function(cell_metadata, part){
- if(part == "cortex") level <- c("Forebrain E12.5",
+ if(part == "cortex") level <- c("Forebrain E10.5",
+ "Forebrain E12.5",
+ "Forebrain E13.5",
"Forebrain E15.5",
+ "Forebrain E16.5",
+ "Forebrain E18.5",
"Forebrain P0",
"Forebrain P3",
"Forebrain P6")
- else if (part == "pons") level <- c("Hindbrain E12.5",
+ else if (part == "pons") level <- c("Pons E10.5",
+ "Pons E12.5",
+ "Pons E13.5",
"Pons E15.5",
+ "Pons E16.5",
+ "Pons E18.5",
"Pons P0",
"Pons P3",
"Pons P6")
else{(return("Wrong usage, input either cortex or pons"))}
+ #print(level)
cell_metadata %>%
select(Age = Sample, Cell, Cluster = Sample_cluster) %>%
# In this case, we remove the "prefix" of the Cluster column, so that we are
@@ -1090,13 +839,11 @@ plot_scatter <- function(data, fc, cluster){
plot_bar_list <- function(data, tf){
data <- data %>% mutate(Cluster = gsub("_", " ", Cluster))
- #print(data)
- palette <- hm_anno$side_colors$Cluster[names(hm_anno$side_colors$Cluster) %in% data$Cluster]
+
+ #print(data$Cluster)
+ palette <- master_palette$Cluster[names(master_palette$Cluster) %in% data$Cluster]
#print(palette)
- #print(length(data$Cluster))
- #print(length(palette))
- #(data)
- #purrr::map(tf, ~print(.x) )
+
# 1. loop over genes, then each index can be referred to with .x
purrr::map(.x = tf, .f = ~data %>% select(.x, Cluster) %>%
arrange(desc(.x)) %>% head(30) %>%
@@ -1112,4 +859,105 @@ plot_bar_list <- function(data, tf){
}
+#-------------Bubble-plot--------------------
+bubble_prep <- function(sample, tf, dend_order, scale){
+ path <- glue("data/{sample}/{sample}.active_specific_tf.Rds")
+ data <- readRDS(path)
+
+ AUC <- data$AUC_df %>% select(Cluster, tf) %>%
+ filter(Cluster %in% dend_order)
+
+ # print(AUC)
+
+ # Scale activity of each tf linearly across clusters to [0, 1]
+ if (scale) {
+
+ AUC <- AUC %>%
+ as.data.frame() %>%
+ select(-Cluster) %>%
+ apply(2, scales::rescale, to = c(0, 1)) %>%
+ as.data.frame %>%
+ mutate(Cluster = rownames(AUC)) %>%
+ select(Cluster, everything())
+
+ }
+ # Convert to long / tidy format with columns: Cluster, TF, AUC
+ AUC <- AUC %>%
+ gather(., "TF", "AUC", 2:ncol(.))
+
+ #print(AUC)
+
+ FC <- data$FC_df %>% select(Cluster, tf) %>%
+ filter(Cluster %in% dend_order) %>%
+ gather(., "TF", "FC", 2:ncol(.))
+
+ #print(AUC)
+
+ # print(FC)
+
+ df <- left_join(AUC, FC, by = c("Cluster", "TF"))
+ #print(df)
+
+ # Tidy data for plotting
+ df <- df %>%
+
+ # Order genes to match order input by user
+ mutate(TF = factor(TF, levels = rev(tf))) %>%
+ arrange(TF) %>%
+
+ # Pad gene names so that the plot takes up a more standardized
+ # width; to roughly the the # of characters in the gene w/ longest name
+ # However, letters take up more pixels than spaces, so do less padding
+ # for genes with longer names
+ # TODO: Fix alignment of bubble plot w/ dendrogram for long gene names (issue #7)
+ mutate(TF_padded = case_when(
+ str_length(TF) <= 5 ~ str_pad(TF, 15, side = 'right', pad = " "),
+ str_length(TF) > 5 ~ str_pad(TF, 12, side = 'right', pad = " ")
+ )
+ ) %>%
+ mutate(TF_padded = factor(TF_padded, levels = unique(.$TF_padded))) %>%
+
+ # Order the clusters on the x-axis to match the dendrogram image
+ slice(match(dend_order_joint_cortex_extended, Cluster)) %>%
+
+ # Keep columns
+ select(TF, Cluster, AUC, FC, TF_padded)
+
+ label_palette <- hm_anno$side_colors$Cluster
+ names(label_palette) <- gsub(" ", "_", names(hm_anno$side_colors$Cluster))
+ label_palette <- label_palette[dend_order]
+
+ return(list("data" = df, "label_palette" = label_palette))
+}
+
+plot_bubble <- function(data, label_palette){
+ p1 <- data %>%
+ ggplot(aes(x = Cluster, y = TF_padded)) +
+ geom_point(aes(size = FC, colour = AUC), alpha = 0.8) +
+ scale_size_area(max_size = 4) +
+ scale_color_gradientn(colours = tail(rdbu, 70)) +
+ theme_min() +
+ ylab(NULL) +
+ theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5,
+ colour = label_palette,
+ size = rel(0.7)),
+ panel.grid.major.x = element_line(colour = "grey90"),
+ panel.border = element_blank(),
+ axis.ticks.x = element_blank(),
+ axis.ticks.y = element_blank(),
+ # Do not show the legend because it is included in the static
+ # dendrogram image displayed above the bubbleplot
+ legend.position = "bottom") +
+ # Put gene labels on the right hand side to improve alignment
+ scale_y_discrete(position = "right")
+
+ gene_labels <- cowplot::get_y_axis(plot = p1, position = "right")
+
+ p1 <- p1 + scale_y_discrete(labels = NULL)
+
+ return(list(plot = p1, labels = gene_labels))
+}
+
+
+
diff --git a/GRN/global.R b/GRN/global.R
index 113a161..117c1ff 100644
--- a/GRN/global.R
+++ b/GRN/global.R
@@ -24,35 +24,47 @@ library(purrr)
library(shinyWidgets)
# Data
-load("data/joint_cortex/cortex_prep.Rda") # a list, data_cortex
-load("data/joint_pons/pons_prep.Rda") # a list, data_pons
+load("data/joint_cortex_extended/cortex_extended_prep.Rda") # a list, data_cortex_extended
+load("data/joint_pons_extended/pons_extended_prep.Rda") # a list, data_pons_extended
load("data/shared/common_prep.Rda") # metadata and colour_palettes
+data_ct_e10 <- readRDS("data/ct_e10/ct_e10_prep.Rds")
data_ct_e12 <- readRDS("data/ct_e12/ct_e12_prep.Rds") # a list, data_ct_e12
+data_ct_e13 <- readRDS("data/ct_e13/ct_e13_prep.Rds")
data_ct_e15 <- readRDS("data/ct_e15/ct_e15_prep.Rds")
+data_ct_e16 <- readRDS("data/ct_e16/ct_e16_prep.Rds")
+data_ct_e18 <- readRDS("data/ct_e18/ct_e18_prep.Rds")
data_ct_p0 <- readRDS("data/ct_p0/ct_p0_prep.Rds")
data_ct_p3 <- readRDS("data/ct_p3/ct_p3_prep.Rds")
data_ct_p6 <- readRDS("data/ct_p6/ct_p6_prep.Rds")
-data_po_e12 <- readRDS("data/po_e12/po_e12_prep.Rds")
+data_po_e10 <- readRDS("data/po_e10/po_e10_prep.Rds")
+data_po_e12 <- readRDS("data/po_e12/po_e12_prep.Rds")
+data_po_e13 <- readRDS("data/po_e13/po_e13_prep.Rds")
data_po_e15 <- readRDS("data/po_e15/po_e15_prep.Rds")
+data_po_e16 <- readRDS("data/po_e16/po_e16_prep.Rds")
+data_po_e18 <- readRDS("data/po_e18/po_e18_prep.Rds")
data_po_p0 <- readRDS("data/po_p0/po_p0_prep.Rds")
data_po_p3 <- readRDS("data/po_p3/po_p3_prep.Rds")
data_po_p6 <- readRDS("data/po_p6/po_p6_prep.Rds")
-#load_plots
+dend_order_joint_cortex_extended <- readRDS("data/joint_cortex_extended/dendrogram_order_joint_extended_forebrain.Rds")
+dend_order_joint_pons_extended <- readRDS("data/joint_pons_extended/dendrogram_order_joint_extended_pons.Rds")
+
+#load ribbon_plots of proportion of cells across developmental time in pons and forebrain
load("data/shared/timeseries_proportion_plots.Rda")
# Custom functions
source("functions.R")
-#allows server side save states
+#allows URL save states
enableBookmarking(store = "url")
#store variable accessible to all of app
-dev_time_points <- c("e12", "e15", "p0", "p3", "p6")
+dev_time_points <- c("e10", "e12", "e13", "e15", "e16", "e18", "p0", "p3", "p6")
-#overwrite pheatmap function so that the heatmap labels can be 45 degrees
+#overwrite pheatmap function that draws the column names on the heatmap
+#so that the heatmap labels can be 45 degrees
library(grid)
draw_colnames_45 <- function (coln, gaps, ...) {
@@ -64,3 +76,6 @@ draw_colnames_45 <- function (coln, gaps, ...) {
## 'Overwrite' default draw_colnames with your own version
assignInNamespace(x="draw_colnames", value="draw_colnames_45",
ns=asNamespace("pheatmap"))
+
+#palette for bubbles
+rdbu <- rev(grDevices::colorRampPalette(RColorBrewer::brewer.pal(8, "RdBu"))(n = 100))
diff --git a/GRN/server.R b/GRN/server.R
index 426bede..80844b5 100644
--- a/GRN/server.R
+++ b/GRN/server.R
@@ -12,14 +12,14 @@ server <- function(input, output, session) {
if(input$region == "cortex"){
updateSelectizeInput(session, inputId = "TF", choices = all_tf_list,
selected = c("Arx","Lef1"), server = TRUE)
- updateSelectizeInput(session, inputId = "gene", choices = unique(data_cortex$TF_target_gene_info$gene),
+ updateSelectizeInput(session, inputId = "gene", choices = unique(data_cortex_extended$TF_target_gene_info$gene),
selected = c("Dlx6","Sox6"), server = TRUE )
}
else{
updateSelectizeInput(session, inputId = "TF", choices = all_tf_list,
selected = c("Lhx5","Pax7"), server = TRUE)
- updateSelectizeInput(session, inputId = "gene", choices = unique(data_pons$TF_target_gene_info$gene),
+ updateSelectizeInput(session, inputId = "gene", choices = unique(data_pons_extended$TF_target_gene_info$gene),
selected = c("Gad2"), server = TRUE)
}
@@ -33,19 +33,21 @@ server <- function(input, output, session) {
#data files (defined in data_prep.R)
l <- list()
if(input$region == "cortex"){
- l <- data_cortex
+ l <- data_cortex_extended
temp <- paste("F-", input$time, sep = "")
+ l$dend_order <- dend_order_joint_cortex_extended
}
else if(input$region == "pons"){
- l <- data_pons
+ l <- data_pons_extended
temp <- paste("P-", input$time, sep = "")
+ l$dend_order <- dend_order_joint_pons_extended
}
#str(input$TF)
l$tf <- input$TF
l$region <- input$region
#l$input_pathway <- input$input_pathway
l$method <- input$method
- l$num_cell_plot <- input$num_cell_plot
+ #l$num_cell_plot <- input$num_cell_plot
l$time_point <- temp
l$gene <- input$gene
l$label <- input$label
@@ -195,8 +197,8 @@ server <- function(input, output, session) {
selected = "joint")
updateSelectInput(session, inputId = "time",
label = "Time-point to Visualize",
- choices = c("All", "e12", "e15", "p0", "p3", "p6"),
- selected = "All")
+ choices = c("All", dev_time_points),
+ selected = "e12")
output$hm_data <- renderText({
""
})
@@ -298,8 +300,54 @@ server <- function(input, output, session) {
}
})
+ # observeEvent(input$tabs, {
+ # if (input$bb_toggle == TRUE & !identical(input$tabs,
+ # "bubble")){
+ # removeUI(
+ # selector = "div:has(>> #bb_tp)"
+ # )
+ # }
+ # else if (input$bb_toggle == TRUE & identical(input$tabs,
+ # "bubble")){
+ # insertUI(
+ # selector = "#region",
+ # where = "afterEnd",
+ # ui = selectInput(inputId = "bb_tp",
+ # label = "Developmental Time-Point to Explore",
+ # choices = dev_time_points,
+ # multiple = FALSE,
+ # selected = "e12")
+ # )
+ # }
+ # })
+ # #insert timepoint selection when the toggle for sample data in the GRN tab is acted on
+ # observeEvent(input$bb_toggle,{
+ # if(input$bb_toggle){
+ # insertUI(
+ # selector = "#region",
+ # where = "afterEnd",
+ # ui = selectInput(inputId = "bb_tp",
+ # label = "Developmental Time-Point to Explore",
+ # choices = dev_time_points,
+ # multiple = FALSE,
+ # selected = "e12")
+ # )
+ # output$bb_data <- renderText({
+ # glue("Current Dataset: {str_to_title(input_new()$region)} - Time-Point {input$bb_tp}")
+ # })
+ # }
+ # else if (input$bb_toggle == FALSE){
+ # removeUI(
+ # selector = "div:has(>> #bb_tp)"
+ # )
+ # output$bb_data <- renderText({
+ # ""
+ # })
+ # }
+ # })
+
#update inputs when toggle is turned so that the plots auto-update
- observeEvent(input$grn_toggle|input$table_toggle|input$heatmap_toggle|input$cluster_toggle|input$as_toggle, {
+ observeEvent(input$grn_toggle|input$table_toggle|input$heatmap_toggle|input$cluster_toggle|input$as_toggle|input$bb_toggle, {
click(id = "update")
}, ignoreInit = TRUE, priority = 1)
@@ -359,7 +407,14 @@ server <- function(input, output, session) {
subset_data <- get(datafile)$TF_target_gene_info %>%
dplyr::filter(TF %in% tf_list$TF_in_data) %>%
- select(TF, gene, Genie3Weight.weight, highConfAnnot, nMotifs, bestMotif)
+ select(TF, gene, starts_with("Genie3Weight"), highConfAnnot, nMotifs, bestMotif)
+
+ #the column name for the SCENIC inference weight has a different name depending on if the timepoint
+ #is in the original dataset from 2019 nat genetic or if it is the extended dataset
+ #so need to have a variable weight_col to rename the appropriate column in the datatable() function below
+ if(input$table_tp %in% c("e12", "e15", "p0", "p3", "p6")){weight_col <- "Genie3Weight.weight"}
+ else{weight_col <- "Genie3Weight"}
+
}
else{
@@ -372,7 +427,8 @@ server <- function(input, output, session) {
subset_data <- input_new()$TF_target_gene_info %>%
dplyr::filter(TF %in% tf_list$TF_in_data) %>%
- select(TF, gene, Genie3Weight.weight, highConfAnnot, nMotifs, bestMotif)
+ select(TF, gene, starts_with("Genie3Weight"), highConfAnnot, nMotifs, bestMotif)
+ weight_col <- "Genie3Weight"
}
subset_data <- addMotifPic(subset_data)
@@ -380,7 +436,7 @@ server <- function(input, output, session) {
datatable(subset_data, escape = FALSE,
colnames = c('Gene' = 'gene', 'Number of Motifs' = 'nMotifs',
'Best Motif' = 'bestMotif',
- 'Strength of Association' = 'Genie3Weight.weight',
+ 'Strength of Association' = weight_col,
'Logo' = 'motif_logo'),
rownames = FALSE)
})
@@ -510,7 +566,7 @@ server <- function(input, output, session) {
req(input$time != "All")
plot_heatmap(tf_list$TF_in_data, "joint",input_new()$region,
- get(datafile)$TF_and_ext, per_sample = input_new()$heatmap_toggle,
+ get(datafile)$TF_and_ext, per_sample = TRUE,
timepoint = input$time)
}
else{
@@ -561,9 +617,18 @@ server <- function(input, output, session) {
width = 20, height = 25)
})
- output$heatmap_cluster <- renderPlot({
- #req(length(input_new()$tf) != 23 ) #change this line after the tf input check has been done
+ output$heatmap_cluster <- renderUI({
+
+ if(input$time == "All"){plot_width = '3500px'}
+ else{plot_width = '800px'}
+
+ plotOutput('heatmap_cluster_plot', width = plot_width)
+ })
+
+ output$heatmap_cluster_plot <- renderPlot({
+
hm_sample_cluster_plot()
+
})
@@ -584,6 +649,7 @@ server <- function(input, output, session) {
if(input_new()$cluster_toggle){
datafile <- glue("data_{reg()}_{input$cluster_tp}")
+ #print(datafile)
temp <- check_tf_input(input_new()$tf, unique(get(datafile)$TF_and_ext[["type"]]))
tf_list$TF_in_data <- temp$TF_in_data
@@ -654,12 +720,12 @@ server <- function(input, output, session) {
req(input$cluster_tp)
- color_by_cluster(get(datafile)$cell_metadata, get(datafile)$cluster_palette,
+ color_by_cluster(get(datafile)$cell_metadata,
input_new()$dim_red, input_new()$cluster_label,
per_sample = input_new()$cluster_toggle)
}
else{
- color_by_cluster(input_new()$cell_metadata, input_new()$cluster_palette,
+ color_by_cluster(input_new()$cell_metadata,
input_new()$dim_red, input_new()$cluster_label)
}
})
@@ -841,14 +907,15 @@ server <- function(input, output, session) {
req(input$as_tp)
datafile <- glue("data_{reg2()}_{input$as_tp}")
- get(datafile)$cell_metadata %>% select(ID_20190715_with_blacklist) %>% unique() %>% deframe()
+ get(datafile)$cell_metadata %>% select(ID_20201028_with_exclude) %>% unique() %>%
+ filter(!grepl("EXCLUDE", ID_20201028_with_exclude)) %>% deframe()
}
else{
- datafile <- glue("data_{input$region}")
+ datafile <- glue("data_{input$region}_extended")
get(datafile)$cell_metadata %>% select(Sample_cluster) %>% unique() %>%
- filter(!grepl("BLACKLISTED", Sample_cluster)) %>% deframe()
+ filter(!grepl("EXCLUDE", Sample_cluster)) %>% deframe()
}
})
update_in <- observe({
@@ -866,8 +933,8 @@ server <- function(input, output, session) {
sample_name <- glue("data_{reg()}_{input$as_tp}")
}
else{
- data_sample <- glue("joint_{input_new()$region}")
- sample_name <- glue("data_{input_new()$region}")
+ data_sample <- glue("joint_{input_new()$region}_extended")
+ sample_name <- glue("data_{input_new()$region}_extended")
}
#print(input_new()$as_cluster)
@@ -878,12 +945,14 @@ server <- function(input, output, session) {
#active_specific_prep(data_sample, input_new()$as_cluster)
})
-
output$as_clust <- renderUI({
fluidRow(
column(width = 7, plotOutput("active_specific_scatter")),
- column(width = 5, tableOutput("active_specific_table"))
+ column(width = 5,
+
+ (div(style='height:400px;overflow-y: scroll; width:450px;overflow-x: scroll;',
+ tableOutput("active_specific_table"))))
)
#fluidRow(plotOutput("active_specific_cluster"))
})
@@ -899,8 +968,8 @@ server <- function(input, output, session) {
names(awo) <- gsub(" ", "_", names(hm_anno$side_colors$Cluster))
to_color <- replace(awo, !grepl(input_new()$as_cluster, names(awo)), "#e5e5e5")
#print(to_color)
- gg <- color_by_cluster(data$cell_metadata, data$cluster_palette,
- "tsne", FALSE,
+ gg <- color_by_cluster(data$cell_metadata,
+ "umap", FALSE,
per_sample = input_new()$as_toggle)
if(input$as_toggle == FALSE){
gg <- gg + geom_point(aes(color = Sample_cluster), alpha = 0.2)
@@ -924,6 +993,7 @@ server <- function(input, output, session) {
head(4)
tf_list$TF_not_data <- temp$TF_not_data
+
}
else{
temp <- check_tf_input(input_new()$tf, unique(input_new()$TF_and_ext[["type"]]))
@@ -932,8 +1002,7 @@ server <- function(input, output, session) {
tf_list$TF_not_data <- temp$TF_not_data
}
- #print(tf_list$TF_in_data)
- #print(active_specific_data())
+
req(length(tf_list$TF_in_data) > 0)
plot_bar_list(active_specific_data()$data$AUC_df, tf_list$TF_in_data)
})
@@ -982,5 +1051,110 @@ server <- function(input, output, session) {
+#-------------------------Bubbles--------------------
+ #reactively changes data for bubble plot depending on inputs
+ bubble_data <- reactive({
+ # if(identical(input_new()$region, "cortex")){
+ # dend_source <- dend_order_forebrain_tp
+ # }
+ # else{
+ # dend_source <- dend_order_pons_tp
+ # }
+
+ temp <- check_tf_input(input_new()$tf, unique(input_new()$TF_and_ext[["type"]]))
+ tf_list$TF_in_data <- temp$TF_in_data %>% transform_tf_input(input_new()$TF_and_ext) %>%
+ head(12)
+ tf_list$TF_not_data <- temp$TF_not_data
+
+ data_sample <- glue("joint_{input_new()$region}_extended")
+
+ #dend_order <- dend_source[data_sample]
+
+ bubble_prep(sample = data_sample,
+ tf = tf_list$TF_in_data,
+ dend_order = input_new()$dend_order,
+ scale = FALSE)
+ #active_specific_prep(data_sample, input_new()$as_cluster)
+ })
+
+
+ # Generate the bubbleplot
+ output$bubble <- renderPlot({
+
+ #print(bubble_data()$data)
+
+ plot_bubble(data = bubble_data()$data,
+ label_palette = bubble_data$label_palette)$plot # Get plot part of output
+
+ },
+
+ # Choose width to align horizontally with dendrogram image
+ width = 1103,
+
+ # Customize the height of the bubbleplot to scale with the number of genes which
+ # are being displayed, after allocating a baseline height for the x-axis & legend
+ height = function() 150 + 30 * length(tf_list$tf_in_data))
+
+ # Create a tooltip with cluster / expression information
+ # that appears when hovering over a bubble
+ # This was adapted from this example: https://gitlab.com/snippets/16220
+
+ output$bubble_hover_info <- renderUI({
+
+ hover <- input$bubble_hover
+
+ # Find the nearest data point to the mouse hover position
+ point <- nearPoints(bubble_data()$data,
+ hover,
+ xvar = "Cluster",
+ yvar = "TF_padded",
+ maxpoints = 1) %>%
+ select(TF, Cluster, AUC, FC)
+
+ # Hide the tooltip if mouse is not hovering over a bubble
+ if (nrow(point) == 0) return(NULL)
+
+ # Create style property for tooltip
+ # background is set to the cluster colour, with opacity = 95% ("F2" at end of hex)
+ # z-index is set so we are sure are tooltip will be on top
+ style <- paste0("position:absolute; z-index:100; background-color: ", point$Colour, "F2;",
+ "left: -350px; top: 500px; width: 350px;")
+
+ # Set text to white if the background colour is dark, else it's black (default)
+ if (dark(point$Colour)) {
+ style <- paste0(style, "color: #FFFFFF")
+ }
+
+ # Specify text content of tooltips - special content for mean expression plot
+ tooltip_text <- paste0(" TF: ", point$TF, "
",
+ " Cluster: ", point$Cluster, "
",
+ " TF Activity: ", point$AUC, "
",
+ " TF Fold Change: ", point$FC, "
")
+
+ # Actual tooltip created as wellPanel
+ wellPanel(
+ style = style,
+ p(HTML(tooltip_text))
+ )
+ })
+
+ # Render the bubble plot gene labels separately with ggdraw
+ output$bubble_labels <- renderPlot({
+
+ ggdraw(plot_bubble(data = bubble_data()$data,
+ label_palette = bubble_data$label_palette)$labels) # Get labels part of output
+
+ },
+
+ # Set height of bubble plot gene labels to (hopefully) align with plots
+ height = function() 28.5 + 29 * length(input_new()$gene),
+
+ # Max length of a gene is 200px
+ # NOTE: If altering this, also change the corresponding cellWidth for
+ # splitLayout in ui.R
+ width = 200
+
+ )
+
}
diff --git a/GRN/ui.R b/GRN/ui.R
index 9b2296a..75e1555 100644
--- a/GRN/ui.R
+++ b/GRN/ui.R
@@ -72,9 +72,9 @@ ui <- fluidPage(
selected = "joint"),
selectInput(inputId = "time",
label = "Time-point to Visualize",
- choices = c("All","e12", "e15", "p0", "p3", "p6"),
+ choices = c("All", dev_time_points),
multiple = FALSE,
- selected = "All")
+ selected = "e12")
),
# -----------------DR plots ---------------------------------------------
@@ -115,6 +115,43 @@ ui <- fluidPage(
mainPanel(
tabsetPanel(
+ #-----------------------Bubble-plot-------------------
+ tabPanel(
+ title = "Dendrogram",
+ # Display the bubbleplot
+ # fluidRow(
+ # column(width = 3, materialSwitch(inputId = "bb_toggle", label = "Explore per Time-Point Data",
+ # value = FALSE, status = "success")),
+ # column(width = 3, actionButton("info5", "What Is This?"))
+ # ),
+ htmlOutput("bb_data"),
+ div(style = "margin-top: 2em; margin-left: 1em; margin-bottom: -5em;
+ overflow-x: visible; overflow-y: visible;",
+
+ fluidRow(
+ # Set cellWidths equal to the actual width of each plot (server.R)
+ splitLayout(cellWidths = c(1103, 200),
+
+ # Bubble plot(s)
+ (plotOutput("bubble",
+ hover = hoverOpts(id = "bubble_hover", clip = FALSE),
+ height = 2000) %>% ws),
+
+ # Gene labels
+ # No spinner to prevent confusing user, because there is only 1 plot
+ (plotOutput("bubble_labels", height = 2000))
+ )
+
+ ),
+
+ # UI for tooltip
+ fluidRow(
+ uiOutput("bubble_hover_info")),
+
+ ),
+ value = "bubble"
+ ),
+
# -----------------ggNet visualisation ---------------------------------------------
tabPanel(
strong("This tab displays a network visualisation of the inferred regulatory relationship between TFs and target genes.") %>% p(),
@@ -206,11 +243,16 @@ ui <- fluidPage(
fluidRow(
plotOutput("heatmap_joint")
),
- downloadButton("download_hm_joint", "Heatmap Download (PDF)"),
- div(style = "margin-left: 1.3em; margin-right: 1.3em;",
- fluidRow(
- plotOutput("heatmap_cluster")
- )),
+
+ downloadButton("download_hm_joint", "Heatmap Download (PDF)"),
+
+ (div(style='width:800px;overflow-x: scroll;',
+ uiOutput("heatmap_cluster"))),
+
+ # div(style = "margin-left: 1.3em; margin-right: 1.3em;",
+ # fluidRow(
+ # plotOutput("heatmap_cluster")
+ # )),
downloadButton("download_hm_cluster", "Heatmap Download (PDF)"),
#imageOutput("color_hm_palette", width = "6in", height = "4in")
),
From f324356d0326aacabb006ed7831d31473c6fc24e Mon Sep 17 00:00:00 2001
From: CooberHoo <84345288+CooberHoo@users.noreply.github.com>
Date: Sun, 15 Aug 2021 20:02:01 -0400
Subject: [PATCH 02/20] Dendrogram tab functional
Note: time-series tab still not functional
---
GRN/functions.R | 39 ++++++++++++++++++--
GRN/server.R | 47 ++++++++++++++++++-------
GRN/ui.R | 25 ++++++++-----
GRN/www/joint_cortex_extended_tree.png | Bin 0 -> 333519 bytes
GRN/www/joint_pons_extended_tree.png | Bin 0 -> 291716 bytes
5 files changed, 87 insertions(+), 24 deletions(-)
create mode 100644 GRN/www/joint_cortex_extended_tree.png
create mode 100644 GRN/www/joint_pons_extended_tree.png
diff --git a/GRN/functions.R b/GRN/functions.R
index ae0e210..212de14 100644
--- a/GRN/functions.R
+++ b/GRN/functions.R
@@ -239,6 +239,32 @@ transform_tf_input <- function(tf, tf_and_ext){
return(tf_to_read)
}
+
+#' Determine if a background colour is dark enough to warrant white text
+#'
+#' @param hex_color String, colour in hex colour format e.g. #000000
+#'
+#' @return TRUE if the colour is dark enough (arbitrary)
+dark <- function(hex_color) {
+
+ red <- substr(hex_color, 2, 2)
+ green <- substr(hex_color, 4, 4)
+ blue <- substr(hex_color, 6, 6)
+ dark_nums <- c(0:8)
+
+ if ((red %in% dark_nums && blue %in% dark_nums) ||
+ (red %in% dark_nums && green %in% dark_nums) ||
+ (green %in% dark_nums && blue %in% dark_nums)) {
+
+ return(TRUE)
+
+ } else {
+
+ return(FALSE)
+
+ }
+}
+
# --------------------------------Create data for plots--------------------------------
# NOTE: TF_and_ext is a dataframe (loaded already) that created in order to identify
# whether the TF data is a regular TF (with high confidence annotation)
@@ -882,7 +908,7 @@ bubble_prep <- function(sample, tf, dend_order, scale){
}
# Convert to long / tidy format with columns: Cluster, TF, AUC
- AUC <- AUC %>%
+ AUC <- AUC %>%
gather(., "TF", "AUC", 2:ncol(.))
#print(AUC)
@@ -918,19 +944,26 @@ bubble_prep <- function(sample, tf, dend_order, scale){
mutate(TF_padded = factor(TF_padded, levels = unique(.$TF_padded))) %>%
# Order the clusters on the x-axis to match the dendrogram image
- slice(match(dend_order_joint_cortex_extended, Cluster)) %>%
+ #slice(match(dend_order_joint_cortex_extended, Cluster)) %>%
# Keep columns
select(TF, Cluster, AUC, FC, TF_padded)
+ # df$Cluster <- factor(df$Cluster, levels = dend_order)
+
label_palette <- hm_anno$side_colors$Cluster
names(label_palette) <- gsub(" ", "_", names(hm_anno$side_colors$Cluster))
label_palette <- label_palette[dend_order]
+
+
return(list("data" = df, "label_palette" = label_palette))
}
-plot_bubble <- function(data, label_palette){
+plot_bubble <- function(data, label_palette, dend_order){
+
+ data$Cluster <- factor(data$Cluster, levels=dend_order)
+
p1 <- data %>%
ggplot(aes(x = Cluster, y = TF_padded)) +
geom_point(aes(size = FC, colour = AUC), alpha = 0.8) +
diff --git a/GRN/server.R b/GRN/server.R
index 80844b5..b241f2d 100644
--- a/GRN/server.R
+++ b/GRN/server.R
@@ -1052,6 +1052,19 @@ server <- function(input, output, session) {
#-------------------------Bubbles--------------------
+ output$dend_image <- renderUI({
+ image_source <- switch(input$region,
+ "cortex" = "joint_cortex_extended_tree.png",
+ "pons" = "joint_pons_extended_tree.png")
+ image_height <- switch(input$region,
+ "cortex" = "143",
+ "pons" = "120")
+ div(style = "margin-top: 3em; margin-bottom: -2em !important;",
+ fluidRow(tags$img(src = image_source, width = "1150", height = image_height))
+ )
+ })
+
+
#reactively changes data for bubble plot depending on inputs
bubble_data <- reactive({
# if(identical(input_new()$region, "cortex")){
@@ -1063,7 +1076,7 @@ server <- function(input, output, session) {
temp <- check_tf_input(input_new()$tf, unique(input_new()$TF_and_ext[["type"]]))
tf_list$TF_in_data <- temp$TF_in_data %>% transform_tf_input(input_new()$TF_and_ext) %>%
- head(12)
+ head(20)
tf_list$TF_not_data <- temp$TF_not_data
data_sample <- glue("joint_{input_new()$region}_extended")
@@ -1077,6 +1090,9 @@ server <- function(input, output, session) {
#active_specific_prep(data_sample, input_new()$as_cluster)
})
+ num_of_tf <- reactive({
+ length(tf_list$TF_in_data)
+ })
# Generate the bubbleplot
output$bubble <- renderPlot({
@@ -1084,16 +1100,21 @@ server <- function(input, output, session) {
#print(bubble_data()$data)
plot_bubble(data = bubble_data()$data,
- label_palette = bubble_data$label_palette)$plot # Get plot part of output
-
+ label_palette = bubble_data()$label_palette,
+ input_new()$dend_order)$plot # Get plot part of output
+
},
# Choose width to align horizontally with dendrogram image
- width = 1103,
+ width = 1143,
# Customize the height of the bubbleplot to scale with the number of genes which
# are being displayed, after allocating a baseline height for the x-axis & legend
- height = function() 150 + 30 * length(tf_list$tf_in_data))
+
+
+ height = function() 150 + 30 * num_of_tf()
+ )
+
# Create a tooltip with cluster / expression information
# that appears when hovering over a bubble
@@ -1103,6 +1124,8 @@ server <- function(input, output, session) {
hover <- input$bubble_hover
+
+
# Find the nearest data point to the mouse hover position
point <- nearPoints(bubble_data()$data,
hover,
@@ -1117,19 +1140,19 @@ server <- function(input, output, session) {
# Create style property for tooltip
# background is set to the cluster colour, with opacity = 95% ("F2" at end of hex)
# z-index is set so we are sure are tooltip will be on top
- style <- paste0("position:absolute; z-index:100; background-color: ", point$Colour, "F2;",
- "left: -350px; top: 500px; width: 350px;")
+ style <- paste0("position:absolute; z-index:100; background-color: ", bubble_data()$label_palette[point$Cluster], "F2;",
+ "left: -350px; top: 400px; width: 350px;")
# Set text to white if the background colour is dark, else it's black (default)
- if (dark(point$Colour)) {
+ if (dark(bubble_data()$label_palette[point$Cluster])) {
style <- paste0(style, "color: #FFFFFF")
}
# Specify text content of tooltips - special content for mean expression plot
tooltip_text <- paste0(" TF: ", point$TF, "
",
" Cluster: ", point$Cluster, "
",
- " TF Activity: ", point$AUC, "
",
- " TF Fold Change: ", point$FC, "
")
+ " TF Activity: ", point$AUC %>% round(3), "
",
+ " TF Activity Fold Change: ", point$FC %>% round(3), "
")
# Actual tooltip created as wellPanel
wellPanel(
@@ -1142,12 +1165,12 @@ server <- function(input, output, session) {
output$bubble_labels <- renderPlot({
ggdraw(plot_bubble(data = bubble_data()$data,
- label_palette = bubble_data$label_palette)$labels) # Get labels part of output
+ label_palette = bubble_data()$label_palette)$labels) # Get labels part of output
},
# Set height of bubble plot gene labels to (hopefully) align with plots
- height = function() 28.5 + 29 * length(input_new()$gene),
+ height = function() 8 + 29 * num_of_tf(),
# Max length of a gene is 200px
# NOTE: If altering this, also change the corresponding cellWidth for
diff --git a/GRN/ui.R b/GRN/ui.R
index 75e1555..94b7996 100644
--- a/GRN/ui.R
+++ b/GRN/ui.R
@@ -118,19 +118,26 @@ ui <- fluidPage(
#-----------------------Bubble-plot-------------------
tabPanel(
title = "Dendrogram",
- # Display the bubbleplot
- # fluidRow(
- # column(width = 3, materialSwitch(inputId = "bb_toggle", label = "Explore per Time-Point Data",
- # value = FALSE, status = "success")),
- # column(width = 3, actionButton("info5", "What Is This?"))
- # ),
- htmlOutput("bb_data"),
- div(style = "margin-top: 2em; margin-left: 1em; margin-bottom: -5em;
+ tags$br(),
+ tags$b("This tab displays the activity and activity fold change of up to 20 TFs over each cluster in the selected brain region."),
+ tags$br(),
+ tags$br(),
+ p("• Clusters are ordered according to the dendrogram which represents a molecular taxonomy of all cell populations"),
+
+ p("• Below the dendrogram, clusters are annotated by brain region, and time point."),
+
+ p("• Bubble colour encodes the mean TF activity within the cluster, and bubble size encodes the fold change of TF activity in each cluster compared to all other clusters - effectively describing TF specificity."),
+
+ p("• Hover over each bubble to get additional details about each cluster & its expression level"),
+
+ uiOutput("dend_image"),
+
+ div(style = "margin-top: 2em; margin-left: 0em; margin-bottom: -5em;
overflow-x: visible; overflow-y: visible;",
fluidRow(
# Set cellWidths equal to the actual width of each plot (server.R)
- splitLayout(cellWidths = c(1103, 200),
+ splitLayout(cellWidths = c(1148, 200),
# Bubble plot(s)
(plotOutput("bubble",
diff --git a/GRN/www/joint_cortex_extended_tree.png b/GRN/www/joint_cortex_extended_tree.png
new file mode 100644
index 0000000000000000000000000000000000000000..afd53aa1c34c7ae3ccb4b7363c98c01861f4ef94
GIT binary patch
literal 333519
zcmcGVcT|&E*XVJakx@q(D@q+v5=Dwg4K3qH5orTbg%A;t8jwhllEfJ+B4Hp(kQSvW
zMLG$D5(OoMs0dQ?08tZ)gn+bA((Z%r``)tFcfYmnA2(~USnxbKWuLwG*?XVgN&eH(
zX4ejd9WpX9yKK){y2!|=7|FeB4~NlE7O>3c_i{z2o5
zOz?ir?*))Uxqtc>hzDmr@LROHt|lhH<;J-|W2K)hvH2_euJK;_}dDx0fDtL+BdW)2^tn?s>Z*QXkTL
zoOB@&T|p#A&a1Jm6pE=zj16v=e{MT%>j4=vzn!<
zJ{x)Z^Jaq&Qu9uYTz5_!AeV^RTzD3HOkooDJ*Mv?f{3?~^5hp4IJR0Favde6J`)?Z
zYoBD7@Nff2?@#p6@^kg6En~hTs9CPD%|@h;=UYeoBcv?Y=8be=;GW0#!o9f3H$~Vz
zI@#5(sC}&b^T!lc@2i~$9wI5TT+iW}(!kF{w^1i~^3;5VDME%q81YdgGj(A-cF$8@
zCh8+&fh=yA(AHYaQH#y#=MLXzZI1U+Q8e0YS7f;$N$Lcy*E0xRUQYWF`6Nv{+}n%R
zX9z?9;Vv#>=jP3(oUw>uazEFTzVcH-2f9!$UrEb*fXySV+7-eI4*6
zYlr8wSqYss!gdy*z-Or`MV&VMwin%ps={-E(LUr|1pmzj@`?!lss~nVUHhRSXGhv*
zS4J#FTu)1&Xi#0E)!vP-*+bGQV6wE4i|Wyc#Wgj!lIF8%&-rny`W~D07(Y70D3E02
z=}u-(u3K5^!`jIA@cXD0JbV16B1iW7~q{{x#Ii;r?GfH+r{j
zKDqQ>7Y6zZ8JV}{{}RuQCOY@f=08rYW-0jxCq*k~VMQuiWp2dNd;h$nq`9%R(+hsX
zr{?mTOQj~e%XHI3yt72C+?qMq%Ja0sr@z2FTX>bt8L}@~^2)9ytVaUI#2y=^UZi_3
znO8-VTnhP$`X@FSl|q(xZdS6i0jyEJ`tFt}Q-1x&j94$C5JhLynw7lNukH!*Bfin1
zjMi4Xc>9;Eim~U#wXu3$Xkn`1%nRSvglckTYh^H66R@P%bXrr~I)NeO7`k$tX0xQ9
zw@*gqrT*vRkh5}&v#;{Ct1dQZgwq79u#Q+K*2Hff#DP=Hg7=2#6S8kEPjo*L+u{C1
z1mOz0YrkPkwtwT?sO+06qwROdoVb-1RlX
z>Y5et{7@iT(;1sv%O|6Kid(yDKdhAT)#CotDnRkHQ_B9+SZw^eY=fJ{%US*43;pvY
zsyZx@`5@uCT7zo(MNoEG2bEq0Sjr|!T)rmc5d4{B53hsNIl!%deDX}gBUak;TJsME
zl6dcl_*?}7;68+DzRz0!m(Y)9J(&LePoTg;m%*rMF@UX%(1K~sIjvf14QU$8%*d+d
z|MgXW;>6M28@jT7!a?uI)>nNOdt)ZBX~j;$3zQ?QXW#fS6wrF7PvbA0F4%eoCo>J)
z$x})Rrjg%Kyn7G%0Vrgp!?gU$n(oGg1=+!hBW`phsmeyX&B0K#iXJjx$c`A%6)>y9
zn=L0;w^|HLj5^8Ng+i22^!-Ipt9BXxy{YH_wZ45<$w`%eDeucsfAlY#uVy9w%Qj@L
zr7?6j|8Z&Vzf)Sdki3||uZXL!e!BJR>5Q(h%{Hvl3M-F9ecEy9;q_Fo`$KYg>Ydkr
zoxI`v#Q>E3B{Sn0g}t(sGSB*KOi>OXR}Su*WBxdr(oOuJvq1a;}>@~
ziqFLLyIbWk78-_pO+7<<98LNCw1B-e`w5(ptCNp|c4x{&e|N3a@Ob3$!d?>)vWTYxm->DbnhtMb8vEX)7qB}S;2*`SS}|$Drb?_
zL-3v~rJijN`hNta(X%^7t(0i;*UG-P&2!YS>iSb&2eICdm3XxeR)rTELfxb;YbY)D
zGa~4luu_*Iatdoo864QDd4j)K47v5Ii;m2xc@5g$nUpItE?u>iVKIY!p;b8Vm{8;&
z(DyD{?x(+!hYlcEp0N*FeJoX$Yc9QviOZW#)LNKgaa7DuxC?q4Hzi4$IKRr#`PFp?ZhB-QS`+zF9boBvnc3TB-iUw;M|!r|ZMNOJ
zGh)E-v+x3k`Xr1Zdx!{My9u8jyVhe48hm;MxXw2{3KX!8O5LQdCFQnpf$287PPjLwyBeZnG7-!>kCB;i7RoV2#sz56MH*PDa`c|W)QLIn62dDR6{w);ypcB=cz2EsYjS2L}X^s`v;*kGJs`+
zD$#8IvJtd}Q??)VVFzQ!v~8qO&$=ym+B*@ee2oEo@8hnc7ET0z*v^4TZezC&qe7~t
z3wxilO3)P@dDQ}%{-ul(6gr$%G~}Khh#0@3#jd(c>8)vVn8+-QVPCQGKc&*38nu3h
zH7#3=a>L$pgVJLJFm1FqSKgXt)oee)ZJfbAv^dxlIXu_LG1y^`UjmIou%vp{`(N0>j}(ydm5B=Q(O0!>ek(7
zM5%y^g_UeQ0h+vhpQb(jwu;9!GhI@sw4Z->;8DwgGef9m#~+H>_;f~%YL(Q&nl|pU
zrYk}3$n*fN;fC2RNcI_MWq*-qsr
z&RyD`<=c=pEao=Ox~#7*CX%&clo7v<9c*pwX3IaWD4ILFOb$(yqUzuI-tW(%im=`K
zt@(c9FY>fQnp*N>ST-cmmY62%88%qqWp;+ckTxzsEkv|k1k&R%UvkaR*T@URdPH&%
zdh`Wj!I+dtz~(bo>}I7k^=L|DAEg!akX!8c68zu(&9d1Vt2Ql-kBKfVv&Vyz7f&3s
zqP%j#uc+SHd02WbD6Tw{Spk46_?8zCu##mjC
zY4U~bG1$=rxV@)Bb7W2~~g7PUH@+%Y
zQr|H2<5VGE@h2g5#){%Ju~G64HkGUA`NNF_uEC#|cbdh3n~Y{wSMTr3w|xXJ0}k$X
z(FBzi`0V`$9BdyEB_
zMZE$2^aRHV*QUzR`CWg$83`hd;gnSkkwVtcM*7qfZ8<_tWE(7;C|aY#cLO%cO(YTi
zDL&cE8|>Yo@`qEYC4uN!)z#@YugN15vKHU|O5v62p4P34e4~21KZaLpFADTJI%}+s
zDrM9}lw(eB>5YL6AH+WJ#otu=@HNK9EuxqS_7FcDVTC$@$W@Ylk_G)77-RS+o8>zT
zk7sajSFniPhg_0K7SGH=>iDrT^*!!+z?
z`|b+3?7H$<<$dvFSFwj<-Q|nm{_&MSab@Wc&x_9x178fXYN!>FdhWI1J(D9~7L1J$
z#Fp%qK($PsFwNihT>%Pp)duEbqR>7oHMM8S8R8j{F%}0vDN!rf_ff8Y6
zTKIHKSK#v4A(tis*ph-t9o$!xL{M*E~!CT7^MNx7H3?RU!_y^!*czIP*#f$&)S
zv4yhk*c;hhb%Em$`qDSMkw-e*&hrujrMX{9F9E#O$_iNr;t|)41Wt$
z>&eWE8;`HnSDpM!MCXH1Qwd*(Ya$gb$=Z#*Qtj-`DxnW}^jW`}N6LK)Z$?m58PzVR
zgcG)I8tN`ul;{WWBampt16qLYMXME#3kp@%4EL^Cf$GH|L8mWZPP^96>fA;gY|~*`
zyP@_qiSN0Z{>EMRBONVFP_Y7dVTAKzyAgQDLEd~=z4ZC6b0;w5Bo5j1V$Ts-6$Nsf
zE-LFT@;rq85sdOC-we?tE3f*3yO!(=c^X5I<(H07vOv*a44`kbk)bp-14C9xXwJQj
zhCf1}nW&nf3sy7yx3O?A7+I}?{$N@ELYw)zx!ZU`Sb%cvm)8Oqf3wrDcW=N$PCIZd
zLbAK^ezYw`Bd`y0f6cLSP+dJYMmK1vC~_D-lb)m0!(32eIdA-u3VD$6!XsR-#*z}`
z8gh0y#U!lL9M&eJNfNp7jQ7oV_^8+ScPG)4HwSDCp=aj(7D`e+%FLejSLprmV?-fO
z;4&QeSvYG54i=448;S&n8j^_1QgwjP-MX%wPLLdRQiYmJdSh@WX1CuB_UWJ0g;^^z
zNoO4O{T_y|&MLPHoTnxgBew%K2Ucp*FcndT!F5)7zu>f
z5jckVMC&d8Lb#d&F&oijsBZVDm`79+|1w|?m-sL+irKcqw3$Mzty@YNtjDgZ6ZzwaW1J7S1Qwjb(?9S;v
zZJ{2Ab83#agr|uir~e+^;7Bh%kUW_9}y1L$-Rz(z+e%Je>exBmBf3#QF@Ux
zh7J)q;e|Ef&HNPBEu^Xuywp4B4Z-vPPFSMe%k>Nnv;t;}Eu}gY*23B1t`$Ggb~r(tbh>qx5c`Jx`DT>x-@Q&GNdaECu4lcaPf-(~A4_v(lV;}sp}0=v}8p+L$B
zz$ro+Q)xy!Pa(b1|MSksN;5W0dovv<|>xcOu)FdbGywt^bp
z(gqBLSrd*|*Dy>fhJI5tmSJalL|!1+h&$I++*!%vR}U5Y-$JN7n%;03GR*|^8tw0c
z6AgK+#Eu@D>JXGU_a1x5Sok&)%j0*%s_JB4Ejj&yz==9MsYmavZG8wg5y;sr$C5{H
zA?XY*WaDUHG0Up5XEAbUU+@-xt!8y_d+Q{*zKOqzsIoGRaNf=^)jX@D`TcLUi5r&qw)ohZFE
zrfuZNphhm$!KELCOfHG`Phb&+oAkPEco)e}ylos5kAFrkf%%V*#W8%xN!#4jS>#
z1P(({phwTg9`RUK^YB={JiU4#bpefW*MC3HM!J87#&kHIOKY594XRPpLnE`N1$Yfm
z+lsK(o0(#CYqz%o)GuSmydt>WGW#}TVfk?hqo%ucoa-2zQc~qsn>QvXA~?=e@sb%O
zLbqN47?-bDSQGs7szY-y<+aLFtEB;Blz0~WE!UXJPw+Vhw|3%1`czDP%aohpmdJ-r4C}BVKtZw%rQvAab^{qpY{Z%NZ>+SnCh@}{Am+sk*T`N|6
z+_DX>pO*CIq;D?}GlU>6kD!X?d(*JX8CcR;IrC@+HC!h>{>BI4XzYY1l-g@i04C{1
z=X?2kYBed$@q^}G1^mK4sUDAi>$V(rQYZ{>9uW8?YE#D1iNn6?(gdDSqCDcdt>IMu
zx}_aqPtJr
zR4*E~%~Oa)kGeGpuW?e11UfPH1V#;3#f!4S;T!H1E7g;fb~f|PPP7i4J`Xf8^NXk>CE7U+&ScitkPF-A@kN4Htd8O0w|PADIRHa~htc
z6xqVo%WQZQ*hla;n1e?PVLKe_4ki5NBpXpaKKO4eQk9HnHk@8R^>EU
zVJeaaGq~3eVO{9l#=KK7?H-J3)8(T0uTO)tnjLjarlABm0!LuE>aADFSP;+Sq~qg>
z^N5o!rQt_QBP&%pPa(VBa2p?cM^5Ca{LP56b=BXVH^^8Z=4H~;3$M=ybkBF@+vwPv`lP2@KByb`v(tz}FRqixI@kTLlcDej;`8uL1cxe1(z0`KnMncFMU`b#z_a
zmn6)Qk^`E%pfur1XL6UN;B`;cOy0Mq3z=4MJEh_|?%JJ5RoXG{S?XLZIWR(-6&g_G
zaGzNAq}4r_B;nR}$FI-f6v@xNtS2iGI1PSiGnPFMtOepm4a4VM@ZxV%iFCyB?e4=v
z0rjC^Ql&|`mYW=LcE8;qFWlQ8=0O-*R30h5KB*p?lwvnh-e@}8U!C80MO%qj
zdpq!`otwp2c&-cEosq4CL^ITxkb>;dB9FFnc1Jn03HrXZpYJH%;al{sBw!0*20B+=zo5C2*c2_VFXVa)VufW0B_3
zOM$3-QkPrauicF%$%0;edpvPb_JbP-isv}WL+Oi+W^2hkk?L4B=Pe_wZ7=zm+Nx=2
zq$zIgd63)v(fsFQHWuD02&aMTy;(l_O>_W^LW|z_bY-kKi;{TL;KqCO1rjabzZ0+;!_u;!xtNI-!qdu<$&>(dgNUqt-5JILTl9{-JcpT2T=i`bzh^FX^FgO(cOHpM*{)6C
z%zW+RdP15D9iv;%7XSSeTpipkog}HOFg=Q@ncQiI-uJPedwrl8G+*JYI2+R*3%W8p
zpzI1*x$a5Y*r-Mn3{8zBmw=UWG!`AEcb`$?o?NK8&%sym%0&ph$6}#6aGwdIO||(r
zDBN!D+H{qVDw%TFZg*ST%Hy0wc$3()xM^)HNXPUl;X3*g5BgVNNUZ~q45{j{+&wH6
zF?2lNN>`l#9c?LtL*}I|h_*Evpi8Yus^XM|zd(O+Nn!M1biN1aHYwmHlJ9og>>CnmSKOK)7k!r$*
zEnGDYC7?yQK`2G?RG)y`7}_ulR
z<9A!7EKuH*S4*;@)9)!(UaP9)-2jjK)G6L?c-$J?c#L4~mFzfaUCrOy8;^{053M
zO9|?-g~0i(&KM>jcqy75ZeXnBT_3e=jZ?;<;j*-^S}9B?;CkKFmLfhQO22eqIQh9l
zrBhp@-L=7xAZ_h=GSjYo0gTx=BqiolT6w?-8Bh9P_^!egFaA;gQ7}+zUxp5s>kgki
zW_-YDcak{Z&$@AVgd*84pxGpTHns|}_wlHea3vj87|RI5ufMEq5e&;|hk@0E%>b%5
zz&ayG2_DYL>xd=g2~1((tLsb$du1;
zg64=M;n5F@fnX$|D`12Y-^R9X`)nRsm7#G3gBAe>QvymkAsEg8*Z-Ucl&%WjfVGA>
z4*Pjknn%&cW1!|bv%>x;KnrksIF0I$*~d4^*^#9r3+4-JGv!sg3n{M%jACr;&{Vx!
z&@Fz(DCqWi5jy}Q+{Qt_W>8iO?~E{hj9V9u?gO49z&SkY3qXrf0cpePZAG}Mb;Maq
zND~<6G7O-zjV)sf`&cHhjpwKY8|C#}?6`!ib&!Y@^wH*46HmwIkST69@%-#1PzLYP
zOd3}cy(6hviSR_in+fMJC}?6}ecMr;0?#4Scjah1;-%4r$_bH}`Dg7d6SGdY_zE!F
zU-@W!CeqseDeK{fAj{XFf1kR(JBtrFg;RThZ
z3cfd#rZtM)ZuB_(^p+P?hrB3+
z`nVPhLweFmou46wzD2B?sg&ff#9ga0!g^X6fe_XwZRUZ<`IDwP3l$7
zO?}dX4<-tQm0mtXonKNqr_?BCG;$2lQjB-Bw>g{L$@Q!>dKBDpY{=+6Sg_Cr4+X@W
z%3h(5x`66ZfNR|ciuu81v{HkPbt5C+UK5j3!r&THXhvo;uTs*ZVlfO)H_a&l6jN%+
zQTLc{^&XyE%5$6l86aLIFu2F`2xY*7%RU+@9F61FQ;Z+e8M+|N0io{%V~$bou+vq8
z$nk`+YIEYK#D&1=VAo7!FkYlOM)Qhx5;(-%xX}6JyR*uZZmRLPMh9)QqU5UZU5C=j
z1g{-stqTTU>Y&re-0sxhHgJ-Cm~4j@+No3CaY(Cos$0Ku*V2rVVsW)6!TlvyXmq9t
z+@K;B7EjgA2e)v464Fe=iNm3bPp6X5QR`1W!WHnu=y$lGWQDW
zTBZK^ALmz#96A~Pd(>ANGeKu2@IeF77K6a&D_*GmSek
z;XLKXznz9%LC`+M($RkCTwu}yh&V`|$^cZsu1>*x@6GiPwl4WwEH?$p@-k@N
zH8#WA>D%4=^HWCefTo_UG#@qGxP|ZQX}Tq8^rrOR+2LU?UbtW25kSM
z2~4uFAbXdep)RZ|*go-FKgv5e6G0b2(!3YUJ%G1?BO+v6Rw
zlyo*V8T|E);H|isDVKxW&=0WbWx|OXl6)c*A4g7@u@D+L!jI($4isR8T@BbqRE*bR3V56Yw
zwEXkl9#6aek$4cAVo}Nn*M8P2d;r>G6$Pso-ZSyQE$BAC$tV7+4LF&pN@@F-+Qog&
zB%_wkyTI(x!#6%~SQ|E(<=-yw8DGq#EbExVKUZXTj3-+>FX^ZTU1U^J!1ouGYKRLcoQH{~X
z+h3M)*geS8O%3a!Df}+rTGN-stsBIA`*D0Tzf+xH;!uXDeaD#p1-Qm=Am@nYzi6f5
zyod8slAPW9wMSOO<=~XK*ZQ5Cx%a#)`N)fs8*isFF1+6kpjwVD6`PzmRwK64G5KvsDXv!@{I4jn^tm}vUghd}
zunN}$tRleq3-gmghP6W$13ecTt@%w{2$0yu!GI5R%$F;wThE(?0Fo8DmZHbO^~*KS
z5o)A;X{>AM>{nnzafprLH-UD8NOafX6pY)_Org#%fcoODNnicZU$44I6>+JVf>6m{K!{7;pJP8mu=e;XFfAo
z`cknZZgcgUhEl)C%OsaxUQd}H4hliu9$m`>s~Z_oan}eqT02O;yZ%!pF3n=2
z1XQ0fJHc+?+WPb!@7sKbqtc5Sp~#FKgWvI)O$_G$;X{3HbS}qHqjtVsZSz~vcO7pe
zRk$`+V@h=$EQOD*2a3zWAMmB}A=8Hvh2hpA`-gP#z^=_#8@>ii6k2JYMEj*v4mz`{
zYAk$SlWqL7`!KCdU5BrX%^`=RB{cGT6DMUK>si6x9sxpQm$H8(X_Bi}STyvV=+UbR
z|6#e|RiJ)lsQ11=VW#c1JYFw~Z}G5Yzysj+IpHaqdr{CfkAQ*pF9nI)h%@R|Ed
zTv<<<-ejG)p+Uu&dv|9FQ?T?>t<7OX5d2oz%9mQ*SkyDO6dZCYLTmA_+i%)Pa@tnW
z%9~?8bSawj%Rp+%uahW5vi>yAjY6YFVt$a
zBY7a#7He(*6IAMa0WSF87K|LHwZ-fKN|><^{#lXJ(iE)gx(%U#c{y#jP(?TL?#;IS
zpAyocyFoTEJ-E-M!67(N!&l$BV3Xi@$hXtl>6O{zyORwqScoaby{pcglpF0%9}u(
ztJY*=l^1}EtSOLW?Gwz)kF-~uM67OtoQ4Rp|4ikkPQCP;4tQ;2h1t83qvkBEE}M-M
zs<~B}DiA{J2>wqw1q=FdsO+3Asv&+@@<$+@<~%`IOJL0#=mH!KKuYm
z93#YN0F}(xQAFHWLxqD<)ayMds5YlTK1#ruov>C!)i+k~e;-<(s{Pi3^rB5(S{1y!8R=g+$LSA%{(@Yw{^JBKh&(UvIP-D
zqLqb@khcSKbY9WL%oR(bYT<0Hea3CnzCfTmu)h*Yx73HsELACj!u$C5(X3w*KLzRB
zhOeb`PX85ZsZpiDa@R+Bltv|tU5qEs4wnhTSe2En0@ka(MT;jXvrGN(9`UutkmmEL
zb`H00qspnY68;~KSqq6E)>oozbLy}_#wk-wE#{Fi!;G3TG@@X}I6XmFsO%ksD~)}m
zP-XnQv%aS10zyE{k910{GI6x3(u)lr5ErxDLR-G9g1n!-DTq7HZpqga#yq-MX$s3^
zl%YJZQfdTn8$pT02sp0&5kL}cj3m~)T!ttX6mB+|od1ypp{)vFFJ=uF-9r#*g23X=
z(&uAjw=pF6Qs>F<+ECB=8FDo4)bU3iUPH&5ed5rXvlfN12r@Afzl3pa#`+GEiw99T
zAIMwf%&yv!$ac$1bTV=+1_WzS1yl8?k1MXtQq8JjjKaxK3QADdU8DrxcqjH$MZ|_9=P93F|K5$Jh_5XL4@!fd-4{Y|BQ{~t|GW-44f6#%I48SR=8*Dt)Df_}Vwn?O%K$mZ
zh4Iz4I1tA?^wakziUj{VVFdpvjwSWYUDN}kPdukV-oo?C4S9VnBi9|WiJpI!#Cl>o-f2Cs_U3{uIm
zVXcx{(%VXqZe$!fLU4JkROMAyLg}?u+;wrNR`_9JWzf3{S1MZRvPd)ja_<%E2e@@e
zVj0f&e;c=3{*ms0KF8yMBTh+Hp^GPYabqzb6E$12}eD(*!6
z-WTGG=LMR;^l<-=3FDi~atZr2>cEZ9-lrwlz!IxXEWO19W#lCoMxrF5ZlJlm(XZg^&
ze2^dQfuoRbEIb&_j--QXLj8=GPZ+wiU8a+F|77JMO^1AQYv&m7*!6{`u%?^BqoOFx
z4P?y2JWZRSBPeH6YjD)Y1b_WEDVDIu%QHL6EPMq~b;v70^q*1*Ptb3Jq*cF+Ijey
zGgZ?+(2E@yM4vg->e>_wJZl0st_{>5!rRI>7s|!YZQ#eHTeZMTE#c6=5ZT`tMlm+D
zODCG>g>xLpa+IwbkGkxc`o{o$yUgS!I!x#*W-Oc%MU_Y)VQ<@5db{HLela~$Y6_d%
z3qSFQ{s&9sUyw#XQFv(SELEFFT|{j(2ImNPCYyTVv`OrBYl3x#8iPqYK8cE}U4!B)
zZHODVH}wt>bm>A9qXz%@$EJwX%5p=NWq%bC&xO*@4^3gvN-IPZXFwTg^%2t@`yEw0
z%HBJoACw^s?v_th3@drs#>R
zeCf?!fyj}SU@vV{qCRX;t`dmi7|t{4x$}n`3QB;Ajy3abBW)
z96w0Yl+9>+R|(KRq+P(~xK4NiK(3MvF*etS=(rbD3*jxc?^kNxC9>737R7SKyAl}@*72+Negnrvyrcr8)~A#BVMy<{Pw%Qw16o75WJ^9GdEDa(eiCPJ=U0%TmA412
zXt7bK8~bIobskei({v$(Aga&^hp%lDzga;$5)yAMheadS!5eDqUBC6-mMgYU(F!
zC1fjwJ=Es$_Xx-#xcXF7c|i(+(>&jnsQIr0;WRb2RI)0&s(nzb>9$;_sC5fSy$M9gpa^y$WECP*OFNW5#5i?*cQ8HQOb0F#A4>ubZm%s^ftGRdUgbF
zl{0i;KLb|hQuT`Lv(^+NgxL&T|mO;z>
zGfRdr2|p5N>Y0r|tp8Ez{BdhVRO=eq945fjMzGzra7kRfA_4byTOKPir=5Gi02AwBb>QSv|(AkJTmjj{r
zy5|wsZdy5&KXgWVH4BQ%ve2KxhYbFRAi_hQyV)T~KjOw>5yV2n@)^T~!w&eE3_mLZ
zCm0xwNj4ELHir)Bwpz#d{MI9fF-p}0bxx;HU?Q5oHD*(f#3`5Z9*}>^?y|Vq76m9D
zW%yPlVTQ-w)Pt8wvM-|_?B6XjqqxHL{LUekMHJT827hgwM)689>tgQsmy@%#ZH2EL
zXIzH#wo42xSC59)h3DkyAE%K(Ol%L|X(a8{8gFkex(vCt5^{v%{n2#{RgR~CxzFYP
z&M2QtjHQGu`uLKtmPb`;DD6+E*ZN>7IK1ECpn-SQ@RiHS5k1fQz`G=T>LzwLQ`qhM
z`mxf{+gopJbb7(ayk47qAhiLwmN{^&Q0IlBLt{kp&|{@?kl+Y_DaiE?bS?$E_Pm*n
zyV4J$ixD}P+yIz~7nklSDcrH4ckf@*E?^W)_Q_R&kYS#!JsvKoN!#_PysFJ4T-6E^
zm@8##XNONNX5_^whZO*y3SD%*^lA6P|E|qV2=iZlOg5R3JbeVWOc*;)EDi+=sAjXA
zv`~lvY;fZFyE3YS>(l#!X9bvh8o;owpurlrK=4lo;D0{CsW6uQ)L2KCV$h}OH0MQA
zHROjNIPHaVZH4q10;F932^2TW+oJX%Hcde1*&OqV_MC1aA%3}n6i`lP
zYldbid4MEEtQFy%Pnn}9&=rPUoS``Kk&R-hHnUu5$I|7P~fQ5BkVLY*VrcAgt--
zgLQV54#{XxGIr7+VQ2ZH93?qnX4f=z!f=E{koGC^DYDao-#v#XMgc`W?@kc30h>G9
zgCto-hK*bo8b+XqLVvnU$A_t0i)XXfP7Xmpy(n9@nw`HAy_XS@69%T8Z<#-$`jF#c
zs<;&%QkqbG%Zn_6Mp_cA-nBU4jmEEYsxevN)vvbsCFa?0mdZgmI#F+*SM2x
zC64JI8BZIC0l@l1$Vc0hO5R_%x!
zL`89%4a$80RbX+T;l$T+DoVf7QTmZ2Sytzv{t+9D1Ob$e&_wiTCn^;}FHHJHt%;|&
ziV8^?jY#c_yRa5};?O#o9Js0kYTstz+1nm3-v^$B09==zUxm{7AW9u4=XqV8sv?3?
zrDWqT!ny?HTHD^%4ozcGf6MM?ye6Maj$qdxGlFGKCASp2Xcxk3sTI&r(bS-3X@TQM
zqib91UP~QWF$g?M6Ga&ML0q6`>d0OP?ZgU|$*0V(?PWcyvTDbtWnK`YeJ%|F4_Wii
zD|LeU3I2#7&dGTB2lXM%tq+H7AJ5yp*eR_1dz!ibXwwgWk5MuxoRsH1a7y#>4Pg$o
zH34aJLU_)KVCCRV;5a+Q-W{Xe14%>hrt5do&?0sK+Ac8svZ*vwGZ?-rrJzlV*@g*q
z)d`Og@aQvODEi1B$iMhL+4q$A%-w%>G{FD*aBJ3^{bdF|RUGXl>H3Q5ghXc0|V5RFWh8d%XT}VOxk||?PV2dV=URdLICIM1WkF*~@CXq_!r5lt1n)`;G
zTLbP;VHUX8At?Ozs-502JR~o6QIT&HnljDx>*PmNSHkggiV4DWUxWNM~@LY~8&Zz_bL{K4$7W;s=Z^yj`c>SR*gp&JR2gt9lwF
z+)P612-c<$miFm6d3zdZI-!sZ;vzOI+e$D~ObX9|KLyF>6jxzm(v&Itu%-j)LS^Hl
zw^5TLKgs)?@|-b*4OT<5CRQ8^dFej55koZt>jxavK;OYu!tX_$JVsyb{R%Q5d9HOC
z%oO4Gw?vJ=35o6yV8c4a2WIT2@xPx@@f&Pne4l5ODAKL
zdt+GS;My`Ky5b4aeR|cOR;{I;4MHR+=7C?6z@Zml#fQ>Sit0Fc(GT-ZgTqW`rf-Vl
zuTCa&W8evV;$nsp`qNV;YqqEs^gmVL0gW+;r@g(+i1Gz=3{S%bBg-44p@rL}f1fCb
z`~k&7RY}M*3DK$r}XA}
zJw#`}*8neHRp74O7NyqVre@h^n=59~bBer}#8k3Z?c7N^)*e4fg2XQus*ag1e>h8Q
zkPaZl17B)KcLUILel%=`lDtv;Zk%T8guh)OBsi2w
z#!UQBk7$4B!uo4B(hlI-;VX+9pLc4{A)-I4k90{2V{_yxC0849$)E+<KPYU_m%`YK&Ps(+zCE1RbP#W$~*V>-?LJ(%|9oEBKagcisrWYcIj=`ixUB
zl}O0b8Q#)!bJ1rxRn3?j`wyLOB;hVN|3ENNSTJ85)$^Rm?-w@?wayuMDny_woT=f`
z#CzvbFJLkG0rO3czuLfHWtgWlPvuoIx)X5Hi0^1x$EUyJR^RujfVf}_ca
z@YV0#S{uMD7QYoH8u?0_)YD_x4m|dxy+0TI0sb!${(DdluAy7R
z0$^1D!iL>V3!RGcN2^j}TOGBVxEZgsf`|T19mePX3OfH3@OaV_^3s8`>Sk~nJXgkm
z$D1INs5lvg)|75tf2A|>)Lo?(!22a?oVK9OQA=l@%3-E2m8!tE)PG&%u7UUtcp=lh
zKx|WRQ(_CAhh7Jw1bdmuy>9#+J8aG>
z1GB6g=gl=-IhoiqHubuciHz9z@=fygT1&7!P-?QS1OX2bb`t!LW`8>fo|=v>k))zm
zeaq_%C+um@nYPWo<~DS0@nu!NWvcW3faWhg{^UCQW6XZ=Wq17%(aV{giSqezXR->}
z@vg(#UYNP~&yq4rf$*j&jdqMJ9mi>gr9h^}H#x*pX(N8j>M=UOwj$~2;C7O!`h&b>
z7P!~5zwtRlF6xN;;Q$!f=yfv|2CFPi
zhtHqqPGLu_kk4}o+Cp?ADgK^(s_jHoJ~>QUqvBBj{B!@n%9P6rb>v?!|^N}Zf=N~IMsYB?y^uW@E>7ExE7o5x+;?_RjUA?y4
zYonuWSK0XG{?(ki9t%^@A#?vZo7rF`3b?lSalnMJ{NomDzMC3YDi{N+i)&xLSV=Rg
zuo1QaASI{0v6%V@N{>Z*tAlBrbT*r^ij5bWc8Gd*+1%l0OIyEA2MTv`)@=Dq-;E(A
zs~i1(q*(_%6=wJhbp6=iSb))Y0ECKxWeVVNzg$82YbPao-lj>4UQbc>#y=3Z(I46R
z#%ZIQCEuKTLJj1A|H0jxM>TzY@uIZ0wSq&HNoA@iAjlx7fHJkpATkMvfDEZ3%8(ES
zK^cmBK!}PEWge7BfP^t=L5UCn88kqE6vIqHBtRkwN$v@@zx%uIuJ_iuYrXf+
z%UU8sa=z#6v(Mi9ob%bAePiZxQ)Ne5M=|&MAs#@$|8!`+w`6{~3|;MphUI=)GfTwL
zna4#`{8I!s4?|3&GKdFk0ufw1A;sPfaV(nW+Pjs07u~ehkU52+X{Zx2tTqseg38Id
z>)4$U9DvV_ipZ1N87P+6xwMmGUU~gpCS|pDZGhGdh(sZRD#
zlq(urPv4|e`$>xr@kf4&TQ~=>2lb9i9+M-LrCfl+8bn7&Cy~{Nv!Y=``km15T_Ybl
zYgjYA5W%Q@MS{wU*sQZcq-
zMGQQfb-n9Jq=w6pRLbR{EtNncf**op!xxnYM$TWd6E#lq!aXVFIut&M-
z2yhtXt!M5$RwaKrZn27t7GBStT=bK`eCbFdXUHUnT1;
z<5-)u??rEkUJH0z!T!EqQ7RQD{@QI9O>5=e`*1PwVcBBzZ{X&=-BP$!6x{#L#hK&Kw!ekj^LEBbV*
zEN2>{VQmHF$1mGUj9LmVpF8^4*;X6po|rd$eVHLgzkBBUQ!Z#D@?;kPH{{Khf{1uX
zTZ$oB8;u-up^_?2;yuZaeo8WH3*
zJR!>2nd%X11JH@~3O;Z>IG(g9DX3EwY8cD@-92oYPJv873;ZJU9kdZ?L
z_fxgAQw{^X&1i2On8C{*r#mI(DE`&@UF`jP
z6jv3czU+y7+>aYTYcAbLRb`Rtz_7M*E)-qy1eZVpO&tW)*T
z-WwxF+Ie^>e(d<_SXnX~$bf%ij*4+HKL$TO``}e86d=f)o;ZWgLK>EqMWde|_Zk{9
zk_MCoqQJ0zmEdt5ihFafA0Yr9-^|ph2UtLp#q#~wf!;m`SZ#xTCelqC4h}qlV@ARk
zT)>iKjD<19J}E3eObmTTjGuwkm-#N~#9B0VMtz{4jrFH#Q~ateTlgRO$V&H0*ONt)
z+Lj<05l=o>xU@@(W@)jSI6rHh9z_|f|bL5Q{
zXS^H&UNx-mptm$JIBRSe!1;=~7;+2iSgq?5S2Q`g{msR|W?`*z2f!ePOS1yBW=ONX
zPFzwx(f^}%3W4pQNVQ2|q)@d-D)i}Y4@BY#qXc*&mtoYYVwN~yid?I2$
zfbH|LPWAjq-Q;oFf;78_2@|0JGI6UK~RW
zop_fGsgvM0#X3er>kEZ+gFtnA^|X*Y@{Rd40B72F6_Hf)L|;hwFcs2b+hNDf0v*$6
zoI2FTlS2EX0JCilfj3SKiQ6{0`f`^a!VlA?9AK+PB4Z#b^4(PM_lnM_;TWy3-e3Tj
zi-YF8HLZXyj}&cAgn-_~N7MD!u7rB&W4=NbvzZzN2q>pI#%3Y;^T>xRE|q{5Xu@$2R2mcwh{
z%RflMKi%#DH8^q{fD8Y5^M62=r|B70W7uHIm&u4t+02v1e+7U2)MJq3&xVKvSzCf~
zUL?>G0p_k+va;=B^W>8Zls3R0PBPuL&=+iHCzrw5v@okPBu5po(s!}hR;&{+SU|NF
zvg8Tjni|dX@)NH;qsJR(03c6Q%-auk`^V?=0qSzEn>L09i5bIhDVt`HW3B>N;(Sam
zz!G)_^j@`&g$-3NUH(HzSnlyLS$Zk&rd?xX9!1m2rt2M_
z<_CeqkVa?>*8)H&qlja>2^xtD(jmr|X($tBxRn_#Hc(89CE3K>y-B5h1}|F3kfY~a
z;S=+v5|M%jKR@%&%DY*r$=40*or29EPe3uMUkVNZC|_Js`<9D|1FZE@Pwji?Pl?JQlqGS&C_y06B&L&Dmpb-L6_cQwXtFv_ozNW{G!vZa?UJ`HsPR#@t5|rBj`tigTwB}h8qi$rjCy#8
zpAZGQXQh$k27Wyf1>a7`*ePaH+|-+468y`f!wfZzBo}};70Lsx2bk3_wI8d!Uu~e)
zr1+=*PhWqwtl>1tachj983rEHPc^NwD+ABIjwp*in`y|+z)T7O4v~won-`qSoE0;O
zrvt7k)_|*P&DemmuNRqZn&s1{>{vlMDM&0@&*bI$a$VIr+mf`wak$a%Z^;Kgr5$Rt
zCAlBidq`IvmVL(CmS})^7y^BGBJliyk-MeuZl&4M9Ssfsi0%u*bk#k{6;8lsI_&;4
z>YqL*GdC+$v_}X{iH4oJDv9Ac>5?kVfZyQRubZ!LkWIR*wbi^@=*_*e)#Ch6tSsfj
z5XIRfZF<7`+kabmmvd2$QZR-&Fg2tZH+m$^mbKea`COw5^1dk5pFu0dw}JfU!l*ba
zFLR{*P7A}F(>cb?in=O6!XjIq;jZ-h&`XaH{$8))8d{fxHhz<5Y1&IkWViXM{Gyr)
zRqxlrG|jmCuNFqMw;O#D7TR`^PB3^@xYNTid;aagZ&$oTmGc@(6>V@#Kd&LGGCD6h
zC<$U1YnL2!kq&J>vq~qFM?!^KJPAl9xW|!%?WFP@x@0MYUX(Ph)
z--fIm5147|shZ``-NxFYin}%l4yDh(SurC=VG1he2^3u$QbgrFLRyvwh?b2r{U^Qz
z*%eyTwITZ=hDp@ozg{7-9=d@h#dY`a?5wv=X_Fnc63-E^{e4)1)~1gv@lT)nLrte9
z8j-8vt;INWX-#}Dsk>gS7PWIqjzU-JtO=rCayQ=~Ta-S!Jj5fJDVI7FRh7D-09zCD
zDxn;dq1O}`FwbrY3K?jNitw*?%Nf(*XxXuDkOL}P4P1DT*u2pOf2>!mziSR+vg4eA
zDs|xxwd+AUdwEX!vKtha(&l9pT`D8>yE<}L-MU^8ol+rji4wA(hTm(RQ)Q*c<$96n
zPC7@9BJl;kuv}vdH5&KoW-ag$BpaRjv2AuxA1)&9cTY*OyxZi^IU1}A~^7QXc)>Q&6j(aqf=pg
z-CZ?7NfSO$$ZK@xl-N$Q&qqa