diff --git a/DESCRIPTION b/DESCRIPTION index ca51f71..8de7324 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,7 +14,6 @@ License: GPL-3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 Imports: shiny, shinydashboard, @@ -39,6 +38,8 @@ Imports: htmltools, ggVennDiagram, lubridate, - markdown + markdown, + ggrepel URL: https://github.com/Cristianetaniguti/Reads2MapApp -BugReports: https://github.com/Cristianetaniguti/Reads2MapApp/issues \ No newline at end of file +BugReports: https://github.com/Cristianetaniguti/Reads2MapApp/issues +RoxygenNote: 7.2.3 diff --git a/Dockerfile b/Dockerfile index cc5b5cd..cd2b9ab 100644 --- a/Dockerfile +++ b/Dockerfile @@ -35,4 +35,5 @@ RUN Rscript -e 'remotes::install_github("mmollina/mappoly")' RUN Rscript -e 'remotes::install_github("Cristianetaniguti/Reads2MapApp" )' EXPOSE 80 -CMD ["R", "-e", "options('shiny.port'=80,shiny.host='0.0.0.0');Reads2MapApp::run_app()"] \ No newline at end of file +CMD ["R", "-e", "options('shiny.port'=80,shiny.host='0.0.0.0');Reads2MapApp::run_app()"] + diff --git a/NAMESPACE b/NAMESPACE index 468fe85..834053f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ import(tidyr) import(vroom) importFrom(config,get) importFrom(ggpubr,ggarrange) +importFrom(ggrepel,geom_text_repel) importFrom(golem,activate_js) importFrom(golem,add_resource_path) importFrom(golem,bundle_resources) diff --git a/R/app_ui.R b/R/app_ui.R index 9c2afd6..fc6e522 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -1,264 +1,264 @@ -#' The application User-Interface -#' -#' @param request Internal parameter for `{shiny}`. -#' DO NOT REMOVE. -#' @import shiny -#' @import shinydashboard -#' @import shinymanager -#' @noRd -app_ui <- function(request) { - tagList( - # Leave this function for adding external resources - golem_add_external_resources(), - # List the first level UI elements here - dashboardPage( - dashboardHeader(title = "Reads2Map App"), - dashboardSidebar( - sidebarMenu( - id = "tabs", - menuItem("About", tabName = "about", icon = icon("lightbulb")), - #menuItem("Parallel map", icon = icon("dot-circle"), tabName = "parallel"), - menuItem("Upload data", icon = icon("upload"), tabName= "upload"), - menuItem("SimulatedReads2Map", icon = icon("dot-circle"), tabName= "simulations", - menuSubItem("SNP calling efficiency", icon = icon("circle"), tabName = "snpcall"), - #menuSubItem("Coverage", icon = icon("circle"), tabName = "coverage"), - menuSubItem("Filters", icon = icon("circle"), tabName = "filters"), - menuSubItem("Markers type", icon = icon("circle"), tabName = "marker_type"), - menuSubItem("Times", icon = icon("circle"), tabName = "times"), - menuSubItem("Depth and genotyping", icon = icon("circle"), tabName = "disper_depth"), - menuSubItem("Genotype probabilities", icon = icon("circle"), tabName = "probs"), - menuSubItem("ROC curves", icon = icon("circle"), tabName = "roc"), - menuSubItem("Map size each family", icon = icon("circle"), tabName = "ind_size"), - menuSubItem("Overview map size", icon = icon("circle"), tabName = "all_size"), - menuSubItem("Phases", icon = icon("circle"), tabName = "phases"), - menuSubItem("Maps", icon = icon("circle"), tabName = "map"), - menuSubItem("Progeny haplotypes", icon = icon("circle"), tabName = "haplo"), - menuSubItem("Breakpoints count", icon = icon("circle"), tabName = "counts"), - menuSubItem("cM x Mb", icon = icon("circle"), tabName = "cmxmb") - ), - #menuSubItem("Overview", icon = icon("circle"), tabName = "overview")), - - menuItem("EmpiricalReads2Map", icon = icon("dot-circle" ), tabName = "empirical", - #menuSubItem("Coverage", icon = icon("circle"), tabName = "coverage_emp"), - menuSubItem("SNP calling efficiency", icon = icon("circle"), tabName = "snpcall_emp"), - menuSubItem("Filters", icon = icon("circle"), tabName = "filters_emp"), - menuSubItem("Markers type", icon = icon("circle"), tabName = "marker_type_emp"), - menuSubItem("Times", icon = icon("circle"), tabName = "times_emp"), - menuSubItem("Depth and genotyping", icon = icon("circle"), tabName = "disper_depth_emp"), - menuSubItem("Map size", icon = icon("circle"), tabName = "ind_size_emp"), - menuSubItem("Plotly heatmaps", icon = icon("circle"), tabName = "heatmaps_emp"), - menuSubItem("Maps", icon = icon("circle"), tabName = "map_emp"), - menuSubItem("Progeny haplotypes", icon = icon("circle"), tabName = "haplo_emp"), - menuSubItem("Breakpoints count", icon = icon("circle"), tabName = "counts_emp"), - menuSubItem("cM x Mb", icon = icon("circle"), tabName = "cmxmb_emp") - ), - menuItem("Polyploid EmpiricalReads2Map", icon = icon("dot-circle" ), tabName = "poly_empirical", - menuSubItem("Data set overview", icon = icon("circle"), tabName = "dat_poly"), - menuSubItem("Map size", icon = icon("circle"), tabName = "size_poly"), - menuSubItem("Progeny haplotypes", icon = icon("circle"), tabName = "haplo_emp_poly") - ), - #menuItem("Workflow tasks times", icon = icon("circle"), tabName = "wf_times"), - tags$li(class = "dropdown", - tags$a(href="https://statgen-esalq.github.io/", target="_blank", - tags$img(height = "55px", alt="Logo", src="www/logo_fundo_azul.png") - ), - tags$a(href="https://www.polyploids.org/", target="_blank", - tags$img(height = "55px", alt="Logo", src="www/logo_white.png")) - ) - ) - ), - - dashboardBody( - # Lab colors - tags$head(tags$style(HTML(' - /* logo */ - .skin-blue .main-header .logo { - background-color: #003350; - } - /* logo when hovered */ - .skin-blue .main-header .logo:hover { - background-color: #003350; - } - /* navbar (rest of the header) */ - .skin-blue .main-header .navbar { - background-color: #003350; - } - /* main sidebar */ - .skin-blue .main-sidebar { - background-color: #003350; - } - /* active selected tab in the sidebarmenu */ - .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{ - background-color: #003350; - color: #ffffff; - } - /* other links in the sidebarmenu */ - .skin-blue .main-sidebar .sidebar .sidebar-menu a{ - background-color: #003350; - color: #ffffff; - } - /* other links in the sidebarmenu when hovered */ - .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{ - background-color: #cc662f; - color: #000000; - } - /* toggle button when hovered */ - .skin-blue .main-header .navbar .sidebar-toggle:hover{ - background-color: #003350; - } - - .box.box-solid.box-primary>.box-header { - color:#fff; - background:#cc662f - } - - .box.box-solid.box-primary{ - border-bottom-color:#cc662f; - border-left-color:#cc662f; - border-right-color:#cc662f; - border-top-color:#cc662f; - } - - .box.box-solid.box-info>.box-header { - color:#fff; - background:#003350 - } - - .box.box-solid.box-info{ - border-bottom-color:#003350; - border-left-color:#003350; - border-right-color:#003350; - border-top-color:#003350; - } - '))), - - tabItems( - # First tab content - tabItem(tabName = "about", - includeMarkdown(system.file("ext", "about.Rmd", package = "Reads2MapApp")) - ), - - tabItem(tabName = "upload", - mod_upload_ui("upload_ui_1") - ), - # simulations - tabItem(tabName = "snpcall", - mod_simu_SNPCalling_efficiency_ui("simu_SNPCalling_efficiency_ui_1") - ), - tabItem(tabName = "filters", - mod_simu_filters_ui("simu_filters_ui_1") - ), - tabItem(tabName = "marker_type", - mod_simu_markers_type_ui("simu_markers_type_ui_1") - ), - tabItem(tabName = "times", - mod_simu_times_ui("simu_times_ui_1") - ), - tabItem(tabName = "disper_depth", - mod_simu_depths_and_genotyping_ui("simu_depths_and_genotyping_ui_1") - ), - tabItem(tabName = "probs", - mod_simu_genotype_probabilities_ui("simu_genotype_probabilities_ui_1") - ), - tabItem(tabName = "roc", - mod_simu_roc_curves_ui("simu_roc_curves_ui_1") - ), - tabItem(tabName = "ind_size", - mod_simu_map_size_each_family_ui("simu_map_size_each_family_ui_1") - ), - tabItem(tabName = "all_size", - mod_simu_overview_map_size_ui("simu_overview_map_size_ui_1") - ), - tabItem(tabName = "phases", - mod_simu_phases_ui("simu_phases_ui_1") - ), - tabItem(tabName = "map", - mod_simu_maps_ui("simu_maps_ui_1") - ), - tabItem(tabName = "haplo", - mod_simu_progeny_haplotypes_ui("simu_progeny_haplotypes_ui_1") - ), - tabItem(tabName = "counts", - mod_simu_breakpoints_counts_ui("simu_breakpoints_counts_ui_1") - ), - tabItem(tabName = "cmxmb", - mod_simu_cM_Mb_ui("simu_cM_Mb_ui_1") - ), - # Empirical - tabItem(tabName = "snpcall_emp", - mod_emp_SNPCalling_efficiency_ui("emp_SNPCalling_efficiency_ui_1") - ), - tabItem(tabName = "filters_emp", - mod_emp_filters_ui("emp_filters_ui_1") - ), - tabItem(tabName = "marker_type_emp", - mod_emp_markers_type_ui("emp_markers_type_ui_1") - ), - tabItem(tabName = "times_emp", - mod_emp_times_ui("emp_times_ui_1") - ), - tabItem(tabName = "disper_depth_emp", - mod_emp_depth_and_genotyping_ui("emp_depth_and_genotyping_ui_1") - ), - tabItem(tabName = "ind_size_emp", - mod_emp_ind_size_ui("emp_ind_size_ui_1") - ), - tabItem(tabName = "heatmaps_emp", - mod_emp_plotly_heatmaps_ui("emp_plotly_heatmaps_ui_1") - ), - tabItem(tabName = "map_emp", - mod_emp_maps_ui("emp_maps_ui_1") - ), - tabItem(tabName = "haplo_emp", - mod_emp_progeny_haplotypes_ui("emp_progeny_haplotypes_ui_1") - ), - tabItem(tabName = "counts_emp", - mod_emp_breakpoints_count_ui("emp_breakpoints_count_ui_1") - ), - tabItem(tabName = "cmxmb_emp", - mod_emp_cM_Mb_ui("emp_cM_Mb_ui_1") - ), - # Polyploids - tabItem(tabName = "dat_poly", - mod_dat_poly_ui("dat_poly_ui_1") - ), - tabItem(tabName = "size_poly", - mod_size_poly_ui("size_poly_ui_1") - ), - tabItem(tabName = "haplo_emp_poly", - mod_haplo_emp_poly_ui("haplo_emp_poly_ui_1") - ), - # workflow times - tabItem(tabName = "wf_times", - mod_workflow_tasks_times_ui("workflow_tasks_times_ui_1") - ) - ) - ) - ) - ) -} - -#' Add external Resources to the Application -#' -#' This function is internally used to add external -#' resources inside the Shiny application. -#' -#' @import shiny -#' @importFrom golem add_resource_path activate_js favicon bundle_resources -#' @noRd -golem_add_external_resources <- function(){ - - add_resource_path( - 'www', app_sys('app/www') - ) - - tags$head( - favicon(), - bundle_resources( - path = app_sys('app/www'), - app_title = 'Reads2MapApp' - ) - # Add here other external resources - # for example, you can add shinyalert::useShinyalert() - ) +#' The application User-Interface +#' +#' @param request Internal parameter for `{shiny}`. +#' DO NOT REMOVE. +#' @import shiny +#' @import shinydashboard +#' @import shinymanager +#' @noRd +app_ui <- function(request) { + tagList( + # Leave this function for adding external resources + golem_add_external_resources(), + # List the first level UI elements here + dashboardPage( + dashboardHeader(title = "Reads2Map App"), + dashboardSidebar( + sidebarMenu( + id = "tabs", + menuItem("About", tabName = "about", icon = icon("lightbulb")), + #menuItem("Parallel map", icon = icon("dot-circle"), tabName = "parallel"), + menuItem("Upload data", icon = icon("upload"), tabName= "upload"), + menuItem("SimulatedReads2Map", icon = icon("dot-circle"), tabName= "simulations", + menuSubItem("SNP calling efficiency", icon = icon("circle"), tabName = "snpcall"), + #menuSubItem("Coverage", icon = icon("circle"), tabName = "coverage"), + menuSubItem("Filters", icon = icon("circle"), tabName = "filters"), + menuSubItem("Markers type", icon = icon("circle"), tabName = "marker_type"), + menuSubItem("Times", icon = icon("circle"), tabName = "times"), + menuSubItem("Depth and genotyping", icon = icon("circle"), tabName = "disper_depth"), + menuSubItem("Genotype probabilities", icon = icon("circle"), tabName = "probs"), + menuSubItem("ROC curves", icon = icon("circle"), tabName = "roc"), + menuSubItem("Map size each family", icon = icon("circle"), tabName = "ind_size"), + menuSubItem("Overview map size", icon = icon("circle"), tabName = "all_size"), + menuSubItem("Phases", icon = icon("circle"), tabName = "phases"), + menuSubItem("Maps", icon = icon("circle"), tabName = "map"), + menuSubItem("Progeny haplotypes", icon = icon("circle"), tabName = "haplo"), + menuSubItem("Breakpoints count", icon = icon("circle"), tabName = "counts"), + menuSubItem("cM x Mb", icon = icon("circle"), tabName = "cmxmb") + ), + #menuSubItem("Overview", icon = icon("circle"), tabName = "overview")), + + menuItem("EmpiricalReads2Map", icon = icon("dot-circle" ), tabName = "empirical", + #menuSubItem("Coverage", icon = icon("circle"), tabName = "coverage_emp"), + menuSubItem("SNP calling efficiency", icon = icon("circle"), tabName = "snpcall_emp"), + menuSubItem("Filters", icon = icon("circle"), tabName = "filters_emp"), + menuSubItem("Markers type", icon = icon("circle"), tabName = "marker_type_emp"), + menuSubItem("Times", icon = icon("circle"), tabName = "times_emp"), + menuSubItem("Depth and genotyping", icon = icon("circle"), tabName = "disper_depth_emp"), + menuSubItem("Map size", icon = icon("circle"), tabName = "ind_size_emp"), + menuSubItem("Plotly heatmaps", icon = icon("circle"), tabName = "heatmaps_emp"), + menuSubItem("Maps", icon = icon("circle"), tabName = "map_emp"), + menuSubItem("Progeny haplotypes", icon = icon("circle"), tabName = "haplo_emp"), + menuSubItem("Breakpoints count", icon = icon("circle"), tabName = "counts_emp"), + menuSubItem("cM x Mb", icon = icon("circle"), tabName = "cmxmb_emp") + ), + menuItem("Polyploid EmpiricalReads2Map", icon = icon("dot-circle" ), tabName = "poly_empirical", + menuSubItem("Map size", icon = icon("circle"), tabName = "size_poly"), + menuSubItem("Data set overview", icon = icon("circle"), tabName = "dat_poly") + #menuSubItem("Progeny haplotypes", icon = icon("circle"), tabName = "haplo_emp_poly") + ), + #menuItem("Workflow tasks times", icon = icon("circle"), tabName = "wf_times"), + tags$li(class = "dropdown", + tags$a(href="https://statgen-esalq.github.io/", target="_blank", + tags$img(height = "55px", alt="Logo", src="www/logo_fundo_azul.png") + ), + tags$a(href="https://www.polyploids.org/", target="_blank", + tags$img(height = "55px", alt="Logo", src="www/logo_white.png")) + ) + ) + ), + + dashboardBody( + # Lab colors + tags$head(tags$style(HTML(' + /* logo */ + .skin-blue .main-header .logo { + background-color: #003350; + } + /* logo when hovered */ + .skin-blue .main-header .logo:hover { + background-color: #003350; + } + /* navbar (rest of the header) */ + .skin-blue .main-header .navbar { + background-color: #003350; + } + /* main sidebar */ + .skin-blue .main-sidebar { + background-color: #003350; + } + /* active selected tab in the sidebarmenu */ + .skin-blue .main-sidebar .sidebar .sidebar-menu .active a{ + background-color: #003350; + color: #ffffff; + } + /* other links in the sidebarmenu */ + .skin-blue .main-sidebar .sidebar .sidebar-menu a{ + background-color: #003350; + color: #ffffff; + } + /* other links in the sidebarmenu when hovered */ + .skin-blue .main-sidebar .sidebar .sidebar-menu a:hover{ + background-color: #cc662f; + color: #000000; + } + /* toggle button when hovered */ + .skin-blue .main-header .navbar .sidebar-toggle:hover{ + background-color: #003350; + } + + .box.box-solid.box-primary>.box-header { + color:#fff; + background:#cc662f + } + + .box.box-solid.box-primary{ + border-bottom-color:#cc662f; + border-left-color:#cc662f; + border-right-color:#cc662f; + border-top-color:#cc662f; + } + + .box.box-solid.box-info>.box-header { + color:#fff; + background:#003350 + } + + .box.box-solid.box-info{ + border-bottom-color:#003350; + border-left-color:#003350; + border-right-color:#003350; + border-top-color:#003350; + } + '))), + + tabItems( + # First tab content + tabItem(tabName = "about", + includeMarkdown(system.file("ext", "about.Rmd", package = "Reads2MapApp")) + ), + + tabItem(tabName = "upload", + mod_upload_ui("upload_ui_1") + ), + # simulations + tabItem(tabName = "snpcall", + mod_simu_SNPCalling_efficiency_ui("simu_SNPCalling_efficiency_ui_1") + ), + tabItem(tabName = "filters", + mod_simu_filters_ui("simu_filters_ui_1") + ), + tabItem(tabName = "marker_type", + mod_simu_markers_type_ui("simu_markers_type_ui_1") + ), + tabItem(tabName = "times", + mod_simu_times_ui("simu_times_ui_1") + ), + tabItem(tabName = "disper_depth", + mod_simu_depths_and_genotyping_ui("simu_depths_and_genotyping_ui_1") + ), + tabItem(tabName = "probs", + mod_simu_genotype_probabilities_ui("simu_genotype_probabilities_ui_1") + ), + tabItem(tabName = "roc", + mod_simu_roc_curves_ui("simu_roc_curves_ui_1") + ), + tabItem(tabName = "ind_size", + mod_simu_map_size_each_family_ui("simu_map_size_each_family_ui_1") + ), + tabItem(tabName = "all_size", + mod_simu_overview_map_size_ui("simu_overview_map_size_ui_1") + ), + tabItem(tabName = "phases", + mod_simu_phases_ui("simu_phases_ui_1") + ), + tabItem(tabName = "map", + mod_simu_maps_ui("simu_maps_ui_1") + ), + tabItem(tabName = "haplo", + mod_simu_progeny_haplotypes_ui("simu_progeny_haplotypes_ui_1") + ), + tabItem(tabName = "counts", + mod_simu_breakpoints_counts_ui("simu_breakpoints_counts_ui_1") + ), + tabItem(tabName = "cmxmb", + mod_simu_cM_Mb_ui("simu_cM_Mb_ui_1") + ), + # Empirical + tabItem(tabName = "snpcall_emp", + mod_emp_SNPCalling_efficiency_ui("emp_SNPCalling_efficiency_ui_1") + ), + tabItem(tabName = "filters_emp", + mod_emp_filters_ui("emp_filters_ui_1") + ), + tabItem(tabName = "marker_type_emp", + mod_emp_markers_type_ui("emp_markers_type_ui_1") + ), + tabItem(tabName = "times_emp", + mod_emp_times_ui("emp_times_ui_1") + ), + tabItem(tabName = "disper_depth_emp", + mod_emp_depth_and_genotyping_ui("emp_depth_and_genotyping_ui_1") + ), + tabItem(tabName = "ind_size_emp", + mod_emp_ind_size_ui("emp_ind_size_ui_1") + ), + tabItem(tabName = "heatmaps_emp", + mod_emp_plotly_heatmaps_ui("emp_plotly_heatmaps_ui_1") + ), + tabItem(tabName = "map_emp", + mod_emp_maps_ui("emp_maps_ui_1") + ), + tabItem(tabName = "haplo_emp", + mod_emp_progeny_haplotypes_ui("emp_progeny_haplotypes_ui_1") + ), + tabItem(tabName = "counts_emp", + mod_emp_breakpoints_count_ui("emp_breakpoints_count_ui_1") + ), + tabItem(tabName = "cmxmb_emp", + mod_emp_cM_Mb_ui("emp_cM_Mb_ui_1") + ), + # Polyploids + tabItem(tabName = "dat_poly", + mod_dat_poly_ui("dat_poly_ui_1") + ), + tabItem(tabName = "size_poly", + mod_size_poly_ui("size_poly_ui_1") + ), + tabItem(tabName = "haplo_emp_poly", + mod_haplo_emp_poly_ui("haplo_emp_poly_ui_1") + ), + # workflow times + tabItem(tabName = "wf_times", + mod_workflow_tasks_times_ui("workflow_tasks_times_ui_1") + ) + ) + ) + ) + ) +} + +#' Add external Resources to the Application +#' +#' This function is internally used to add external +#' resources inside the Shiny application. +#' +#' @import shiny +#' @importFrom golem add_resource_path activate_js favicon bundle_resources +#' @noRd +golem_add_external_resources <- function(){ + + add_resource_path( + 'www', app_sys('app/www') + ) + + tags$head( + favicon(), + bundle_resources( + path = app_sys('app/www'), + app_title = 'Reads2MapApp' + ) + # Add here other external resources + # for example, you can add shinyalert::useShinyalert() + ) } \ No newline at end of file diff --git a/R/graphics_poly_emp.R b/R/graphics_poly_emp.R index 92cfbfd..d2b4596 100644 --- a/R/graphics_poly_emp.R +++ b/R/graphics_poly_emp.R @@ -50,16 +50,14 @@ prepare_poly_datas_emp <- function(x = NULL, example_emp = NULL){ software <- "mappoly" datas <- unlist(datas) - list_items <- c("dat", "mat2", "map") + list_items <- c("dat", "mat2", "maps", "summaries", "info") result_list <- list() for(j in 1:length(list_items)){ files <- datas[grep(list_items[j], datas)] if(length(files) > 0){ temp_item <- list() for(i in 1:length(files)){ - if(grepl("map", files[i]) & !grepl("0", files[i])){ - temp_item[[i]] <- list(readRDS(files[i])) - } else temp_item[[i]] <- readRDS(files[i]) + temp_item[[i]] <- readRDS(files[i]) } } else temp_item <- NULL names(temp_item) <- sapply(strsplit(basename(files), "_"), function(x) paste0(x[1:3], collapse = "_")) @@ -67,6 +65,12 @@ prepare_poly_datas_emp <- function(x = NULL, example_emp = NULL){ } names(result_list) <- list_items result_list$software <- software + result_list1 <- result_list + + for(i in 1:5){ + idx <- which(sapply(result_list[[i]], is.list)) + if(length(result_list[[i]]) > length(idx)) result_list[[i]][-idx] <- NULL + } return(result_list) } diff --git a/R/mod_dat_poly.R b/R/mod_dat_poly.R index d9eaab1..a77cc6b 100644 --- a/R/mod_dat_poly.R +++ b/R/mod_dat_poly.R @@ -28,28 +28,39 @@ mod_dat_poly_ui <- function(id){ ) ), hr(), column(width = 12, - box(title = "Dataset overview", width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary", - div(downloadButton(ns("dats_down"), label = "Download PDF with all"),style="float:right"), + div(downloadButton(ns("dats_down"), label = "Download as PDF image"),style="float:right"), actionButton(ns("go1"), "Update",icon("refresh", verify_fa = FALSE)), - plotOutput(ns("dat_out")),hr(), + plotOutput(ns("dat_out")) ), - column(width = 6, - box(title = "Recombination fraction heatmap", - width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary", - div(downloadButton(ns("rf_down"), label = "Download PDF with all"),style="float:right"), - plotOutput(ns("rf_out"), width = "600px", height = "600px"),hr(), - ) + box(title = "Recombination fraction heatmap", + width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary", + div(downloadButton(ns("rf_down"), label = "Download as PDF image"),style="float:right"), + plotOutput(ns("rf_out"), width = "600px", height = "600px"),hr(), ), - column(width = 6, - box(title = "Genetic map", - width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary", - actionButton(ns("go2"), "Update",icon("refresh", verify_fa = FALSE)), - div(downloadButton(ns("map_down"), label = "Download PDF with all"),style="float:right"), - imageOutput(ns("map_out"), width = "100%", height = "100%"), - ) - ) + box(title = "Select markers", + width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary", + sliderInput(ns("interval"), label = "Select map size interval", min = 10, max = 200, value = c(90,120)), br(), + radioButtons(ns("prob"), label = h3("Radio buttons"), + choices = list("5% global error" = "error", "probabilities" = 2), + selected = "error"), + actionButton(ns("go2"), "Update",icon("refresh", verify_fa = FALSE)), br(), + textOutput(ns("selected")), br(), + div(downloadButton(ns("selected_down"), + label = "Download the list of selected markers IDs"),style="float:right") + ), + box(title = "Build map", + width = NULL, solidHeader = TRUE, collapsible = FALSE, status="primary", + p("Building the map will take a while, make sure you selected your best pipeline and interval."), br(), + numericInput(ns("ncores"), label = "Set number of cores to be used for the analysis", value =1), br(), + actionButton(ns("go3"), "Update",icon("refresh", verify_fa = FALSE)), + plotOutput(ns("built_map"),height = "600px"), br(), + plotOutput(ns("rf_built_map"), width = "600px", height = "600px"), + div(downloadButton(ns("datas_down"), + label = "Download a list object with \n selected dataset (first list level) + \n and built map (second list level)"),style="float:right") + ), hr() ) ) ) @@ -65,7 +76,7 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){ ns <- session$ns observe({ - file_names <- strsplit(names(datas_poly_emp()[[3]]), "_") + file_names <- strsplit(names(datas_poly_emp()[[1]]), "_") SNPCall_choice <- as.list(unique(sapply(file_names, "[[", 1))) names(SNPCall_choice) <- unique(sapply(file_names, "[[", 1)) @@ -108,25 +119,27 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){ grepl(sapply(strsplit(input$ErrorProb, "0"), "[[",1), names(datas_poly_emp()$mat2))) idx1 <- which(grepl(input$CountsFrom, names(datas_poly_emp()$dat)) & - grepl(input$SNPCall, names(datas_poly_emp()$dat)) & - grepl(sapply(strsplit(input$ErrorProb, "0"), "[[",1), names(datas_poly_emp()$dat))) + grepl(input$SNPCall, names(datas_poly_emp()$dat)) & + grepl(sapply(strsplit(input$ErrorProb, "0"), "[[",1), names(datas_poly_emp()$dat))) - idx2 <- which(grepl(input$CountsFrom, names(datas_poly_emp()$map)) & - grepl(input$SNPCall, names(datas_poly_emp()$map)) & - grepl(paste0(input$ErrorProb, "_"), names(datas_poly_emp()$map))) + idx2 <- which(grepl(input$CountsFrom, names(datas_poly_emp()$maps)) & + grepl(input$SNPCall, names(datas_poly_emp()$maps)) & + grepl(paste0(input$ErrorProb, "_"), names(datas_poly_emp()$maps))) - - cat(paste("map:", names(datas_poly_emp()$map)[idx2], "\n")) - seq <- datas_poly_emp()$map[[idx2]][[1]] + cat(paste("map:", names(datas_poly_emp()$maps)[idx2], "\n")) + seq <- datas_poly_emp()$map[[idx2]] cat(idx, "\n") cat(paste("mat:", names(datas_poly_emp()$mat2)[idx], "\n")) mat <- datas_poly_emp()$mat2[[idx]] - + cat(paste("dat:", names(datas_poly_emp()$dat)[idx1], "\n")) - dat <- datas_poly_emp()$dat[[idx1]] - - list(dat, mat, seq, input$ErrorProb) + dat <<- datas_poly_emp()$dat[[idx1]] + + summary <- datas_poly_emp()$summaries[[which(names(datas_poly_emp()$summaries) %in% names(datas_poly_emp()$dat)[idx1])]] + info <- datas_poly_emp()$info[[which(names(datas_poly_emp()$info) %in% names(datas_poly_emp()$dat)[idx1])]] + + list(dat, mat, seq, summary, info, input$ErrorProb) }) }) @@ -135,37 +148,124 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){ }) output$rf_out <- renderPlot({ - mappoly:::plot.mappoly.rf.matrix(button1()[[2]], ord = button1()[[3]]$info$mrk.names, type = "lod") + mappoly:::plot.mappoly.rf.matrix(button1()[[2]], ord = button1()[[3]]$info$mrk.names) }) button2 <- eventReactive(input$go2, { - withProgress(message = 'Building draw', value = 0, { + withProgress(message = 'Building heatmap', value = 0, { incProgress(0, detail = paste("Doing part", 1)) + df <- button1()[[4]] + df$`Map length (cM)` <- as.numeric(button1()[[4]]$`Map length (cM)`) + summary_sub <- df %>% filter(map == paste0(input$prob, ".p1")) + idx.p1 <- which(summary_sub$`Map length (cM)` >= input$interval[1] & + summary_sub$`Map length (cM)` <= input$interval[2]) - stop_bam(input$CountsFrom, input$ErrorProb) + summary_sub <- df %>% filter(map == paste0(input$prob, ".p2")) + idx.p2 <- which(summary_sub$`Map length (cM)` >= input$interval[1] & + summary_sub$`Map length (cM)` <= input$interval[2]) + + incProgress(0.5, detail = paste("Doing part", 2)) + if(input$prob == "error"){ + selec.p1 <- button1()[[3]]$map.err.p1[idx.p1] + selec.p1 <- unlist(sapply(selec.p1, function(x) x$info$mrk.names)) + selec.p1 <- unique(selec.p1) + + selec.p2 <- button1()[[3]]$map.err.p2[idx.p2] + selec.p2 <- unlist(sapply(selec.p2, function(x) x$info$mrk.names)) + selec.p2 <- unique(selec.p2) + select.mks <- unique(c(selec.p1, selec.p2)) + + } else { + selec.p1 <- button1()[[3]]$map.prob.p1[idx.p1] + selec.p1 <- unlist(sapply(selec.p1, function(x) x$info$mrk.names)) + selec.p1 <- unique(selec.p1) + + selec.p2 <- button1()[[3]]$map.prob.p2[idx.p2] + selec.p2 <- unlist(sapply(selec.p2, function(x) x$info$mrk.names)) + selec.p2 <- unique(selec.p2) + select.mks <- unique(selec.p1, selec.p2) + } + + pos <- button1()[[1]]$genome.pos[match(select.mks, button1()[[1]]$mrk.names)] + select.mks <- select.mks[order(pos)] + select.mks + }) + }) + + output$selected <- renderText({ + paste0("Number of selected markers:", + length(button2())) + }) + + output$selected_down <- downloadHandler( + filename = function() { + tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".csv") + }, + # content is a function with argument file. content writes the plot to the device + content = function(file) { + + datas_lst <- data.frame(selected_markers = button2()) + white.csv(datas_lst, file = file) + + } + ) + + build_map <- eventReactive(input$go3, { + withProgress(message = 'Building map', value = 0, { + incProgress(0, detail = paste("Doing part", 1)) - idx <- which(grepl(input$CountsFrom, names(datas_poly_emp()$map)) & - grepl(input$SNPCall, names(datas_poly_emp()$map)) & - grepl(paste0(input$ErrorProb, "_"), names(datas_poly_emp()$map))) + dat <- button1()[[1]] + seq_dat <- make_seq_mappoly(dat, button2()) - data <- datas_poly_emp()$map[[idx]][[1]] + tpt <- est_pairwise_rf(seq_dat, ncpus = input$ncores) + incProgress(0.3, detail = paste("Doing part", 2)) - outfile <- tempfile(pattern="file", tmpdir = tempdir(), fileext = ".png") - list(data, outfile) + map <- est_rf_hmm_sequential(input.seq = seq_dat, + start.set = 5, + thres.twopt = 10, + thres.hmm = 10, + extend.tail = 30, + info.tail = TRUE, + twopt = tpt, + phase.number.limit = 10, + reestimate.single.ph.configuration = TRUE, + tol = 10e-2, + tol.final = 10e-4, + verbose = FALSE) + incProgress(0.8, detail = paste("Doing part", 4)) + + map <- filter_map_at_hmm_thres(map, thres.hmm = 0.0001) + map2 <- est_full_hmm_with_global_error(map, error = 0.05, tol = 10e-3) + map3 <- split_and_rephase(map2, gap.threshold = 20, size.rem.cluster = 3, twopt = tpt) + map.final <- est_full_hmm_with_global_error(map3, error = 0.05, tol = 10e-4) + map.final }) }) - output$map_out <- renderImage({ - - png(button2()[[2]]) - mappoly:::plot.mappoly.map(button2()[[1]]) - dev.off() - - list(src = button2()[[2]], - contentType = 'image/png') - }, deleteFile = TRUE) + output$built_map <- renderPlot({ + plot(build_map()) + }) + + output$rf_built_map <- renderPlot({ + mappoly:::plot.mappoly.rf.matrix(button1()[[2]], ord = build_map()$info$mrk.names) + }) + ## download all + output$datas_down <- downloadHandler( + filename = function() { + tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".rds") + }, + # content is a function with argument file. content writes the plot to the device + content = function(file) { + + dat <- button1()[[1]] + datas_lst <- list(dat, build_map()) + saveRDS(datas_lst, file = file) + + } + ) + ## download all output$dats_down <- downloadHandler( filename = function() { @@ -202,34 +302,13 @@ mod_dat_poly_server <- function(input, output, session, datas_poly_emp){ for(i in 1:length(datas_poly_emp()$mat2)){ idx <- match(names(datas_poly_emp()$mat2)[i], gsub("0.05", "", names(datas_poly_emp()$map)))[1] mappoly:::plot.mappoly.rf.matrix(datas_poly_emp()$mat2[[i]], - ord = datas_poly_emp()$map[[idx]][[1]]$info$mrk.names, type = "lod") + ord = datas_poly_emp()$map[[idx]][[1]]$info$mrk.names) mtext(text = names(datas_poly_emp()$mat2)[i], side = 1) } dev.off() }) } ) - - - ## download all onemap heatmaps - output$map_down <- downloadHandler( - filename = function() { - tempfile(pattern = "file", tmpdir = tempdir(), fileext = ".pdf") - }, - # content is a function with argument file. content writes the plot to the device - content = function(file) { - withProgress(message = 'Building heatmap', value = 0, { - incProgress(0, detail = paste("Doing part", 1)) - - pdf(file = file, onefile = T) - for(i in 1:length(datas_poly_emp()$map)){ - mappoly:::plot.mappoly.map(datas_poly_emp()$map[[i]][[1]]) - mtext(text = names(datas_poly_emp()$map)[i], side = 3) - } - dev.off() - }) - } - ) } ## To be copied in the UI diff --git a/R/mod_size_poly.R b/R/mod_size_poly.R index c4e7f24..39aaac0 100644 --- a/R/mod_size_poly.R +++ b/R/mod_size_poly.R @@ -10,18 +10,8 @@ mod_size_poly_ui <- function(id){ ns <- NS(id) tagList( - "The graphic show the distribuition of the difference between estimated and simulated distances between each pair markers of the generated maps.", hr(), fluidRow( - column(width = 12, - box(title = "Map size", - width = NULL,solidHeader = TRUE, collapsible = FALSE, status="primary", - plotOutput(ns("size_poly_out")), - hr(), - actionButton(ns("go"), "Update",icon("refresh", verify_fa = FALSE)), - ) - ), - column(width = 6, box( width = NULL, solidHeader = TRUE, @@ -30,7 +20,8 @@ mod_size_poly_ui <- function(id){ choices = "This will be updated", selected = "This will be updated"), hr() - ) + ), + actionButton(ns("go"), "Update",icon("refresh", verify_fa = FALSE)), ) ), column(width = 6, @@ -42,18 +33,32 @@ mod_size_poly_ui <- function(id){ hr() ), fluidPage( - checkboxGroupInput(ns("CountsFrom"), label = p("Counts from"), choices = "This will be updated", selected = "This will be updated") ) ) + ), + column(width = 12, + box(title = "Number of markers after filters", + width = NULL,solidHeader = TRUE, collapsible = FALSE, status="primary", + plotOutput(ns("filters_poly_out")), + ) + ), + column(width = 12, + box(title = "Map size", + width = NULL,solidHeader = TRUE, collapsible = FALSE, status="primary", + plotOutput(ns("size_poly_out"), height = 700), + p("* Dashed red line correspond to 100 cM"), + ) ) ) ) } #' size_poly Server Functions +#' +#' @importFrom ggrepel geom_text_repel #' #' @noRd mod_size_poly_server <- function(input, output, session, datas_poly_emp){ @@ -92,7 +97,7 @@ mod_size_poly_server <- function(input, output, session, datas_poly_emp){ withProgress(message = 'Building graphic', value = 0, { incProgress(0, detail = paste("Doing part", 1)) - file_names <- strsplit(names(datas_poly_emp()[[3]]), "_") + file_names <- strsplit(names(datas_poly_emp()[[1]]), "_") SNPCall_choice <- unique(sapply(file_names, "[[", 1)) ErrorProb_choice <- unique(sapply(file_names, "[[",2)) CountsFrom_choice <- unique(sapply(file_names, "[[",3)) @@ -104,50 +109,52 @@ mod_size_poly_server <- function(input, output, session, datas_poly_emp){ choices <- apply(expand.grid(SNPCall_choice, ErrorProb_choice), 1, paste, collapse="_") choices <- apply(expand.grid(choices, CountsFrom_choice), 1, paste, collapse="_") - idx <- which(names(datas_poly_emp()$map) %in% choices) - - #seqs <- datas_poly_emp()$map[idx] - seqs <- datas_poly_emp()$map[idx] - choosed_files <- file_names[idx] - - data <- data.frame() - for(i in 1:length(seqs)){ - dist <- cumsum(datas_poly_emp()$map[[idx[i]]][[1]]$maps[[1]]$seq.rf) - - data_temp <- data.frame(SNPCall = choosed_files[[i]][1], - GenoCall = choosed_files[[i]][2], - CountsFrom = choosed_files[[i]][3], - rf = c(0,dist)) - data <- rbind(data, data_temp) - } - - data_df <- data %>% group_by(GenoCall, SNPCall, CountsFrom) %>% - summarise(tot_size = round(rf[length(rf)],3), - n = n()) - - data1 <- data %>% mutate(interv.diff = sqrt(c(0,rf[-1] - rf[-length(rf)])^2)) + idx <- which(names(datas_poly_emp()$summaries) %in% choices) + idx2 <- which(names(datas_poly_emp()$info) %in% choices) + + summaries <- datas_poly_emp()$summaries[idx] + summaries <- do.call(rbind, summaries) + info <- datas_poly_emp()$info[idx2] + info <- do.call(rbind, info) + info$step <- factor(info$step, levels = c("raw", "miss filtered", + "segr filtered", "p1", "p2")) - data_n <- data1 %>% group_by(GenoCall, SNPCall, CountsFrom) %>% - summarise(n = n()) - - data2 <- merge(data1, data_n) %>% - gather(key, value, -GenoCall, -SNPCall, - CountsFrom, -rf) + summaries$`Map length (cM)` <- as.numeric(summaries$`Map length (cM)`) + summaries$Total <- as.numeric(summaries$Total) + summaries_long <- summaries %>% select(`Map length (cM)`, Total, map, data) %>% pivot_longer(cols = 1:2) + summaries_long$map1 <- sapply(strsplit(summaries_long$map, "[.]"), "[[", 1) + summaries_long$map1 <- gsub("error", "global error 5%",summaries_long$map1) + summaries_long$map1 <- gsub("prob", "geno call \n probabilities",summaries_long$map1) + summaries_long$map2 <- sapply(strsplit(summaries_long$map, "[.]"), "[[", 2) + summaries_long$map2 <- gsub("p1", "parent 1",summaries_long$map2) + summaries_long$map2 <- gsub("p2", "parent 2",summaries_long$map2) incProgress(0.5, detail = paste("Doing part", 2)) - n <- c(`n markers` = "n", `Distance between markers (cM)` = "interv.diff") - data2$key <- names(n)[match(data2$key, n)] - - list(data2, data_df) + list(info, summaries_long) }) }) - output$size_poly_out <- renderPlot({ - ind_size_graph_emp(button()[[1]]) + output$filters_poly_out <- renderPlot({ + button()[[1]] %>% ggplot(aes(x=step, y = n.markers, color = dat, group=dat, label = n.markers)) + + geom_point() + geom_line() + geom_text_repel() + theme_bw() + + labs(x = "", y = "number of markers", color = "dataset") + theme(text = element_text(size = 15)) }) - output$size_poly_df_out <- renderDataTable({ - button()[[2]] + output$size_poly_out <- renderPlot({ + p1 <- button()[[2]] %>% filter(name != "Total") %>% ggplot(aes(x=value, fill = data, color = data)) + + geom_density(alpha=0.1) + facet_grid(map1 + map2~.) + theme_bw() + ggtitle("Map size (cM)") + + labs(x = "map size (cM)") + + theme(text = element_text(size = 15)) + + geom_vline(xintercept = 100, linetype="dotted", + color = "red", linewidth=1.5) + + p2 <- button()[[2]] %>% filter(name == "Total") %>% ggplot(aes(x=value, fill = data, color = data)) + + geom_density(alpha=0.1) + facet_grid(map1 + map2~.) + theme_bw() + ggtitle("Number of Markers") + + labs(x = "Number of Markers") + + theme(text = element_text(size = 15)) + + ggarrange(p1, p2,common.legend = TRUE, legend = "bottom") }) } diff --git a/README.md b/README.md index 1a4e591..5afae8c 100644 --- a/README.md +++ b/README.md @@ -29,6 +29,27 @@ devtools::install_github('Cristianetaniguti/Reads2MapApp') Reads2MapApp::run_app() ``` +### Reads2MapApp versions + +We adapt the Reads2MapApp according to Reads2Map updates, if you have datasets from older versions of Reads2Map, use the compatible docker images Reads2MapApp version: + +Reads2Map workflow | workflow version | Reads2MapApp version +--- | --- | --- +SimulatedReads2Map | 1.0.2 | 0.0.1 +EmpiricalReads2Map | 1.5.0 | 0.0.1 +EmpiricalMap | 1.3.0 | 0.0.1 +EmpiricalReads2Map | 1.5.1 | 0.0.2 +EmpiricalMap | 1.3.1 | 0.0.2 + +To download and deploy the image use: + +```{bash, eval=FALSE} +docker pull cristaniguti/reads2mapapp:0.0.2 +docker run --rm -e USERID=$(id -u) -e GROUPID=$(id -g) -p 8085:80 -e DISABLE_AUTH=true cristaniguti/reads2mapapp:0.0.2 +``` + +This will make the container available in port 8085 (choose other if you prefer). After, you just need to go to your favorite browser and search for :8085 (example: 127.0.0.1:8085). That is it! Everything you need is there. + ## How to cite * [Taniguti, C. H.; Taniguti, L. M.; Amadeu, R. R.; Lau, J.; de Siqueira Gesteira, G.; Oliveira, T. de P.; Ferreira, G. C.; Pereira, G. da S.; Byrne, D.; Mollinari, M.; Riera-Lizarazu, O.; Garcia, A. A. F. Developing best practices for genotyping-by-sequencing analysis in the construction of linkage maps. GigaScience, 12, giad092. https://doi.org/10.1093/gigascience/giad092](https://doi.org/10.1093/gigascience/giad092) diff --git a/app.R b/app.R index ad3c839..9a9dd31 100644 --- a/app.R +++ b/app.R @@ -6,3 +6,4 @@ pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE) options( "golem.app.prod" = TRUE, shiny.autoload.r=FALSE) #golem::disable_autoload() Reads2MapApp::run_app() # add parameters here (if any) + diff --git a/inst/ext/toy_sample_emp/polyploid/EmpiricalReads_results.tar.gz b/inst/ext/toy_sample_emp/polyploid/EmpiricalReads_results.tar.gz index fa92aef..d8134c0 100644 Binary files a/inst/ext/toy_sample_emp/polyploid/EmpiricalReads_results.tar.gz and b/inst/ext/toy_sample_emp/polyploid/EmpiricalReads_results.tar.gz differ