main dashboard

This commit is contained in:
Tanushree Tunstall 2022-09-07 19:22:50 +01:00
parent 877e128ee1
commit b1c65863c6
3 changed files with 1471 additions and 677 deletions

View file

@ -4,32 +4,40 @@ library(NGLVieweR)
library(hash) library(hash)
# FIXME This is slow and should happen *once only* # FIXME This is slow and should happen *once only*
#source("/srv/shiny-server/git/LSHTM_analysis/scripts/Header_TT.R") #source(load_dir, "git/LSHTM_analysis/scripts/Header_TT.R")
# FIXME: these are needed but slow to load every time # FIXME: these are needed but slow to load every time
# source("/srv/shiny-server/git/LSHTM_analysis/config/alr.R") # source(load_dir, "git/LSHTM_analysis/config/alr.R")
# source("/srv/shiny-server/git/LSHTM_analysis/config/gid.R") # source(load_dir, "git/LSHTM_analysis/config/gid.R")
# source("/srv/shiny-server/git/LSHTM_analysis/config/pnca.R") # source(load_dir, "git/LSHTM_analysis/config/pnca.R")
# source("/srv/shiny-server/git/LSHTM_analysis/config/rpob.R") # source(load_dir, "git/LSHTM_analysis/config/rpob.R")
# source("/srv/shiny-server/git/LSHTM_analysis/config/katg.R") # source(load_dir, "git/LSHTM_analysis/config/katg.R")
# TODO: this is TEMPORARY and will shortly get replaced with a target picker # TODO: this is TEMPORARY and will shortly get replaced with a target picker
# that'll reload everything when changing targets. the lapply() is *much* quicker # that'll reload everything when changing targets. the lapply() is *much* quicker
# than previous approaches # than previous approaches
# system.time({ # system.time({
#source("/srv/shiny-server/git/LSHTM_analysis/scripts/Header_TT.R")
load_dir="~/git/"
#load_dir="/srv/shiny-server/git/"
source(paste0(load_dir, "LSHTM_analysis/scripts/Header_TT.R"))
load_target_globals=function(target){ load_target_globals=function(target){
cat(paste0("Reloading Target: ", target)) cat(paste0("Reloading Target: ", target))
source(paste0("/srv/shiny-server/git/LSHTM_analysis/config/", target, ".R")) # load per-target config file source(paste0(load_dir, "LSHTM_analysis/config/", target, ".R")) # load per-target config file
invisible(assign(paste0(target, "_aa_pos_drug"), aa_pos_drug, envir = .GlobalEnv))
invisible(assign(paste0(target, "_merged_df3"), read.csv(paste0("/srv/shiny-server/git/Misc/shiny_dashboard/data/",target,"-merged_df3.csv")), envir = .GlobalEnv)) invisible(assign(paste0(target, "_active_aa_pos"), active_aa_pos, envir = .GlobalEnv))
invisible(assign(paste0(target, "_merged_df2"), read.csv(paste0("/srv/shiny-server/git/Misc/shiny_dashboard/data/",target,"-merged_df2.csv")), envir = .GlobalEnv)) invisible(assign(paste0(target, "_aa_pos_lig1"), aa_pos_lig1, envir = .GlobalEnv))
invisible(assign(paste0(target, "_corr_df_m3_f"), read.csv(paste0("/srv/shiny-server/git/Misc/shiny_dashboard/data/",target,"-corr_df_m3_f.csv")), envir = .GlobalEnv)) invisible(assign(paste0(target, "_aa_pos_lig2"), aa_pos_lig2, envir = .GlobalEnv))
invisible(assign(paste0(target, "_lin_lf"), read.csv(paste0("/srv/shiny-server/git/Misc/shiny_dashboard/data/",target,"-lin_lf.csv")), envir = .GlobalEnv)) invisible(assign(paste0(target, "_aa_pos_lig3"), aa_pos_lig3, envir = .GlobalEnv))
invisible(assign(paste0(target, "_lin_wf"), read.csv(paste0("/srv/shiny-server/git/Misc/shiny_dashboard/data/",target,"-lin_wf.csv")), envir = .GlobalEnv)) invisible(assign(paste0(target, "_merged_df3"), read.csv(paste0(load_dir, "Misc/shiny_dashboard/data/",target,"-merged_df3.csv")), envir = .GlobalEnv))
invisible(assign(paste0(target, "_merged_df2"), read.csv(paste0(load_dir, "Misc/shiny_dashboard/data/",target,"-merged_df2.csv")), envir = .GlobalEnv))
invisible(assign(paste0(target, "_corr_df_m3_f"), read.csv(paste0(load_dir, "Misc/shiny_dashboard/data/",target,"-corr_df_m3_f.csv")), envir = .GlobalEnv))
invisible(assign(paste0(target, "_lin_lf"), read.csv(paste0(load_dir, "Misc/shiny_dashboard/data/",target,"-lin_lf.csv")), envir = .GlobalEnv))
invisible(assign(paste0(target, "_lin_wf"), read.csv(paste0(load_dir, "Misc/shiny_dashboard/data/",target,"-lin_wf.csv")), envir = .GlobalEnv))
lapply( lapply(
c( c(
"duet", "duet",
@ -41,15 +49,18 @@ load_target_globals=function(target){
"snap2", "snap2",
"provean", "provean",
"dist_gen", "dist_gen",
"mcsm_ppi2"#, "mcsm_ppi2",
"mmcsm_lig",
"mcsm_na"
#,
#"mcsm_na" #"mcsm_na"
), function(x){ ), function(x){
wf_filename=paste0("/srv/shiny-server/git/Misc/shiny_dashboard/data/", tolower(gene), "-wf_", x ,".csv") wf_filename=paste0(load_dir, "Misc/shiny_dashboard/data/", tolower(gene), "-wf_", x ,".csv")
wf_var=paste0("wf_",x) wf_var=paste0(target, "wf_",x)
if (file.exists(wf_filename)){ if (file.exists(wf_filename)){
invisible(assign(wf_var,read.csv(wf_filename), envir = .GlobalEnv)) # FILTH invisible(assign(wf_var,read.csv(wf_filename), envir = .GlobalEnv)) # FILTH
} }
lf_filename=paste0("/srv/shiny-server/git/Misc/shiny_dashboard/data/", tolower(gene), "-lf_", x ,".csv") lf_filename=paste0(load_dir, "Misc/shiny_dashboard/data/", tolower(gene), "-lf_", x ,".csv")
lf_var=paste0(target, "_lf_",x) lf_var=paste0(target, "_lf_",x)
if (file.exists(lf_filename)){ if (file.exists(lf_filename)){
invisible(assign(lf_var,read.csv(lf_filename), envir = .GlobalEnv)) # FILTH invisible(assign(lf_var,read.csv(lf_filename), envir = .GlobalEnv)) # FILTH
@ -57,24 +68,6 @@ load_target_globals=function(target){
} }
) )
} }
# populate target-specific *_unified_msa vars
load_msa_global=function(gene){
drug=target_map[[gene]]
in_filename_msa = paste0(tolower(gene), "_msa.csv")
infile_msa = paste0("/srv/shiny-server/git/Data/", drug, "/output/", in_filename_msa)
print(infile_msa)
msa1 = read.csv(infile_msa, header = F)
msa_seq = msa1$V1
infile_fasta = paste0("/srv/shiny-server/git/Data/", drug, "/input/", tolower(gene), "2_f2.fasta")
print(infile_fasta)
msa2 = read.csv(infile_fasta, header = F)
wt_seq = msa2$V1
target_name=paste0(gene, '_unified_msa')
#print(target_name)
invisible(assign(target_name, list(msa_seq = msa_seq, wt_seq = wt_seq), envir = .GlobalEnv))
}
#### Local Functions #### #### Local Functions ####
# Generate a conditionalPanel() for a given graph function and sidebar name combination # Generate a conditionalPanel() for a given graph function and sidebar name combination
@ -114,39 +107,36 @@ options(DT.options = list(scrollX = TRUE))
plot_functions_df=data.frame( plot_functions_df=data.frame(
tab_name=c( tab_name=c(
"LogoP SNP", "LogoP SNP",
"Lineage Sample Count", #"Lineage Sample Count",
"Site SNP count", #"Site SNP count",
"Stability SNP by site", "Stability SNP by site",
"DM OM Plots", "DM OM Plots",
"Correlation", "Correlation",
"Lineage Distribution", #"Lineage Distribution",
"Consurf", "Consurf",
"LogoP OR", "LogoP OR"
"LogoP ED"
), ),
plot_function=c( plot_function=c(
"LogoPlotSnps", "LogoPlotSnps",
"lin_sc", #"lin_sc",
"site_snp_count_bp", #"site_snp_count_bp",
"bp_stability_hmap", "bp_stability_hmap",
"lf_bp2", "lf_bp2",
"my_corr_pairs", "my_corr_pairs",
"lineage_distP", #"lineage_distP",
"wideP_consurf3", "wideP_consurf3",
"LogoPlotCustomH", "LogoPlotCustomH"
"LogoPlotMSA"
), ),
plot_df=c( plot_df=c(
"mutable_df3" , "mutable_df3" ,
"lin_lf", #"lin_lf",
"mutable_df3", #"mutable_df3",
"merged_df3" , "merged_df3" ,
"lf_duet" , "lf_duet" ,
"corr_df_m3_f", "corr_df_m3_f",
"merged_df2", #"merged_df2",
"merged_df3", "merged_df3",
"merged_df2", "merged_df2"
"unified_msa"
) )
) )
@ -262,8 +252,7 @@ lapply(c(
"pnca", "pnca",
"rpob" "rpob"
),function(x){ ),function(x){
invisible(load_target_globals(x)) load_target_globals(x)
invisible(load_msa_global(x)) # turn off to speed up start time at the expense of "LogoP ED"
} }
) )
@ -316,14 +305,15 @@ consurf_colours = c(
, "9" = rgb(0.63,0.16,0.37) , "9" = rgb(0.63,0.16,0.37)
) )
if (interactive()){ if (true()){
#if (interactive()){
options(shiny.launch.browser = FALSE) # i am a big girl and can tie my own laces options(shiny.launch.browser = FALSE) # i am a big girl and can tie my own laces
options(shiny.port = 8000) # don't change the port every time options(shiny.port = 8000) # don't change the port every time
options(shiny.host = '0.0.0.0') # This means "listen to all addresses on all interfaces" options(shiny.host = '0.0.0.0') # This means "listen to all addresses on all interfaces"
options(width=120) options(width=120)
options(DT.options = list(scrollX = TRUE)) options(DT.options = list(scrollX = TRUE))
#### UI ####
ui=dashboardPage(skin="purple", ui <- dashboardPage(skin="purple",
dashboardHeader(title = "Drug/Target Explorer"), dashboardHeader(title = "Drug/Target Explorer"),
dashboardSidebar( dashboardSidebar(
@ -341,16 +331,16 @@ if (interactive()){
), ),
selected="embb"), selected="embb"),
menuItem("LogoP SNP", tabName="LogoP SNP"), menuItem("LogoP SNP", tabName="LogoP SNP"),
menuItem("Lineage Sample Count", tabName="Lineage Sample Count"), #menuItem("Lineage Sample Count", tabName="Lineage Sample Count"),
menuItem("Site SNP count", tabName="Site SNP count"), menuItem("Site SNP count", tabName="Site SNP count"),
menuItem("Stability SNP by site", tabName="Stability SNP by site"), menuItem("Stability SNP by site", tabName="Stability SNP by site"),
menuItem("DM OM Plots", tabName="DM OM Plots"), menuItem("DM OM Plots", tabName="DM OM Plots"),
menuItem("Correlation", tabName="Correlation"), menuItem("Correlation", tabName="Correlation"),
menuItem("Lineage Distribution", tabName="Lineage Distribution"), #menuItem("Lineage Distribution", tabName="Lineage Distribution"),
menuItem("Consurf", tabName="Consurf"), menuItem("Consurf", tabName="Consurf"),
menuItem("LogoP OR", tabName="LogoP OR"), menuItem("LogoP OR", tabName="LogoP OR"),
menuItem("LogoP ED", tabName="LogoP ED"), menuItem("Lineage", tabName="Lineage"),
menuItem('Stability count', tabName='Stability count'), #menuItem('Stability count', tabName='Stability count'),
# These conditionalPanel()s make extra settings appear in the sidebar when needed # These conditionalPanel()s make extra settings appear in the sidebar when needed
conditionalPanel( conditionalPanel(
@ -374,23 +364,13 @@ if (interactive()){
input.sidebar == 'LogoP SNP'|| input.sidebar == 'LogoP SNP'||
input.sidebar == 'Stability SNP by site' || input.sidebar == 'Stability SNP by site' ||
input.sidebar == 'Consurf' || input.sidebar == 'Consurf' ||
input.sidebar == 'LogoP OR' || input.sidebar == 'LogoP OR'",
input.sidebar == 'Site SNP count'",
sliderInput( sliderInput(
"display_position_range" "display_position_range"
, "Display Positions" , "Display Positions"
, min=1, max=150, value=c(1,150) # 150 is just a little less than the smallest pos_count , min=1, max=150, value=c(1,150) # 150 is just a little less than the smallest pos_count
) )
), ),
conditionalPanel(
condition="input.sidebar == 'LogoP ED'",
sliderInput(
"display_position_full_range"
, "Display Positions"
, min=1, max=150, value=c(1,150)
)
),
conditionalPanel( conditionalPanel(
condition=" condition="
@ -404,13 +384,6 @@ if (interactive()){
selected="chemistry" selected="chemistry"
) )
), ),
#conditionalPanel(
# condition="input.sidebar == 'LogoP SNP' || input.sidebar == 'LogoP ED'|| input.sidebar == 'Consurf'",
# numericInput(
# "table_position"
# , "Table Position", value=1
# )
#),
conditionalPanel( conditionalPanel(
condition="input.sidebar == 'Correlation'", condition="input.sidebar == 'Correlation'",
selectInput( selectInput(
@ -429,6 +402,27 @@ if (interactive()){
, "Ligand Distance Cutoff (Å)", value=1 , "Ligand Distance Cutoff (Å)", value=1
) )
), ),
conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
numericInput(
"snp_ligand_dist"
, "Ligand Distance Cutoff (Å)", value=10
)
),
conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
numericInput(
"snp_interface_dist"
, "Interface Distance Cutoff (Å)", value=10
)
),
conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
numericInput(
"snp_nca_dist"
, "NCA Distance Cutoff (Å)", value=10
)
),
conditionalPanel( conditionalPanel(
condition="input.sidebar == 'Correlation'", condition="input.sidebar == 'Correlation'",
@ -440,33 +434,30 @@ if (interactive()){
"Dynamut2", "Dynamut2",
"FoldX", "FoldX",
"ConSurf"#, "ConSurf"#,
#"dst_mode"
), ),
choiceValues = c( choiceValues = c(
"DeepDDG", "DeepDDG",
"Dynamut2", "Dynamut2",
"FoldX", "FoldX",
"ConSurf"#, "ConSurf"#,
#"dst_mode"
), ),
selected = c( selected = c(
"DeepDDG", "DeepDDG",
"Dynamut2", "Dynamut2",
"FoldX", "FoldX",
"ConSurf"#, "ConSurf"#,
#"dst_mode"
) )
) )
), ),
conditionalPanel( # conditionalPanel(
condition="input.sidebar == 'DM OM Plots'", # condition="input.sidebar == 'DM OM Plots'",
selectInput( # selectInput(
"dm_om_param", # "dm_om_param",
label="Stability Parameter", # label="Stability Parameter",
choices = keys(dm_om_map), # choices = keys(dm_om_map),
selected="SNAP2") # selected="SNAP2")
), # ),
# colour_categ # colour_categ
conditionalPanel( conditionalPanel(
condition="input.sidebar == 'Stability SNP by site'", condition="input.sidebar == 'Stability SNP by site'",
@ -493,8 +484,7 @@ if (interactive()){
condition="input.sidebar == 'LogoP SNP' || condition="input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' || input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' || input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR' || input.sidebar =='LogoP OR'",
input.sidebar =='LogoP ED'",
actionButton("clear_ngl", actionButton("clear_ngl",
"Clear Structure") "Clear Structure")
), ),
@ -502,8 +492,7 @@ if (interactive()){
condition="input.sidebar == 'LogoP SNP' || condition="input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' || input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' || input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR' || input.sidebar =='LogoP OR'",
input.sidebar =='LogoP ED'",
actionButton("test_ngl", actionButton("test_ngl",
"Test NGLViewR") "Test NGLViewR")
)#, )#,
@ -518,6 +507,7 @@ if (interactive()){
) )
), ),
#### body ####
body <- dashboardBody( body <- dashboardBody(
tabItems( tabItems(
@ -549,6 +539,92 @@ if (interactive()){
) )
) )
), ),
# Explicit fluidRow() for Lineage plots together
fluidRow(
column(conditionalPanel(
condition="input.sidebar.match(/^Lineage.*/)", box(
title="Lineage Distribution"
, status = "info"
, width=NULL
, plotOutput("lineage_distP", height="700px") %>% withSpinner(color="#0dc5c1"),
height=800
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar.match(/^Lineage.*/)", box(
title="Lineage SNP Diversity"
, status = "info"
, width=NULL
, plotOutput("lin_sc", height="700px") %>% withSpinner(color="#0dc5c1"),
height=800
)
), width=6
)
),
# Explicit fluidRow() for Site SNP Count
fluidRow(
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="Site SNP count"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_bp") %>% withSpinner(color="#0dc5c1")
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="Ligand Distance"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_bp_ligand") %>% withSpinner(color="#0dc5c1")
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="Interface Distance"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_interface") %>% withSpinner(color="#0dc5c1")
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="NCA Distance"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_nca") %>% withSpinner(color="#0dc5c1")
)
), width=6
)
),
# # Explicit fluidRow() for Stability Count
# fluidRow(
# column(
# conditionalPanel(
# condition="input.sidebar.match(/^Lineage.*/)",
# lapply(
# # FIXME: using a hardcoded target DF for this IS WRONG AND WILL BREAK
# stability_boxes_df[stability_boxes_df$outcome_colname %in% colnames(embb_merged_df3),"outcome_colname"],
# function(x){
# print(paste0("outcome_colname: ",x))
# box(plotOutput(x), width=4)
# }
# ),
# width=12
# )
# )
# ),
#### fluidRow()s for "Stability Count" in the sidebar #### #### fluidRow()s for "Stability Count" in the sidebar ####
fluidRow( fluidRow(
conditionalPanel( conditionalPanel(
@ -556,8 +632,7 @@ if (interactive()){
input.sidebar == 'LogoP SNP' || input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' || input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' || input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR' || input.sidebar =='LogoP OR'",
input.sidebar =='LogoP ED'",
column(NGLVieweROutput("structure"), column(NGLVieweROutput("structure"),
width=3 width=3
) )
@ -568,92 +643,410 @@ if (interactive()){
input.sidebar == 'Stability SNP by site' || input.sidebar == 'Stability SNP by site' ||
input.sidebar == 'Site SNP count' || input.sidebar == 'Site SNP count' ||
input.sidebar == 'Consurf' || input.sidebar == 'Consurf' ||
input.sidebar == 'LogoP OR' || input.sidebar == 'LogoP OR'",
input.sidebar == 'LogoP ED'",
column( column(
DT::dataTableOutput('table'), DT::dataTableOutput('table'),
width=9 width=9
) )
) )
) ),
) )
) )
server = function(input, output) { server <- function(input, output, session) {
observeEvent({
input$combined_model
input$combined_data
input$combined_training_genes
input$score_dropdown
input$resample_dropdown
input$drug_dropdown
input$split_dropdown
},{ #output$LogoPlotSnps = renderPlot(LogoPlotSnps(mutable_df3))
combined_model = input$combined_model output$lin_sc = renderPlot(
selection = input$score_dropdown lin_sc(
resampler = input$resample_dropdown input$switch_target,
selected_drug = input$drug_dropdown all_lineages = input$all_lineages,
selected_split = input$split_dropdown my_xats = 12, # x axis text size
combined_data = input$combined_data my_yats = 12, # y axis text size
combined_training_genes = input$combined_training_genes my_xals = 12, # x axis label size
my_yals = 12, # y axis label size
selected_gene = combo[combo$drug == selected_drug,'gene'] my_lls = 12, # legend label size
d_lab_size = 4
# hide stuff if selected
if(combined_model == "combined") {
#if(combined_model == TRUE) {
hide("split_dropdown")
hide("resample_dropdown")
show("combined_data")
show("combined_training_genes")
filedata = paste0(combined_training_genes,
'genes_logo_skf_BT_',
selected_gene,
'_',
combined_data
)
print(filedata)
print('doing COMBINED plot')
output$plot <- renderPlot(makeplot(loaded_files[[filedata]],
selection,
"none", # always 'none' for combined plot
gene = combo[drug==selected_drug,"gene"],
combined_training_genes = combined_training_genes,
display_combined = TRUE,
) )
) )
# e.g. #### lineage_distP ####
# makeplot(loaded_files$`5genes_logo_skf_BT_pnca_actual`, "MCC", "none" , gene = 'foo', combined_training_genes = '1234', display_combined = TRUE) output$lineage_distP = renderPlot(
} else { lineage_distP(
show("split_dropdown") get(paste0(input$switch_target, '_merged_df2')),
show("resample_dropdown") all_lineages = input$all_lineages,
hide("combined_data") x_lab = "Average Stability",
hide("combined_training_genes") x_axis = "avg_stability_scaled",
filedata = paste0(combo[drug==selected_drug,"gene"], fill_categ_cols = c("red", "blue")
'_baselineC_',
selected_split
)
print(filedata)
print("doing GENE plot")
output$plot <- renderPlot(makeplot(loaded_files[[filedata]],
selection,
resampler,
gene = combo[drug==selected_drug,"gene"],
display_combined = FALSE,
) )
) )
} #### observeEvent() Fun(tm) ####
# 6genes_logo_skf_BT_gid_complete observeEvent(input$clear_ngl, {
NGLVieweR_proxy("structure") %>%
# filedata example for combined: 6genes_logo_skf_BT_embb_actual removeSelection("Pos")
# 6genes_logo_skf_BT_embb_combined
}) })
# Button to test adding a position
observeEvent(input$test_ngl, {
NGLVieweR_proxy("structure") %>%
addSelection('ball+stick'
, param = list(
name = "Pos"
, sele = "35"
, color = "green")
)
})
observeEvent(
{
input$display_position_range
input$stability_snp_param
input$logoplot_colour_scheme
input$omit_snp_count
input$switch_target
input$snp_ligand_dist
input$snp_nca_dist
input$snp_interface_dist
},
{
print("entering main observeEvent()")
# C O M P A T I B I L I T Y
#gene=input$switch_target
#drug=target_map[[gene]]
target_gene = input$switch_target
merged_df3 = cbind(get(paste0(input$switch_target, '_merged_df3')))
position_max=max(merged_df3[['position']])
position_min=min(merged_df3[['position']])
min_ligand_distance=min(merged_df3$ligand_distance)
max_ligand_distance=max(merged_df3$ligand_distance)
# FIXME: these are IMPORTANT
# # add "pos_count" position count column
# merged_df3=merged_df3 %>% dplyr::add_count(position)
# merged_df3$pos_count=merged_df3$n
# merged_df3$n=NULL
#
mutable_df3 = cbind(merged_df3)
#
# # re-sort the dataframe according to position count
sorted_df = cbind(merged_df3)
sorted_df = sorted_df %>% arrange(pos_count)
#
outdir = paste0(load_dir, "Data/", drug, '/output/')
indir = paste0(load_dir, "Data/", drug , "/input/")
#### nasty special-purpose merged_df3 variants ####
# FIXME: SLOW
# corr_plotdf = corr_data_extract(
# merged_df3
# , gene = gene
# , drug = drug
# , extract_scaled_cols = F
# )
#input$stability_snp_param
updateCheckboxGroupInput(
session,
"corr_selected",
choiceNames = colnames(get(paste0(input$switch_target,"_corr_df_m3_f"))),
choiceValues = colnames(get(paste0(input$switch_target,"_corr_df_m3_f"))),
selected = c("FoldX", "DeepDDG", "mCSM.DUET")
)
updateSliderInput(
session,
"display_position_range",
min = position_min,
max = position_max
#, value = c(position_min, position_min+150)
)
updateNumericInput(session, "selected_logop_snp_position", min = position_min, max = position_max, value = position_min)
updateNumericInput(session, "selected_logop_ed_position", min = position_min, max = position_max, value = position_min)
updateNumericInput(session, "corr_lig_dist", min = min_ligand_distance, max = max_ligand_distance, value = min_ligand_distance)
updateNumericInput(session, "snp_ligand_dist", min = min(merged_df3$ligand_distance), max = max(merged_df3$ligand_distance))
updateNumericInput(session, "snp_interface_dist", min = min(merged_df3$interface_dist), max = max(merged_df3$interface_dist))
updateNumericInput(session, "snp_nca_dist", min = min(merged_df3$nca_distance), max = max(merged_df3$nca_distance))
# different data ranges required for SNP distances
snp_ligand_dist_df3 = merged_df3[merged_df3$ligand_distance<input$snp_ligand_dist,]
snp_interface_dist_df3 = merged_df3[merged_df3$interface_dist<input$snp_interface_dist,]
snp_nca_dist_df3 = merged_df3[merged_df3$nca_distance<input$snp_nca_dist,]
stability_colname = stability_boxes_df[stability_boxes_df$stability_type==input$stability_snp_param,"stability_colname"]
outcome_colname = stability_boxes_df[stability_boxes_df$stability_type==input$stability_snp_param,"outcome_colname"]
display_position_range = input$display_position_range
plot_min=display_position_range[1]
plot_max=display_position_range[2]
logoplot_colour_scheme = input$logoplot_colour_scheme
omit_snp_count = input$omit_snp_count
print(paste0('Plotting positions between: ', plot_min, ' and ', plot_max))
subset_mutable_df3=mutable_df3[(mutable_df3$position>=plot_min & mutable_df3$position <=plot_max),]
subset_mutable_df3=mutable_df3[(mutable_df3$position>=plot_min & mutable_df3$position <=plot_max),]
subset_sorted_df=sorted_df[(sorted_df$position>=plot_min & sorted_df$position <=plot_max),]
#### LogoPlotSnps ####
output$LogoPlotSnps = renderPlot(
LogoPlotSnps(subset_mutable_df3,
aa_pos_drug = get(paste0(target_gene,"_aa_pos_drug")),
active_aa_pos = get(paste0(target_gene,"_active_aa_pos")),
aa_pos_lig1 = get(paste0(target_gene,"_aa_pos_lig1")),
aa_pos_lig2 = get(paste0(target_gene,"_aa_pos_lig2")),
aa_pos_lig3 = get(paste0(target_gene,"_aa_pos_lig3")),
my_logo_col = logoplot_colour_scheme,
omit_snp_count = omit_snp_count
)
)
### NGLViewer ####
# Structure Viewer WebGL/NGLViewR window
output$structure <- renderNGLVieweR({
ngl_gene=isolate(input$switch_target)
ngl_drug=target_map[[ngl_gene]]
ngl_pdb_file=paste0(load_dir, "Data/", ngl_drug, '/output/depth/', ngl_gene, '_complex.pdb')
print(ngl_pdb_file)
NGLVieweR(ngl_pdb_file) %>%
addRepresentation("cartoon",
param = list(name = "cartoon",
color="tan"
#, colorScheme = "chainid"
)
) %>%
stageParameters(backgroundColor = "lightgrey") %>%
setQuality("high") %>%
setFocus(0) %>%
setSpin(FALSE)
})
#### Shared dataTable() ####
output$table = DT::renderDataTable(
datatable(subset_sorted_df[,table_columns],
filter="top",
selection = "single"
)
)
#### bp_stability_hmap ####
# red/blue tiles wala "Stability SNP by Site"
output$bp_stability_hmap = renderPlot(
bp_stability_hmap(
subset_sorted_df,
reorder_position = input$reorder_custom_h,
p_title = NULL,
yvar_colname = stability_colname,
stability_colname = stability_colname,
stability_outcome_colname = outcome_colname,
my_ylab = NULL,
y_max_override = max(sorted_df$pos_count),
aa_pos_drug = get(paste0("embb","_aa_pos_drug")),
active_aa_pos = get(paste0("embb","_active_aa_pos")),
aa_pos_lig1 = get(paste0("embb","_aa_pos_lig1")),
aa_pos_lig2 = get(paste0("embb","_aa_pos_lig2")),
aa_pos_lig3 = get(paste0("embb","_aa_pos_lig3"))
)
)
#### LogoPlotCustomH ####
output$LogoPlotCustomH = renderPlot(
LogoPlotCustomH(
subset_sorted_df,
my_logo_col = logoplot_colour_scheme,
aa_pos_drug = get(paste0(target_gene,"_aa_pos_drug")),
active_aa_pos = get(paste0(target_gene,"_active_aa_pos")),
aa_pos_lig1 = get(paste0(target_gene,"_aa_pos_lig1")),
aa_pos_lig2 = get(paste0(target_gene,"_aa_pos_lig2")),
aa_pos_lig3 = get(paste0(target_gene,"_aa_pos_lig3"))
)
)
#### wideP_consurf3 ####
output$wideP_consurf3 = renderPlot(
wideP_consurf3(
subset_sorted_df,
point_colours = consurf_colours,
aa_pos_drug = get(paste0(target_gene,"_aa_pos_drug")),
active_aa_pos = get(paste0(target_gene,"_active_aa_pos")),
aa_pos_lig1 = get(paste0(target_gene,"_aa_pos_lig1")),
aa_pos_lig2 = get(paste0(target_gene,"_aa_pos_lig2")),
aa_pos_lig3 = get(paste0(target_gene,"_aa_pos_lig3"))
)
)
#### site_snp_count_bp ####
#mutable_df3[(mutable_df3$position>=plot_min & mutable_df3$position <=plot_max),]
# ligand_distance
# interface_dist
# nca_distance
# change to: multiple plots, all use site_snp_count_bp
# 4 x plots side by side, one normal (no dist. filter), 2/3 filtered by distance columns above
# use "subtitle text" from pos_count_bp_i.R
output$site_snp_count_bp = renderPlot(
site_snp_count_bp(
mutable_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
output$site_snp_count_bp_ligand = renderPlot(
site_snp_count_bp(
snp_ligand_dist_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
output$site_snp_count_interface = renderPlot(
site_snp_count_bp(
snp_interface_dist_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
output$site_snp_count_nca = renderPlot(
site_snp_count_bp(
snp_nca_dist_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
#### DM OM Plots ####
#dm_om_param
# order needs to be:
# embb_lf_duet, embb_lf_foldx, embb_lf_deepddg, embb_lf_dynamut2, embb_lf_dist_gen,
# embb_lf_consurf, embb_lf_provean, embb_lf_snap2, embb_lf_mcsm_lig, embb_lf_mmcsm_lig,
# embb_lf_mcsm_ppi2, SOMETHING NA
# embb_lf_mmcsm_lig SOMETHING NA,
#dm_om_selection=input$dm_om_param
#dm_om_df = dm_om_map[[dm_om_selection]]
#output$lf_bp2 = renderPlot(lf_bp2(get(paste0(input$switch_target, '_', dm_om_df))))
output$lf_bp2 = renderPlot(
cowplot::plot_grid(
plotlist = lapply(
ls(name=.GlobalEnv,
pattern=paste0(
target_gene,
'_lf_'
)
),
function(x){
lf_bp2(get(x))
} }
)#, nrow=3
), height=800
)
}
)
# FIXME: Doesn't add selected table rows correctly
observeEvent(
{
input$table_rows_selected
},
{
# having to duplicate this is a bit annoying :-(
ngl_merged_df3=cbind(get(paste0(input$switch_target, '_merged_df3')))
ngl_sorted_df = cbind(ngl_merged_df3)
ngl_sorted_df = ngl_sorted_df %>% arrange(pos_count)
position_max=max(ngl_merged_df3[['position']])
position_min=min(ngl_merged_df3[['position']])
display_position_range = input$display_position_range
plot_min=display_position_range[1]
plot_max=display_position_range[2]
#ngl_subset_df=ngl_merged_df3[(ngl_merged_df3$position>=plot_min & ngl_merged_df3$position <=plot_max),]
ngl_subset_df=ngl_sorted_df[(ngl_sorted_df$position>=plot_min & ngl_sorted_df$position <=plot_max),]
#table_rows_selected = isolate(input$table_rows_selected)
table_rows_selected = input$table_rows_selected
class(table_rows_selected)
#cat(paste0("Target: ", as.character(input$switch_target), "\nTable Rows for NGLViewR: ", as.character(table_rows_selected)))
struct_pos=(as.character(ngl_subset_df[table_rows_selected,"position"]))
cat(paste0('Table Index: ', table_rows_selected, "position: ", struct_pos))
NGLVieweR_proxy("structure") %>%
#addSelection('ball+stick'
addSelection('hyperball'
, param = list(
name = "Pos"
, sele = struct_pos
#, color = "#00ff00"
, colorValue="00ff00"
, colorScheme="element"
)
)
#cat(paste0('Done NGLViewR addSelection for: ', positions_to_add))
}
)
#### Correlation observeEvent ####
# Yet another special-case observeEvent to handle the correlation pair plot
observeEvent(
{
input$corr_selected
input$corr_method
input$corr_lig_dist
},
{
dist_cutoff_user = input$corr_lig_dist
target_gene=input$switch_target
plot_title=paste0(target_map[[target_gene]],"/",target_gene)
corr_plot_df = get(
paste0(
input$switch_target,"_corr_df_m3_f"
)
)[,c(input$corr_selected, "dst_mode")]
#if ( dist_cutoff_user >= 2) {
#corr_plotdf_subset = corr_plot_df[corr_plot_df[['Lig.Dist']] < dist_cutoff_user,]
#}
# else {
# corr_plotdf_subset = corr_plot_df
# }
#### Correlation using ggpairs() ####
output$my_corr_pairs = renderPlot(
dashboard_ggpairs(
corr_plot_df,
plot_title = plot_title,
method = input$corr_method,
tt_args_size = 7,
gp_args_size = 7
), height = 900
)
}
)
}
app <- shinyApp(ui, server) app <- shinyApp(ui, server)
runApp(app) runApp(app)
} }

View file

@ -4,78 +4,395 @@ library(DT)
library(NGLVieweR) library(NGLVieweR)
library(hash) library(hash)
server <- function(input, output) { function(input, output, session) {
observeEvent({
input$combined_model
input$combined_data
input$combined_training_genes
input$score_dropdown
input$resample_dropdown
input$drug_dropdown
input$split_dropdown
},{ #output$LogoPlotSnps = renderPlot(LogoPlotSnps(mutable_df3))
combined_model = input$combined_model output$lin_sc = renderPlot(
selection = input$score_dropdown lin_sc(
resampler = input$resample_dropdown input$switch_target,
selected_drug = input$drug_dropdown all_lineages = input$all_lineages,
selected_split = input$split_dropdown my_xats = 12, # x axis text size
combined_data = input$combined_data my_yats = 12, # y axis text size
combined_training_genes = input$combined_training_genes my_xals = 12, # x axis label size
my_yals = 12, # y axis label size
selected_gene = combo[combo$drug == selected_drug,'gene'] my_lls = 12, # legend label size
d_lab_size = 4
# hide stuff if selected
if(combined_model == "combined") {
#if(combined_model == TRUE) {
hide("split_dropdown")
hide("resample_dropdown")
show("combined_data")
show("combined_training_genes")
filedata = paste0(combined_training_genes,
'genes_logo_skf_BT_',
selected_gene,
'_',
combined_data
)
print(filedata)
print('doing COMBINED plot')
output$plot <- renderPlot(makeplot(loaded_files[[filedata]],
selection,
"none", # always 'none' for combined plot
gene = combo[drug==selected_drug,"gene"],
combined_training_genes = combined_training_genes,
display_combined = TRUE,
) )
) )
# e.g. #### lineage_distP ####
# makeplot(loaded_files$`5genes_logo_skf_BT_pnca_actual`, "MCC", "none" , gene = 'foo', combined_training_genes = '1234', display_combined = TRUE) output$lineage_distP = renderPlot(
} else { lineage_distP(
show("split_dropdown") get(paste0(input$switch_target, '_merged_df2')),
show("resample_dropdown") all_lineages = input$all_lineages,
hide("combined_data") x_lab = "Average Stability",
hide("combined_training_genes") x_axis = "avg_stability_scaled",
filedata = paste0(combo[drug==selected_drug,"gene"], fill_categ_cols = c("red", "blue")
'_baselineC_',
selected_split
)
print(filedata)
print("doing GENE plot")
output$plot <- renderPlot(makeplot(loaded_files[[filedata]],
selection,
resampler,
gene = combo[drug==selected_drug,"gene"],
display_combined = FALSE,
) )
) )
} #### observeEvent() Fun(tm) ####
# 6genes_logo_skf_BT_gid_complete observeEvent(input$clear_ngl, {
NGLVieweR_proxy("structure") %>%
# filedata example for combined: 6genes_logo_skf_BT_embb_actual removeSelection("Pos")
# 6genes_logo_skf_BT_embb_combined
}) })
# Button to test adding a position
observeEvent(input$test_ngl, {
NGLVieweR_proxy("structure") %>%
addSelection('ball+stick'
, param = list(
name = "Pos"
, sele = "35"
, color = "green")
)
})
observeEvent(
{
input$display_position_range
input$stability_snp_param
input$logoplot_colour_scheme
input$omit_snp_count
input$switch_target
input$snp_ligand_dist
input$snp_nca_dist
input$snp_interface_dist
},
{
print("entering main observeEvent()")
# C O M P A T I B I L I T Y
#gene=input$switch_target
#drug=target_map[[gene]]
target_gene = input$switch_target
merged_df3 = cbind(get(paste0(input$switch_target, '_merged_df3')))
position_max=max(merged_df3[['position']])
position_min=min(merged_df3[['position']])
min_ligand_distance=min(merged_df3$ligand_distance)
max_ligand_distance=max(merged_df3$ligand_distance)
# FIXME: these are IMPORTANT
# # add "pos_count" position count column
# merged_df3=merged_df3 %>% dplyr::add_count(position)
# merged_df3$pos_count=merged_df3$n
# merged_df3$n=NULL
#
mutable_df3 = cbind(merged_df3)
#
# # re-sort the dataframe according to position count
sorted_df = cbind(merged_df3)
sorted_df = sorted_df %>% arrange(pos_count)
#
outdir = paste0(load_dir, "Data/", drug, '/output/')
indir = paste0(load_dir, "Data/", drug , "/input/")
#### nasty special-purpose merged_df3 variants ####
# FIXME: SLOW
# corr_plotdf = corr_data_extract(
# merged_df3
# , gene = gene
# , drug = drug
# , extract_scaled_cols = F
# )
#input$stability_snp_param
updateCheckboxGroupInput(
session,
"corr_selected",
choiceNames = colnames(get(paste0(input$switch_target,"_corr_df_m3_f"))),
choiceValues = colnames(get(paste0(input$switch_target,"_corr_df_m3_f"))),
selected = c("FoldX", "DeepDDG", "mCSM.DUET")
)
updateSliderInput(
session,
"display_position_range",
min = position_min,
max = position_max
#, value = c(position_min, position_min+150)
)
updateNumericInput(session, "selected_logop_snp_position", min = position_min, max = position_max, value = position_min)
updateNumericInput(session, "selected_logop_ed_position", min = position_min, max = position_max, value = position_min)
updateNumericInput(session, "corr_lig_dist", min = min_ligand_distance, max = max_ligand_distance, value = min_ligand_distance)
updateNumericInput(session, "snp_ligand_dist", min = min(merged_df3$ligand_distance), max = max(merged_df3$ligand_distance))
updateNumericInput(session, "snp_interface_dist", min = min(merged_df3$interface_dist), max = max(merged_df3$interface_dist))
updateNumericInput(session, "snp_nca_dist", min = min(merged_df3$nca_distance), max = max(merged_df3$nca_distance))
# different data ranges required for SNP distances
snp_ligand_dist_df3 = merged_df3[merged_df3$ligand_distance<input$snp_ligand_dist,]
snp_interface_dist_df3 = merged_df3[merged_df3$interface_dist<input$snp_interface_dist,]
snp_nca_dist_df3 = merged_df3[merged_df3$nca_distance<input$snp_nca_dist,]
stability_colname = stability_boxes_df[stability_boxes_df$stability_type==input$stability_snp_param,"stability_colname"]
outcome_colname = stability_boxes_df[stability_boxes_df$stability_type==input$stability_snp_param,"outcome_colname"]
display_position_range = input$display_position_range
plot_min=display_position_range[1]
plot_max=display_position_range[2]
logoplot_colour_scheme = input$logoplot_colour_scheme
omit_snp_count = input$omit_snp_count
print(paste0('Plotting positions between: ', plot_min, ' and ', plot_max))
subset_mutable_df3=mutable_df3[(mutable_df3$position>=plot_min & mutable_df3$position <=plot_max),]
subset_mutable_df3=mutable_df3[(mutable_df3$position>=plot_min & mutable_df3$position <=plot_max),]
subset_sorted_df=sorted_df[(sorted_df$position>=plot_min & sorted_df$position <=plot_max),]
#### LogoPlotSnps ####
output$LogoPlotSnps = renderPlot(
LogoPlotSnps(subset_mutable_df3,
aa_pos_drug = get(paste0(target_gene,"_aa_pos_drug")),
active_aa_pos = get(paste0(target_gene,"_active_aa_pos")),
aa_pos_lig1 = get(paste0(target_gene,"_aa_pos_lig1")),
aa_pos_lig2 = get(paste0(target_gene,"_aa_pos_lig2")),
aa_pos_lig3 = get(paste0(target_gene,"_aa_pos_lig3")),
my_logo_col = logoplot_colour_scheme,
omit_snp_count = omit_snp_count
)
)
### NGLViewer ####
# Structure Viewer WebGL/NGLViewR window
output$structure <- renderNGLVieweR({
ngl_gene=isolate(input$switch_target)
ngl_drug=target_map[[ngl_gene]]
ngl_pdb_file=paste0(load_dir, "Data/", ngl_drug, '/output/depth/', ngl_gene, '_complex.pdb')
print(ngl_pdb_file)
NGLVieweR(ngl_pdb_file) %>%
addRepresentation("cartoon",
param = list(name = "cartoon",
color="tan"
#, colorScheme = "chainid"
)
) %>%
stageParameters(backgroundColor = "lightgrey") %>%
setQuality("high") %>%
setFocus(0) %>%
setSpin(FALSE)
})
#### Shared dataTable() ####
output$table = DT::renderDataTable(
datatable(subset_sorted_df[,table_columns],
filter="top",
selection = "single"
)
)
#### bp_stability_hmap ####
# red/blue tiles wala "Stability SNP by Site"
output$bp_stability_hmap = renderPlot(
bp_stability_hmap(
subset_sorted_df,
reorder_position = input$reorder_custom_h,
p_title = NULL,
yvar_colname = stability_colname,
stability_colname = stability_colname,
stability_outcome_colname = outcome_colname,
my_ylab = NULL,
y_max_override = max(sorted_df$pos_count),
aa_pos_drug = get(paste0("embb","_aa_pos_drug")),
active_aa_pos = get(paste0("embb","_active_aa_pos")),
aa_pos_lig1 = get(paste0("embb","_aa_pos_lig1")),
aa_pos_lig2 = get(paste0("embb","_aa_pos_lig2")),
aa_pos_lig3 = get(paste0("embb","_aa_pos_lig3"))
)
)
#### LogoPlotCustomH ####
output$LogoPlotCustomH = renderPlot(
LogoPlotCustomH(
subset_sorted_df,
my_logo_col = logoplot_colour_scheme,
aa_pos_drug = get(paste0(target_gene,"_aa_pos_drug")),
active_aa_pos = get(paste0(target_gene,"_active_aa_pos")),
aa_pos_lig1 = get(paste0(target_gene,"_aa_pos_lig1")),
aa_pos_lig2 = get(paste0(target_gene,"_aa_pos_lig2")),
aa_pos_lig3 = get(paste0(target_gene,"_aa_pos_lig3"))
)
)
#### wideP_consurf3 ####
output$wideP_consurf3 = renderPlot(
wideP_consurf3(
subset_sorted_df,
point_colours = consurf_colours,
aa_pos_drug = get(paste0(target_gene,"_aa_pos_drug")),
active_aa_pos = get(paste0(target_gene,"_active_aa_pos")),
aa_pos_lig1 = get(paste0(target_gene,"_aa_pos_lig1")),
aa_pos_lig2 = get(paste0(target_gene,"_aa_pos_lig2")),
aa_pos_lig3 = get(paste0(target_gene,"_aa_pos_lig3"))
)
)
#### site_snp_count_bp ####
#mutable_df3[(mutable_df3$position>=plot_min & mutable_df3$position <=plot_max),]
# ligand_distance
# interface_dist
# nca_distance
# change to: multiple plots, all use site_snp_count_bp
# 4 x plots side by side, one normal (no dist. filter), 2/3 filtered by distance columns above
# use "subtitle text" from pos_count_bp_i.R
output$site_snp_count_bp = renderPlot(
site_snp_count_bp(
mutable_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
output$site_snp_count_bp_ligand = renderPlot(
site_snp_count_bp(
snp_ligand_dist_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
output$site_snp_count_interface = renderPlot(
site_snp_count_bp(
snp_interface_dist_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
output$site_snp_count_nca = renderPlot(
site_snp_count_bp(
snp_nca_dist_df3,
title_colour = 'black',
subtitle_colour = "black",
leg_text_size = 12,
axis_label_size = 12,
geom_ls = 4
)
)
#### DM OM Plots ####
#dm_om_param
# order needs to be:
# embb_lf_duet, embb_lf_foldx, embb_lf_deepddg, embb_lf_dynamut2, embb_lf_dist_gen,
# embb_lf_consurf, embb_lf_provean, embb_lf_snap2, embb_lf_mcsm_lig, embb_lf_mmcsm_lig,
# embb_lf_mcsm_ppi2, SOMETHING NA
# embb_lf_mmcsm_lig SOMETHING NA,
#dm_om_selection=input$dm_om_param
#dm_om_df = dm_om_map[[dm_om_selection]]
#output$lf_bp2 = renderPlot(lf_bp2(get(paste0(input$switch_target, '_', dm_om_df))))
output$lf_bp2 = renderPlot(
cowplot::plot_grid(
plotlist = lapply(
ls(name=.GlobalEnv,
pattern=paste0(
target_gene,
'_lf_'
)
),
function(x){
lf_bp2(get(x))
}
)#, nrow=3
), height=800
)
}
)
# FIXME: Doesn't add selected table rows correctly
observeEvent(
{
input$table_rows_selected
},
{
# having to duplicate this is a bit annoying :-(
ngl_merged_df3=cbind(get(paste0(input$switch_target, '_merged_df3')))
ngl_sorted_df = cbind(ngl_merged_df3)
ngl_sorted_df = ngl_sorted_df %>% arrange(pos_count)
position_max=max(ngl_merged_df3[['position']])
position_min=min(ngl_merged_df3[['position']])
display_position_range = input$display_position_range
plot_min=display_position_range[1]
plot_max=display_position_range[2]
#ngl_subset_df=ngl_merged_df3[(ngl_merged_df3$position>=plot_min & ngl_merged_df3$position <=plot_max),]
ngl_subset_df=ngl_sorted_df[(ngl_sorted_df$position>=plot_min & ngl_sorted_df$position <=plot_max),]
#table_rows_selected = isolate(input$table_rows_selected)
table_rows_selected = input$table_rows_selected
class(table_rows_selected)
#cat(paste0("Target: ", as.character(input$switch_target), "\nTable Rows for NGLViewR: ", as.character(table_rows_selected)))
struct_pos=(as.character(ngl_subset_df[table_rows_selected,"position"]))
cat(paste0('Table Index: ', table_rows_selected, "position: ", struct_pos))
NGLVieweR_proxy("structure") %>%
#addSelection('ball+stick'
addSelection('hyperball'
, param = list(
name = "Pos"
, sele = struct_pos
#, color = "#00ff00"
, colorValue="00ff00"
, colorScheme="element"
)
)
#cat(paste0('Done NGLViewR addSelection for: ', positions_to_add))
}
)
#### Correlation observeEvent ####
# Yet another special-case observeEvent to handle the correlation pair plot
observeEvent(
{
input$corr_selected
input$corr_method
input$corr_lig_dist
},
{
dist_cutoff_user = input$corr_lig_dist
target_gene=input$switch_target
plot_title=paste0(target_map[[target_gene]],"/",target_gene)
corr_plot_df = get(
paste0(
input$switch_target,"_corr_df_m3_f"
)
)[,c(input$corr_selected, "dst_mode")]
#if ( dist_cutoff_user >= 2) {
#corr_plotdf_subset = corr_plot_df[corr_plot_df[['Lig.Dist']] < dist_cutoff_user,]
#}
# else {
# corr_plotdf_subset = corr_plot_df
# }
#### Correlation using ggpairs() ####
output$my_corr_pairs = renderPlot(
dashboard_ggpairs(
corr_plot_df,
plot_title = plot_title,
method = input$corr_method,
tt_args_size = 7,
gp_args_size = 7
), height = 900
)
}
)
} }

View file

@ -7,11 +7,10 @@ library(hash)
#### Shiny UI ##### #### Shiny UI #####
#dashboardHeader(title = paste0(gene, "/", drug)),
dashboardPage(skin="purple", dashboardPage(skin="purple",
dashboardHeader(title = "Drug/Target Explorer"), dashboardHeader(title = "Drug/Target Explorer"),
dashboardSidebar( dashboardSidebar(
sidebarMenu( id = "sidebar", sidebarMenu( id = "sidebar",
selectInput( selectInput(
"switch_target", "switch_target",
@ -26,16 +25,16 @@ dashboardSidebar(
), ),
selected="embb"), selected="embb"),
menuItem("LogoP SNP", tabName="LogoP SNP"), menuItem("LogoP SNP", tabName="LogoP SNP"),
menuItem("Lineage Sample Count", tabName="Lineage Sample Count"), #menuItem("Lineage Sample Count", tabName="Lineage Sample Count"),
menuItem("Site SNP count", tabName="Site SNP count"), menuItem("Site SNP count", tabName="Site SNP count"),
menuItem("Stability SNP by site", tabName="Stability SNP by site"), menuItem("Stability SNP by site", tabName="Stability SNP by site"),
menuItem("DM OM Plots", tabName="DM OM Plots"), menuItem("DM OM Plots", tabName="DM OM Plots"),
menuItem("Correlation", tabName="Correlation"), menuItem("Correlation", tabName="Correlation"),
menuItem("Lineage Distribution", tabName="Lineage Distribution"), #menuItem("Lineage Distribution", tabName="Lineage Distribution"),
menuItem("Consurf", tabName="Consurf"), menuItem("Consurf", tabName="Consurf"),
menuItem("LogoP OR", tabName="LogoP OR"), menuItem("LogoP OR", tabName="LogoP OR"),
menuItem("LogoP ED", tabName="LogoP ED"), menuItem("Lineage", tabName="Lineage"),
menuItem('Stability count', tabName='Stability count'), #menuItem('Stability count', tabName='Stability count'),
# These conditionalPanel()s make extra settings appear in the sidebar when needed # These conditionalPanel()s make extra settings appear in the sidebar when needed
conditionalPanel( conditionalPanel(
@ -59,23 +58,13 @@ dashboardSidebar(
input.sidebar == 'LogoP SNP'|| input.sidebar == 'LogoP SNP'||
input.sidebar == 'Stability SNP by site' || input.sidebar == 'Stability SNP by site' ||
input.sidebar == 'Consurf' || input.sidebar == 'Consurf' ||
input.sidebar == 'LogoP OR' || input.sidebar == 'LogoP OR'",
input.sidebar == 'Site SNP count'",
sliderInput( sliderInput(
"display_position_range" "display_position_range"
, "Display Positions" , "Display Positions"
, min=1, max=150, value=c(1,150) # 150 is just a little less than the smallest pos_count , min=1, max=150, value=c(1,150) # 150 is just a little less than the smallest pos_count
) )
), ),
conditionalPanel(
condition="input.sidebar == 'LogoP ED'",
sliderInput(
"display_position_full_range"
, "Display Positions"
, min=1, max=150, value=c(1,150)
)
),
conditionalPanel( conditionalPanel(
condition=" condition="
@ -89,13 +78,6 @@ dashboardSidebar(
selected="chemistry" selected="chemistry"
) )
), ),
#conditionalPanel(
# condition="input.sidebar == 'LogoP SNP' || input.sidebar == 'LogoP ED'|| input.sidebar == 'Consurf'",
# numericInput(
# "table_position"
# , "Table Position", value=1
# )
#),
conditionalPanel( conditionalPanel(
condition="input.sidebar == 'Correlation'", condition="input.sidebar == 'Correlation'",
selectInput( selectInput(
@ -114,6 +96,27 @@ dashboardSidebar(
, "Ligand Distance Cutoff (Å)", value=1 , "Ligand Distance Cutoff (Å)", value=1
) )
), ),
conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
numericInput(
"snp_ligand_dist"
, "Ligand Distance Cutoff (Å)", value=10
)
),
conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
numericInput(
"snp_interface_dist"
, "Interface Distance Cutoff (Å)", value=10
)
),
conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
numericInput(
"snp_nca_dist"
, "NCA Distance Cutoff (Å)", value=10
)
),
conditionalPanel( conditionalPanel(
condition="input.sidebar == 'Correlation'", condition="input.sidebar == 'Correlation'",
@ -125,33 +128,30 @@ dashboardSidebar(
"Dynamut2", "Dynamut2",
"FoldX", "FoldX",
"ConSurf"#, "ConSurf"#,
#"dst_mode"
), ),
choiceValues = c( choiceValues = c(
"DeepDDG", "DeepDDG",
"Dynamut2", "Dynamut2",
"FoldX", "FoldX",
"ConSurf"#, "ConSurf"#,
#"dst_mode"
), ),
selected = c( selected = c(
"DeepDDG", "DeepDDG",
"Dynamut2", "Dynamut2",
"FoldX", "FoldX",
"ConSurf"#, "ConSurf"#,
#"dst_mode"
) )
) )
), ),
conditionalPanel( # conditionalPanel(
condition="input.sidebar == 'DM OM Plots'", # condition="input.sidebar == 'DM OM Plots'",
selectInput( # selectInput(
"dm_om_param", # "dm_om_param",
label="Stability Parameter", # label="Stability Parameter",
choices = keys(dm_om_map), # choices = keys(dm_om_map),
selected="SNAP2") # selected="SNAP2")
), # ),
# colour_categ # colour_categ
conditionalPanel( conditionalPanel(
condition="input.sidebar == 'Stability SNP by site'", condition="input.sidebar == 'Stability SNP by site'",
@ -178,8 +178,7 @@ dashboardSidebar(
condition="input.sidebar == 'LogoP SNP' || condition="input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' || input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' || input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR' || input.sidebar =='LogoP OR'",
input.sidebar =='LogoP ED'",
actionButton("clear_ngl", actionButton("clear_ngl",
"Clear Structure") "Clear Structure")
), ),
@ -187,8 +186,7 @@ dashboardSidebar(
condition="input.sidebar == 'LogoP SNP' || condition="input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' || input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' || input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR' || input.sidebar =='LogoP OR'",
input.sidebar =='LogoP ED'",
actionButton("test_ngl", actionButton("test_ngl",
"Test NGLViewR") "Test NGLViewR")
)#, )#,
@ -202,8 +200,9 @@ dashboardSidebar(
# ) # )
) )
), ),
body <- dashboardBody( #### body ####
body <- dashboardBody(
tabItems( tabItems(
tabItem(tabName = "dashboard", tabItem(tabName = "dashboard",
@ -234,6 +233,92 @@ body <- dashboardBody(
) )
) )
), ),
# Explicit fluidRow() for Lineage plots together
fluidRow(
column(conditionalPanel(
condition="input.sidebar.match(/^Lineage.*/)", box(
title="Lineage Distribution"
, status = "info"
, width=NULL
, plotOutput("lineage_distP", height="700px") %>% withSpinner(color="#0dc5c1"),
height=800
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar.match(/^Lineage.*/)", box(
title="Lineage SNP Diversity"
, status = "info"
, width=NULL
, plotOutput("lin_sc", height="700px") %>% withSpinner(color="#0dc5c1"),
height=800
)
), width=6
)
),
# Explicit fluidRow() for Site SNP Count
fluidRow(
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="Site SNP count"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_bp") %>% withSpinner(color="#0dc5c1")
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="Ligand Distance"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_bp_ligand") %>% withSpinner(color="#0dc5c1")
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="Interface Distance"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_interface") %>% withSpinner(color="#0dc5c1")
)
), width=6
),
column(conditionalPanel(
condition="input.sidebar == 'Site SNP count'",
box(
title="NCA Distance"
, status = "info"
, width=NULL
, plotOutput("site_snp_count_nca") %>% withSpinner(color="#0dc5c1")
)
), width=6
)
),
# # Explicit fluidRow() for Stability Count
# fluidRow(
# column(
# conditionalPanel(
# condition="input.sidebar.match(/^Lineage.*/)",
# lapply(
# # FIXME: using a hardcoded target DF for this IS WRONG AND WILL BREAK
# stability_boxes_df[stability_boxes_df$outcome_colname %in% colnames(embb_merged_df3),"outcome_colname"],
# function(x){
# print(paste0("outcome_colname: ",x))
# box(plotOutput(x), width=4)
# }
# ),
# width=12
# )
# )
# ),
#### fluidRow()s for "Stability Count" in the sidebar #### #### fluidRow()s for "Stability Count" in the sidebar ####
fluidRow( fluidRow(
conditionalPanel( conditionalPanel(
@ -241,8 +326,7 @@ body <- dashboardBody(
input.sidebar == 'LogoP SNP' || input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' || input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' || input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR' || input.sidebar =='LogoP OR'",
input.sidebar =='LogoP ED'",
column(NGLVieweROutput("structure"), column(NGLVieweROutput("structure"),
width=3 width=3
) )
@ -253,13 +337,13 @@ body <- dashboardBody(
input.sidebar == 'Stability SNP by site' || input.sidebar == 'Stability SNP by site' ||
input.sidebar == 'Site SNP count' || input.sidebar == 'Site SNP count' ||
input.sidebar == 'Consurf' || input.sidebar == 'Consurf' ||
input.sidebar == 'LogoP OR' || input.sidebar == 'LogoP OR'",
input.sidebar == 'LogoP ED'",
column( column(
DT::dataTableOutput('table'), DT::dataTableOutput('table'),
width=9 width=9
) )
) )
),
) )
) )
)