added the almost done shiny for barplots subcolours

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)