Now possible to estimate IBDs through heuristic method, has to become more...

Now possible to estimate IBDs through heuristic method, has to become more fleshed out to select offspring in haplotype visualisation and linkage group. For HMM the modal spinner may be more effective

polyploid_vis/app.R

@@ -6,6 +6,7 @@
 
 # Packages ----
 library(shiny)
+library(shinybusy)
 library(polyqtlR)
 library(DT)
 library(data.table)
@@ -78,12 +79,14 @@ ui <-  fluidPage(
                             actionButton('heu_estimate',
                                          label = 'Estimate IBD')
                             ),
-                          
+                            
                           mainPanel(
                             h3('Output heuristic method'),
-                            DT::dataTableOutput('table_heu')
+                            
+                            plotOutput('plot_haplo')
                           )
-                        )),
+                        )
+                      ),
                tabPanel('HMM')
             ),
              
@@ -115,34 +118,37 @@ server <- function(input, output) {
   # Phenotype
   phenotype <- reactive({
     req(input$i_phenotype) 
-    fread(input$i_phenotype$datapath)
+    read.csv(input$i_phenotype$datapath, row.names = 1)
     })
   
   # Phased Linkage maps
   link_map <- reactive({
     req(input$i_link_map)
-    lapply(input$i_link_map$datapath, fread)
+    lapply(input$i_link_map$datapath, read.csv, row.names = 1)
   })
   
   # SNP Dosage data
   dosage <- reactive({
     req(input$i_dosage) 
-    fread(input$i_dosage$datapath)})
+    as.matrix(read.csv(input$i_dosage$datapath, row.names = 1))
+    })
   
   # IBD
   IBD <- reactive({
     req(input$i_IBD) 
-    fread(input$i_IBD$datapath)})
+    read.csv(input$i_IBD$datapath, row.names = 1)})
   
   # Data tables ----
   # Show table for phenotype data
   output$table_phenotype <- DT::renderDataTable(phenotype())
   
   # Show table for linkage map 1 data
-  output$table_link_map_1 <- DT::renderDataTable(link_map()[[1]])
+  output$table_link_map_1 <- DT::renderDataTable(link_map()[[1]], 
+                                                 selection = list(target = 'row+column'))
   
   # Show table for linkage map 2 data
-  output$table_link_map_2 <- DT::renderDataTable(link_map()[[2]])
+  output$table_link_map_2 <- DT::renderDataTable(link_map()[[2]],
+                                                 selection = list(target = 'row+column'))
   
   # Show table for SNP dosage data
   output$table_dosage <- DT::renderDataTable(dosage())
@@ -151,7 +157,7 @@ server <- function(input, output) {
   output$table_IBD <- DT::renderDataTable(IBD())
   
   # IBD imputation ----
-  # heuristic IBD estimation
+  # Heuristic IBD estimation
   heu_IBD <- eventReactive(input$heu_estimate, {
     estimate_IBD(phased_maplist = link_map(),
                  genotypes = dosage(),
@@ -159,8 +165,20 @@ server <- function(input, output) {
                  ncores = 2)
   })
   
+  # Modal window to prevent interaction
+  observeEvent(input$heu_estimate, {
+    show_modal_spinner(text = 'Estimating IBDs, please wait')
+    Sys.sleep(5)
+    remove_modal_spinner()
+  })
+  
   # show table heuristic IBDs
-  output$table_heu <- DT::renderDataTable(heu_IBD())
+  output$plot_haplo <- renderPlot(visualiseHaplo(IBD_list = heu_IBD(),
+                                                display_by = "name",
+                                                linkage_group = 1,
+                                                select_offspring = colnames(dosage())[3:11],
+                                                multiplot = c(3, 3))
+  )
 }