#' Shiny Probability module
#'
#' Shiny genotype probability access.
#'
#' @param id identifier for shiny reactive
#' @param win_par,pheno_names,project_info reactive arguments
#'
#' @author Brian S Yandell, \email{brian.yandell@@wisc.edu}
#' @keywords utilities
#'
#' @return Object of class \code{probs}.
#'
#' @export
#' @importFrom assertthat assert_that
#' @importFrom qtl2mediate get_snpprobs
#' @importFrom shiny reactive req
#' withProgress setProgress
shinyProbs <- function(id, win_par, project_info) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
probs_obj <- shiny::reactive({
shiny::req(project_info())
chr_id <- shiny::req(win_par$chr_id)
shiny::withProgress(message = 'Read probs ...', value = 0, {
shiny::setProgress(1)
if(shiny::isTruthy(win_par$local)) {
mid <- req(win_par$peak_Mbp)
win <- req(win_par$window_Mbp)
start_val <- mid - win
end_val <- mid + win
} else {
start_val <- end_val <- NULL
}
# Define query_probs function
query_probs <- read_query_rds(project_info(), "query_probs.rds")
# Note probs object keeps map with it
query_probs(chr_id, start_val, end_val)
})
})
probs_obj
})
}
#' @rdname shinyProbs
#' @export
shinyPairProbs <- function(id, win_par, project_info) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
## Probs object for allele pair diplotypes.
probs_obj <- shiny::reactive({
shiny::req(project_info())
chr_id <- shiny::req(win_par$chr_id)
range_val <- shiny::req(win_par$peak_Mbp) +
c(-1,1) * shiny::req(win_par$window_Mbp)
shiny::withProgress(message = 'Diplotype Probs ...', value = 0, {
shiny::setProgress(1)
# Define query_probs function
query_probs <- read_query_rds(project_info(), "query_probs.rds")
query_probs(chr_id, range_val[1], range_val[2],
allele = FALSE)
})
})
probs_obj
})
}
#' @rdname shinyProbs
#' @export
shinySNPProbs <- function(id, win_par, pheno_names, project_info) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
shiny::reactive({
shiny::req(project_info())
shiny::req(chr_id <- win_par$chr_id,
peak_Mbp <- win_par$peak_Mbp,
window_Mbp <- win_par$window_Mbp)
shiny::req(pheno_names())
shiny::withProgress(message = 'SNP Probs ...', value = 0, {
shiny::setProgress(1)
# Define query_probs function
query_probs <- read_query_rds(project_info(), "query_probs.rds")
probs_obj <- query_probs(chr_id,
peak_Mbp - window_Mbp,
peak_Mbp + window_Mbp,
allele = FALSE)
# define the query_variants function
query_variants <- read_query_rds(project_info(), "query_variants.rds")
snpinfo <- query_variants(chr_id,
peak_Mbp - window_Mbp,
peak_Mbp + window_Mbp)
qtl2mediate::get_snpprobs(chr_id, peak_Mbp, window_Mbp,
pheno_names(),
probs_obj$probs,
probs_obj$map,
snpinfo)
})
})
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.