Merge pull request #10 from jumpingrivers/main

Adds "colour by sequence" functionality

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tfpbrowser
 Title: Builds Shiny application for 'tfpscanner' outputs
-Version: 0.0.19
+Version: 0.0.21
 Authors@R: 
     person("Jumping", "Rivers", , "[email protected]", role = c("aut", "cre"))
 Description: An R package to contain the code for the Shiny app to explore
@@ -10,6 +10,7 @@ Depends:
     R (>= 4.0.0)
 Imports:
     bslib,
+    data.table,
     dplyr,
     fs,
     ggiraph (>= 0.8.4),

NAMESPACE

@@ -4,6 +4,7 @@ export("%>%")
 export(create_all_node_lookups)
 export(empty_treeview)
 export(get_cluster_ID)
+export(get_sequences_lookup)
 export(run_app)
 export(update_data)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,3 +1,13 @@
+# tfpbrowser 0.0.21 _2023-03-01_
+
+- Fix: change to using `all_mutations` data
+- Fix: change wording of downloads
+
+# tfpbrowser 0.0.20 _2023-01-25_
+
+- Add function to get lookup of sequences and clusterID
+- Add CSV of all_sequences
+
 # tfpbrowser 0.0.19 _2023-01-25_
 
 - Add function to create empty treeview

R/app_server.R

@@ -59,11 +59,27 @@ app_server = function(input, output, session) {
   }) %>%
     shiny::bindCache(input$widgetChoice)
 
+
+# Mutation colouring ------------------------------------------------------
+
   # disable dropdown unless mutation treeview
   shiny::observe({
     shiny::req(input$widgetChoice)
+    # toggle mutation dropdown
     shinyjs::toggleState(id = "mutationChoice",
                          condition = input$widgetChoice == "tree-mutations.rds")
+    # toggle sequence dropdown
+    shinyjs::toggleState(id = "sequenceChoice",
+                         condition = input$widgetChoice == "tree-sequences.rds")
+    # select input for sequences
+    if (input$widgetChoice == "tree-sequences.rds") {
+      avail_seqs = data.table::as.data.table(available_sequences())
+      names(avail_seqs) = "Sequences"
+      shiny::updateSelectizeInput(inputId = "sequenceChoice",
+                                  label = "Select sequence",
+                                  choices = avail_seqs
+                                  )
+    }
   })
 
   # get selected nodes from mutation choice
@@ -86,6 +102,30 @@ app_server = function(input, output, session) {
     )
   })
 
