diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 6540dcf..0000000 --- a/LICENSE +++ /dev/null @@ -1,2 +0,0 @@ -YEAR: 2021 -COPYRIGHT HOLDER: metapr2 authors diff --git a/NEWS.md b/NEWS.md index 6fb1521..5c027a3 100644 --- a/NEWS.md +++ b/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 diff --git a/R/app.R b/R/app.R index a7be966..40dfed2 100644 --- a/R/app.R +++ b/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: ") diff --git a/R/fct_phyloseq.R b/R/fct_phyloseq.R index 119ec1b..6dcb168 100644 --- a/R/fct_phyloseq.R +++ b/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) diff --git a/R/fct_sequences.R b/R/fct_sequences.R index 010463f..4837ddb 100644 --- a/R/fct_sequences.R +++ b/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, diff --git a/R/module_datasets.R b/R/module_datasets.R index 104dff6..92fe12f 100644 --- a/R/module_datasets.R +++ b/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, diff --git a/R/module_display_info.R b/R/module_display_info.R index 5421e19..6e6dcbb 100644 --- a/R/module_display_info.R +++ b/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( diff --git a/R/module_download.R b/R/module_download.R index 6acec3a..9878f48 100644 --- a/R/module_download.R +++ b/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: ", nrow(samples_selected()), - if_else(n_samples_valid(), "", " - Too many for phyloseq download!! - Must be below 2000 !"), + if_else(n_samples_valid(), "", " - Too many samples for phyloseq download!! - Samples must be below 2000 !"), sep=" ")}) diff --git a/R/module_phyloseq.R b/R/module_phyloseq.R index 52a7e06..9f2f521 100644 --- a/R/module_phyloseq.R +++ b/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: ", nrow(samples_selected()), - if_else(n_samples_valid(), "", " - Too many !! - Must be below 1000 !"), + if_else(n_samples_valid(), "", " - Too many samples !! - Sample # must be below 1000 !"), 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")), diff --git a/R/module_query.R b/R/module_query.R index adab541..a0d422e 100644 --- a/R/module_query.R +++ b/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") }) diff --git a/R/module_taxonomy_multiple.R b/R/module_taxonomy_multiple.R index b2d74d6..700715f 100644 --- a/R/module_taxonomy_multiple.R +++ b/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")) }) diff --git a/R/module_treemap.R b/R/module_treemap.R index 10af2d3..42af285 100644 --- a/R/module_treemap.R +++ b/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] diff --git a/README.Rmd b/README.Rmd index f474917..7468a08 100644 --- a/README.Rmd +++ b/README.Rmd @@ -21,16 +21,16 @@ knitr::opts_chunk$set( [![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) ## 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 diff --git a/README.md b/README.md index e7b5eeb..5032472 100644 --- a/README.md +++ b/README.md @@ -6,16 +6,16 @@ [![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) ## 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 diff --git a/docs/404.html b/docs/404.html index 2c1079f..af77564 100644 --- a/docs/404.html +++ b/docs/404.html @@ -7,10 +7,10 @@ Page not found (404) • metapr2 - - + + - + MIT License • metapr2MIT License • metapr2 @@ -10,7 +10,7 @@ metapr2 - 2.0.0 + 2.0.1