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

Added cofactor option to qtlscan and if statements based on checkboxinput for...

Added cofactor option to qtlscan and if statements based on checkboxinput for arguments block and cofactor
parent 1cf27994
......@@ -11,6 +11,9 @@ app_server <- function( input, output, session ) {
# construct list in rv to carry different models made
rv$model_list <- list()
# construct dataframe for possible cofactors in polyqtlR::QTLscan
rv$co_factor_df <- data.frame('LG' = numeric(0), 'cM' = numeric(0))
# Input data ----
mod_import_panel_server("import_panel_ui_1", rv = rv)
......
......@@ -31,8 +31,31 @@ mod_model_panel_ui <- function(id, rv){
label = 'Select phenotype column',
choices = 'Import phenotype file first'),
# does co-factor need to be taken into account?
checkboxInput(inputId = ns('check_cofactor'),
label = 'Co-factor',
value = FALSE),
conditionalPanel(
condition ='input.check_cofactor',
ns = ns,
fluidRow(
column(6,
numericInput(inputId = ns('cofactor_LG'),
label = 'Linkage Group',
value = 1)
),
column(6,
textInput(inputId = ns('cofactor_cm'),
label = 'Postion (cM)')
)
),
actionButton(inputId = ns('cofactor_add'),
label = 'Add')
),
# does block need to be taken into account?
checkboxInput(inputId = ns('check_block'), #outside ns for conditionalpanel
checkboxInput(inputId = ns('check_block'),
label = 'Blocks',
value = FALSE),
......@@ -122,6 +145,14 @@ mod_model_panel_server <- function(id, rv){
choices = names(rv$phenotype[[1]]))
})
# adding co-factor
observeEvent(input$cofactor_add, {
# 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))
})
# create polyqtlR model
observeEvent(input$go, {
req(input$model_name, rv$ibd_estimate, rv$phenotype, input$choice_geno,
......@@ -132,7 +163,8 @@ mod_model_panel_server <- function(id, rv){
Phenotype.df = as.data.frame(rv$phenotype[[1]]), #BUG: load_file still needing indexing
genotype.ID = input$choice_geno,
trait.ID = input$choice_pheno,
block = input$choice_block,
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,
ncores = input$choice_core,
......@@ -196,11 +228,6 @@ mod_model_panel_server <- function(id, rv){
## To be copied in the server
# mod_model_panel_server("model_panel_ui_1")
#
# qtl_LODs.4x <- QTLscan(IBD_list = IBD_4x,
# Phenotype.df = Phenotypes_4x,
# genotype.ID = "geno",
# trait.ID = "pheno",
# block = "year")
......@@ -67,13 +67,17 @@ plotLinearQTL(LOD_data = qtl_LODs.4x,
# Manual co-factor analysis ----
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 = "year",
cofactor_df = data.frame("LG" = 1,
"cM" = 12.3),
block = if(block){'year'},
cofactor_df = co_factor_df,
perm_test = FALSE,
ncores = 2)
......@@ -176,7 +180,6 @@ gp <- ggplotly(p, tooltip = 'text') %>%
gp
# qtl LOD plot group_map----
palet <- park_palette('Hawaii')
panel <- . %>%
plot_ly(x = ~position, y = ~LOD) %>%
add_lines(color = ~model, legendgroup = ~model) %>%
......@@ -205,7 +208,7 @@ bind_rows(modellist, .id = 'model' ) %>%
subplot(nrows = 1, shareX = TRUE, shareY=TRUE) %>%
highlight('plotly_selected')
image(SNP_dosages.4x)
# trelliscope example ----
......
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