added the almost done shiny for barplots subcolours

scripts/plotting/barplots_subcolours.R

@@ -94,7 +94,7 @@ my_df_u$group <- paste0(my_df_u$duet_outcome, "_", my_grp, sep = "")
 # Call the function to create the palette based on the group defined above
 colours <- ColourPalleteMulti(my_df_u, "duet_outcome", "my_grp")
 print(paste0("Colour palette generated for: ", length(colours), " colours"))
-my_title = "Protein stability (DUET)"
+
 
 # axis label size
 my_xaxls = 12
@@ -104,6 +104,7 @@ my_yaxls = 20
 my_xaxts = 18
 my_yaxts = 20
 
+my_title = "Protein stability (DUET)"
 #********************
 # generate plot: PS
 # NO axis colours

scripts/plotting/barplots_subcolours_aa_PS.R

@@ -132,7 +132,7 @@ setDT(df)[, pos_count := .N, by = .(position)]
 table(df$pos_count)
 
 # use group by on this
-library(dplyr)
+#library(dplyr)
 snpsBYpos_df <- df %>%
   group_by(position) %>%
   summarize(snpsBYpos = mean(pos_count))

scripts/plotting/get_plotting_dfs.R

@@ -12,6 +12,7 @@ source("../functions/my_pairs_panel.R") # with lower panel turned off
 source("../functions/plotting_globals.R")
 source("../functions/plotting_data.R")
 source("../functions/combining_dfs_plotting.R")
+source("../functions/bp_subcolours.R")
 
 #********************
 # cmd args passed 
@@ -25,7 +26,7 @@ source("../functions/combining_dfs_plotting.R")
 #====================
 
 LigDist_colname = "ligand_distance"
-LigDist_cutoff = 20
+LigDist_cutoff = 10
 
 #===========
 # input
@@ -38,8 +39,8 @@ import_dirs(drug, gene)
 #---------------------------
 # call: plotting_data()
 #---------------------------
