Commit 78833eee authored by Kunst, Jonathan's avatar Kunst, Jonathan
Browse files

Changed filter in selecting ploty points in lod plot to only show unique...

Changed filter in selecting ploty points in lod plot to only show unique markers. This works with models of the same phenotype, but may produce implicit errors when multiple models are made for different phenotypes and PVE is of importance. (i.e. showing pve of phenotpye 1 while points for phenotype 2 are selected) Solution could be some method of letting model selection in legend flow through
parent 72709594
......@@ -3,6 +3,7 @@
export(run_app)
import(shiny)
importFrom(dplyr,bind_rows)
importFrom(dplyr,distinct)
importFrom(dplyr,filter)
importFrom(dplyr,left_join)
importFrom(dplyr,select)
......
......@@ -8,7 +8,7 @@
#'
#' @importFrom shiny NS tagList
#' @importFrom polyqtlR QTLscan
#' @importFrom dplyr left_join select bind_rows filter
#' @importFrom dplyr left_join select bind_rows filter distinct
#' @importFrom magrittr %>%
#' @importFrom ggplot2 ggplot aes geom_point geom_line facet_wrap theme element_blank
#' @importFrom plotly ggplotly renderPlotly plotlyOutput highlight layout event_data
......@@ -166,7 +166,7 @@ mod_model_panel_server <- function(id, rv){
cofactor_df = if(input$check_cofactor){rv$co_factor_df},
block = if(input$check_block){input$choice_block},
perm_test = input$check_permutation,
N_parm.max = 1000,
N_parm.max = input$choice_permutation,
ncores = input$choice_core,
verbose = TRUE)
)
......@@ -206,6 +206,7 @@ mod_model_panel_server <- function(id, rv){
# render of ggplot object as plotly object
output$plotly <- renderPlotly({
req(rv$lod_ggplot)
ggplotly(rv$lod_ggplot, tooltip = 'text') %>%
highlight('plotly_selected') %>%
layout(title = list(text = 'Chromosome', xanchor = 'center'))
......@@ -213,12 +214,12 @@ mod_model_panel_server <- function(id, rv){
# render print of dataframe from selected points
output$click <- renderPrint({
d <- event_data('plotly_selected')
if (is.null(d)) return('select points')
event_df <- event_data('plotly_selected')
if (is.null(event_df)) return('select points')
bind_rows(rv$model_list, .id = 'model') %>%
filter(position %in% d$x)
filter(position %in% event_df$x) %>%
distinct(position, .keep_all = TRUE) %>%
select(-model)
})
})
}
......
......@@ -70,13 +70,13 @@ findPeak(qtl_LODs.4x, linkage_group = 1)
co_factor_df <- data.frame('LG' = numeric(0), 'cM' = numeric(0))
co_factor_df[nrow(co_factor_df)+1, ] <- c(as.numeric(1), as.numeric(12.3))
block <- FALSE
qtl_LODs.4x_cofactor <- QTLscan(IBD_list = IBD_4x,
Phenotype.df = Phenotypes_4x,
genotype.ID = "geno",
trait.ID = "pheno",
block = if(block){'year'},
block = 'year',
cofactor_df = co_factor_df,
perm_test = FALSE,
ncores = 2)
......@@ -151,7 +151,10 @@ modellist[['nonfactor']] <- qtl_LODs.4x$QTL.res %>%
modellist[['co-factor']] <- qtl_LODs.4x_cofactor$QTL.res %>%
left_join(select(bind_rows(phased_maplist.4x), !marker), by = 'position')
bind_rows(modellist, .id = 'model') %>%
filter(position %in% c(1.56, 4.99, 34.19)) %>%
distinct(position, .keep_all = TRUE) %>%
select(-model)
p <- ggplot(bind_rows(modellist, .id = 'model'), aes(x = position,
y = LOD,
......
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