125 lines
3.8 KiB
R
125 lines
3.8 KiB
R
#!/usr/bin/env Rscript
|
|
|
|
library(shiny)
|
|
library(shinyBS)
|
|
|
|
getwd()
|
|
setwd("~/git/LSHTM_analysis/scripts/plotting")
|
|
getwd()
|
|
source("~/git/LSHTM_analysis/scripts/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)
|