Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Mvp updates #88

Merged
merged 8 commits into from
Dec 22, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions R/app_server.R
Original file line number Diff line number Diff line change
@@ -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)
}
10 changes: 10 additions & 0 deletions R/mod_DosageCall.R
Original file line number Diff line number Diff line change
@@ -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,
57 changes: 53 additions & 4 deletions R/mod_Filtering.R
Original file line number Diff line number Diff line change
@@ -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("<b>Input files</b>"),
p(downloadButton(ns('download_vcf'),""), "VCF Example File"),
p(HTML("<b>Parameters description:</b>"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>Results description:</b>"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>How to cite:</b>"), 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(
61 changes: 55 additions & 6 deletions R/mod_GS.R
Original file line number Diff line number Diff line change
@@ -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("<b>Input files</b>"),
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("<b>Parameters description:</b>"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>Results description:</b>"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>How to cite:</b>"), 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
})
57 changes: 53 additions & 4 deletions R/mod_GSAcc.R
Original file line number Diff line number Diff line change
@@ -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("<b>Input files</b>"),
p(downloadButton(ns('download_vcf'),""), "VCF Example File"),
p(downloadButton(ns('download_pheno'),""), "Trait Example File"), hr(),
p(HTML("<b>Parameters description:</b>"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>Results description:</b>"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>How to cite:</b>"), 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",
220 changes: 136 additions & 84 deletions R/mod_PCA.R
Original file line number Diff line number Diff line change
@@ -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("<b>Input files</b>"),
p(downloadButton(ns('download_vcf'),""), "VCF Example File"),
p(downloadButton(ns('download_pheno'),""), "Trait Example File"), hr(),
p(HTML("<b>Parameters description:</b>"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>Results description:</b>"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>How to cite:</b>"), 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,
88 changes: 80 additions & 8 deletions R/mod_dapc.R
Original file line number Diff line number Diff line change
@@ -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("<b>Input files</b>"),
p(downloadButton(ns('download_vcf'),""), "VCF Example File"),
p(downloadButton(ns('download_pheno'),""), "Trait Example File"), hr(),
p(HTML("<b>Parameters description:</b>"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>Results description:</b>"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>How to cite:</b>"), 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,14 +223,21 @@ 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)

#Assign results to reactive values
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
119 changes: 100 additions & 19 deletions R/mod_diversity.R
Original file line number Diff line number Diff line change
@@ -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("<b>Input files</b>"),
p(downloadButton(ns('download_vcf'),""), "VCF Example File"),
p(HTML("<b>Parameters description:</b>"), actionButton(ns("goPar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>Results description:</b>"), actionButton(ns("goRes"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>How to cite:</b>"), 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)
}

10 changes: 10 additions & 0 deletions R/mod_dosage2vcf.R
Original file line number Diff line number Diff line change
@@ -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(
43 changes: 39 additions & 4 deletions R/mod_gwas.R
Original file line number Diff line number Diff line change
@@ -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("<b>Input files</b>"),
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("<b>Parameters description:</b>"), actionButton(ns("goGWASpar"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>Results description:</b>"), actionButton(ns("goGWASgraph"), icon("arrow-up-right-from-square", verify_fa = FALSE) )), hr(),
p(HTML("<b>How to cite:</b>"), 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)))
2 changes: 1 addition & 1 deletion R/mod_help.R
Original file line number Diff line number Diff line change
@@ -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"))
))
),
5 changes: 5 additions & 0 deletions R/run_app.R
Original file line number Diff line number Diff line change
@@ -7,13 +7,18 @@
#' @export
#' @importFrom shiny shinyApp
#' @importFrom golem with_golem_options
#'
run_app <- function(
onStart = NULL,
options = list(),
enableBookmarking = NULL,
uiPattern = "/",
...
) {
#Uncomment the sink command to allow console output
sink(file = tempfile())
options(warn = -1)

with_golem_options(
app = shinyApp(
ui = app_ui,
2 changes: 1 addition & 1 deletion R/utils.R
Original file line number Diff line number Diff line change
@@ -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
)
38 changes: 26 additions & 12 deletions inst/help_files/DAPC_res.Rmd
Original file line number Diff line number Diff line change
@@ -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

&nbsp;
- **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.
36 changes: 30 additions & 6 deletions inst/help_files/Genomic_Diversity_res.Rmd
Original file line number Diff line number Diff line change
@@ -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.
2 changes: 1 addition & 1 deletion inst/help_files/Genomic_Prediction_par.Rmd
Original file line number Diff line number Diff line change
@@ -25,7 +25,7 @@ This tab estimates the trait and estimated-breeding-values (EBVs) for either all

&nbsp;

* **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.

16 changes: 13 additions & 3 deletions inst/help_files/Genomic_Prediction_res.Rmd
Original file line number Diff line number Diff line change
@@ -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 |
<center>

| Sample ID | Sepal.Length|Sepal.Width |
|------------|--------------|-------------|
| Sample_1 | 4.8 | 3.5 |
| Sample_2 | 4.9 | 3.0 |
@@ -16,15 +18,23 @@ date: "2024-08-29"
| Sample_6 | 5.4 | 3.9 |


&nbsp;
<center>


* **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 |

<center>

| Sample ID | Sepal.Length | Sepal.Width |
|------------|--------------|-------------|
| Sample_1 | 0.32 | 0.48 |
| Sample_2 | -0.12 | -0.28 |
| Sample_3 | 0.14 | 0.31 |
| Sample_4 | 1.21 | 1.03 |
| Sample_5 | 0.43 | 0.33 |
| Sample_6 | 0.03 | 0.91 |

<center>

&nbsp;
17 changes: 7 additions & 10 deletions inst/help_files/PCA_cite.Rmd
Original file line number Diff line number Diff line change
@@ -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).
18 changes: 15 additions & 3 deletions inst/help_files/PCA_res.Rmd
Original file line number Diff line number Diff line change
@@ -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.
25 changes: 19 additions & 6 deletions inst/help_files/Predictive_Ability_res.Rmd
Original file line number Diff line number Diff line change
@@ -4,19 +4,32 @@ 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**:

<center>

|Iter | Sepal.Length | Sepal.Width |
|:---------:|:------------:|:-----------:|
|1 | 0.728| 0.571|
|2 | 0.721| 0.568|
|3 | 0.724| 0.543|



&nbsp;
<center>
21 changes: 11 additions & 10 deletions inst/help_files/Updog_Dosage_Calling_cite.Rmd
Original file line number Diff line number Diff line change
@@ -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).
16 changes: 7 additions & 9 deletions inst/help_files/VCF_Filtering_cite.Rmd
Original file line number Diff line number Diff line change
@@ -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).