From 4cdcebb0b24a2a34a7a1a0d3f87b85e2fb409e37 Mon Sep 17 00:00:00 2001 From: Tanushree Tunstall Date: Mon, 10 Oct 2022 16:47:23 +0100 Subject: [PATCH] isolating observeevent()s --- drug-target/global.R | 1520 +++++++++++++++++++++--------------------- 1 file changed, 760 insertions(+), 760 deletions(-) diff --git a/drug-target/global.R b/drug-target/global.R index e1c524c..54175cb 100644 --- a/drug-target/global.R +++ b/drug-target/global.R @@ -312,764 +312,764 @@ if (interactive()){ 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="RNA 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']]=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_gene=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 - # ) - # ) - # - # # if ("interface_dist" %in% colnames(input$switch_target)) { - # 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 - # ) - # ) - # # } #else { - # # output$site_snp_count_interface = renderPlot( - # # ggplot() + annotate(x=1,y=1,"text", label="No interface data for this target")+theme_void() - # # ) - # # } - # - # output$site_snp_count_nca = renderPlot( #{ - # #if ("nca_distance" %in% colnames(input$switch_target)) { - # 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 - # ) - # # } else { - # # ggplot() + annotate(x=1,y=1,"text", label="No RNA data for this target")+theme_void() - # # } - # # } - # ) - # - # - # - # #### 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) + 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="RNA 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']]=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_gene=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 + ) + ) + + # if ("interface_dist" %in% colnames(input$switch_target)) { + 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 + ) + ) + # } #else { + # output$site_snp_count_interface = renderPlot( + # ggplot() + annotate(x=1,y=1,"text", label="No interface data for this target")+theme_void() + # ) + # } + + output$site_snp_count_nca = renderPlot( #{ + #if ("nca_distance" %in% colnames(input$switch_target)) { + 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 + ) + # } else { + # ggplot() + annotate(x=1,y=1,"text", label="No RNA data for this target")+theme_void() + # } + # } + ) + + + + #### 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) }