+# Sequence colouring ------------------------------------------------------
+
+  # get selected nodes from sequence choice
+  shiny::observeEvent(input$sequenceChoice, {
+
+    nodeChoice = selected_seq_nodes(input$sequenceChoice)
+
+    # the 'node' column contains integers that define the IDs for graph-nodes in the htmlwidget
+    node_map = imported_ggtree()$data[c("cluster_id", "node")]
+    selection_map = dplyr::filter(
+      node_map,
+      .data[["cluster_id"]] %in% nodeChoice
+    )
+
+    session$sendCustomMessage(
+      # "<output_id>_set" defines the collection of selected nodes on the htmlwidget
+      type = paste0("treeview", "_set"),
+      #   but the nodes in the widget are ID's using strings, not integers
+      message = as.character(selection_map[["node"]])
+    )
+  })
+
+# Get click ---------------------------------------------------------------
+
   # get selected cluster id based on widget choice
   selected_cluster_id = shiny::reactive({
     shiny::req(input$widgetChoice)

R/app_ui.R

@@ -30,7 +30,7 @@ app_ui = function(request) {
                         # use details and summary to create expandable section
                         htmltools::tags$details(
                           # preview of expandable section
-                          htmltools::tags$summary("Download Files (click to expand)"),
+                          htmltools::tags$summary("Cluster statistics (click to expand)"),
 
                           shiny::br(),
 
@@ -71,6 +71,11 @@ app_ui = function(request) {
                                               label = "Select mutation",
                                               choices = available_mutations()),
 
+                        # choose type of sequence
+                        shiny::selectizeInput(inputId = "sequenceChoice",
+                                              label = "Select sequence",
+                                              choices = NULL),
+
                         # markdown files to add description
                         shiny::uiOutput("tree_md_files"),
 

R/update-data.R

@@ -1,21 +1,26 @@
 #' function to create a treeview with all grey nodes to display
 #' @param treeview RDS file containing an existing treeview plot
+#' @param types Character vector of new variables to colour by
 #' @export
-empty_treeview = function(treeview = "tree-logistic_growth_rate.rds") {
+empty_treeview = function(treeview = "tree-logistic_growth_rate.rds",
+                          types = c("mutations", "sequences")) {
   filename = system.file("app", "www", "data", "treeview",
                          treeview,
                          package = "tfpbrowser",
                          mustWork = TRUE)
   g = readRDS(filename)
-  new_g = g +
-    ggplot2::scale_colour_gradient(low = "grey", high = "grey") +
-    ggplot2::guides(colour = "none",
-                    fill = "none",
-                    shape = "none") +
-    ggplot2::labs(title = "Colour: mutation")
-  new_filename = file.path("inst", "app", "www", "data", "treeview",
-                           "tree-mutations.rds")
-  saveRDS(new_g, file = new_filename)
+  make_treeview_type = function(type) { # nolint
+    new_g = g +
+      ggplot2::scale_colour_gradient(low = "grey", high = "grey") +
+      ggplot2::guides(colour = "none",
+                      fill = "none",
+                      shape = "none") +
+      ggplot2::labs(title = glue::glue("Colour: {type}"))
+    new_filename = file.path("inst", "app", "www", "data", "treeview",
+                             glue::glue("tree-{type}.rds"))
+    saveRDS(new_g, file = new_filename)
+  }
+  purrr::walk(.x = types, .f = ~make_treeview_type(.x))
 }
 
 #' function to create lookup for a single treeview
@@ -51,6 +56,34 @@ create_all_node_lookups = function() {
   purrr::walk(.x = all_widgets, .f = ~create_node_lookup(.x))
 }
 
+#' function to get lookup table of clusterID and sequence
+#' @param selected_folder Folder name relating to a single clusterID
+process_seq_table = function(selected_folder) {
+  sequences = system.file("app", "www", "data", "scanner_output",
+                          selected_folder, "sequences.csv",
+                          package = "tfpbrowser")
+  sequences = suppressMessages(readr::read_csv(sequences))
+  if (nrow(sequences) > 0) {
+    seq_names = unique(sequences$sequence_name)
+    output = tibble::tibble(cluster_id = rep(selected_folder, length(seq_names)),
+                            sequence = seq_names)
+    return(output)
+  }
+}
+
+#' function to save a CSV file of all sequences for all clusterIDs
+#' @export
+get_sequences_lookup = function() {
+  all_files = list.files(
+    system.file("app", "www", "data", "scanner_output",
+                package = "tfpbrowser")
+  )
+  output = purrr::map_dfr(.x = all_files, .f = ~process_seq_table(.x))
+  filepath = file.path("inst", "app", "www", "data", "sequences",
+                       "all_sequences.csv")
+  readr::write_csv(output, file = filepath)
+}
+
 #' function to be run anytime the data is updated
 #' wrapper around other required functions
 #' ideally these will be added to {tfpscanner} in the longer term
@@ -62,4 +95,6 @@ update_data = function(treeview = "tree-logistic_growth_rate.rds") {
   empty_treeview(treeview = treeview)
   # save csv files with node lookups
   create_all_node_lookups()
+  # get CSV of sequences vs clusterIDs
+  get_sequences_lookup()
 }

R/utils.R

@@ -29,7 +29,7 @@ available_mutations = function() {
 #' @param chosen_mutation String for the user selected mutation
 selected_mut_nodes = function(chosen_mutation) {
   all_muts = readr::read_csv(system.file("app", "www", "data",
-                                         "mutations", "defining_mutations.csv",
+                                         "mutations", "all_mutations.csv",
                                          package = "tfpbrowser"),
                              col_types = readr::cols())
   selected_nodes = all_muts %>%
@@ -184,3 +184,26 @@ get_selected_cluster_id = function(widgetChoice,
   selected_cluster = as.numeric(ids[which(ids$data_id == treeviewSelected), 2])
   return(selected_cluster)
 }
+
+#' function to return sequence options
+available_sequences = function() {
+  all_seq = readr::read_csv(system.file("app", "www", "data",
+                                         "sequences", "all_sequences.csv",
+                                         package = "tfpbrowser"),
+                             col_types = readr::cols())
+  all_seq = unique(all_seq$sequence)
+  return(all_seq)
+}
+
+#' Which nodes have a given sequence
+#' @param chosen_sequence String for the user selected sequence
+selected_seq_nodes = function(chosen_sequence) {
+  all_seq = readr::read_csv(system.file("app", "www", "data",
+                                         "sequences", "all_sequences.csv",
+                                         package = "tfpbrowser"),
+                             col_types = readr::cols())
+  selected_nodes = all_seq %>%
+    dplyr::filter(.data$sequence == chosen_sequence) %>%
+    dplyr::pull(.data$cluster_id)
+  return(selected_nodes)
+}

inst/app/www/content/treeview/tree-mutations.md

@@ -1 +0,0 @@
-Some text describing the graph.