-#if (!exists("infile_params") && exists("gene")){
+if (!exists("infile_params") && exists("gene")){
-if (!is.character(infile_params) && exists("gene")){ # when running as cmd
+#if (!is.character(infile_params) && exists("gene")){ # when running as cmd
   #in_filename_params = paste0(tolower(gene), "_all_params.csv") 
   in_filename_params = paste0(tolower(gene), "_comb_afor.csv") # part combined for gid
   infile_params = paste0(outdir, "/", in_filename_params)
@@ -61,8 +62,8 @@ dup_muts    = pd_df[[4]]
 #--------------------------------
 # call: combining_dfs_plotting()
 #--------------------------------
-#if (!exists("infile_metadata") && exists("gene")){
+if (!exists("infile_metadata") && exists("gene")){
-if (!is.character(infile_metadata) && exists("gene")){ # when running as cmd
+#if (!is.character(infile_metadata) && exists("gene")){ # when running as cmd
   in_filename_metadata = paste0(tolower(gene), "_metadata.csv") # part combined for gid
   infile_metadata = paste0(outdir, "/", in_filename_metadata)
   cat("\nInput file for gene metadata not specified, assuming filename: ", infile_metadata, "\n")
@@ -89,6 +90,139 @@ merged_df3_lig      = all_plot_dfs[[6]]
 merged_df2_comp_lig = all_plot_dfs[[7]]
 merged_df3_comp_lig = all_plot_dfs[[8]]
 
+####################################################################
+#                        Data for subcols barplot (~heatmpa)
+####################################################################
+# can include: mutation, or_kin, pwald, af_kin
+cols_to_select = c("mutationinformation", "drtype"
+                   #, "wild_type"
+                   , "position"
+                   #, "mutant_type"
+                   , "chain", "ligand_id", "ligand_distance"
+                   , "duet_stability_change", "duet_outcome", "duet_scaled"
+                   , "ligand_affinity_change", "ligand_outcome", "affinity_scaled"
+                   , "ddg", "foldx_scaled", "foldx_outcome"
+                   , "deepddg", "deepddg_outcome"
+                   , "asa", "rsa", "rd_values", "kd_values")
+                   #, "af", "or_mychisq", "pval_fisher" 
+                   #, "or_fisher", "or_logistic", "pval_logistic")
+                   #, "wt_prop_water", "mut_prop_water", "wt_prop_polarity", "mut_prop_polarity"
+                   #, "wt_calcprop", "mut_calcprop")
+
+#=======================
+# Data for sub colours
+# barplot: PS
+#=======================
+
+cat("\nNo. of cols to select:", length(cols_to_select))
+
+subcols_df_ps = merged_df3[, cols_to_select]
+
+cat("\nNo of unique positions for ps:"
+    , length(unique(subcols_df_ps$position)))
+
+# add count_pos col that counts the no. of nsSNPS at a position
+setDT(subcols_df_ps)[, pos_count := .N, by = .(position)]
+
+# should be a factor
+if (is.factor(subcols_df_ps$duet_outcome)){
+  cat("\nDuet_outcome is factor")
+  table(subcols_df_ps$duet_outcome)
+}else{
+  cat("\nConverting duet_outcome to factor")
+  subcols_df_ps$duet_outcome = as.factor(subcols_df_ps$duet_outcome)
+  table(subcols_df_ps$duet_outcome)
+}
+
+# should be -1 and 1
+min(subcols_df_ps$duet_scaled)
+max(subcols_df_ps$duet_scaled)
+
+tapply(subcols_df_ps$duet_scaled, subcols_df_ps$duet_outcome, min)
+tapply(subcols_df_ps$duet_scaled, subcols_df_ps$duet_outcome, max)
+
+# check unique values in normalised data
+cat("\nNo. of unique values in duet scaled, no rounding:"
+    , length(unique(subcols_df_ps$duet_scaled)))
+
+# No rounding    
+my_grp = subcols_df_ps$duet_scaled; length(my_grp)
+
+# Add rounding is to be used
+n = 3 
+subcols_df_ps$duet_scaledR = round(subcols_df_ps$duet_scaled, n)
+
+cat("\nNo. of unique values in duet scaled", n, "places rounding:"
+    , length(unique(subcols_df_ps$duet_scaledR)))
+
+my_grp_r = subcols_df_ps$duet_scaledR  # rounding
+
+# Add grp cols
+subcols_df_ps$group <- paste0(subcols_df_ps$duet_outcome, "_", my_grp, sep = "")
+subcols_df_ps$groupR <- paste0(subcols_df_ps$duet_outcome, "_", my_grp_r, sep = "")
+
+# Call the function to create the palette based on the group defined above
+subcols_ps <- ColourPalleteMulti(subcols_df_ps, "duet_outcome", "my_grp")
+subcolsR_ps <- ColourPalleteMulti(subcols_df_ps, "duet_outcome", "my_grp_r")
+
+print(paste0("Colour palette generated for my_grp: ", length(subcols_ps), " colours"))
+print(paste0("Colour palette generated for my_grp_r: ", length(subcolsR_ps), " colours"))
+
+#=======================
+# Data for sub colours
+# barplot: LIG
+#=======================
+cat("\nNo. of cols to select:", length(cols_to_select))
+
+subcols_df_lig = merged_df3_lig[, cols_to_select]
+
+cat("\nNo of unique positions for LIG:"
+    , length(unique(subcols_df_lig$position)))
+
+# should be a factor
+if (is.factor(subcols_df_lig$ligand_outcome)){
+  cat("\nLigand_outcome is factor")
+  table(subcols_df_lig$ligand_outcome)
+}else{
+  cat("\nConverting ligand_outcome to factor")
+  subcols_df_lig$ligand_outcome = as.factor(subcols_df_lig$ligand_outcome)
+  table(subcols_df_lig$ligand_outcome)
+}
+
+# should be -1 and 1
+min(subcols_df_lig$affinity_scaled)
+max(subcols_df_lig$affinity_scaled)
+
+tapply(subcols_df_lig$affinity_scaled, subcols_df_lig$ligand_outcome, min)
+tapply(subcols_df_lig$affinity_scaled, subcols_df_lig$ligand_outcome, max)
+
+# check unique values in normalised data
+cat("\nNo. of unique values in affinity scaled, no rounding:"
+    , length(unique(subcols_df_lig$affinity_scaled)))
+
+# No rounding    
+my_grp_lig = subcols_df_lig$affinity_scaled; length(my_grp_lig)
+
+# Add rounding is to be used
+n = 3 
+subcols_df_lig$affinity_scaledR = round(subcols_df_lig$affinity_scaled, n)
+
+cat("\nNo. of unique values in duet scaled", n, "places rounding:"
+    , length(unique(subcols_df_lig$affinity_scaledR)))
+
+my_grp_lig_r = subcols_df_lig$affinity_scaledR  # rounding
+
+# Add grp cols
+subcols_df_lig$group_lig <- paste0(subcols_df_lig$ligand_outcome, "_", my_grp_lig, sep = "")
+subcols_df_lig$group_ligR <- paste0(subcols_df_lig$ligand_outcome, "_", my_grp_lig_r, sep = "")
+
+# Call the function to create the palette based on the group defined above
+subcols_lig <- ColourPalleteMulti(subcols_df_lig, "ligand_outcome", "my_grp_lig")
+subcolsR_lig <- ColourPalleteMulti(subcols_df_lig, "ligand_outcome", "my_grp_lig_r")
+
+print(paste0("Colour palette generated for my_grp: ", length(subcols_lig), " colours"))
+print(paste0("Colour palette generated for my_grp_r: ", length(subcolsR_lig), " colours"))
+
 ####################################################################
 #                        Data for logoplots
 ####################################################################

scripts/plotting/myshiny/app_layout_eg.R

@@ -1,106 +0,0 @@
-# 
-# 
-# Home
-# Public
-# 
-# Questions
-# Tags
-# Users
-# Find a Job
-# Jobs
-# Companies
-# 
-# Teams
-# Stack Overflow for Teams – Collaborate and share knowledge with a private group. 
-# 
-# How can put multiple plots side-by-side in shiny r?
-#     Asked 5 years, 5 months ago
-# Active 2 years, 1 month ago
-# Viewed 59k times
-# 28
-# 11
-# 
-# In mainpanel, I try to handle this problem via fluidrow. However, one of my plot is optional to be displayed or not by users. When user clicks the button, the second plot appears below the first plot.
-# 
-# fluidRow(
-#     column(2, align="right",
-#            plotOutput(outputId = "plotgraph1", width  = "500px",height = "400px"),  
-#            plotOutput(outputId = "plotgraph2", width  = "500px",height = "400px")
-#     ))
-# 
-# I played with "align" and "widths", but nothing changed.
-# r
-# plot
-# ggplot2
-# shiny
-# Share
-# Improve this question
-# Follow
-# edited Jan 21 '17 at 17:51
-# Mike Wise
-# 18.8k66 gold badges7171 silver badges9595 bronze badges
-# asked Dec 20 '15 at 19:25
-# can.u
-# 42511 gold badge44 silver badges1111 bronze badges
-# Add a comment
-# 3 Answers
-# 30
-# 
-# So it is a couple years later, and while the others answers - including mine - are still valid, it is not how I would recommend approaching it today. Today I would lay it out using the grid.arrange from the gridExtra package.
-# 
-# It allows any number of plots, and can lay them out in a grid checkerboard-like. (I was erroneously under the impression splitLayout only worked with two).
-# It has more customization possibilities (you can specify rows, columns, headers, footer, padding, etc.)
-# It is ultimately easier to use, even for two plots, since laying out in the UI is finicky - it can be difficult to predict what Bootstrap will do with your elements when the screen size changes.
-# Since this question gets a lot of traffic, I kind of think more alternative should be here.
-# 
-# The cowplot package is also worth looking into, it offers similar functionality, but I am not so familiar with it.
-# 
-# Here is a small shiny program demonstrating that:
-#     
-library(shiny)
-library(ggplot2)
-library(gridExtra)
-
-u <- shinyUI(fluidPage(
-    titlePanel("title panel"),
-    sidebarLayout(position = "left",
-                  sidebarPanel("sidebar panel",
-                               checkboxInput("donum1", "Make #1 plot", value = T),
-                               checkboxInput("donum2", "Make #2 plot", value = F),
-                               checkboxInput("donum3", "Make #3 plot", value = F),
-                               sliderInput("wt1","Weight 1",min=1,max=10,value=1),
-                               sliderInput("wt2","Weight 2",min=1,max=10,value=1),
-                               sliderInput("wt3","Weight 3",min=1,max=10,value=1)
-                  ),
-                  mainPanel("main panel",
-                            column(6,plotOutput(outputId="plotgraph", width="500px",height="400px"))
-                  ))))
-
-s <- shinyServer(function(input, output) 
-{
-    set.seed(123)
-    pt1 <- reactive({
-        if (!input$donum1) return(NULL)
-        qplot(rnorm(500),fill=I("red"),binwidth=0.2,main="plotgraph1")
-    })
-    pt2 <- reactive({
-        if (!input$donum2) return(NULL)
-        qplot(rnorm(500),fill=I("blue"),binwidth=0.2,main="plotgraph2")
-    })
-    pt3 <- reactive({
-        if (!input$donum3) return(NULL)
-        qplot(rnorm(500),fill=I("green"),binwidth=0.2,main="plotgraph3")
-    })
-    output$plotgraph = renderPlot({
-        ptlist <- list(pt1(),pt2(),pt3())
-        wtlist <- c(input$wt1,input$wt2,input$wt3)
-        # remove the null plots from ptlist and wtlist
-        to_delete <- !sapply(ptlist,is.null)
-        ptlist <- ptlist[to_delete] 
-        wtlist <- wtlist[to_delete]
-        if (length(ptlist)==0) return(NULL)
-        
-        grid.arrange(grobs=ptlist,widths=wtlist,ncol=length(ptlist))
-    })
-})
-shinyApp(u,s)

scripts/plotting/myshiny/bp_app.R

@@ -1,150 +0,0 @@
-## This is a Shiny web application. You can run the application by clicking
-# the 'Run App' button above.
-#
-# Find out more about building applications with Shiny here:
-#
-#    http://shiny.rstudio.com/
-##
-###################################
-# load libraries and function
-#source("Header_TT.R")
-library(shiny)
-library(ggplot2)
-library(data.table)
-library(dplyr)
-#require("getopt", quietly = TRUE) # cmd parse arguments
-
-# load functions
-source("../plotting_globals.R")
-source("../plotting_data.R")
-source("../functions/stability_count_bp.R")
-###################################
-# command line args : 
-
-
-# INSERT HERE
-
-# hardcoded vars
-infile = "/home/tanu/git/Data/streptomycin/output/gid_comb_stab_struc_params.csv"
-drug = "streptomycin"
-gene = "gid"
-
-###################################
-# call functions with relevant args
-#------------------------------------------
-# import_dirs()
-# should return the follwoing variables:
-# datadir
-# indir
-# outdir
-# plotdir
-# dr_muts_col
-# other_muts_col
-# resistance_col
-#--------------------------------------------
-import_dirs(drug, gene)
-#---------------------------------------------
-# plotting_data()
-# should return the following dfs:
-# my_df
-# my_df_u
-# my_df_u_lig
-# dup_muts
-#----------------------------------------------
-
-#if (!exists("infile") && exists("gene")){
-if (!is.character(infile) && exists("gene")){
-    #in_filename_params = paste0(tolower(gene), "_all_params.csv") 
-    in_filename_params = paste0(tolower(gene), "_comb_stab_struc_params.csv") # part combined for gid
-    infile = paste0(outdir, "/", in_filename_params)
-    cat("\nInput file not specified, assuming filename: ", infile, "\n")
-}
-
-# Get the DFs out of plotting_data()
-pd_df = plotting_data(infile)
-my_df       = pd_df[[1]]
-my_df_u     = pd_df[[2]]
-my_df_u_lig = pd_df[[3]]
-dup_muts    = pd_df[[4]]
-
-#########################################################
-cat(paste0("Directories imported:"
-           , "\ndatadir:", datadir
-           , "\nindir:", indir
-           , "\noutdir:", outdir
-           , "\nplotdir:", plotdir))
-
-cat(paste0("Variables imported:"
-           , "\ndrug:", drug
-           , "\ngene:", gene))
-#==========================================================
-#================
-# Data for plots
-#================
-# REASSIGNMENT as necessary
-#df  = my_df_u
-
-# sanity checks
-str(df)
-#===========================================================
-# Define UI for application that draws a histogram
-ui <- fluidPage(
-
-    # Application title
-    titlePanel("Mtb target: gid"),
-
-    # Sidebar with a slider input for number of bins 
-    sidebarLayout(
-        sidebarPanel(radioButtons("rb", "Biophysical effect"
-                         , choiceNames = list(
-                             "mCSM"
-                            , "FoldX"
-                            , "mCSM-lig")
-                         , choiceValues = list(
-                             "mCSM"
-                             , "FoldX"
-                             , "mCSM-lig")
-                         ))
-        # Show a plot of the generated distribution
-        , mainPanel(plotOutput("distPlot")
-                  , textOutput("txt"))))
-
-# Define server logic required to draw a histogram
-server <- function(input, output) {output$distPlot <- renderPlot({
-        axisType = input$rb
-        my_title = paste0("Barplots for biophyiscal effects ", axisType)
-        
-        if (axisType == "mCSM") {
-            data_plot = my_df_u
-            stability_colname = "duet_outcome"
-            leg_name = "DUET outcome"
-            p_title = ""}
-        
-        if (axisType == "FoldX") {
-            data_plot = my_df_u
-            stability_colname = "foldx_outcome"
-            leg_name = "FoldX outcome"
-            p_title = ""}
-        
-        if (axisType == "mCSM-lig") {
-            data_plot = my_df_u_lig
-            stability_colname = "ligand_outcome"
-            leg_name = "Ligand affinity outcome"
-            p_title = "Sites < 10 Ang of ligand"}
-    
-        # plot the  basic barplots
-        stability_count_bp(plotdf = data_plot
-                           , df_colname = stability_colname, 
-                           , leg_title = leg_name
-                           , bp_plot_title = p_title) 
-       
-    })
-    #output$txt <- renderText({
-    #    paste("You chose", input$rb)})
-    
-}
-
-stabiliyPlot <- function(input, output) {
-}
-# Run the application 
-shinyApp(ui = ui, server = server)

scripts/plotting/myshiny/subcols_bp.R

@@ -0,0 +1,125 @@
+#!/usr/bin/env Rscript
+
+library(shiny)
+library(shinyBS)
+
+getwd()
+setwd("~/git/LSHTM_analysis/scripts/plotting")
+getwd()
+source("Header_TT.R")
+
+drug = 'streptomycin'
+gene = 'gid'
+
+source("../functions/bp_subcolours.R")
+source("get_plotting_dfs.R")
+
+cat(paste0("Variables imported:"
+           , "\ndrug:", drug
+           , "\ngene:", gene))
+
+# sanity checks
+str(df)
+#===========================================================
+# Define UI for application that draws a histogram
+wide_ui <- 
+  fillPage(
+  #fluidPage(
+  #titlePanel("Mtb target: gid"),
+  # sidebarLayout(
+  #  sidebarPanel(),
+    bsTooltip("wide graph", "Really wide graph","right", options = list(container = "body")),
+    
+    mainPanel(
+      plotOutput("widePlot", click = "plot_click", width = "100%"),
+#      uiOutput("uiExample")
+    verbatimTextOutput("info_pos"),
+    tableOutput("info")
+
+      )
+  #  )
+  )
+
+# Define server logic required to draw a histogram
+wide_plot_server <- function(input, output, session) {
+  
+  output$widePlot <- renderPlot({
+
+    # axis label size
+    my_xaxls = 12
+    my_yaxls = 20
+    
+    # axes text size
+    my_xaxts = 18
+    my_yaxts = 20
+    
+    #title_ps = "Protein stability (DUET)"
+    
+    g = ggplot(subcols_df_ps, aes(x = factor(position, ordered = T)))
+    g + geom_bar(aes(fill = group), colour = "grey") +
+      scale_fill_manual( values = subcols_ps
+                         , guide = "none") +
+      theme( axis.text.x = element_text(size = my_xaxls
+                                        , angle = 90
+                                        , hjust = 1
+                                        , vjust = 0.4)
+             , axis.text.y = element_text(size = my_yaxls 
+                                          , angle = 0
+                                          , hjust = 1
+                                          , vjust = 0)
+             , axis.title.x = element_text(size = my_xaxts)
+             , axis.title.y = element_text(size = my_yaxts ) ) +
+      labs(title = ""
+           #title = title_ps
+           , x = "Position"
+           , y = "Frequency")
+}, width = "auto")
+  
+#output$info_pos <- renderText({paste("Clicked Position", "\nx=", input$plot_click$x, "\ny=", input$plot_click$y)})
+
+#   
+# output$info_pos <- renderText({paste("Clicked Position",
+#                                      "\nx=",
+#                                      #round(as.numeric(input$plot_click$x, digits = 0)),
+#                                      ceiling(as.numeric(input$plot_click$x)),
+#                                      "\ny=",
+#                                      #round(as.numeric(input$plot_click$y, digits = 0))
+#                                      ceiling(as.numeric(input$plot_click$y))
+#                                      )})
+
+# output$info <-renderTable({
+#     nearPoints(
+#       subcols_df_ps,
+#       input$plot_click,
+#       xvar = "position",
+#       yvar = "pos_count")
+#   })
+ 
+ #output$info <- renderTable(xtable::xtable(subcols_df_ps[]))
+
+#############################################################
+# upos <- unique(subcols_df_ps$position)
+# upos <- upos[order(upos)]
+# x <- ceiling(as.numeric(input$plot_click$x))
+# x_mod = upos[x]   
+
+output$info_pos <- renderText({paste("Clicked Position",
+                                     "\nx=",
+                                     ceiling(as.numeric(input$plot_click$x)),
+                                     "\ny=",
+                                     ceiling(as.numeric(input$plot_click$y))
+)})
+
+  ##magic happens here##
+  output$info <- renderTable({
+    upos <- unique(subcols_df_ps$position)
+    upos <- upos[order(upos)]
+    x_pos <- upos[ceiling(as.numeric(input$plot_click$x))]
+    subcols_df_ps[subcols_df_ps$position == x_pos,]
+  })
+  
+############################################################
+}
+
+# Run the application 
+shinyApp(ui = wide_ui, server = wide_plot_server)