added loading circles for go buttons

polyqtlvis/NAMESPACE

@@ -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)

polyqtlvis/R/mod_IBD_panel.R

@@ -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()
     })
     
     

polyqtlvis/R/mod_model_panel.R

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