Skip to content
Snippets Groups Projects
Commit edf580bc authored by Kunst, Jonathan's avatar Kunst, Jonathan
Browse files

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
parent e0f12c79
Branches
No related tags found
Loading
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
# Packages ---- # Packages ----
library(shiny) library(shiny)
library(shinybusy)
library(polyqtlR) library(polyqtlR)
library(DT) library(DT)
library(data.table) library(data.table)
...@@ -81,9 +82,11 @@ ui <- fluidPage( ...@@ -81,9 +82,11 @@ ui <- fluidPage(
mainPanel( mainPanel(
h3('Output heuristic method'), h3('Output heuristic method'),
DT::dataTableOutput('table_heu')
plotOutput('plot_haplo')
)
) )
)), ),
tabPanel('HMM') tabPanel('HMM')
), ),
...@@ -115,34 +118,37 @@ server <- function(input, output) { ...@@ -115,34 +118,37 @@ server <- function(input, output) {
# Phenotype # Phenotype
phenotype <- reactive({ phenotype <- reactive({
req(input$i_phenotype) req(input$i_phenotype)
fread(input$i_phenotype$datapath) read.csv(input$i_phenotype$datapath, row.names = 1)
}) })
# Phased Linkage maps # Phased Linkage maps
link_map <- reactive({ link_map <- reactive({
req(input$i_link_map) 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 # SNP Dosage data
dosage <- reactive({ dosage <- reactive({
req(input$i_dosage) req(input$i_dosage)
fread(input$i_dosage$datapath)}) as.matrix(read.csv(input$i_dosage$datapath, row.names = 1))
})
# IBD # IBD
IBD <- reactive({ IBD <- reactive({
req(input$i_IBD) req(input$i_IBD)
fread(input$i_IBD$datapath)}) read.csv(input$i_IBD$datapath, row.names = 1)})
# Data tables ---- # Data tables ----
# Show table for phenotype data # Show table for phenotype data
output$table_phenotype <- DT::renderDataTable(phenotype()) output$table_phenotype <- DT::renderDataTable(phenotype())
# Show table for linkage map 1 data # 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 # 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 # Show table for SNP dosage data
output$table_dosage <- DT::renderDataTable(dosage()) output$table_dosage <- DT::renderDataTable(dosage())
...@@ -151,7 +157,7 @@ server <- function(input, output) { ...@@ -151,7 +157,7 @@ server <- function(input, output) {
output$table_IBD <- DT::renderDataTable(IBD()) output$table_IBD <- DT::renderDataTable(IBD())
# IBD imputation ---- # IBD imputation ----
# heuristic IBD estimation # Heuristic IBD estimation
heu_IBD <- eventReactive(input$heu_estimate, { heu_IBD <- eventReactive(input$heu_estimate, {
estimate_IBD(phased_maplist = link_map(), estimate_IBD(phased_maplist = link_map(),
genotypes = dosage(), genotypes = dosage(),
...@@ -159,8 +165,20 @@ server <- function(input, output) { ...@@ -159,8 +165,20 @@ server <- function(input, output) {
ncores = 2) 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 # 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))
)
} }
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment