Merge pull request #30 from CRI-iAtlas/fix_barchart_module

fix feature name and display issue, added example

R/barplot_server.R

@@ -4,8 +4,8 @@
 #' @param id Module ID
 #' @param plot_data_function A shiny::reactive that returns a function
 #' The function must take an argument called ".feature_class" and return a
-#' dataframe with columns "sample_name", "feature_name", "feature_value",
-#' "group_name", and optionally "group_description"
+#' dataframe with columns "sample_name", "feature_name", "feature_display",
+#' "feature_value", "group_name", and optionally "group_description"
 #' @param feature_classes A shiny::reactive that returns a vector of strings.
 #' One of these strings are passed to plot_data_function
 #' @param barplot_xlab A shiny::reactive that returns a string
@@ -77,7 +77,7 @@ barplot_server <- function(
           source_name = barplot_source_name(),
           x_col = "group_name",
           y_col = "MEAN",
-          color_col = "feature_name",
+          color_col = "feature_display",
           error_col = "SE",
           text_col = "text",
           xlab = barplot_xlab(),
@@ -117,9 +117,9 @@ barplot_server <- function(
         shiny::req(barplot_data(), selected_group())
         barplot_data() %>%
           dplyr::filter(.data$group_name == selected_group()) %>%
-          dplyr::select("sample_name", "group_name", "feature_name", "feature_value") %>%
+          dplyr::select("sample_name", "group_name", "feature_display", "feature_value") %>%
           tidyr::pivot_wider(
-            ., values_from = "feature_value", names_from = "feature_name"
+            ., values_from = "feature_value", names_from = "feature_display"
           )
       })
 

R/barplot_server_functions.R

@@ -5,6 +5,7 @@ build_barplot_data <- function(plot_data_function, feature_class_choice){
       c(
         "sample_name",
         "feature_name",
+        "feature_display",
         "feature_value",
         "group_name",
         "group_description"
@@ -14,16 +15,16 @@ build_barplot_data <- function(plot_data_function, feature_class_choice){
 
 summarise_barplot_se <- function(data, title){
   data %>%
-    dplyr::select("group_name", "feature_name", "feature_value") %>%
+    dplyr::select("group_name", "feature_display", "feature_value") %>%
     tidyr::drop_na() %>%
-    dplyr::group_by_at(dplyr::vars("group_name", "feature_name")) %>%
+    dplyr::group_by_at(dplyr::vars("group_name", "feature_display")) %>%
     dplyr::summarise(
       "MEAN" = mean(.data$feature_value),
       "SE" = .data$MEAN / sqrt(dplyr::n()),
       .groups = "drop"
     ) %>%
     create_plotly_text(
-      .data$feature_name,
+      .data$feature_display,
       .data$group_name,
       c("MEAN", "SE"),
       title

R/example_data.R

@@ -11,7 +11,8 @@ example_starwars_data <- function(){
     ) %>%
     tidyr::pivot_longer(
       -c("sample_name", "group_name"), names_to = "feature_name", values_to = "feature_value"
-    )
+    ) %>%
+    dplyr::mutate("feature_display" = .data$feature_name)
 }
 
 example_starwars_data_func <- function(.feature_class){
@@ -62,7 +63,7 @@ example_iris_data_func <- function(.feature_class = NULL, .feature = NULL){
   dplyr::select(iris_data, -"feature_class")
 }
 
-# heatmap examples ----
+# pcawg examples ----
 
 get_pcawg_feature_class_list <- function(){
   features <-
@@ -246,3 +247,53 @@ get_feature_values_by_feature_no_data <- function(.feature){
     "group_color" = character()
   )
 }
+
+# TCGA
+
+get_tcga_feature_values_by_feature <- function(.feature){
+  feature_data <-
+    iatlas.api.client::query_feature_values(
+      cohorts = "TCGA", features = .feature
+    ) %>%
+    dplyr::select(
+      "sample_name" = "sample",
+      "feature_name",
+      "feature_display",
+      "feature_value"
+    )
+
+  group_data <-
+    iatlas.api.client::query_tag_samples(
+      cohorts = "TCGA", parent_tags = "Immune_Subtype"
+    ) %>%
+    dplyr::select(
+      "sample_name",
+      "group_name" = "tag_short_display",
+      "group_description" = "tag_characteristics",
+      "group_color" = "tag_color"
+    )
+
+  dplyr::inner_join(
+    feature_data,
+    group_data,
+    by = "sample_name"
+  )
+}
+
+get_tcga_cell_proportions <- function(.feature_class){
+  result <-
+    get_tcga_feature_values_by_feature(
+      c("leukocyte_fraction", "Stromal_Fraction", "Tumor_fraction")
+    )  %>%
+    dplyr::select(
+      "sample_name",
+      "group_name",
+      "feature_name",
+      "feature_display",
+      "feature_value",
+      "group_description"
+    )
+}
+
+
+

app/server.R

@@ -32,6 +32,17 @@ server <- function(input, output, session) {
     y_feature_input = shiny::reactive("Petal.Width")
   )
 
+  barplot_server(
+    "barplot5",
+    shiny::reactive(get_tcga_cell_proportions),
+    barplot_xlab    = shiny::reactive("Fraction type by group"),
+    barplot_ylab    = shiny::reactive("Fraction mean"),
+    barplot_label   = shiny::reactive("Fraction"),
+    drilldown       = shiny::reactive(T),
+    y_feature_input = shiny::reactive("Leukocyte Fraction"),
+    x_feature_input = shiny::reactive("Stromal Fraction")
+  )
+
   distributions_plot_server(
     "distplot1",
     plot_data_function = shiny::reactive(example_iris_data_func),

app/ui.R

@@ -10,7 +10,8 @@ ui <- function() {
           barplot_ui("barplot1", title = "Example 1"),
           barplot_ui("barplot2", title = "Example 2"),
           barplot_ui("barplot3", title = "Example 3"),
-          barplot_ui("barplot4", title = "Example 4")
+          barplot_ui("barplot4", title = "Example 4"),
+          barplot_ui("barplot5", title = "Example 5")
         ),
         shiny::tabPanel(
           "Distribution Plots",