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

Now possible to select which offspring/LG to show in haplotype visualisation,...

Now possible to select which offspring/LG to show in haplotype visualisation, plot does not adjust yet. Possibly plotly object might be better
parent 1edfb432
......@@ -46,8 +46,8 @@ ui <- fluidPage(
tabPanel('Phenotype',
DT::dataTableOutput('table_phenotype')),
tabPanel('Phased Linkage Map',
selectInput(inputId = 'map_choice',
label = 'Linkage Groups',
selectInput(inputId = 'choice_map',
label = 'Linkage Group',
choices = 'Input map first'),
DT::dataTableOutput('table_link_map'),
textOutput('text_link_map')),
......@@ -92,7 +92,7 @@ ui <- fluidPage(
max = detectCores() - 2),
# Estimate starter
actionButton('heu_estimate',
actionButton('go_estimate',
label = 'Estimate IBD'),
hr(),
......@@ -101,13 +101,21 @@ ui <- fluidPage(
# IBD input
fileInput(inputId = 'i_IBD',
label = 'Phenotype file')
label = 'IBD file')
),
mainPanel(
h3('Output'),
selectInput(inputId = 'choice_LG',
label = 'Select linkage group',
choices = 'Estimate or import first'),
selectInput(inputId = 'choice_offspring',
label = 'Select offspring',
choices = 'Estimate or import first'),
plotOutput('plot_haplo')
)
)
......@@ -147,7 +155,9 @@ load_file <- function(name, path){
server <- function(input, output, session) {
# initiate reactive values object
rv <- reactiveValues()
rv$linkage_select <- NULL
rv$select_map <- NULL
rv$select_LG <- NULL
rv$select_offspring <- NULL
# Read Data ----
# Phenotype
......@@ -175,11 +185,11 @@ server <- function(input, output, session) {
# update maplist selection
observeEvent(input$i_link_map, {
file_list <- names(link_map())
updateSelectInput(session, 'map_choice', label = 'Linkage Groups', choices = file_list)
updateSelectInput(session, 'choice_map', label = 'Linkage Groups', choices = file_list)
})
# retrieve table selection
rv$linkage_select <- eventReactive(input$map_choice, {fname <- input$map_choice})
# retrieve map LG selection
rv$select_map <- eventReactive(input$choice_map, {input$choice_map})
# SNP Dosage data
dosage <- reactive({
......@@ -187,7 +197,7 @@ server <- function(input, output, session) {
# estimate IBD will need a matrix of snp dosages, expecting matrix input
read.csv(input$i_dosage$datapath, row.names = 1)
})
})
# Data tables ----
# table for phenotype
......@@ -199,12 +209,9 @@ server <- function(input, output, session) {
# table for SNP dosage
output$table_dosage <- DT::renderDataTable(dosage())
# table for IBD probability
output$table_IBD <- DT::renderDataTable(IBD())
# IBD estimationputation ----
# IBD ----
# IBD estimation
IBD <- eventReactive(input$heu_estimate, {
IBD_est <- eventReactive(input$go_estimate, {
estimate_IBD(phased_maplist = link_map(),
genotypes = as.matrix(dosage()),
method = input$IBD_method,
......@@ -213,24 +220,50 @@ server <- function(input, output, session) {
ncores = input$IBD_core)
})
# IBD import
IBD_imp <- reactive({
req(input$i_IBD)
load_file(name = input$i_IBD$name, path = input$i_IBD$datapath)
})
# Modal window to prevent interaction
observeEvent(input$heu_estimate, {
show_modal_spinner(text = 'Estimating IBDs, please wait')
remove_modal_spinner()
# observeEvent(input$go_estimate, {
# show_modal_spinner(text = 'Estimating IBDs, please wait')
# remove_modal_spinner()
# })
# update LG selection IBD file
observeEvent(input$go_estimate, {
updateSelectInput(session, 'choice_LG', label = 'Linkage Group', choices = names(IBD_est()))
})
# show table heuristic IBDs
output$plot_haplo <- renderPlot(visualiseHaplo(IBD_list = IBD(),
# retrieve LG selection
rv$select_LG <- eventReactive(input$choice_LG, {input$choice_LG})
#update offspring selection
observeEvent(input$choice_LG, {
updateSelectInput(session, 'choice_offspring', label = 'Offspring', choices = IBD_est()[[input$choice_LG]]$offspring)
})
# retrieve offspring selection
rv$select_offspring <- eventReactive(input$choice_offspring, {input$choice_offspring})
# show haplotypes from estimated IBDs
output$plot_haplo <- renderPlot(visualiseHaplo(IBD_list = IBD_est(),
display_by = "name",
linkage_group = 1,
select_offspring = colnames(dosage())[3:11],
select_offspring = IBD_est()[[1]]$offspring[3:11],
multiplot = c(3, 3))
)
output$plot_haplo_imp <- renderPlot(visualiseHaplo(IBD_list = IBD_imp(),
display_by = "name",
linkage_group = 1,
select_offspring = IBD_imp()[1]$offspring[3:11],
multiplot = c(3, 3))
)
}
# Run Shiny app example ----
shinyApp(ui = ui, server = server)
shinyApp(ui = ui, server = server)
\ No newline at end of file
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