Update 2.1.0

NEWS.md

@@ -1,9 +1,26 @@
+# metapr2 2.1.0
+
+Released: 2023-05-16
+
+### Web application and R package
+
+* Only the latest version (2.1) of the database is provided.
+* Taxonomy table reflects the groups selected on the side panel
+
+### Database version 2.1
+
+* Metabarcodes are now assigned with PR2 version 5.0.0 (9 taxonomy levels).
+
+---
+
 # metapr2 2.0.1
 
 Released: 2023-02-17
 
 ### Web application and R package
+
 Two bugs fixed:
+
 * Error linked to version 4.2 of R giving error instead of warning for `if` when the condition a dimension > 1
 * Some long sequences where giving an error in the Query panel
 

R/app.R

@@ -34,8 +34,8 @@ messages$no_data = tags$div(
 shinymanager::set_labels(
   language = "en",
   "Please authenticate" = "Choose datasets ",
-  "Username:" = "Datasets (`blank` for version 2.0 and `v1` for version 1.0):",
-  "Password:" = "Password (`blank` for version 1.0 and 2.0):",
+  "Username:" = "Datasets (Leave blank for public version):",
+  "Password:" = "Password (Leave blank for public version):",
   "Login" = "Enter metaPR2"
 )
 
@@ -76,11 +76,13 @@ ui <- fluidPage(
     tags_bottom = tags$div(
       checkboxInput("asv_clustered", "Use clustered ASVs (see Help)", value = TRUE, width = NULL),
       tags$p("  "),
-      tags$h4("metaPR2  version: 2.0.1"),
-      tags$h4("Datasets version: 2.0"),
-      tags$h5("59 public datasets (V4 and V9), no password needed"),
-      tags$p("  "),
-      tags$p("For other datasets, please  contact ",
+      tags$h4("metaPR2  version: 2.1.0"),
+      tags$br(),
+      tags$h4("Datasets version: 2.1"),
+      tags$h5("Datasets #: 59 (identical to version 2.0)"),
+      tags$h5("Assignment: PR2 version 5.0.0"),
+      tags$br(),
+      tags$p("No password needed. For other datasets, please  contact ",
         tags$a(href = "mailto:vaulot@gmail.com", target="_top", "Daniel Vaulot")
       )
     )
@@ -169,7 +171,7 @@ server <- function(input, output, session) {
 
     # Panel - Taxonomy table
 
-    taxo_table_Server("taxo_table", asv_set$fasta_all)
+    taxo_table_Server("taxo_table", asv_set$fasta_selected)
 
 
     # cat("Server: ")

R/fct_phyloseq.R

@@ -91,7 +91,7 @@ ps_alpha <- function(ps, measures = c("Shannon"),
   samples <- samples %>% 
     tibble::rownames_to_column(var = "file_code") %>% 
     left_join(diversity) %>% 
-    tidyr::pivot_longer(cols = measures, values_to = "diversity", names_to = "measures") %>% 
+    tidyr::pivot_longer(cols = all_of(measures), values_to = "diversity", names_to = "measures") %>% 
     filter(diversity > 0)
 
   # print(head(samples))
@@ -202,7 +202,7 @@ otu <- df %>%
 # 3. Taxonomy table
 
 tax <-  fasta %>%
-  select(asv_code, kingdom:species) %>%
+  select(asv_code, domain:species) %>%
   distinct(asv_code, .keep_all = TRUE) %>%
   tibble::column_to_rownames(var = "asv_code")
 
@@ -218,7 +218,7 @@ TAX = phyloseq::tax_table(tax_mat)
 samples = phyloseq::sample_data(samples_df)
 
 
-cat("Make phyloseq done \n")
+# cat("Make phyloseq done \n")
 
 ps <- phyloseq::phyloseq(OTU, TAX, samples)
 

R/fct_sequences.R

@@ -45,7 +45,7 @@ match_asv <- function(fasta.df, query){
   df <- bind_cols(fasta.df, scores) %>%
     arrange(desc(pid)) %>%
     mutate(pid = round(pid, 2)) %>%  # Only 2 decimals
-    select(asv_code, pid, kingdom:species, sequence, sum_reads_asv)
+    select(asv_code, pid, domain:species, sequence, sum_reads_asv)
 
   # print(df)
 
@@ -88,7 +88,7 @@ blaster_asv <- function(fasta.df, query,
       inner_join(fasta.df) %>% 
       select(asv_code, pid, mismatches, gaps, 
              query_start, query_end, asv_start, asv_end,  
-             kingdom:species, sequence, sum_reads_asv)
+             domain:species, sequence, sum_reads_asv)
   } else {
     df <- NULL
   }
@@ -112,6 +112,7 @@ fasta_write <- function(df,file_name, compress=FALSE, taxo_include=TRUE, taxo_se
     names(seq_out) <- str_c(df$seq_name,
                             df$supergroup,
                             df$division,
+                            df$subdivision,
                             df$class,
                             df$order,
                             df$family,

R/module_datasets.R

@@ -396,8 +396,8 @@ dataServer <- function(id, taxo, authentification, asv_clustered) {
       req(iv_samples$is_valid())  
       asv_set()$df %>% 
         inner_join(samples_selected(), by = "file_code") %>% 
-        left_join(select(asv_set()$fasta, asv_code, kingdom:species, ecological_function, sum_reads_asv), by="asv_code") %>%
-        filter(!is.na(kingdom)) %>% # Some asvs are missing from the FASTA table... (to be checked) %>% 
+        left_join(select(asv_set()$fasta, asv_code, domain:species, ecological_function, sum_reads_asv), by="asv_code") %>%
+        filter(!is.na(domain)) %>% # Some asvs are missing from the FASTA table... (to be checked) %>% 
         select(-any_of(cols_to_remove)) %>% 
         filter(.data[[taxo()$level]] %in% taxo()$name ,
                sum_reads_asv >= input$reads_min, 

R/module_display_info.R

@@ -20,12 +20,12 @@ display_info_server <- function(id, authentification, asv_clustered) {
     ns <- NS(id)
 
     version <- reactive({
-      if(length(authentification$user) == 0) return("2.0") # Defaut case
+      if(length(authentification$user) == 0) return("2.1") # Defaut case
       if(authentification$user == "v1") return( "1.0")
       if(authentification$user == "ge") return( "1.0 + Green edge")
-      if(authentification$user == "ge2") return( "2.0 + Green edge")
-      if(authentification$user == "private") return(  "2.0 + private")
-      return("2.0")
+      if(authentification$user == "ge2") return( "2.1 + Green edge")
+      if(authentification$user == "private") return(  "2.1 + private")
+      return("2.1")
     })
 
     output$label <- renderPrint(tagList(

R/module_download.R

@@ -24,17 +24,18 @@ downloadServer <- function(id, datasets_selected, samples_selected, df_selected,
   # See:  https://stackoverflow.com/questions/43916535/download-multiple-csv-files-with-one-button-downloadhandler-with-r-shiny
 
     ps_selected <- reactive({
-      req(n_samples_valid())
+      req(n_samples_valid(), nrow(df_selected()) > 0)
       ps <- make_phyloseq(samples_selected(), df_selected(), fasta_selected())
-      print(ps)
+      # print(ps)
     })
 
+
     n_samples_max = 2000
 
-    n_samples_valid <- reactive({nrow(samples_selected()) <= n_samples_max})
+    n_samples_valid <- reactive({(nrow(samples_selected()) <= n_samples_max)} )
 
     output$sample_number <- renderText({stringr::str_c("Number of samples: <b>", nrow(samples_selected()), 
-                                                       if_else(n_samples_valid(), "</b>", " - Too many for phyloseq download!!</b> - Must be below <b>2000 !</b>"),
+                                                       if_else(n_samples_valid(), "</b>", " - Too many samples for phyloseq download!!</b> - Samples must be below <b>2000 !</b>"),
                                                        sep=" ")})
 
 

R/module_phyloseq.R

@@ -45,10 +45,10 @@ phyloseqServer <- function(id, samples_selected, df_selected, fasta_selected, ta
 
     n_samples_max = 1000
 
-    n_samples_valid <- reactive({nrow(samples_selected()) <= n_samples_max})
+    n_samples_valid <- reactive({(nrow(samples_selected()) <= n_samples_max)} )
 
     output$sample_number <- renderText({stringr::str_c("Number of samples: <b>", nrow(samples_selected()), 
-                                                       if_else(n_samples_valid(), "</b>", " - Too many !!</b> - Must be below <b>1000 !</b>"),
+                                                       if_else(n_samples_valid(), "</b>", " - Too many samples !!</b> - Sample # must be below <b>1000 !</b>"),
                                                        sep=" ")})
 
     # Construct the phyloseq object for selected samples 
@@ -62,6 +62,7 @@ phyloseqServer <- function(id, samples_selected, df_selected, fasta_selected, ta
     output$ui_ps <- renderUI({
       tagList(
         includeMarkdown(system.file("readme", 'phyloseq.md', package = "metapr2")),
+        if(nrow(df_selected()) == 0) {messages$no_data},
         htmlOutput(ns("sample_number")),
         p(),
         actionButton(ns("button_ps"), "Compute diversity - Press again after updating samples", class = ifelse(n_samples_valid(), "btn-primary", "btn-danger")),

R/module_query.R

@@ -130,7 +130,7 @@ queryServer <- function(id, samples_selected, df_all, fasta_all) {
       df_all() %>%
         filter(file_code %in% samples_selected()$file_code) %>% 
         left_join(samples_selected()) %>% 
-        left_join(select(fasta_all(), asv_code, kingdom:species, sum_reads_asv)) %>%
+        left_join(select(fasta_all(), asv_code, domain:species, sum_reads_asv)) %>%
         filter(asv_code == asv_selected()) %>% 
         reformat_df_map(samples = samples_selected(), taxo_level = "asv_code")
     })

R/module_taxonomy_multiple.R

@@ -12,6 +12,7 @@ options_picker_exclude <- shinyWidgets::pickerOptions(
   noneSelectedText = "None"
 )
 
+
 # =================================
 # Small function to return the taxo number
 # =================================
@@ -24,10 +25,10 @@ taxo_level_number <- function(taxo_level) {
 # Small function to return the taxo level and taxon name 
 # =================================
 
-taxo_selected <- function(supergroup, division, class, order, family, genus, species, asv_code) {
+taxo_selected <- function(supergroup, division, subdivision, class, order, family, genus, species, asv_code) {
 
-  taxo_1 <- c(supergroup[1], division[1], class[1], order[1], family[1], genus[1], species[1], asv_code[1])
-  taxo_list <- list(supergroup = supergroup, division=division, class=class, order = order, family = family, genus = genus, species = species, asv_code=asv_code)
+  taxo_1 <- c(supergroup[1], division[1], subdivision[1], class[1], order[1], family[1], genus[1], species[1], asv_code[1])
+  taxo_list <- list(supergroup = supergroup, division=division, subdivision=subdivision, class=class, order = order, family = family, genus = genus, species = species, asv_code=asv_code)
 
   # The levels for which nothing is selected return NULL and the length of the vector gives the first rank which is NULL
 
@@ -39,7 +40,7 @@ taxo_selected <- function(supergroup, division, class, order, family, genus, spe
 
   # taxo_name <- taxo_list[[taxo_level]]
 
-  if (taxo_level == "kingdom") taxo_name = "Eukaryota"
+  if (taxo_level == "domain") taxo_name = "Eukaryota"
 
   message("Taxo level: ", taxo_level)
   message(taxo_name)
@@ -69,7 +70,7 @@ taxoUI <- function(id) {
     shinyWidgets::pickerInput(ns("supergroup"), "Supergroup", choices = unique(global$pr2_taxo$supergroup), selected = NULL, multiple = TRUE, options= options_picker_taxo),
 
     # Use the purr map function to create the pickerInput
-    purrr::map(global$taxo_levels[3:9], ~  shinyWidgets::pickerInput(ns(.x), str_to_title(.x) , choices = NULL, selected = NULL, multiple = TRUE, options= options_picker_taxo)),
+    purrr::map(global$taxo_levels[3:10], ~  shinyWidgets::pickerInput(ns(.x), str_to_title(.x) , choices = NULL, selected = NULL, multiple = TRUE, options= options_picker_taxo)),
 
     p(),
 
@@ -112,7 +113,7 @@ taxoServer <- function(id, fasta_all) {
 
     taxo <- reactive({
       # Do not use req because if one member is NULL it will not be activated
-      taxo_selected(input$supergroup, input$division, input$class, input$order, input$family, input$genus, input$species, input$asv_code)
+      taxo_selected(input$supergroup, input$division, input$subdivision, input$class, input$order, input$family, input$genus, input$species, input$asv_code)
       })
 
 
@@ -144,7 +145,7 @@ taxoServer <- function(id, fasta_all) {
 
       # The next line prevents update of taxonomy selector when loading new values from yaml file
       req((taxo_level_number(taxo_level) >= taxo_level_number(taxo()$level)) |
-           (taxo_level == "kingdom"))
+           (taxo_level == "domain"))
 
      taxo_level_below = global$taxo_levels[taxo_level_number(taxo_level) + 1]
 
@@ -210,7 +211,7 @@ taxoServer <- function(id, fasta_all) {
         # shinyWidgets::updatePickerInput(session = session,  inputId = "supergroup", selected = taxo_new[["supergroup"]])
         # purrr::map(global$taxo_levels[2:8], ~ update_taxo_picker_upload(.x, taxo_new))
         # shinyWidgets::updatePickerInput(session = session,  inputId = "asv_code", selected = taxo_new[["asv_code"]])
-        purrr::map(global$taxo_levels[2:9], ~ shinyWidgets::updatePickerInput(session = session,  inputId = .x, choices = taxo_new[[.x]], selected = taxo_new[[.x]]))
+        purrr::map(global$taxo_levels[2:10], ~ shinyWidgets::updatePickerInput(session = session,  inputId = .x, choices = taxo_new[[.x]], selected = taxo_new[[.x]]))
 
         shinyWidgets::updatePickerInput(session = session,  inputId = "taxa_excluded", selected = taxo_new[["taxa_excluded"]])
         update_taxo_auto(TRUE)
@@ -230,7 +231,7 @@ taxoServer <- function(id, fasta_all) {
       input$reset_taxo
       update_taxo_auto(FALSE)
       shinyWidgets::updatePickerInput(session = session,  inputId = "supergroup", choices = unique(global$pr2_taxo$supergroup), selected = character(0), )
-      purrr::map(global$taxo_levels[3:9], ~ shinyWidgets::updatePickerInput(session = session,  inputId = .x, choices = character(0), selected = character(0)))
+      purrr::map(global$taxo_levels[3:10], ~ shinyWidgets::updatePickerInput(session = session,  inputId = .x, choices = character(0), selected = character(0)))
       update_taxo_auto(TRUE)
       # click(ns("validate_taxo"))
     })

R/module_treemap.R

@@ -8,8 +8,8 @@ treemap <- function(df, taxo_level) {
 
     taxo_level_number = which(global$taxo_levels == taxo_level)
 
-  # Do not go beyond ASV level (taxo_level_number = 9)
-  if(taxo_level_number >= 8 ) taxo_level_number = 7
+  # Do not go beyond ASV level (taxo_level_number = 10)
+  if(taxo_level_number >= 9 ) taxo_level_number = 8
 
     taxo_level_1 = global$taxo_levels[taxo_level_number + 1] 
     taxo_level_2 = global$taxo_levels[taxo_level_number + 2]

README.Rmd

@@ -21,16 +21,16 @@ knitr::opts_chunk$set(
 
 <!-- badges: start -->
 [![DOI](https://zenodo.org/badge/410160328.svg)](https://zenodo.org/badge/latestdoi/410160328)
-![Release](https://img.shields.io/badge/release-2.0.0-blue.svg)
-![Date](https://img.shields.io/badge/date-23%20Nov%202022-lightgrey.svg)
+![Release](https://img.shields.io/badge/release-2.1.0-blue.svg)
+![Date](https://img.shields.io/badge/date-16%20May%202023-lightgrey.svg)
 
 <!-- badges: end -->
 
 ## A database of 18S rRNA metabarcodes
 
-**Version**:  2.0.0 - 59 datasets
+**Version**:  2.1.0 - 59 datasets
 
-**Release date**: 2022-11-23
+**Release date**: 2023-05-16
 
 ### Presentation
 

README.md

@@ -6,16 +6,16 @@
 <!-- badges: start -->
 
 [![DOI](https://zenodo.org/badge/410160328.svg)](https://zenodo.org/badge/latestdoi/410160328)
-![Release](https://img.shields.io/badge/release-2.0.0-blue.svg)
-![Date](https://img.shields.io/badge/date-23%20Nov%202022-lightgrey.svg)
+![Release](https://img.shields.io/badge/release-2.1.0-blue.svg)
+![Date](https://img.shields.io/badge/date-16%20May%202023-lightgrey.svg)
 
 <!-- badges: end -->
 
 ## A database of 18S rRNA metabarcodes
 
-**Version**: 2.0.0 - 59 datasets
+**Version**: 2.1.0 - 59 datasets
 
-**Release date**: 2022-11-23
+**Release date**: 2023-05-16
 
 ### Presentation