Merge pull request #204 from CRI-iAtlas/develop

1.3.1.

data/javascript/extracellular_network_styles.js

@@ -45,7 +45,7 @@
       "line-color": "black",
         "target-arrow-shape": "triangle",
         "target-arrow-color": "black",
-        "width": 0.5,
+        "width": "mapData(score,0,25,1.0,15.0)",
         "curve-style": "bezier"
     }
   }, {

data/javascript/extracellular_network_stylesEdges.js

@@ -54,42 +54,48 @@
     "css" : {
       "line-color" : "rgb(38,201,36)",
       "target-arrow-color" : "black",
-      "source-arrow-color" : "rgb(38,201,36)"
+      "source-arrow-color" : "rgb(38,201,36)",
+      "width": "mapData(score,0,25,1.0,15.0)"
     }
   }, {
     "selector" : "edge[interaction = 'C5']",
     "css" : {
       "line-color" : "rgb(0,66,249)",
       "target-arrow-color" : "black",
-      "source-arrow-color" : "rgb(0,66,249)"
+      "source-arrow-color" : "rgb(0,66,249)",
+      "width": "mapData(score,0,25,1.0,15.0)"
     }
   }, {
     "selector" : "edge[interaction = 'C6']",
     "css" : {
       "line-color" : "rgb(250,60,251)",
       "target-arrow-color" : "black",
-      "source-arrow-color" : "rgb(250,60,251)"
+      "source-arrow-color" : "rgb(250,60,251)",
+      "width": "mapData(score,0,25,1.0,15.0)"
     }
   }, {
     "selector" : "edge[interaction = 'C1']",
     "css" : {
       "line-color" : "rgb(251,12,28)",
       "target-arrow-color" : "black",
-      "source-arrow-color" : "rgb(251,12,28)"
+      "source-arrow-color" : "rgb(251,12,28)",
+      "width": "mapData(score,0,25,1.0,15.0)"
     }
   }, {
     "selector" : "edge[interaction = 'C2']",
     "css" : {
       "line-color" : "rgb(245,239,55)",
       "target-arrow-color" : "black",
-      "source-arrow-color" : "rgb(255,249,56)"
+      "source-arrow-color" : "rgb(255,249,56)",
+      "width": "mapData(score,0,25,1.0,15.0)"
     }
   }, {
     "selector" : "edge[interaction = 'C4']",
     "css" : {
       "line-color" : "rgb(35,203,202)",
       "target-arrow-color" : "black",
-      "source-arrow-color" : "rgb(35,203,202)"
+      "source-arrow-color" : "rgb(35,203,202)",
+      "width": "mapData(score,0,25,1.0,15.0)"
     }
   }, {
     "selector" : "edge:selected",

data/markdown/io_target.markdown

@@ -5,6 +5,7 @@ This module allows you to explore the tumor expression of some of the immuno-onc
 - Comprehensive 2017 IO landscape analysis ([Annals of Oncology](https://academic.oup.com/annonc/article/29/1/84/4693829) December 2017)
 - Comprehensive 2018 IO landscape analysis including a comparison to the previous year ([Nature Reviews Drug Discovery](https://www.nature.com/articles/nrd.2018.167) October 2018)
 - Comprehensive 2019 IO landscape analysis ([Nature Reviews Drug Discovery](https://www.nature.com/articles/d41573-019-00167-9) September 2019)
+- Comprehensive 2020 IO landscape analysis ([Nature Reviews Drug Discovery](https://www.nature.com/articles/d41573-020-00166-1) September 2020)
 
 and to connect to additional resources on agents for those targets provided by those studies.
 

functions/transform.R

@@ -35,6 +35,7 @@ build_distribution_plot_df <- function(
     dplyr::mutate(y = scale_function(y)) %>% 
     tidyr::drop_na() %>% 
     dplyr::filter(!is.infinite(y))
+
 }
 
 
@@ -221,7 +222,7 @@ build_group_size_df <- function(df, group_col){
         dplyr::select(Group = group_col) %>% 
         get_complete_df_by_columns("Group") %>%  
         dplyr::group_by(Group) %>% 
-        dplyr::summarise(Group_Size = n()) 
+        dplyr::summarise(Group_Size = dplyr::n()) 
     assert_df_has_columns(result_df, c("Group", "Group_Size"))
     assert_df_has_rows(result_df)
     return(result_df)
@@ -739,6 +740,102 @@ build_cnvs_df <- function(df, response_var, group_column, group_options){
 # Functions below this line do not have tests yet, newly written functions 
 ###############################################################################
 
+build_distribution_plot_df2 <- function(
+  .df, 
+  ycol = "y", 
+  scale_func_choice = "None",
+  reorder_choice = "None",
+  grp_choice
+){
+
+  scale_function <- switch(
+    scale_func_choice,
+    "None" = identity, 
+    "Log2" = log2,
+    "Log2 + 1" = function(x) log2(x + 1),
+    "Log10" = log10,
+    "Log10 + 1" = function(x) log10(x + 1),
+  )
+
+  reorder_function <- function(reorder_choice, x,y) {
+    x <- factor(x)
+    switch(
+      reorder_choice,
+      "None" = x,
+      "Median" = forcats::fct_reorder(x, y, median, na.rm=T),
+      "Mean" = forcats::fct_reorder(x, y, mean, na.rm=T),
+      "Max" = forcats::fct_reorder(x, y, max, na.rm=T),
+      "Min" = forcats::fct_reorder(x, y, min, na.rm=T)
+    )
+  }
+
+  .df2 <- .df %>% 
+    dplyr::select(x, y = ycol, label) %>% 
+    tidyr::drop_na() %>% 
+    dplyr::mutate(y = scale_function(y)) %>% 
+    dplyr::mutate(x = reorder_function(reorder_choice,x,y)) %>%
+    tidyr::drop_na() %>% 
+    dplyr::filter(!is.infinite(y))
+
+}
+
+
+
+build_cellcontent_barplot_df2 <- function(df, x_column, y_column, sort_by_var_choice, reorder_func_choice) {
+
+  assert_df_has_columns(df, c("GROUP", "fraction_type", "fraction"))
+
+  #
+  # Here we reorder the bars. Max = mean+error, Min = mean-error
+  #
+
+  reorder_function2 <- function(result_df, sort_by_var_choice, reorder_func_choice) {
+    if (reorder_func_choice == 'Mean') {
+      x_levels <- result_df %>% 
+        dplyr::filter(color == sort_by_var_choice) %>% 
+        dplyr::arrange(y) %>% 
+        dplyr::pull(x)
+    } else if (reorder_func_choice == 'Max') {
+      x_levels <- result_df %>% 
+        dplyr::filter(color == sort_by_var_choice) %>% 
+        dplyr::arrange(y+error) %>% 
+        dplyr::pull(x)
+    } else if (reorder_func_choice == 'Min') {
+      x_levels <- result_df %>% 
+        dplyr::filter(color == sort_by_var_choice) %>% 
+        dplyr::arrange(y-error) %>% 
+        dplyr::pull(x)
+    }
+    result_df$x <- factor(result_df$x, levels=x_levels)
+    result_df
+  }
+
+  # sort_by_var_choice is labeled 'color' in the result_df
+  result_df <- df %>%
+    summarise_df_at_column(
+      column = "fraction",
+      grouping_columns = c("GROUP", "fraction_type"),
+      function_names = c("mean", "se")) %>% 
+    create_label(
+      title = stringr::str_to_title(y_column),
+      name_column = x_column,
+      group_column = "GROUP",
+      value_columns = c("mean", "se")) %>% 
+    dplyr::select(
+      x = "GROUP",
+      y = "mean",
+      color = "fraction_type",
+      error = "se",
+      label) 
+
+  if (sort_by_var_choice != 'Group' & reorder_func_choice != 'None') {
+    # then we want to sort by something other than the group labels
+    result_df <- reorder_function2(result_df, sort_by_var_choice, reorder_func_choice)
+  }
+  assert_df_has_columns(result_df, c("x", "y", "label", "color", "error"))
+  assert_df_has_rows(result_df)
+  return(result_df)
+}
 
 
 ###############################################################################

functions/violinplot.R

@@ -6,6 +6,7 @@ create_violinplot <- function(
     color_col = NA,
     label_col = NA,
     split_col = NA,
+    order_by = NULL,
     xlab = "",
     ylab = "", 
     title = "", 
@@ -51,7 +52,9 @@ create_violinplot <- function(
         layout(
             title = title,
             xaxis = list(title = xlab),
-            yaxis = list(title = ylab)
+            yaxis = list(title = ylab,
+                         categoryorder = "array",
+                         categoryarray = ~order_by)
         ) %>% 
         format_plotly() %>%
         I

modules/distribution_plot_module.R

@@ -4,7 +4,7 @@ distributions_plot_module_UI <- function(
     message_html = p(stringr::str_c(
         "Select variable to its to see its distribution over sample groups.",
         "Plots are available as violin plots, and box plots with full data",
-        "points superimposed."
+        "points superimposed. For reordering violins, first choose a variable (bar) to sort on, then a sorting function like Mean or Median. Reordering function Max sorts by the maximum value and min by the minimum value within each group."
     )),
     click_text = "Click plot to see group information.",
     scale_default = "None",
@@ -59,6 +59,15 @@ distributions_plot_module_UI <- function(
                             "Display histogram of distribution by clicking on a violin", 
                             plot_clicked_group_default
                         )
+                    ),
+                    column(
+                        width = 4,
+                        selectInput(
+                            ns("reorder_distributions"), 
+                            "Reorder Function", 
+                            choices=c('None','Median','Mean','Max','Min'),
+                            selected = 'None'
+                        )
                     )
                 )
             ),
@@ -160,11 +169,15 @@ distributions_plot_module <- function(
     })
 
     plot_df <- reactive({
-        req(data_df(), input$variable_choice, input$scale_method)
-        build_distribution_plot_df(
-            data_df(), 
+        req(data_df(), 
             input$variable_choice, 
             input$scale_method)
+        build_distribution_plot_df2(  
+            data_df(), 
+            input$variable_choice, 
+            input$scale_method,
+            input$reorder_distributions,
+            group_display_choice())
     })
 
     varible_display_name <- reactive({