Commit cbde5fd9 authored by Kunst, Jonathan's avatar Kunst, Jonathan
Browse files

added loading circles for go buttons

parent 78833eee
......@@ -36,4 +36,9 @@ importFrom(shiny,NS)
importFrom(shiny,shinyApp)
importFrom(shiny,tagList)
importFrom(shiny,validate)
importFrom(shinycssloaders,withSpinner)
importFrom(tools,file_ext)
importFrom(waiter,Waiter)
importFrom(waiter,spin_6)
importFrom(waiter,transparent)
importFrom(waiter,useWaiter)
......@@ -8,6 +8,7 @@
#'
#' @importFrom shiny NS tagList
#' @importFrom polyqtlR estimate_IBD visualiseHaplo
#' @importFrom waiter Waiter useWaiter spin_6 transparent
mod_IBD_panel_ui <- function(id){
ns <- NS(id)
tagList(
......@@ -69,12 +70,18 @@ mod_IBD_panel_server <- function(id, rv){
# Side panel ----
observeEvent(input$go, {
progress <- Waiter$new(id = ns('go'),
html = spin_6(),
color = 'grey')
progress$show()
rv$ibd_estimate <- estimate_IBD(phased_maplist = rv$linkmap,
genotypes = as.matrix(rv$snp),
method = input$ibd_method,
map_function = input$ibd_mf,
ploidy = input$ibd_ploidy,
ncores = input$ibd_core)
progress$hide()
})
......
......@@ -12,6 +12,8 @@
#' @importFrom magrittr %>%
#' @importFrom ggplot2 ggplot aes geom_point geom_line facet_wrap theme element_blank
#' @importFrom plotly ggplotly renderPlotly plotlyOutput highlight layout event_data
#' @importFrom waiter Waiter useWaiter spin_6 transparent
#' @importFrom shinycssloaders withSpinner
mod_model_panel_ui <- function(id, rv){
ns <- NS(id)
tagList(
......@@ -99,7 +101,8 @@ mod_model_panel_ui <- function(id, rv){
# scan
actionButton(inputId = ns('go'),
label = 'Create')
label = 'Create'),
useWaiter()
),
# sidebarpanel for qtlpoly model options
......@@ -111,7 +114,7 @@ mod_model_panel_ui <- function(id, rv){
actionButton(inputId = ns('update_plot'),
label = 'Update plot'),
plotlyOutput(outputId = ns('plotly')),
withSpinner(plotlyOutput(outputId = ns('plotly'))),
verbatimTextOutput(ns('click'))
)
......@@ -150,11 +153,20 @@ mod_model_panel_server <- function(id, rv){
# co_factor_df is originally empty, every add, adds a co_factor row
rv$co_factor_df[nrow(rv$co_factor_df)+1,] <- c(as.numeric(input$cofactor_LG),
as.numeric(input$cofactor_cm))
# return feedback to user that cofactor was added
showNotification('Co-factor added', type = 'message')
Sys.sleep(.5)
})
# create polyqtlR model
observeEvent(input$go, {
progress <- Waiter$new(id = ns('go'),
html = spin_6(),
color = 'grey')
progress$show()
req(input$model_name, rv$ibd_estimate, rv$phenotype, input$choice_geno,
input$choice_pheno)
......@@ -169,7 +181,12 @@ mod_model_panel_server <- function(id, rv){
N_parm.max = input$choice_permutation,
ncores = input$choice_core,
verbose = TRUE)
)
progress$hide()
showNotification('Model created', type = 'message')
})
# add to model result of polyqtl scane to model_list for later binding
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment