#' Isoform switch analysis and visualization with Shiny App
#'
#' @param data.size.max maximum size limit for unload files in Shiny. Default is 100 (MB).
#'
#' @return the Shiny App.
#'
#' @examples TSIS.app()
#'
#' @seealso \code{\link{shiny}}
#'
#' @export
TSIS.app <- function(data.size.max=100) {
# require(tools)
require(shiny)
# require(shinyFiles)
library(shinythemes)
library(plotly)
library(TSIS)
# library(TSIS)
message('Generating tutorial...')
message(paste0('Tutorial is saved in ',getwd(),'/tutorial'))
message('Starting Shiny App...')
##download tutorial
if(!file.exists('tutorial'))
dir.create('tutorial')
if(file.exists('tutorial/tutorial-shiny.html'))
file.remove('tutorial/tutorial-shiny.html')
download.file('https://github.com/wyguo/TSIS/raw/master/vignettes/tutorial-shiny.zip',
destfile = 'tutorial/tutorial-shiny.zip',quiet = T)
unzip('tutorial/tutorial-shiny.zip',exdir = 'tutorial')
invisible(file.remove('tutorial/tutorial-shiny.zip'))
##shiny app
shinyApp(options = list(launch.browser=T),
ui = navbarPage("Time-series isoform switch",
tags$head(includeScript(system.file("google-analytics.js", package = "TSIS"))),
# tags$head(tags$script(src="google-analytics.js")),
##Page 1
tabPanel("Manual",
htmlOutput("tutorial")
),
##Page 2
tabPanel("Isoform switch analysis",
fluidPage(
fluidRow(
##input gene expression data part
column(3,
titlePanel('Input data files'),
wellPanel(
##input isoform expression data
h4('Isoform expression data:'),
fileInput('filedata','Select the expression data file',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)),
p('The expression input is a data table with columns of samples and rows of isoforms.'),
br(),
##isoforms mapping data
h4('Isoforms mapping data:'),
fileInput('filetarget','Select the mapping data file',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)),
p('The mapping input is a data table with first column of genes and second column of isoforms.')
),
wellPanel(
##input subset of isoforms for investigation
h4('Subset of isoforms for investigation:'),
fileInput('file.subtarget','Select the subset of isoforms data file',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)),
HTML('Only the results of provided subset of isoforms and their isoform partners will be shown in the results.')
),
titlePanel('Density/Frequency of switch'),
wellPanel(
plotlyOutput('density',height = "300px"),
HTML('<b>Figure:</b> Density/Frequency plot of switch time points. The plot is made based
on the occurring time points of isoform switches after scoring and filtering.'),
fluidRow(
column(6,
radioButtons("densityplot.type", label = h5("Select plot type:"),
choices = list("Frequency" = 'frequency',"Density" = 'density'),
selected = 'frequency',inline = F)
),
column(6,
radioButtons("show.density.line", label = h5("Density/frequency line:"),
choices = list("FALSE" = 'FALSE',"TRUE" = 'TRUE'),
selected = 'FALSE',inline = F)
)
),
fluidRow(
column(6,
radioButtons("densityplot.format", label = h5("Select format to save:"),
choices = list("html" = 'html', "png" = "png", "pdf" = 'pdf'),
selected = 'html',inline = T)
),
column(6,
br(),
br(),
downloadButton('download.densityplot', 'Save',class="btn btn-primary")
)
)
)
),
##input taret part
column(9,
titlePanel('Parameter settings'),
wellPanel(
fluidRow(
h4('Scoring parameters'),
# column(3,
# numericInput('t.start',label='Start time:',value=1)
# ),
# column(3,
# numericInput('t.end',label='End time:',value=26)
# ),
# column(3,
# numericInput('nrep',label='Replicates:',value=9)
# ),
column(3,
selectInput('method.intersection','Search intersections',c('Mean','Spline'))
),
column(3,
numericInput('spline.df',label='Spline degree:',value=18)
)
),
actionButton('scoring','Scoring',icon("send outline icon"),class="btn btn-primary"),
br(),
br(),
HTML('Press Scoring button to implement the scoring of isoform switches. The details of parameters:
<ul><li><b>Method for intersections:</b> Using either mean values or natural spline fitted smooth curves (see detail in ns() function in splines R package) of time-series expression
to determine the intersection points of isoforms.</li>
<li><b>Degree of spline:</b> The degree of spline in splines::ns() function.</li>
</ul>')
),
wellPanel(
fluidRow(
h4('Filtering parameters'),
column(3,
numericInput('prob.cutoff',label='Probability cutoff:',value=0.5)
),
column(3,
numericInput('diff.cutoff',label='Difference cutoff:',value=1)
),
column(3,
numericInput('pval.cutoff',label='p-value cutoff:',value=0.001)
),
column(3,
numericInput('t.points.cutoff',label='Min time in interval:',value=2)
),
column(3,
numericInput('cor.cutoff',label='Correlation cutoff:',value=0)
),
column(3,
numericInput('x.lower.boundary',label='Lower time:',value=1)
),
column(3,
numericInput('x.upper.boundary',label='Upper time:',value=26)
),
column(3,
selectInput('sub.isoforms.ft','Subset of isoforms:',c('FALSE','TRUE'))
),
column(3,
selectInput('max.ratio','Most abundant isoforms only',c('FALSE','TRUE'))
)
),
br(),
actionButton('filtering','Filtering',icon("send outline icon"),class="btn btn-primary"),
br(),
br(),
HTML('Press Filtering button to filter the scores. The details of parameters:
<ul><li><b>Probability cutoff:</b> The isoform switch probability/frequency cut-off for the column "prob" in the output table. </li>
<li><b>Difference cutoff:</b> The isoform switch difference cut-off for the column "diff" in the output table. </li>
<li><b>P-value cutoff:</b> The p-value cut-off of both columns "before.pval" and "after.pval" in the output table. </li>
<li><b>Min time in interval:</b> The minimum time points for both columns "before.t.points" and "after.t.points" in the output table.</li>
<li><b>Correlation cutoff:</b> The cut-off for Pearson correlation of isoform pairs.</li>
<li><b>Lower boundary of time, Upper boundary of time:</b> Specifies the time frame of interest to investigate the isoform switch. </li>
<li><b>Subset of isoforms:</b> Logical, output subset of the results only according to the subset isoform list in the input if selected. </li>
<li><b>Most abundant isoforms only:</b> Logical, only output the results of most abundant isoforms if selected. </li>
</ul>')
),
titlePanel('Output results of isoform switch'),
wellPanel(
HTML('The following table shows the feature scores of isoform switches. The columns in the output table:
<ul><li><b>iso1, iso2:</b> the isoform pairs. </li>
<li><b>iso1.mean.ratio, iso2.mean.ratio:</b> The mean ratios of isoforms to their gene. </li>
<li><b>before.interval, after.interval:</b> The intervals before and after switch points. </li>
<li><b>x.value, y.value:</b> The values of x axis (time) and y axis (expression) coordinates of the switch points.</li>
<li><b>prob:</b> The probability/frequency of switch.</li>
<li><b>diff:</b> The sum of average sample differences before and after switch.</li>
<li><b>before.pval, after.pval:</b> The paired t-test p-values of the samples in the intervals before and after switch points.</li>
<li><b>before.t.points, after.t.points:</b> The number of time points in intervals before and after the switch points.</li>
<li><b>cor:</b> The Pearson correlation of iso1 and iso2.</li>
</ul>')
)
)
),
fluidRow(
column(12,
wellPanel(
HTML('<b>Table:</b> The TSIS analysis results'),
br(),
shiny::dataTableOutput('score.table')
))
),
fluidRow(
column(10,
div(align='right',downloadButton('download.scores', 'Download score table',class="btn btn-primary"))
),
column(2,
div(align='right',downloadButton('download.genes', 'Download gene names',class="btn btn-primary"))
)
)
)
),
##Page 3
tabPanel("Visualization",
fluidRow(
titlePanel('Switch plots'),
column(2,
wellPanel(
p(h4('Input isoform names:')),
textInput('iso1', label = 'Isoform 1: ', value = ''),
textInput('iso2', label = 'Isoform 2: ', value = ''),
numericInput('prob.cutoff.switch.points',label = 'Show switch poitns with prob >:',value = 0.5),
selectInput('ribbon.plot','Plot types',c('Error bar','Ribbon')),
radioButtons("show.scores", label = h4("Show feature labels:"),
choices = list("TRUE" = 'TRUE', "FALSE" = "FALSE"),
selected = 'TRUE',inline = T),
radioButtons("show.color.region", label = h4("Show region:"),
choices = list("TRUE" = 'TRUE', "FALSE" = "FALSE"),
selected = 'TRUE',inline = T),
actionButton('plot1iso','Plot',icon("send outline icon"),class="btn btn-primary"),
br(),
br(),
# p(h4('Select format to save:')),
# selectInput('plot1.format','',c('html','png','pdf')),
radioButtons("plot1.format", label = h4("Select format to save:"),
choices = list("html" = 'html', "png" = "png", "pdf" = 'pdf'),
selected = 'html',inline = T),
downloadButton('download.1plot', 'Save',class="btn btn-primary")
)
),
column(10,
wellPanel(
plotlyOutput('plot.isoform',width = 'auto',height = '550px')
)
)
),
fluidRow(
titlePanel('Isoform switch plots in batch'),
column(2,
wellPanel(
p(h4('Isoforms pairs to plot:')),
numericInput('topn','Top n isofomrs:',value = 10),
# selectInput('plotmulti.format','Select format to save:',c('png','pdf'))
radioButtons("plotmulti.format", label = h4("Select format to save:"),
choices = list("png" = "png", "pdf" = 'pdf'),
selected = 'png',inline = T)
)),
column(5,
wellPanel(
textInput('folder2save', label = 'Folder to save: ', value = 'figure',width='400px'),
HTML('Note: typing a folder name to save the multiple plots. If the folder does not exist in the working directory, a
new folder is created with the name.'),
br(),
br(),
actionButton('plotmultiiso','Plot',icon("send outline icon"),buttonType ='button',class="btn btn-primary"),
h5(textOutput("directorypath", container = span))
))),
fluidRow(
column(12,
wellPanel(
h4('Isoform pairs to plot'),
shiny::dataTableOutput('isoform.pairs.to.plot'),
textOutput('isoform.pairs.to.plot.loops')
)
)
)
)
),
##server function
server = function(input, output,session) {
output$tutorial<-renderUI({
withMathJax(includeHTML("tutorial/tutorial-shiny.html"))
})
options(shiny.maxRequestSize = data.size.max*1024^2)
data.exp0<-reactive({
infile.data<-input$filedata
if (is.null(infile.data))
return(NULL)
data.exp0<-read.csv(file=infile.data$datapath,header=F)
return(data.exp0)
# values<-data.exp[-c(1:2),-1]
# values<-data.frame(apply(values,2,as.numeric))
# rownames(values)<-as.character(data.exp[-c(1:2),1])
# colnames(values)<-paste0(as.character(t(data.exp[1,-1])),'_',as.character((t(data.exp[2,-1]))))
# data.exp<-values
# data.exp<-na.omit(data.exp)
})
times<-reactive({
if (is.null(data.exp0))
return(NULL)
times<-as.numeric(as.vector(t(data.exp0()[2,-1])))
return(times)
})
data.exp<-reactive({
if (is.null(data.exp0))
return(NULL)
data.exp<-data.exp0()
values<-data.exp[-c(1:2),-1]
values<-data.frame(apply(values,2,as.numeric))
rownames(values)<-as.character(data.exp[-c(1:2),1])
colnames(values)<-paste0(as.character(t(data.exp[1,-1])),'_',as.character((t(data.exp[2,-1]))))
data.exp<-values
data.exp<-na.omit(data.exp)
return(data.exp)
})
mapping<-reactive({
infile.target<-input$filetarget
if (is.null(infile.target))
return(NULL)
mapping<-read.csv(file=infile.target$datapath,header=T)
mapping<-na.omit(mapping)
})
sub.isoform.list<-reactive({
infile.subtarget<-input$file.subtarget
if(input$sub.isoforms.ft=='TRUE' & !is.null(infile.subtarget))
sub.isoform.list<-as.vector(t(read.csv(file=infile.subtarget$datapath,header=T))) else sub.isoform.list<-NULL
})
scores<-eventReactive(input$scoring,{
if (is.null(data.exp()) | is.null(mapping()))
return()
##parameter for itch()
# t.start<-input$t.start
# t.end<-input$t.end
# nrep<-input$nrep
min.t.points<-input$t.points.cutoff
min.difference<-input$diff.cutoff
##parameters for
scores<-iso.switch.shiny(data.exp=data.exp(),mapping=mapping(),times = times(),
min.t.points = min.t.points,min.difference = min.difference,rank = F,
spline = input$method.intersection=='Spline',spline.df = input$spline.df)
})
scores.filtered<-eventReactive(input$filtering,{
if (is.null(data.exp()) | is.null(mapping()))
return()
t.points.cutoff<-input$t.points.cutoff
prob.cutoff<-input$prob.cutoff
diff.cutoff<-input$diff.cutoff
pval.cutoff<-input$pval.cutoff
cor.cutoff<-input$cor.cutoff
x.value.limit<-c(input$x.lower.boundary,input$x.upper.boundary)
#
scores.filtered<-score.filter(scores = scores(),t.points.cutoff=t.points.cutoff,prob.cutoff=prob.cutoff,diff.cutoff=diff.cutoff,
pval.cutoff=pval.cutoff,cor.cutoff = cor.cutoff,x.value.limit=x.value.limit,sub.isoform.list=sub.isoform.list(),
sub.isoform=(input$sub.isoforms.ft=='TRUE'),max.ratio=(input$max.ratio=='TRUE'),
data.exp=data.exp(),mapping=mapping()
)
})
score.show<-reactiveValues(scores=NULL)
observeEvent(input$scoring, {
if (is.null(data.exp()) | is.null(mapping()))
return()
x<- scores()
if(nrow(x)>1)
x[,-c(1,2,5,6)]<-apply(x[,-c(1,2,5,6)],2,function(x) as.numeric(format(x,digits = 3)))
rownames(x)<-NULL
score.show$scores<-x[,c('iso1','iso2','iso1.mean.ratio','iso2.mean.ratio',
'before.interval','after.interval','x.value','y.value','prob','diff','before.pval','after.pval','before.t.points','after.t.points','cor')]
})
observeEvent(input$filtering, {
if (is.null(data.exp()) | is.null(mapping()))
return()
x<- scores.filtered()
if(nrow(x)>1)
x[,-c(1,2,5,6)]<-apply(x[,-c(1,2,5,6)],2,function(x) as.numeric(format(x,digits = 3)))
rownames(x)<-NULL
score.show$scores<-x[,c('iso1','iso2','iso1.mean.ratio','iso2.mean.ratio',
'before.interval','after.interval','x.value','y.value','prob','diff','before.pval','after.pval','before.t.points','after.t.points','cor')]
})
output$score.table <- shiny::renderDataTable(options=list(pageLength=20,
aoColumnDefs = list(list(sClass="alignLeft",aTargets="_all")),
scrollX=TRUE,scrollY="500px"),{
if(is.null(score.show$scores))
return()
score.show$scores
})
##save scores to csv files
##save p-value table
output$download.scores <- downloadHandler(
filename=function(){
'scores.csv'
},
content=function(file){
write.csv(score.show$scores,file,row.names = F)
}
)
output$download.genes <- downloadHandler(
filename=function(){
'genes.csv'
},
content=function(file){
write.csv(data.frame(genes=unique(mapping()[which(as.vector(mapping()[,2]) %in% unique(c(as.vector(score.show$scores$iso1),as.vector(score.show$scores$iso2)))),1])),
file,row.names = F)
}
)
##plot the density
# height = 400, width = 600
output$density <- renderPlotly({
if(is.null(score.show$scores))
return()
switch.density(x=score.show$scores$x.value,time.points = unique(times()),plot.type = input$densityplot.type,make.plotly = T,
show.line = input$show.density.line,title = '',autosize = F,width=250,height=250)
})
output$download.densityplot <- downloadHandler(
filename = function() {
paste0('Density plot.',input$densityplot.format)
},
content = function(file,format=input$densityplot.format) {
if(format=='html')
suppressWarnings(htmlwidgets::saveWidget(
switch.density(x=score.show$scores$x.value,time.points = unique(times()),plot.type = input$densityplot.type,make.plotly = T,
show.line = input$show.density.line,title = ''), file=file,selfcontained=T))
else ggsave(file,
switch.density(x=score.show$scores$x.value,time.points = unique(times()),plot.type = input$densityplot.type,make.plotly = F,
show.line = input$show.density.line,title = ''),
width = 16,height = 12,units = "cm")
})
#########
g<-eventReactive(input$plot1iso,{
if(is.null(input$iso1) | is.null(input$iso2) | is.null(data.exp()))
return()
iso1<-trimws(input$iso1)
iso2<-trimws(input$iso2)
g<-plotTSIS(data2plot = data.exp()[c(iso1,iso2),],
iso1 = iso1,
show.region = input$show.color.region,
iso2 = iso2,
scores = scores.filtered(),
show.scores = input$show.scores,times = times(),
x.lower.boundary=input$x.lower.boundary,
x.upper.boundary=input$x.upper.boundary,
prob.cutoff=input$prob.cutoff.switch.points,
y.lab = 'Expression',spline=(input$method.intersection=='Spline'),spline.df = input$spline.df,ribbon.plot = (input$ribbon.plot=='Ribbon')
)
})
output$plot.isoform<-renderPlotly({
if(is.null(g()))
return()
ggplotly(g(),autosize = F,width=1000,height=500)
})
#
output$download.1plot <- downloadHandler(
filename = function() {
paste0(input$iso1,' vs ',input$iso2,'.',input$plot1.format)
},
content = function(file,format=input$plot1.format) {
if(format=='html')
suppressWarnings(htmlwidgets::saveWidget(ggplotly(g(),autosize = F,width=1000,height=500),
file=file,selfcontained=T))
else ggsave(file, g(),width = 25,height = 12,units = "cm")
})
topn<-eventReactive(input$plotmultiiso,{
topn<-input$topn
})
plotmulti.format<-eventReactive(input$plotmultiiso,{
plotmulti.format<-input$plotmulti.format
})
folderInput <- eventReactive(input$plotmultiiso,{
x<-paste0(getwd(),'/',trimws(input$folder2save))
if(!file.exists(x))
dir.create(x)
x
})
output$directorypath = renderText({
paste0('Plots are saved in: "', folderInput(),'"')
})
data2plot<-eventReactive(input$plotmultiiso,{
if(is.null(scores.filtered()))
return()
topn<-topn()
topn<-min(topn,nrow(scores.filtered()))
data2plot<-score.show$scores[1:topn,]
})
output$isoform.pairs.to.plot <- shiny::renderDataTable(options=list(pageLength=10,
aoColumnDefs = list(list(sClass="alignLeft",aTargets="_all")),
scrollX=TRUE,scrollY="400px"),{
if(is.null(score.show$scores))
return()
score.show$scores[1:input$topn,]
})
output$isoform.pairs.to.plot.loops<-renderText({
if(is.null(data2plot()))
return()
start.time <- Sys.time()
x<-data2plot()
iso1s<-as.character(x[,1])
iso2s<-as.character(x[,2])
# c(iso1s,iso2s)
withProgress(message = 'Making plots...',value=0,{
for(i in 1:length(iso1s)){
gs<-plotTSIS(data2plot = data.exp()[c(iso1s[i],iso2s[i]),],line.width= 1,
iso1 = NULL,
iso2 = NULL,
scores = data2plot(),times=times(),
x.lower.boundary=input$x.lower.boundary,
x.upper.boundary=input$x.upper.boundary,
prob.cutoff=input$prob.cutoff.switch.points,
y.lab = 'Expression',spline=(input$method.intersection=='Spline'),spline.df = input$spline.df,ribbon.plot = (input$ribbon.plot=='Ribbon')
)
plot.name<-paste0(folderInput(),'/',iso1s[i],' vs ',iso2s[i],'.',plotmulti.format())
ggsave(plot.name,gs,width = 25,height = 12,units = "cm")
# unlink(plot.name)
incProgress(1/length(iso1s), detail = paste(i, ' of ', length(iso1s)))
Sys.sleep(0)
}
})
end.time <- Sys.time()
time.taken <- end.time - start.time
paste0('Done. Time for ploting: ',format(time.taken,digits=4,unit='auto'))
})
#
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.