diff --git a/R/app_server.R b/R/app_server.R index ae734bf..2052408 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -73,12 +73,15 @@ app_server <- function(input, output, session) { #Check for updates from GitHub for BIGapp get_latest_github_commit <- function(repo, owner) { - url <- paste0("https://api.github.com/repos/", owner, "/", repo, "/commits/main") + url <- paste0("https://api.github.com/repos/", owner, "/", repo, "/releases/latest") response <- GET(url) content <- content(response, "parsed") if (status_code(response) == 200) { - return(content$sha) + tag_name <- content$tag_name + clean_tag_name <- sub("-.*", "", tag_name) + clean_tag_name <- sub("v", "", clean_tag_name) + return(clean_tag_name) } else { return(NULL) } diff --git a/R/mod_DosageCall.R b/R/mod_DosageCall.R index 638ca26..ed737b7 100644 --- a/R/mod_DosageCall.R +++ b/R/mod_DosageCall.R @@ -10,12 +10,22 @@ #' @importFrom shiny NS tagList #' @importFrom future availableCores #' @importFrom bs4Dash renderValueBox +#' @import shinydisconnect #' #' mod_DosageCall_ui <- function(id){ ns <- NS(id) tagList( fluidPage( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), fluidRow( box( title = "Inputs", status = "info", solidHeader = TRUE, collapsible = FALSE, collapsed = FALSE, diff --git a/R/mod_Filtering.R b/R/mod_Filtering.R index 2c8308a..511bcc2 100644 --- a/R/mod_Filtering.R +++ b/R/mod_Filtering.R @@ -13,18 +13,28 @@ #' @importFrom shinyjs enable disable useShinyjs #' #' @import dplyr +#' @import shinydisconnect #' #' mod_Filtering_ui <- function(id){ ns <- NS(id) tagList( fluidRow( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), column(width = 3, box(width = 12, title = "Quality Filtering", status = "info", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE, fileInput(ns("updog_rdata"),"Choose VCF File", accept = c(".vcf",".gz")), textInput(ns("filter_output_name"), "Output File Name"), - numericInput(ns("filter_ploidy"),"Ploidy", min = 0, value = NULL), + numericInput(ns("filter_ploidy"),"Species Ploidy", min = 0, value = NULL), numericInput(ns("filter_maf"),"MAF filter", min = 0, max=1, value = 0.05, step = 0.01), numericInput(ns("size_depth"),"Min Read Depth (Marker per Sample)", min = 0, max = 300, value = 10, step = 1), numericInput(ns("snp_miss"),"Remove SNPs with >= % missing data", min = 0, max = 100, value = 50, step = 1), @@ -44,9 +54,11 @@ mod_Filtering_ui <- function(id){ useShinyjs(), downloadButton(ns("start_updog_filter"), "Download", icon = icon("download"), class = "butt"), div(style="display:inline-block; float:right",dropdownButton( - tags$h3("Updog Filter Parameters"), - "You can download examples of the expected file here: \n", - downloadButton(ns('download_vcf'), "Download VCF Example File"), hr(), + HTML("Input files"), + p(downloadButton(ns('download_vcf'),""), "VCF Example File"), + p(HTML("Parameters description:"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("Results description:"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("How to cite:"), actionButton(ns("goCite"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), actionButton(ns("filtering_summary"), "Summary"), circle = FALSE, status = "warning", @@ -100,6 +112,43 @@ mod_Filtering_ui <- function(id){ mod_Filtering_server <- function(input, output, session, parent_session){ ns <- session$ns + + # Help links + observeEvent(input$goPar, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "VCF_Filtering_tabset", + selected = "VCF_Filtering_par") + # expand specific box + updateBox(id = "VCF_Filtering_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goRes, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "VCF_Filtering_tabset", + selected = "VCF_Filtering_results") + # expand specific box + updateBox(id = "VCF_Filtering_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goCite, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "VCF_Filtering_tabset", + selected = "VCF_Filtering_cite") + # expand specific box + updateBox(id = "VCF_Filtering_box", action = "toggle", session = parent_session) + }) #vcf filtering_files <- reactiveValues( diff --git a/R/mod_GS.R b/R/mod_GS.R index 933bb70..cf65eb8 100644 --- a/R/mod_GS.R +++ b/R/mod_GS.R @@ -12,12 +12,22 @@ #' @importFrom bs4Dash valueBox #' @importFrom shiny NS tagList #' @importFrom shinyWidgets virtualSelectInput progressBar +#' @import shinydisconnect #' #' mod_GS_ui <- function(id){ ns <- NS(id) tagList( fluidRow( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), column(width = 3, box(title="Inputs", width = 12, collapsible = TRUE, collapsed = FALSE, status = "info", solidHeader = TRUE, "* Required", @@ -56,11 +66,13 @@ mod_GS_ui <- function(id){ ), actionButton(ns("prediction_est_start"), "Run Analysis"), div(style="display:inline-block; float:right",dropdownButton( - tags$h3("GP Parameters"), - "You can download examples of the expected input input files here: \n", - downloadButton(ns('download_vcft'), "Download Training VCF Example File"), - downloadButton(ns('download_pheno'), "Download Passport Example File"), - downloadButton(ns('download_vcfp'), "Download Prediction VCF Example File"),hr(), + HTML("Input files"), + p(downloadButton(ns('download_vcf'),""), "VCF Example File"), + p(downloadButton(ns('download_pheno'),""), "Trait Example File"), + p(downloadButton(ns('download_vcfp'), ""), "Download Prediction VCF Example File"),hr(), + p(HTML("Parameters description:"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("Results description:"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("How to cite:"), actionButton(ns("goCite"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), actionButton(ns("pred_summary"), "Summary"), circle = FALSE, status = "warning", @@ -126,6 +138,43 @@ mod_GS_ui <- function(id){ mod_GS_server <- function(input, output, session, parent_session){ ns <- session$ns + + # Help links + observeEvent(input$goPar, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Genomic_Prediction_tabset", + selected = "Genomic_Prediction_par") + # expand specific box + updateBox(id = "Genomic_Prediction_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goRes, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Genomic_Prediction_tabset", + selected = "Genomic_Prediction_results") + # expand specific box + updateBox(id = "Genomic_Prediction_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goCite, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Genomic_Prediction_tabset", + selected = "Genomic_Prediction_cite") + # expand specific box + updateBox(id = "Genomic_Prediction_box", action = "toggle", session = parent_session) + }) #Default model choices advanced_options_pred <- reactiveValues( @@ -573,7 +622,7 @@ mod_GS_server <- function(input, output, session, parent_session){ } #Save to reactive values - pred_inputs2$shared_snps <- length(common_markers) + #pred_inputs2$shared_snps <- length(common_markers) pred_inputs2$matrix <- Kin_mat pred_inputs2$pheno_input <- pheno2 }) diff --git a/R/mod_GSAcc.R b/R/mod_GSAcc.R index 472e2b5..9df59b2 100644 --- a/R/mod_GSAcc.R +++ b/R/mod_GSAcc.R @@ -12,12 +12,22 @@ #' @importFrom bs4Dash valueBox #' @importFrom shiny NS tagList #' @importFrom shinyWidgets virtualSelectInput +#' @import shinydisconnect #' mod_GSAcc_ui <- function(id){ ns <- NS(id) tagList( # Add GWAS content here fluidRow( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), column(width = 3, box(title="Inputs", width = 12, collapsible = TRUE, collapsed = FALSE, status = "info", solidHeader = TRUE, fileInput(ns("pred_file"), "Choose VCF File", accept = c(".csv",".vcf",".gz")), @@ -56,10 +66,12 @@ mod_GSAcc_ui <- function(id){ ), actionButton(ns("prediction_start"), "Run Analysis"), div(style="display:inline-block; float:right", dropdownButton( - tags$h3("GP Parameters"), - "You can download examples of the expected input input files here: \n", - downloadButton(ns('download_vcf'), "Download VCF Example File"), - downloadButton(ns('download_pheno'), "Download Passport Example File"),hr(), + HTML("Input files"), + p(downloadButton(ns('download_vcf'),""), "VCF Example File"), + p(downloadButton(ns('download_pheno'),""), "Trait Example File"), hr(), + p(HTML("Parameters description:"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("Results description:"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("How to cite:"), actionButton(ns("goCite"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), actionButton(ns("predAcc_summary"), "Summary"), circle = FALSE, status = "warning", @@ -137,6 +149,43 @@ mod_GSAcc_server <- function(input, output, session, parent_session){ ns <- session$ns + # Help links + observeEvent(input$goPar, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Predictive_Ability_tabset", + selected = "Predictive_Ability_par") + # expand specific box + updateBox(id = "Predictive_Ability_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goRes, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Predictive_Ability_tabset", + selected = "Predictive_Ability_results") + # expand specific box + updateBox(id = "Predictive_Ability_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goCite, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Predictive_Ability_tabset", + selected = "Predictive_Ability_cite") + # expand specific box + updateBox(id = "Predictive_Ability_box", action = "toggle", session = parent_session) + }) + #Default model choices advanced_options <- reactiveValues( pred_model = "GBLUP", diff --git a/R/mod_PCA.R b/R/mod_PCA.R index 106931f..229e240 100644 --- a/R/mod_PCA.R +++ b/R/mod_PCA.R @@ -16,91 +16,104 @@ mod_PCA_ui <- function(id){ ns <- NS(id) tagList( + fluidPage( # Add PCA content here - fluidRow( - useShinyjs(), - inlineCSS(list(.borderred = "border-color: red", .redback = "background: red")), - - column(width = 3, - box( - title = "Inputs", width = 12, solidHeader = TRUE, status = "info", - p("* Required"), - fileInput(ns("dosage_file"), "Choose VCF File*", accept = c(".csv",".vcf",".gz")), - fileInput(ns("passport_file"), "Choose Trait File (IDs in first column)", accept = c(".csv")), - #Dropdown will update after passport upload - numericInput(ns("pca_ploidy"), "Species Ploidy*", min = 2, value = NULL), - actionButton(ns("pca_start"), "Run Analysis"), - div(style="display:inline-block; float:right", - dropdownButton( - tags$h3("PCA Inputs"), - "You can download examples of the expected files here: \n", - downloadButton(ns('download_vcf'), "Download VCF Example File"), - downloadButton(ns('download_pheno'), "Download Trait Example File"),hr(), - actionButton(ns("pca_summary"), "Summary"), - circle = FALSE, - status = "warning", - icon = icon("info"), width = "300px", - tooltip = tooltipOptions(title = "Click to see info!") - )), - style = "overflow-y: auto; height: 480px" - ), - box( - title = "Plot Controls", status = "warning", solidHeader = TRUE, collapsible = TRUE,collapsed = FALSE, width = 12, - selectInput(ns('group_info'), label = 'Color Variable', choices = NULL), - materialSwitch(ns('use_cat'), label = "Color Category", status = "success"), - conditionalPanel(condition = "input.use_cat", - ns = ns, - virtualSelectInput( - inputId = ns("cat_color"), - label = "Select Category To Color:", - choices = NULL, - showValueAsTags = TRUE, - search = TRUE, - multiple = TRUE - ), - selectInput(ns("grey_choice"), "Select Grey", choices = c("Light Grey", "Grey", "Dark Grey", "Black"), selected = "Grey") + fluidRow( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), + useShinyjs(), + inlineCSS(list(.borderred = "border-color: red", .redback = "background: red")), + + column(width = 3, + box( + title = "Inputs", width = 12, solidHeader = TRUE, status = "info", + p("* Required"), + fileInput(ns("dosage_file"), "Choose VCF File*", accept = c(".csv",".vcf",".gz")), + fileInput(ns("passport_file"), "Choose Trait File (IDs in first column)", accept = c(".csv")), + #Dropdown will update after passport upload + numericInput(ns("pca_ploidy"), "Species Ploidy*", min = 2, value = NULL), + br(), + actionButton(ns("pca_start"), "Run Analysis"), + div(style="display:inline-block; float:right",dropdownButton( + HTML("Input files"), + p(downloadButton(ns('download_vcf'),""), "VCF Example File"), + p(downloadButton(ns('download_pheno'),""), "Trait Example File"), hr(), + p(HTML("Parameters description:"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("Results description:"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("How to cite:"), actionButton(ns("goCite"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + actionButton(ns("pca_summary"), "Summary"), + circle = FALSE, + status = "warning", + icon = icon("info"), width = "300px", + tooltip = tooltipOptions(title = "Click to see info!") + ))#, + #style = "overflow-y: auto; height: 480px" ), - selectInput(ns("color_choice"), "Color Palette", choices = list("Standard Palettes" = c("Set1","Set3","Pastel2", - "Pastel1","Accent","Spectral", - "RdYlGn","RdGy"), - "Colorblind Friendly" = c("Set2","Paired","Dark2","YlOrRd","YlOrBr","YlGnBu","YlGn", - "Reds","RdPu","Purples","PuRd","PuBuGn","PuBu", - "OrRd","Oranges","Greys","Greens","GnBu","BuPu", - "BuGn","Blues","RdYlBu", - "RdBu", "PuOr","PRGn","PiYG","BrBG" - )), - selected = "Set1"), - selectInput(ns("pc_X"), "X-Axis (2D-Plot only)", choices = c("PC1","PC2","PC3","PC4","PC5"), selected = "PC1"), - selectInput(ns("pc_Y"), "Y-Axis (2D-Plot only)", choices = c("PC1","PC2","PC3","PC4","PC5"), selected = "PC2"), - div(style="display:inline-block; float:right",dropdownButton( - tags$h3("Save Image"), - selectInput(inputId = ns('pca_figure'), label = 'Figure', choices = c("2D Plot", "Scree Plot"), selected = "2D Plot"), - selectInput(inputId = ns('pca_image_type'), label = 'File', choices = c("jpeg","tiff","png"), selected = "jpeg"), - sliderInput(inputId = ns('pca_image_res'), label = 'Resolution', value = 300, min = 50, max = 1000, step=50), - sliderInput(inputId = ns('pca_image_width'), label = 'Width', value = 10, min = 1, max = 20, step=0.5), - sliderInput(inputId = ns('pca_image_height'), label = 'Height', value = 6, min = 1, max = 20, step = 0.5), - downloadButton(ns("download_pca"), "Save Image"), - circle = FALSE, - status = "danger", - icon = icon("floppy-disk"), width = "300px", - tooltip = tooltipOptions(title = "Click to see inputs!") - )) - ) - ), - column(width = 8, - box(title = "Trait Data", width = 12, solidHeader = TRUE, collapsible = TRUE, status = "info", collapsed = FALSE, maximizable = T, - DTOutput(ns('passport_table')), - style = "overflow-y: auto; height: 480px" - ), - box( - title = "PCA Plots", status = "info", solidHeader = FALSE, width = 12, height = 550, maximizable = T, - bs4Dash::tabsetPanel( - tabPanel("3D-Plot",withSpinner(plotlyOutput(ns("pca_plot"), height = '460px'))), - tabPanel("2D-Plot", withSpinner(plotOutput(ns("pca_plot_ggplot"), height = '460px'))), - tabPanel("Scree Plot", withSpinner(plotOutput(ns("scree_plot"), height = '460px')))) # Placeholder for plot outputs - ) - ), - column(width = 1) + box( + title = "Plot Controls", status = "warning", solidHeader = TRUE, collapsible = TRUE,collapsed = FALSE, width = 12, + selectInput(ns('group_info'), label = 'Color Variable', choices = NULL), + materialSwitch(ns('use_cat'), label = "Color Category", status = "success"), + conditionalPanel(condition = "input.use_cat", + ns = ns, + virtualSelectInput( + inputId = ns("cat_color"), + label = "Select Category To Color:", + choices = NULL, + showValueAsTags = TRUE, + search = TRUE, + multiple = TRUE + ), + selectInput(ns("grey_choice"), "Select Grey", choices = c("Light Grey", "Grey", "Dark Grey", "Black"), selected = "Grey") + ), + selectInput(ns("color_choice"), "Color Palette", choices = list("Standard Palettes" = c("Set1","Set3","Pastel2", + "Pastel1","Accent","Spectral", + "RdYlGn","RdGy"), + "Colorblind Friendly" = c("Set2","Paired","Dark2","YlOrRd","YlOrBr","YlGnBu","YlGn", + "Reds","RdPu","Purples","PuRd","PuBuGn","PuBu", + "OrRd","Oranges","Greys","Greens","GnBu","BuPu", + "BuGn","Blues","RdYlBu", + "RdBu", "PuOr","PRGn","PiYG","BrBG" + )), + selected = "Set1"), + selectInput(ns("pc_X"), "X-Axis (2D-Plot only)", choices = c("PC1","PC2","PC3","PC4","PC5"), selected = "PC1"), + selectInput(ns("pc_Y"), "Y-Axis (2D-Plot only)", choices = c("PC1","PC2","PC3","PC4","PC5"), selected = "PC2"), + div(style="display:inline-block; float:right",dropdownButton( + tags$h3("Save Image"), + selectInput(inputId = ns('pca_figure'), label = 'Figure', choices = c("2D Plot", "Scree Plot"), selected = "2D Plot"), + selectInput(inputId = ns('pca_image_type'), label = 'File', choices = c("jpeg","tiff","png"), selected = "jpeg"), + sliderInput(inputId = ns('pca_image_res'), label = 'Resolution', value = 300, min = 50, max = 1000, step=50), + sliderInput(inputId = ns('pca_image_width'), label = 'Width', value = 10, min = 1, max = 20, step=0.5), + sliderInput(inputId = ns('pca_image_height'), label = 'Height', value = 6, min = 1, max = 20, step = 0.5), + downloadButton(ns("download_pca"), "Save Image"), + circle = FALSE, + status = "danger", + icon = icon("floppy-disk"), width = "300px", + tooltip = tooltipOptions(title = "Click to see inputs!") + )) + ) + ), + column(width = 8, + box(title = "Trait Data", width = 12, solidHeader = TRUE, collapsible = TRUE, status = "info", collapsed = FALSE, maximizable = T, + DTOutput(ns('passport_table')), + style = "overflow-y: auto; height: 480px" + ), + box( + title = "PCA Plots", status = "info", solidHeader = FALSE, width = 12, height = 550, maximizable = T, + bs4Dash::tabsetPanel( + tabPanel("3D-Plot",withSpinner(plotlyOutput(ns("pca_plot"), height = '460px'))), + tabPanel("2D-Plot", withSpinner(plotOutput(ns("pca_plot_ggplot"), height = '460px'))), + tabPanel("Scree Plot", withSpinner(plotOutput(ns("scree_plot"), height = '460px')))) # Placeholder for plot outputs + ) + ), + column(width = 1) + ) ) ) } @@ -113,12 +126,51 @@ mod_PCA_ui <- function(id){ #' @importFrom plotly layout plotlyOutput renderPlotly add_markers plot_ly #' @importFrom RColorBrewer brewer.pal #' @importFrom shinyjs toggleClass +#' @import shinydisconnect #' #' @noRd mod_PCA_server <- function(input, output, session, parent_session){ ns <- session$ns - + options(warn = -1) #Uncomment to suppress warnings + + # Help links + observeEvent(input$goPar, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "PCA_tabset", + selected = "PCA_par") + # expand specific box + updateBox(id = "PCA_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goRes, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "PCA_tabset", + selected = "PCA_results") + # expand specific box + updateBox(id = "PCA_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goCite, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "PCA_tabset", + selected = "PCA_cite") + # expand specific box + updateBox(id = "PCA_box", action = "toggle", session = parent_session) + }) + #PCA reactive values pca_data <- reactiveValues( pc_df_pop = NULL, diff --git a/R/mod_dapc.R b/R/mod_dapc.R index 1399866..f221261 100644 --- a/R/mod_dapc.R +++ b/R/mod_dapc.R @@ -8,11 +8,21 @@ #' @noRd #' #' @importFrom shiny NS tagList +#' @import shinydisconnect mod_dapc_ui <- function(id){ ns <- NS(id) tagList( # Add PCA content here fluidRow( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), column(width = 3, bs4Dash::box( title = "Inputs", width = 12, solidHeader = TRUE, status = "info", @@ -23,9 +33,12 @@ mod_dapc_ui <- function(id){ numericInput(ns("dapc_ploidy"), "Species Ploidy", min = 1, value = NULL), actionButton(ns("K_start"), "Run Step 1"), div(style="display:inline-block; float:right",dropdownButton( - tags$h3("DAPC Inputs"), - "You can download an examples of the expected input file here: \n", - downloadButton(ns('download_vcf'), "Download VCF Example File"),hr(), + HTML("Input files"), + p(downloadButton(ns('download_vcf'),""), "VCF Example File"), + p(downloadButton(ns('download_pheno'),""), "Trait Example File"), hr(), + p(HTML("Parameters description:"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("Results description:"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("How to cite:"), actionButton(ns("goCite"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), actionButton(ns("dapc_summary"), "Summary"), circle = FALSE, status = "warning", @@ -112,7 +125,43 @@ mod_dapc_ui <- function(id){ mod_dapc_server <- function(input, output, session, parent_session){ ns <- session$ns - + + # Help links + observeEvent(input$goPar, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "DAPC_tabset", + selected = "DAPC_par") + # expand specific box + updateBox(id = "DAPC_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goRes, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "DAPC_tabset", + selected = "DAPC_results") + # expand specific box + updateBox(id = "DAPC_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goCite, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "DAPC_tabset", + selected = "DAPC_cite") + # expand specific box + updateBox(id = "DAPC_box", action = "toggle", session = parent_session) + }) dapc_items <- reactiveValues( grp = NULL, @@ -144,6 +193,9 @@ mod_dapc_server <- function(input, output, session, parent_session){ ) } req(input$dosage_file$datapath, input$dapc_ploidy) + + #PB + updateProgressBar(session = session, id = "pb_dapc", value = 5, title = "Importing input files") ploidy <- as.numeric(input$dapc_ploidy) maxK <- as.numeric(input$dapc_kmax) @@ -171,7 +223,10 @@ mod_dapc_server <- function(input, output, session, parent_session){ genotypeMatrix <- apply(genotypeMatrix, 2, convert_to_dosage) rm(vcf) #Remove VCF } - + + #PB + updateProgressBar(session = session, id = "pb_dapc", value = 30, title = "Calculating K") + #Perform analysis get_k <- findK(genotypeMatrix, maxK, ploidy) @@ -179,6 +234,10 @@ mod_dapc_server <- function(input, output, session, parent_session){ dapc_items$grp <- get_k$grp dapc_items$bestK <- get_k$bestK dapc_items$BIC <- get_k$BIC + + #PB + updateProgressBar(session = session, id = "pb_dapc", value = 100, title = "Step 1: Finished!") + }) observeEvent(input$dapc_start, { @@ -203,7 +262,10 @@ mod_dapc_server <- function(input, output, session, parent_session){ ) } req(input$dosage_file$datapath, input$dapc_ploidy, input$dapc_k) - + + #Pb + updateProgressBar(session = session, id = "pb_dapc", value = 5, title = "Importing input files") + geno <- input$dosage_file$datapath ploidy <- as.numeric(input$dapc_ploidy) selected_K <- as.numeric(input$dapc_k) @@ -216,7 +278,10 @@ mod_dapc_server <- function(input, output, session, parent_session){ # Apply the function to the first INFO string info_ids <- extract_info_ids(info[1]) - + + #Pb + updateProgressBar(session = session, id = "pb_dapc", value = 30, title = "Formatting files") + #Get the genotype values if the updog dosage calls are present if ("UD" %in% info_ids) { genotypeMatrix <- extract.gt(vcf, element = "UD") @@ -228,13 +293,20 @@ mod_dapc_server <- function(input, output, session, parent_session){ genotypeMatrix <- apply(genotypeMatrix, 2, convert_to_dosage) rm(vcf) #Remove VCF } - + + #Pb + updateProgressBar(session = session, id = "pb_dapc", value = 60, title = "Performing DAPC") + #Perform analysis clusters <- performDAPC(genotypeMatrix, selected_K, ploidy) #Assign results to reactive value dapc_items$assignments <- clusters$Q dapc_items$dapc <- clusters$dapc + + #Pb + updateProgressBar(session = session, id = "pb_dapc", value = 100, title = "Finished!") + }) ###Outputs from DAPC diff --git a/R/mod_diversity.R b/R/mod_diversity.R index a9c3141..90295af 100644 --- a/R/mod_diversity.R +++ b/R/mod_diversity.R @@ -7,20 +7,32 @@ #' @noRd #' #' @importFrom shiny NS tagList +#' @import shinydisconnect mod_diversity_ui <- function(id){ ns <- NS(id) tagList( # Add GWAS content here fluidRow( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), column(width = 3, box(title="Inputs", width = 12, collapsible = TRUE, collapsed = FALSE, status = "info", solidHeader = TRUE, fileInput(ns("diversity_file"), "Choose VCF File", accept = c(".csv",".vcf",".gz")), numericInput(ns("diversity_ploidy"), "Species Ploidy", min = 1, value = NULL), actionButton(ns("diversity_start"), "Run Analysis"), div(style="display:inline-block; float:right",dropdownButton( - tags$h3("Diversity Parameters"), - "You can download an examples of the expected input file here: \n", - downloadButton(ns('download_vcf'), "Download VCF Example File"),hr(), + HTML("Input files"), + p(downloadButton(ns('download_vcf'),""), "VCF Example File"), + p(HTML("Parameters description:"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("Results description:"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), + p(HTML("How to cite:"), actionButton(ns("goCite"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), actionButton(ns("diversity_summary"), "Summary"), circle = FALSE, status = "warning", @@ -84,6 +96,44 @@ mod_diversity_ui <- function(id){ mod_diversity_server <- function(input, output, session, parent_session){ ns <- session$ns + + # Help links + observeEvent(input$goPar, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Genomic_Diversity_tabset", + selected = "Genomic_Diversity_par") + # expand specific box + updateBox(id = "Genomic_Diversity_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goRes, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Genomic_Diversity_tabset", + selected = "Genomic_Diversity_results") + # expand specific box + updateBox(id = "Genomic_Diversity_box", action = "toggle", session = parent_session) + }) + + observeEvent(input$goCite, { + # change to help tab + updatebs4TabItems(session = parent_session, inputId = "MainMenu", + selected = "help") + + # select specific tab + updateTabsetPanel(session = parent_session, inputId = "Genomic_Diversity_tabset", + selected = "Genomic_Diversity_cite") + # expand specific box + updateBox(id = "Genomic_Diversity_box", action = "toggle", session = parent_session) + }) + #######Genomic Diversity analysis #Genomic Diversity output files @@ -93,7 +143,8 @@ mod_diversity_server <- function(input, output, session, parent_session){ het_df = NULL, maf_df = NULL, pos_df = NULL, - markerPlot = NULL + markerPlot = NULL, + snp_stats = NULL ) #Reactive boxes @@ -165,15 +216,15 @@ mod_diversity_server <- function(input, output, session, parent_session){ geno_mat <- apply(geno_mat, 2, convert_to_dosage) rm(vcf) #Remove VCF - print(class(geno_mat)) + #print(class(geno_mat)) #Convert genotypes to alternate counts if they are the reference allele counts #Importantly, the dosage plot is based on the input format NOT the converted genotypes - is_reference <- TRUE #(input$zero_value == "Reference Allele Counts") + is_reference <- FALSE #(input$zero_value == "Reference Allele Counts") - print("Genotype file successfully imported") + #print("Genotype file successfully imported") ######Get MAF plot (Need to remember that the VCF genotypes are likely set as 0 = homozygous reference, where the dosage report is 0 = homozygous alternate) - print("Starting percentage calc") + #print("Starting percentage calc") #Status updateProgressBar(session = session, id = "pb_diversity", value = 70, title = "Calculating...") # Calculate percentages for both genotype matrices @@ -182,7 +233,7 @@ mod_diversity_server <- function(input, output, session, parent_session){ percentages1_df <- as.data.frame(t(percentages1)) percentages1_df$Data <- "Dosages" # Assuming my_data is your dataframe - print("Percentage Complete: melting dataframe") + #print("Percentage Complete: melting dataframe") melted_data <- percentages1_df %>% pivot_longer(cols = -(Data),names_to = "Dosage", values_to = "Percentage") @@ -197,16 +248,46 @@ mod_diversity_server <- function(input, output, session, parent_session){ # Calculating heterozygosity diversity_items$het_df <- calculate_heterozygosity(geno_mat, ploidy = ploidy) - print("Heterozygosity success") + #print("Heterozygosity success") diversity_items$maf_df <- calculateMAF(geno_mat, ploidy = ploidy) diversity_items$maf_df <- diversity_items$maf_df[, c(1,3)] - print("MAF success") - + #Calculate PIC + calc_allele_frequencies <- function(d_diplo_t, ploidy) { + allele_frequencies <- apply(d_diplo_t, 1, function(x) { + count_sum <- sum(!is.na(x)) + allele_sum <- sum(x, na.rm = TRUE) + if (count_sum != 0) {allele_sum / (ploidy * count_sum)} else {NA} + }) + + all_allele_frequencies <- data.frame(SNP = rownames(d_diplo_t), p1= allele_frequencies, p2= 1-allele_frequencies) + return(all_allele_frequencies) + } + Fre <-calc_allele_frequencies(geno_mat,as.numeric(ploidy)) + calc_pic <- function(x) { + freq_squared <- x^2 + outer_matrix <- outer(freq_squared, freq_squared) + upper_tri_sum <- sum(outer_matrix[upper.tri(outer_matrix)]) + pic <- 1 - sum(freq_squared) - 2*upper_tri_sum + return(pic) + } + + print(Fre[1:5,]) + + PIC_results <- apply(Fre[, c("p1", "p2")], 1, calc_pic) + PIC_df <- data.frame(SNP_ID = Fre$SNP, PIC = PIC_results) + rownames(PIC_df) <- NULL + + print(PIC_df[1:5,]) + print(diversity_items$maf_df[1:5,]) + + diversity_items$snp_stats <- (merge(diversity_items$maf_df, PIC_df, by = "SNP_ID", all = TRUE))[,c("SNP_ID","MAF","PIC")] + colnames(diversity_items$snp_stats)[1] <- "SNP" + #Updating value boxes output$mean_het_box <- renderValueBox({ valueBox( - value = round(mean(diversity_items$het_df$ObservedHeterozygosity),3), + value = round(mean(diversity_items$het_df$Ho),3), subtitle = "Mean Heterozygosity", icon = icon("dna"), color = "info" @@ -252,7 +333,7 @@ mod_diversity_server <- function(input, output, session, parent_session){ validate( need(!is.null(diversity_items$het_df) & !is.null(input$hist_bins), "Input VCF, define parameters and click `run analysis` to access results in this session.") ) - hist(diversity_items$het_df$ObservedHeterozygosity, breaks = as.numeric(input$hist_bins), col = "tan3", border = "black", xlim= c(0,1), + hist(diversity_items$het_df$Ho, breaks = as.numeric(input$hist_bins), col = "tan3", border = "black", xlim= c(0,1), xlab = "Observed Heterozygosity", ylab = "Number of Samples", main = "Sample Observed Heterozygosity") @@ -336,9 +417,9 @@ mod_diversity_server <- function(input, output, session, parent_session){ snp_table <- reactive({ validate( - need(!is.null(diversity_items$maf_df), "Input VCF, define parameters and click `run analysis` to access results in this session.") + need(!is.null(diversity_items$snp_stats), "Input VCF, define parameters and click `run analysis` to access results in this session.") ) - diversity_items$maf_df + diversity_items$snp_stats }) output$snp_table <- renderDT({snp_table()}, options = list(scrollX = TRUE,autoWidth = FALSE, pageLength = 5)) @@ -373,7 +454,7 @@ mod_diversity_server <- function(input, output, session, parent_session){ hist(diversity_items$maf_df$MAF, breaks = as.numeric(input$hist_bins), col = "grey", border = "black", xlab = "Minor Allele Frequency (MAF)", ylab = "Frequency", main = "Minor Allele Frequency Distribution") } else if (input$div_figure == "OHet Histogram") { - hist(diversity_items$het_df$ObservedHeterozygosity, breaks = as.numeric(input$hist_bins), col = "tan3", border = "black", xlim= c(0,1), + hist(diversity_items$het_df$Ho, breaks = as.numeric(input$hist_bins), col = "tan3", border = "black", xlim= c(0,1), xlab = "Observed Heterozygosity", ylab = "Number of Samples", main = "Sample Observed Heterozygosity") @@ -404,10 +485,10 @@ mod_diversity_server <- function(input, output, session, parent_session){ temp_files <- c(temp_files, het_file) } - if (!is.null(diversity_items$maf_df)) { + if (!is.null(diversity_items$snp_stats)) { # Create a temporary file for BIC data frame maf_file <- file.path(temp_dir, paste0("SNP-statistics-", Sys.Date(), ".csv")) - write.csv(diversity_items$maf_df, maf_file, row.names = FALSE) + write.csv(diversity_items$snp_stats, maf_file, row.names = FALSE) temp_files <- c(temp_files, maf_file) } diff --git a/R/mod_dosage2vcf.R b/R/mod_dosage2vcf.R index 4c2ebfd..2c8c879 100644 --- a/R/mod_dosage2vcf.R +++ b/R/mod_dosage2vcf.R @@ -8,11 +8,21 @@ #' #' @importFrom shiny NS tagList #' @importFrom shinyjs enable disable useShinyjs +#' @import shinydisconnect #' mod_dosage2vcf_ui <- function(id){ ns <- NS(id) tagList( fluidPage( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), fluidRow( column(width = 5, box( diff --git a/R/mod_gwas.R b/R/mod_gwas.R index 0f230ba..999a634 100644 --- a/R/mod_gwas.R +++ b/R/mod_gwas.R @@ -11,12 +11,22 @@ #' @importFrom future availableCores #' @importFrom shinycssloaders withSpinner #' @importFrom shinyWidgets virtualSelectInput +#' @import shinydisconnect #' mod_gwas_ui <- function(id){ ns <- NS(id) tagList( # Add GWAS content here fluidRow( + disconnectMessage( + text = "An unexpected error occurred, please reload the application and check the input file(s).", + refresh = "Reload now", + background = "white", + colour = "grey", + overlayColour = "grey", + overlayOpacity = 0.3, + refreshColour = "purple" + ), column(width = 3, box(title="Inputs", width = 12, collapsible = TRUE, collapsed = FALSE, status = "info", solidHeader = TRUE, fileInput(ns("gwas_file"), "Choose VCF File", accept = c(".csv",".vcf",".gz")), @@ -38,7 +48,7 @@ mod_gwas_ui <- function(id){ div(style="display:inline-block; float:right",dropdownButton( HTML("Input files"), p(downloadButton(ns('download_vcf'),""), "VCF Example File"), - p(downloadButton(ns('download_pheno'),""), "Passport Example File"), hr(), + p(downloadButton(ns('download_pheno'),""), "Trait Example File"), hr(), p(HTML("Parameters description:"), actionButton(ns("goGWASpar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), p(HTML("Results description:"), actionButton(ns("goGWASgraph"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), p(HTML("How to cite:"), actionButton(ns("goGWAScite"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(), @@ -140,7 +150,7 @@ mod_gwas_ui <- function(id){ mod_gwas_server <- function(input, output, session, parent_session){ ns <- session$ns - + # Help links observeEvent(input$goGWASpar, { # change to help tab @@ -532,6 +542,30 @@ mod_gwas_server <- function(input, output, session, parent_session){ #Status updateProgressBar(session = session, id = "pb_gwas", value = 100, status = "success", title = "Finished") }) + + #Checking if any QTLs were detected and returning a user notice if not + observe({ + req(gwas_vars$gwas_df) + if(dim(gwas_vars$gwas_df)[1] == 0) { + shinyalert( + title = "No QTL Detected", + text = "No QTL detected for this trait.", + size = "s", + closeOnEsc = TRUE, + closeOnClickOutside = FALSE, + html = TRUE, + type = "info", + showConfirmButton = TRUE, + confirmButtonText = "OK", + confirmButtonCol = "#004192", + showCancelButton = FALSE, + animation = TRUE + ) + } + + #Gracefully abort + return() + }) #Updating value boxes output$qtls_detected <- renderValueBox({ @@ -575,12 +609,13 @@ mod_gwas_server <- function(input, output, session, parent_session){ observe({ - req(gwas_vars$gwas_df_filt) + req(gwas_vars$gwas_df_filt, nrow(gwas_vars$gwas_df_filt) > 0) updatePickerInput(session = session, inputId = "sele_models", choices = unique(gwas_vars$gwas_df_filt$Model), selected = unique(gwas_vars$gwas_df_filt$Model)[1]) }) observe({ - req(gwas_vars$gwas_df_filt) + req(gwas_vars$gwas_df_filt, nrow(gwas_vars$gwas_df_filt) > 0) + df <- gwas_vars$gwas_df_filt %>% filter(Model %in% input$sele_models) updatePickerInput(session = session, inputId = "sele_qtl", choices = unique(paste0(df$Marker, "_", df$Model)), selected = unique(paste0(df$Marker, "_", df$Model))) diff --git a/R/mod_help.R b/R/mod_help.R index 69d0ca0..8020916 100644 --- a/R/mod_help.R +++ b/R/mod_help.R @@ -51,7 +51,7 @@ mod_help_ui <- function(id){ tabPanel("Results description", value = "VCF_Filtering_results", br(), includeMarkdown(system.file("help_files/VCF_Filtering_res.Rmd", package = "BIGapp")) ), - tabPanel("How to cite", value = "Updog_Dosage_Calling_cite", br(), + tabPanel("How to cite", value = "VCF_Filtering_cite", br(), includeMarkdown(system.file("help_files/VCF_Filtering_cite.Rmd", package = "BIGapp")) )) ), diff --git a/R/run_app.R b/R/run_app.R index 5d60ac1..baf85e7 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -7,6 +7,7 @@ #' @export #' @importFrom shiny shinyApp #' @importFrom golem with_golem_options +#' run_app <- function( onStart = NULL, options = list(), @@ -14,6 +15,10 @@ run_app <- function( uiPattern = "/", ... ) { + #Uncomment the sink command to allow console output + sink(file = tempfile()) + options(warn = -1) + with_golem_options( app = shinyApp( ui = app_ui, diff --git a/R/utils.R b/R/utils.R index 9e78b21..096f3ef 100644 --- a/R/utils.R +++ b/R/utils.R @@ -210,7 +210,7 @@ calculate_heterozygosity <- function(genotype_matrix, ploidy = 2) { # Create a dataframe with Sample ID and Observed Heterozygosity result_df <- data.frame( SampleID = colnames(genotype_matrix), - ObservedHeterozygosity = heterozygosity_proportion, + Ho = heterozygosity_proportion, row.names = NULL, check.names = FALSE ) diff --git a/inst/help_files/DAPC_res.Rmd b/inst/help_files/DAPC_res.Rmd index 99bce83..f31e234 100644 --- a/inst/help_files/DAPC_res.Rmd +++ b/inst/help_files/DAPC_res.Rmd @@ -4,22 +4,36 @@ output: html_document date: "2024-08-29" --- -* **Cluster assignments table** +#### BIC Table +- **Description**: The BIC table summarizes the association between different numbers of clusters (K) and their Bayesian Information Criterion (BIC) values. +- **Interpretation**: Each row corresponds to a different number of clusters (K), with the BIC value indicating the model fit. Typically, lower BIC values suggest a better model fit, pointing to the optimal number of genetic clusters. This can be viewed as the "knee", where the BIC values stabilize after decreasing sharply. +- **Use**: In breeding applications, the table helps identify the most suitable number of genetic clusters, providing insights into genetic diversity and structure that inform breeding choices. +#### BIC Plot -|K | BIC | -|:---------:|:------------:| -|Sample_1 | 5.1| -|Sample_2 | 4.9| -|Sample_3 | 4.7| -|Sample_4 | 4.6| -|Sample_5 | 5.0| -|Sample_6 | 5.4| +- **Description**: The BIC plot graphically displays the BIC values for different numbers of clusters (K) derived from the data, typically to determine the optimal number of clusters. +- **Interpretation**: The x-axis presents different cluster numbers (K), while the y-axis indicates corresponding BIC values. The optimal number of clusters is suggested by an "elbow" or point where BIC values level off, indicating diminishing returns for increasing the number of clusters. +- **Use**: This plot is crucial for deciding how many distinct genetic clusters exist within the population. In breeding, it helps determine the number of genetically distinct groups worth considering in breeding programs. In population genetics, it guides researchers in identifying sub-population structures. +#### DAPC Results Table -  +- **Description**: The DAPC results table provides a detailed view of sample membership probabilities across different genetic clusters, and identifies the most likely cluster assignment for each sample. +- **Interpretation**: Each row corresponds to a specific sample, with columns representing the probability of membership in each cluster based on discriminant analysis. The final column, "Cluster_Assignment," indicates the cluster to which a sample is most strongly associated, based on the highest probability value. +- **Use**: This table is instrumental in both breeding and population genetics. In breeding, it aids in identifying which genetic clusters individuals belong to, helping in the selection of genetically favorable traits. In population genetics, it helps delineate the distribution of genetic diversity across the population, facilitating studies on migration, adaptation, and evolutionary patterns. -* **BIC plot** +- **Example Table**: -* **DAPC plot** + | Sample | Cluster_1 | Cluster_2 | Cluster_3 | Cluster_Assignment | + |:--------:|:---------:|:---------:|:---------:|:------------------:| + | Sample_1 | 0.80 | 0.10 | 0.10 | 1 | + | Sample_2 | 0.20 | 0.70 | 0.10 | 2 | + | Sample_3 | 0.15 | 0.15 | 0.70 | 3 | + | Sample_4 | 0.40 | 0.50 | 0.10 | 2 | + | Sample_5 | 0.60 | 0.20 | 0.20 | 1 | + +#### DAPC Plot + +- **Description**: The DAPC plot visualizes the discriminant analysis results, showing genetic sample distribution based on discriminant functions. +- **Interpretation**: Each point represents a genetic sample, plotted based on its discriminant function scores, which are linear combinations of principal components. Clusters of points suggest genetic similarity or differentiation. +- **Use**: This plot is instrumental in distinguishing between genetic clusters and assessing population structure. For breeding applications, it facilitates the selection of genetically similar or diverse individuals suited for breeding objectives. In population genetics studies, it provides insights into the genetic differentiation between groups. diff --git a/inst/help_files/Genomic_Diversity_res.Rmd b/inst/help_files/Genomic_Diversity_res.Rmd index 2046b00..347820b 100644 --- a/inst/help_files/Genomic_Diversity_res.Rmd +++ b/inst/help_files/Genomic_Diversity_res.Rmd @@ -4,14 +4,38 @@ output: html_document date: "2024-08-29" --- -* **MAF plot** +#### Dosage Ratio Plot -* **OHet plot** +- **Description**: The dosage ratio box plot illustrates the distribution of different genotypic dosage levels across the genomic dataset. +- **Interpretation**: Each box in the plot corresponds to a specific dosage level, showing the proportion of samples exhibiting each dosage. These levels typically indicate the number of copies of a particular allele. +- **Use**: This plot is beneficial in understanding the distribution of allelic dosages in the population. -* **Dosage Ratio plot** +#### MAF Plot -* **Marker distribution plot** +- **Description**: The MAF plot shows the minor allele frequency distribution for the SNPs within the dataset. +- **Interpretation**: The x-axis represents SNPs, while the y-axis depicts the frequency of the less common allele. High MAF values indicate prevalent mutations, whereas low values suggest rarity. +- **Use**: This visualization helps in assessing allele variation across the population, essential for breeding decisions aiming to maximize genetic diversity. It's crucial for identifying potentially beneficial minor alleles in a population genetics context or ensuring adequate filtering prior to downstream analyses such as GWAS. -* **MAF table** +#### OHet Plot -* **OHet table** +- **Description**: The OHet plot displays the observed heterozygosity for samples, illustrating genetic variability. +- **Interpretation**: The y-axis may represent heterozygosity levels, with distinct individuals on the x-axis. Variation indicates the degree of genetic diversity within samples. +- **Use**: High heterozygosity is often associated with genetic health and adaptability, making this plot valuable for breeding insight. In population genetics, it aids understanding of population diversity and potential inbreeding effects. + +#### Marker Distribution Plot + +- **Description**: This plot provides a spatial distribution of markers across different chromosomes or linkage groups. +- **Interpretation**: Points correspond to SNPs or markers, plotted along chromosomal positions. Patterns suggest marker density and distribution. +- **Use**: Insight into marker distribution is critical for genomic selection and breeding strategy, ensuring comprehensive genomic coverage. This is also a good visual to determine if markers were filtered too strictly or sequenced poorly for a given project. + +#### Sample Table + +- **Description**: The sample table includes a list of sample IDs with associated summary statistics, such as heterozygosity. +- **Interpretation**: Each row details a specific sample, providing key genetic metrics valuable for assessing sample quality and genetic integrity. +- **Use**: This table supports the evaluation of sample quality and diversity, crucial for selecting appropriate breeding candidates or conducting robust population analyses. + +#### SNP Table + +- **Description**: The SNP table features SNP IDs alongside their summary statistics, including metrics like Minor Allele Frequency (MAF) and Polymorphism Information Content (PIC). +- **Interpretation**: The table provides insight into each SNP's genetic contribution and informativeness, facilitating genome-wide association studies and diversity assessments. +- **Use**: By highlighting key SNP metrics, this table assists in choosing markers for selection in breeding programs and understanding diversity in population genetics. diff --git a/inst/help_files/Genomic_Prediction_par.Rmd b/inst/help_files/Genomic_Prediction_par.Rmd index b411335..133627c 100644 --- a/inst/help_files/Genomic_Prediction_par.Rmd +++ b/inst/help_files/Genomic_Prediction_par.Rmd @@ -25,7 +25,7 @@ This tab estimates the trait and estimated-breeding-values (EBVs) for either all   -* **Prediction VCF file** +* **Prediction VCF file**(optional): Variant Call Format (VCF). See above for required formatting details. * **Species Ploidy**: Specifies the ploidy level of the species. The current analysis supports both diploids and autopolyploids. diff --git a/inst/help_files/Genomic_Prediction_res.Rmd b/inst/help_files/Genomic_Prediction_res.Rmd index d467256..a028faa 100644 --- a/inst/help_files/Genomic_Prediction_res.Rmd +++ b/inst/help_files/Genomic_Prediction_res.Rmd @@ -6,7 +6,9 @@ date: "2024-08-29" * **Predicted Trait table**: The trait values are predicted for all samples in either the input VCF file (if only one provided), or for all of the samples in the predictive VCF file. It is in the format of samples IDs in the first column, and each subsequent column being the information for the traits selected by the user. -| Sample ID | Sepal Length | Sepal Width | +
+ +| Sample ID | Sepal.Length|Sepal.Width | |------------|--------------|-------------| | Sample_1 | 4.8 | 3.5 | | Sample_2 | 4.9 | 3.0 | @@ -16,11 +18,15 @@ date: "2024-08-29" | Sample_6 | 5.4 | 3.9 | -  +
+ * **EBV table**: Estimated Breeding Values (EBVs) from genomic prediction are statistical estimates of an individual's genetic potential for a specific trait, calculated by combining genomic information with phenotypic and pedigree data. These values help predict an organism's ability to pass on desirable traits to its offspring, allowing for more accurate selection in breeding programs. The EBVs are predicted for all samples in either the input VCF file (if only one provided), or for all of the samples in the predictive VCF file. It is in the format of samples IDs in the first column, and each subsequent column being the information for the traits selected by the user. -| Sample ID | Sepal Length | Sepal Width | + +
+ +| Sample ID | Sepal.Length | Sepal.Width | |------------|--------------|-------------| | Sample_1 | 0.32 | 0.48 | | Sample_2 | -0.12 | -0.28 | @@ -28,3 +34,7 @@ date: "2024-08-29" | Sample_4 | 1.21 | 1.03 | | Sample_5 | 0.43 | 0.33 | | Sample_6 | 0.03 | 0.91 | + +
+ +  diff --git a/inst/help_files/PCA_cite.Rmd b/inst/help_files/PCA_cite.Rmd index f65632a..d9e2272 100644 --- a/inst/help_files/PCA_cite.Rmd +++ b/inst/help_files/PCA_cite.Rmd @@ -4,16 +4,13 @@ output: html_document date: "2024-08-29" --- -* **BIGapp** +- **BIGapp** -* **BIGr** +- **BIGr** -* **vcfR** +- **vcfR** + - Knaus BJ, Grünwald NJ (2017). *VCFR: a package to manipulate and visualize variant call format data in R.* Molecular Ecology Resources, 17(1), 44–53. ISSN 757. [doi:10.1111/1755-0998.12549](https://dx.doi.org/10.1111/1755-0998.12549). + - Knaus BJ, Grünwald NJ (2016). *VcfR: an R package to manipulate and visualize VCF format data.* BioRxiv. [doi:10.1101/041277](https://dx.doi.org/10.1101/041277). -Knaus BJ, Grünwald NJ (2017). “VCFR: a package to manipulate and visualize variant call format data in R.” Molecular Ecology Resources, 17(1), 44–53. ISSN 757, https://dx.doi.org/10.1111/1755-0998.12549. - -Knaus BJ, Grünwald NJ (2016). “VcfR: an R package to manipulate and visualize VCF format data.” BioRxiv. https://dx.doi.org/10.1101/041277. - -* **AGHmatrix** - -R Amadeu R, Franco Garcia A, Munoz P, V Ferrao L (2023). “AGHmatrix: genetic relationship matrices in R .” Bioinformatics, 39(7). +- **AGHmatrix** + - Amadeu R, Franco Garcia A, Munoz P, V Ferrao L (2023). *AGHmatrix: genetic relationship matrices in R.* Bioinformatics, 39(7). diff --git a/inst/help_files/PCA_res.Rmd b/inst/help_files/PCA_res.Rmd index 07c678d..54ac140 100644 --- a/inst/help_files/PCA_res.Rmd +++ b/inst/help_files/PCA_res.Rmd @@ -4,8 +4,20 @@ output: html_document date: "2024-08-29" --- -* **3D PCA plot** +#### 3D PCA Plot -* **2D PCA plot** +- **Description**: The 3D PCA plot visualizes the first three principal components of genomic data, displayed in a three-dimensional space. +- **Interpretation**: Each point represents an individual sample or genome, positioned according to its scores on the first three principal components. Clusters may indicate genetic similarities or groupings within the population. +- **Use**: In the context of breeding decisions, this plot helps identify genetic diversity and potential outliers within a gene pool, facilitating the evaluation of genetic relationships between individuals. In broader population genetics, it aids in visualizing population structure and sub-structure. -* **Scree plot** +#### 2D PCA Plot + +- **Description**: The 2D PCA plot represents two principal components of the genomic data in a two-dimensional view. +- **Interpretation**: Points on the plot correspond to individual genetic samples, with the axes signifying the most significant components capturing data variance. Patterns or grouping may suggest genetic linkage or divergence. +- **Use**: For breeding applications, this plot offers a straightforward view to quickly assess genetic variance and clustering among candidate individuals. In population genetics, it helps in examining genetic differentiation or affinity among populations. + +#### Scree Plot + +- **Description**: The scree plot displays the eigenvalues of each principal component, in descending order, providing a visual summary of variance explained by each component. +- **Interpretation**: The x-axis lists the principal components, while the y-axis shows associated eigenvalues. A significant drop in eigenvalues, or "elbow", indicates where additional components provide diminishing returns in explaining data variance. +- **Use**: This plot assists in deciding the optimal number of principal components for analysis, striking a balance between data simplification and variance preservation. For breeding decisions, it informs which components capture most genetic variation, aiding in selection strategies. In population genetics, it helps determine the dimensional analysis required to understand genetic structure comprehensively. diff --git a/inst/help_files/Predictive_Ability_res.Rmd b/inst/help_files/Predictive_Ability_res.Rmd index bfb1db6..67b01e7 100644 --- a/inst/help_files/Predictive_Ability_res.Rmd +++ b/inst/help_files/Predictive_Ability_res.Rmd @@ -4,12 +4,27 @@ output: html_document date: "2024-08-29" --- -* **Violin plot** +#### Violin Plot -* **Box plot** +- **Description**: The violin plot showcases the distribution of Pearson correlation coefficients between predicted and known phenotype values for each group in a five-fold cross-validation, repeated across the user selected number of iterations. +- **Interpretation**: The shape and width of the violins illustrate the distribution and density of correlation values, while individual points represent specific correlation outcomes for each cross-validation split (total points = 5*# of iters). +- **Use**: This plot is vital for assessing the variability and robustness of predictive models in genomic selection, highlighting how well genotype data can predict phenotypes. -* **Predictive ability table** +#### Box Plot +- **Description**: The box plot is similar to the violin plot, summarizing the Pearson correlation coefficients without displaying individual data points. +- **Interpretation**: The box plot shows the median, interquartile range, and potential outliers of the correlation values, providing a concise view of prediction accuracy across all cross-validation folds. +- **Use**: This visualization is useful for quickly comparing the central tendency and variability of predictive performance across different traits or models, facilitating quick assessments of model reliability and effectiveness in genomic selection. + +#### Predictive Ability Table + +- **Description**: The predictive ability table summarizes the Pearson correlations (Predictive Ability) for each iteration, organized by specific traits of interest, such as Sepal Length and Sepal Width. +- **Interpretation**: Each row represents a different iteration, with columns providing correlation values for each phenotypic trait. Higher values indicate better predictive performance of the genomic selection model. +- **Use**: This table serves as a detailed summary of predictive ability across iterations, allowing researchers to evaluate model performance over repeated trials. It is crucial for determining model reliability and can be used to generate custom figures. + +- **Example**: + +
|Iter | Sepal.Length | Sepal.Width | |:---------:|:------------:|:-----------:| @@ -17,6 +32,4 @@ date: "2024-08-29" |2 | 0.721| 0.568| |3 | 0.724| 0.543| - - -  +
diff --git a/inst/help_files/Updog_Dosage_Calling_cite.Rmd b/inst/help_files/Updog_Dosage_Calling_cite.Rmd index 21e35d4..e7ca342 100644 --- a/inst/help_files/Updog_Dosage_Calling_cite.Rmd +++ b/inst/help_files/Updog_Dosage_Calling_cite.Rmd @@ -4,13 +4,14 @@ output: html_document date: "2024-08-29" --- -* **BIGapp** - - -* **Updog package** - -Gerard, D., Ferrão, L. F. V., Garcia, A. A. F., & Stephens, M. (2018). Genotyping Polyploids from Messy Sequencing Data. Genetics, 210(3), 789-807. doi: 10.1534/genetics.118.301468. - -If you used the “norm” model cite also: - -Gerard D, Ferrão L (2020). “Priors for Genotyping Polyploids.” Bioinformatics, 36(6), 1795-1800. ISSN 1367-4803, doi: 10.1093/bioinformatics/btz852. +- **BIGapp** + +- **BIGr** + +- **Updog Package** + + Gerard, D., Ferrão, L. F. V., Garcia, A. A. F., & Stephens, M. (2018). *Genotyping Polyploids from Messy Sequencing Data*. Genetics, 210(3), 789-807. [doi: 10.1534/genetics.118.301468](https://doi.org/10.1534/genetics.118.301468). + + If you used the “norm” model, cite also: + + Gerard D, Ferrão L (2020). *Priors for Genotyping Polyploids*. Bioinformatics, 36(6), 1795-1800. ISSN 1367-4803, [doi: 10.1093/bioinformatics/btz852](https://doi.org/10.1093/bioinformatics/btz852). diff --git a/inst/help_files/VCF_Filtering_cite.Rmd b/inst/help_files/VCF_Filtering_cite.Rmd index 1958c9d..390e900 100644 --- a/inst/help_files/VCF_Filtering_cite.Rmd +++ b/inst/help_files/VCF_Filtering_cite.Rmd @@ -4,16 +4,14 @@ output: html_document date: "2024-08-29" --- -* **BIGapp** -* **BIGr** +- **BIGapp** -* **Updog** (if filtering parameters used) +- **BIGr** -Gerard, D., Ferrão, L. F. V., Garcia, A. A. F., & Stephens, M. (2018). Genotyping Polyploids from Messy Sequencing Data. Genetics, 210(3), 789-807. doi: 10.1534/genetics.118.301468. +- **Updog** (if filtering parameters used) + Gerard, D., Ferrão, L. F. V., Garcia, A. A. F., & Stephens, M. (2018). *Genotyping Polyploids from Messy Sequencing Data*. Genetics, 210(3), 789-807. [doi: 10.1534/genetics.118.301468](https://doi.org/10.1534/genetics.118.301468). -* **vcfR** - -Knaus BJ, Grünwald NJ (2017). “VCFR: a package to manipulate and visualize variant call format data in R.” Molecular Ecology Resources, 17(1), 44–53. ISSN 757, https://dx.doi.org/10.1111/1755-0998.12549. - -Knaus BJ, Grünwald NJ (2016). “VcfR: an R package to manipulate and visualize VCF format data.” BioRxiv. https://dx.doi.org/10.1101/041277. +- **vcfR** + - Knaus BJ, Grünwald NJ (2017). *vcfR: a package to manipulate and visualize variant call format data in R.* Molecular Ecology Resources, 17(1), 44–53. ISSN 757, [doi:10.1111/1755-0998.12549](https://dx.doi.org/10.1111/1755-0998.12549). + - Knaus BJ, Grünwald NJ (2016). *VcfR: an R package to manipulate and visualize VCF format data.* BioRxiv. [doi:10.1101/041277](https://dx.doi.org/10.1101/041277).