Dashboards/drug-target/global.R
2022-09-09 14:25:27 +01:00

1052 lines
42 KiB
R

library(shinycssloaders)
library(DT)
library(NGLVieweR)
library(hash)
# FIXME This is slow and should happen *once only*
#source(load_dir, "git/LSHTM_analysis/scripts/Header_TT.R")
# FIXME: these are needed but slow to load every time
# source(load_dir, "git/LSHTM_analysis/config/alr.R")
# source(load_dir, "git/LSHTM_analysis/config/gid.R")
# source(load_dir, "git/LSHTM_analysis/config/pnca.R")
# source(load_dir, "git/LSHTM_analysis/config/rpob.R")
# source(load_dir, "git/LSHTM_analysis/config/katg.R")
# 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
# than previous approaches
# system.time({
load_dir="~/git/"
#load_dir="/srv/shiny-server/git/"
source(paste0(load_dir, "LSHTM_analysis/scripts/Header_TT.R"))
load_target_globals=function(target){
cat(paste0("Reloading Target: ", target))
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, "_active_aa_pos"), active_aa_pos, envir = .GlobalEnv))
invisible(assign(paste0(target, "_aa_pos_lig1"), aa_pos_lig1, envir = .GlobalEnv))
invisible(assign(paste0(target, "_aa_pos_lig2"), aa_pos_lig2, envir = .GlobalEnv))
invisible(assign(paste0(target, "_aa_pos_lig3"), aa_pos_lig3, 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(
c(
"duet",
"mcsm_lig",
"foldx",
"deepddg",
"dynamut2",
"consurf",
"snap2",
"provean",
"dist_gen",
"mcsm_ppi2",
"mmcsm_lig",
"mcsm_na"
#,
#"mcsm_na"
), function(x){
wf_filename=paste0(load_dir, "Misc/shiny_dashboard/data/", tolower(gene), "-wf_", x ,".csv")
wf_var=paste0(target, "wf_",x)
if (file.exists(wf_filename)){
invisible(assign(wf_var,read.csv(wf_filename), envir = .GlobalEnv)) # FILTH
}
lf_filename=paste0(load_dir, "Misc/shiny_dashboard/data/", tolower(gene), "-lf_", x ,".csv")
lf_var=paste0(target, "_lf_",x)
if (file.exists(lf_filename)){
invisible(assign(lf_var,read.csv(lf_filename), envir = .GlobalEnv)) # FILTH
}
}
)
}
#### Local Functions ####
# Generate a conditionalPanel() for a given graph function and sidebar name combination
generate_conditionalPanel = function(tab_name, plot_function, plot_df){
# e.g.: list("lin_count_bp_diversity", "Lineage diversity count")
cond=paste0("input.sidebar == '", tab_name, "'")
conditionalPanel(condition=cond, box(
title=tab_name
, status = "info"
, width=NULL
, plotOutput(plot_function
, click = "plot_click") %>% withSpinner(color="#0dc5c1")
# , plotOutput(plot_function, click = "plot_click")
)
)
}
# FIXME: passing in the per-plot params is broken
lin_sc=function(x, all_lineages = F, ...){
lf_var = get(paste0(x,"_lin_lf"))
wf_var = get(paste0(x,"_lin_wf"))
cowplot::plot_grid(lin_count_bp_diversity(wf_var, all_lineages, ...), lin_count_bp(lf_var, all_lineages, ...))
}
options(shiny.port = 8000)
options(shiny.host = '0.0.0.0') # This means "listen to all addresses on all interfaces"
options(shiny.launch.browser = FALSE)
options(width=120)
options(DT.options = list(scrollX = TRUE))
################ STATIC GLOBALS ONLY ##############
# never quite sure where "outdir" gets set :-|
# using dataframes instead of lists lets us avoid use of map()
plot_functions_df=data.frame(
tab_name=c(
"LogoP SNP",
#"Lineage Sample Count",
#"Site SNP count",
"Stability SNP by site",
"DM OM Plots",
"Correlation",
#"Lineage Distribution",
"Consurf",
"LogoP OR"
),
plot_function=c(
"LogoPlotSnps",
#"lin_sc",
#"site_snp_count_bp",
"bp_stability_hmap",
"lf_bp2",
"my_corr_pairs",
#"lineage_distP",
"wideP_consurf3",
"LogoPlotCustomH"
),
plot_df=c(
"mutable_df3" ,
#"lin_lf",
#"mutable_df3",
"merged_df3" ,
"lf_duet" ,
"corr_df_m3_f",
#"merged_df2",
"merged_df3",
"merged_df2"
)
)
stability_boxes_df=data.frame(
outcome_colname=c("duet_outcome",
"foldx_outcome",
"deepddg_outcome",
"ddg_dynamut2_outcome",
"mcsm_na_outcome",
"mcsm_ppi2_outcome",
"snap2_outcome",
"consurf_outcome",
"avg_stability_outcome"),
stability_type=c(
"DUET",
"FoldX",
"DeepDDG",
"Dynamut2",
"mCSM-NA",
"mCSM-ppi2",
"SNAP2",
"Consurf",
"Average"
),
stability_colname=c(
"duet_scaled",
"foldx_scaled",
"deepddg_scaled",
"ddg_dynamut2_scaled",
"mcsm_na_scaled",
"mcsm_ppi2_scaled",
"snap2_scaled",
"consurf_scaled",
"avg_stability_scaled"
)
)
table_columns = c(
"position",
"mutationinformation",
"sensitivity",
"ligand_distance",
"avg_lig_affinity",
"avg_lig_affinity_outcome",
"avg_stability",
"avg_stability_outcome",
"or_mychisq",
"maf",
"snap2_outcome",
"consurf_outcome",
"provean_outcome",
"rsa",
"kd_values" ,
"rd_values"
)
logoPlotSchemes <- list("chemistry"
, "taylor"
, "hydrophobicity"
, "clustalx")
dm_om_methods = c("DUET ΔΔG"
, "Consurf"
, "Deepddg ΔΔG"
, "Dynamut2 ΔΔG"
, "FoldX ΔΔG"
, "Ligand affinity (log fold change)"
, "mCSM-NA affinity ΔΔG"
, "SNAP2")
dm_om_map = hash(c(
"DUET ΔΔG"
, "Consurf"
, "Deepddg ΔΔG"
, "Dynamut2 ΔΔG"
, "FoldX ΔΔG"
, "Ligand affinity (log fold change)"
, "mCSM-NA affinity ΔΔG"
, "SNAP2"
), c(
"lf_duet"
,"lf_consurf"
,"lf_deepddg"
,"lf_dynamut2"
,"lf_foldx"
,"lf_mcsm_lig"
,"lf_mcsm_na"
,"lf_snap2"
)
)
#### target_map: handy gene/drug mapping hash ####
target_map = hash(
c(
"alr",
"gid",
"embb",
"pnca",
"rpob",
"katg"),
c(
"cycloserine",
"streptomycin",
"ethambutol",
"pyrazinamide",
"rifampicin",
"isoniazid")
)
# load E V E R Y T H I N G
lapply(c(
"alr",
"embb",
"gid",
"katg",
"pnca",
"rpob"
),function(x){
load_target_globals(x)
}
)
consurf_palette1 = c("0" = "yellow2"
, "1" = "cyan1"
, "2" = "steelblue2"
, "3" = "cadetblue2"
, "4" = "paleturquoise2"
, "5" = "thistle3"
, "6" = "thistle2"
, "7" = "plum2"
, "8" = "maroon"
, "9" = "violetred2")
consurf_palette2 = c("0" = "yellow2"
, "1" = "forestgreen"
, "2" = "seagreen3"
, "3" = "palegreen1"
, "4" = "darkseagreen2"
, "5" = "thistle3"
, "6" = "lightpink1"
, "7" = "orchid3"
, "8" = "orchid4"
, "9" = "darkorchid4")
# decreasing levels mess legend
# consurf_colours_LEVEL = c(
# "0" = rgb(1.00,1.00,0.59)
# , "9" = rgb(0.63,0.16,0.37)
# , "8" = rgb(0.94,0.49,0.67)
# , "7" = rgb(0.98,0.78,0.86)
# , "6" = rgb(0.98,0.92,0.96)
# , "5" = rgb(1.00,1.00,1.00)
# , "4" = rgb(0.84,0.94,0.94)
# , "3" = rgb(0.65,0.86,0.90)
# , "2" = rgb(0.29,0.69,0.75)
# , "1" = rgb(0.04,0.49,0.51)
# )
consurf_colours = c(
"0" = rgb(1.00,1.00,0.59)
, "1" = rgb(0.04,0.49,0.51)
, "2" = rgb(0.29,0.69,0.75)
, "3" = rgb(0.65,0.86,0.90)
, "4" = rgb(0.84,0.94,0.94)
, "5" = rgb(1.00,1.00,1.00)
, "6" = rgb(0.98,0.92,0.96)
, "7" = rgb(0.98,0.78,0.86)
, "8" = rgb(0.94,0.49,0.67)
, "9" = rgb(0.63,0.16,0.37)
)
# if (true()){
if (interactive()){
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.host = '0.0.0.0') # This means "listen to all addresses on all interfaces"
options(width=120)
options(DT.options = list(scrollX = TRUE))
#### UI ####
ui <- dashboardPage(skin="purple",
dashboardHeader(title = "Drug/Target Explorer"),
dashboardSidebar(
sidebarMenu( id = "sidebar",
selectInput(
"switch_target",
label="Switch to New Target",
choices = c(
"alr",
"embb",
"gid",
"katg",
"pnca",
"rpob"
),
selected="embb"),
menuItem("LogoP SNP", tabName="LogoP SNP"),
#menuItem("Lineage Sample Count", tabName="Lineage Sample Count"),
menuItem("Site SNP count", tabName="Site SNP count"),
menuItem("Stability SNP by site", tabName="Stability SNP by site"),
menuItem("DM OM Plots", tabName="DM OM Plots"),
menuItem("Correlation", tabName="Correlation"),
#menuItem("Lineage Distribution", tabName="Lineage Distribution"),
menuItem("Consurf", tabName="Consurf"),
menuItem("LogoP OR", tabName="LogoP OR"),
menuItem("Lineage", tabName="Lineage"),
#menuItem('Stability count', tabName='Stability count'),
# These conditionalPanel()s make extra settings appear in the sidebar when needed
conditionalPanel(
condition="input.sidebar == 'LogoP SNP'",
textInput(
"omit_snp_count",
"Omit SNPs",
value = c(0),
placeholder = "1,3,6"
)
),
# NOTE:
# I *think* we can cheat here slightly and use the min/max from
# merged_df3[['position']] for everything because the various
# dataframes for a given gene/drug combination have the
# same range of positions. May need fixing, especially
# if we get/shrink the imported data files to something
# more reasonable.
conditionalPanel(
condition="
input.sidebar == 'LogoP SNP'||
input.sidebar == 'Stability SNP by site' ||
input.sidebar == 'Consurf' ||
input.sidebar == 'LogoP OR'",
sliderInput(
"display_position_range"
, "Display Positions"
, min=1, max=150, value=c(1,150) # 150 is just a little less than the smallest pos_count
)
),
conditionalPanel(
condition="
input.sidebar == 'LogoP SNP' ||
input.sidebar == 'LogoP OR' ||
input.sidebar == 'LogoP ED'",
selectInput(
"logoplot_colour_scheme",
label="Logo Plot Colour Scheme",
choices = logoPlotSchemes,
selected="chemistry"
)
),
conditionalPanel(
condition="input.sidebar == 'Correlation'",
selectInput(
"corr_method",
label="Correlation Method",
choices = list("spearman",
"pearson",
"kendall"),
selected="spearman"
)
),
conditionalPanel(
condition="input.sidebar == 'Correlation'",
numericInput(
"corr_lig_dist"
, "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(
condition="input.sidebar == 'Correlation'",
checkboxGroupInput(
"corr_selected",
"Parameters",
choiceNames = c(
"DeepDDG",
"Dynamut2",
"FoldX",
"ConSurf"#,
),
choiceValues = c(
"DeepDDG",
"Dynamut2",
"FoldX",
"ConSurf"#,
),
selected = c(
"DeepDDG",
"Dynamut2",
"FoldX",
"ConSurf"#,
)
)
),
# conditionalPanel(
# condition="input.sidebar == 'DM OM Plots'",
# selectInput(
# "dm_om_param",
# label="Stability Parameter",
# choices = keys(dm_om_map),
# selected="SNAP2")
# ),
# colour_categ
conditionalPanel(
condition="input.sidebar == 'Stability SNP by site'",
selectInput(
"stability_snp_param",
label="Stability Parameter",
choices = stability_boxes_df$stability_type,
selected="Average")
),
conditionalPanel(
condition="input.sidebar == 'Stability SNP by site'",
checkboxInput("reorder_custom_h",
label="Reorder by SNP count",
FALSE)
),
conditionalPanel(
condition="input.sidebar.match(/^Lineage.*/)",
checkboxInput("all_lineages",
label="All Lineages",
FALSE)
),
# an example of how you can match multiple things in frontend JS
conditionalPanel(
condition="input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR'",
actionButton("clear_ngl",
"Clear Structure")
),
conditionalPanel(
condition="input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR'",
actionButton("test_ngl",
"Test NGLViewR")
)#,
# downloadButton("save",
# "Download Plot"
# )
# actionButton(
# "reload_target",
# label="Reload Target\nData (slow!)"
# )
)
),
#### body ####
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
),
# creates a 'Conditional Panel' containing a plot object from each of our
# ggplot plot functions (and its associated data frame)
fluidRow(column(width=12,
lapply(plot_functions_df$tab_name,
function(x){
plot_function=plot_functions_df[
plot_functions_df$tab_name==x,
"plot_function"]
plot_df=plot_functions_df[
plot_functions_df$tab_name==x,
"plot_df"]
cat(paste0('\nCreating output: ', x))
generate_conditionalPanel(x, plot_function, plot_df)
}
)
)
),
# 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(
conditionalPanel(
condition="
input.sidebar == 'LogoP SNP' ||
input.sidebar =='Stability SNP by site' ||
input.sidebar =='Consurf' ||
input.sidebar =='LogoP OR'",
column(NGLVieweROutput("structure"),
width=3
)
),
conditionalPanel(
condition="
input.sidebar == 'LogoP SNP' ||
input.sidebar == 'Stability SNP by site' ||
input.sidebar == 'Site SNP count' ||
input.sidebar == 'Consurf' ||
input.sidebar == 'LogoP OR'",
column(
DT::dataTableOutput('table'),
width=9
)
)
),
)
)
server <- function(input, output, session) {
#output$LogoPlotSnps = renderPlot(LogoPlotSnps(mutable_df3))
output$lin_sc = renderPlot(
lin_sc(
input$switch_target,
all_lineages = input$all_lineages,
my_xats = 12, # x axis text size
my_yats = 12, # y axis text size
my_xals = 12, # x axis label size
my_yals = 12, # y axis label size
my_lls = 12, # legend label size
d_lab_size = 4
)
)
#### lineage_distP ####
output$lineage_distP = renderPlot(
lineage_distP(
get(paste0(input$switch_target, '_merged_df2')),
all_lineages = input$all_lineages,
x_lab = "Average Stability",
x_axis = "avg_stability_scaled",
fill_categ_cols = c("red", "blue")
)
)
#### observeEvent() Fun(tm) ####
observeEvent(input$clear_ngl, {
NGLVieweR_proxy("structure") %>%
removeSelection("Pos")
})
# 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)
runApp(app)
}