added the almost done shiny for barplots subcolours
This commit is contained in:
parent
374764b136
commit
ed2fc016ca
6 changed files with 267 additions and 263 deletions
|
|
@ -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)
|
||||
|
|
@ -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)
|
||||
125
scripts/plotting/myshiny/subcols_bp.R
Normal file
125
scripts/plotting/myshiny/subcols_bp.R
Normal file
|
|
@ -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)
|
||||
Loading…
Add table
Add a link
Reference in a new issue