Nothing
#' Trendy shiny app to interactively vizualize results after running trendy().
#'
#'
#' @return Opens a browser window with an interactive \code{shiny}
#' app and visualize all precomputed Trendy fits.
#'
#' @name trendyShiny
#' @import shiny
#' @import utils
#' @import shinyFiles
#' @importFrom magrittr %>%
#' @export
# tVectIn <- NULL
# origData <- NULL
# trendyOut <- NULL
globalVariables(c("tVectIn", "origData", "trendyOut"))
trendyShiny <- function() {
options(shiny.maxRequestSize = 10000*1024^2)
ui <- fluidPage(
# Application title
headerPanel("Trendy Visualization"),
fluidRow(
column(width = 7,
tags$div(tags$h4("This shiny app is designed to explore the
output from Trendy. First the .RData object
output from Trendy must be uploaded.")),
tags$br(),
tags$br(),
fileInput("filename", label = "Input .Rdata from
trendy() run:"),
actionButton("Submit1","Upload File")
)
),
# Sidebar with sliders that demonstrate various available options
conditionalPanel(condition = "input.Submit1 > 0",
fluidRow(
column(width = 7,
tags$br(),
tags$br(),
tags$div(tags$h4("To visualize gene trends one by one,
use the 'Visualize genes' tab."),
tags$h4("To obtain a list of genes according to a specific
pattern use the 'Obtain gene patterns' tab.")),
tags$br()
)
),
fluidRow(
column(12,
tabsetPanel(
tabPanel("Visualize genes",
tags$br(),
column(6, align='left',
tags$div(tags$h4("Select a row in the table to update the
trend visualization."))
),
column(4, align='right',
downloadButton('downloadPlot', 'Download Plot')
),
column(10, align="center",
mainPanel(plotOutput('genePlot'), width = "100%"),
tags$br(),
DT::dataTableOutput("tab"),
tags$br(),
tags$br()
)
),
tabPanel("Obtain gene patterns",
tags$br(),
column(5,
tags$div(tags$b("Please select a folder for output :")),
shinyDirButton('Outdir', label ='Select Output Folder',
title = 'Please select a folder'),
tags$br(),
tags$br(),
textInput("pattern", "Enter pattern (separate by
comma, no spaces):", "up,down"),
textInput("rcut", "Only consider genes with an
adjusted R squared greater than: ", ".5",
placeholder="Must be between 0 and 1."),
textInput("delay", "Only consider genes with the pattern
occurring after time-point: ", "0"),
radioButtons("scatterplots",
label = "Output a plot of patterned genes?",
choices = list("Yes" = 1,"No" = 2),
selected = 1),
textInput("OutFileName",
label = "Name of output files (default will
be the specified pattern)", value = ""),
tags$br(),
tags$br(),
actionButton("Submit","Submit for processing"),
tags$br(),
tags$br()),
column(6, textOutput("text1"),
tags$head(tags$style("#text1{color: red;font-size:
26px;font-style: bold;}")))
)
)
)
)),
fluidRow(mainPanel(""))
)
server <- function(input, output, session) {
raVar <- reactiveValues(genes.pass=NULL, outdir=NULL, plotVals=1)
volumes <- c('home'="~")
shinyDirChoose(input, 'Outdir', roots=volumes, session=session,
restrictions=system.file(package='base'))
output$Dir <- renderPrint({parseDirPath(volumes, input$Outdir)})
In <- eventReactive(input$Submit1, {
load(input$filename$datapath)
allTrendy <- Trendy::topTrendy(trendyOut, -1)
ToPrint <- Trendy::formatResults(allTrendy)
LIST = list(trendyOut, origData, tVectIn, ToPrint, allTrendy)
names(LIST) <- c("trendyOut", "origData", "tVectIn",
"ToPrint", "TopTrendy")
return(LIST)
})
observeEvent(input$Submit, {
withProgress(message = 'Finding gene patterns:', value = 0, {
IN <- In()
outdir <- paste0("~", do.call("file.path", input$Outdir[[1]]), "/")
pattern <- strsplit(input$pattern, ",")[[1]]
delay <- as.numeric(input$delay)
rcut <- as.numeric(input$rcut)
incProgress(0.4, detail = "Extracting genes")
genes.pass <- Trendy::extractPattern(IN$trendyOut,
Pattern = pattern, adjR2Cut = rcut, Delay = delay)
if (input$OutFileName == "") {
outfilename = paste0("Pattern_", input$pattern)
} else {outfilename <- input$OutFileName}
outfileP = paste0(outdir, outfilename, "_Scatter.pdf")
outfileSS = paste0(outdir, outfilename, "_ShortSummary.csv")
outfileLS = paste0(outdir, outfilename, "_FullSummary.csv")
write.table(genes.pass, file = outfileSS, quote = FALSE,
row.names = FALSE, sep = ",")
toFormat <- genes.pass$Gene
fullSummary <- IN$ToPrint[toFormat,]
write.table(fullSummary, file = outfileLS, quote=FALSE,
row.names=FALSE, sep=",")
incProgress(0.4, detail = "Writing genes to output folder")
if (input$scatterplots == "1") {
incProgress( 0, detail = "Making scatter plots of
patterned genes")
pdf(outfileP, height=15, width=10)
par(mar=c(5,5,2,1), mfrow=c(3,2))
XX <- Trendy::plotFeature(Data = IN$origData,
tVectIn = IN$tVectIn,
featureNames = genes.pass$Gene, showFit = TRUE,
trendyOutData = IN$trendyOut)
dev.off()
}
incProgress(.2, detail = "Done!")
raVar$outdir = outdir
raVar$genes.pass = genes.pass
})
})
output$text1 <- renderText({
if (is.null(raVar$genes.pass)) return()
numG <- length(raVar$genes.pass$Gene)
MM <- paste(numG, "genes/features with pattern", input$pattern,
"have been output to", raVar$outdir )
return(MM)
})
observeEvent(input$tab_rows_selected, {
raVar$plotVals <- input$tab_rows_selected
})
plotInput <- reactive({
IN <- In()
topg <- as.character(IN$ToPrint[raVar$plotVals, 1])
par(mfrow=c(1,1), cex=1.5, cex.lab=1, cex.axis=1, cex.main=1.1,
mar=c(5,5,2,2), oma=c(0,.1,.1,6))
plot(IN$tVectIn, IN$origData[topg,], pch=20, col="#696969",
main=paste0(topg), ylab="Normalized Expr.", xlab="Time",
cex.axis=1.2, cex.lab=1.2)
if (topg %in% names(IN$trendyOut)) {
plotFeature(Data = IN$origData, tVectIn = IN$tVectIn,
featureNames=topg, simple=FALSE, showLegend=TRUE,
showFit=TRUE, trendyOutData = IN$trendyOut,
xlab = "Time", ylab="Normalized Expr.")
}
})
output$genePlot <- renderPlot({
plotInput()
}, height=400, width=800)
output$downloadPlot <- downloadHandler(
filename = function() {
IN <- In()
topg <- as.character(IN$ToPrint[raVar$plotVals, 1])
paste0("trendPlot_", topg, ".pdf")
},
content = function(file) {
pdf(file, height=5, width=10)
IN <- In()
topg <- as.character(IN$ToPrint[raVar$plotVals, 1])
par(mfrow=c(1,1), cex=1.5, cex.lab=1, cex.axis=1, cex.main=1.1,
mar=c(5,5,2,2), oma=c(0,.1,.1,6))
plotFeature(Data = IN$origData, tVectIn = IN$tVectIn, featureNames=topg,
showFit=TRUE, trendyOutData = IN$trendyOut, xlab = "Time", ylab="Normalized Expr.")
dev.off()
}
)
# Show the values using an HTML table
output$tab <- DT::renderDataTable({
IN <- In()
toprint <- IN$ToPrint
toprint[,-1] <- round(toprint[,-1], 3)
numSeg <-colnames(toprint)[grepl("^Segment.*Trend",colnames(toprint))]
numCols <- ncol(toprint)
mkSmallTable <- c("Feature", "AdjustedR2", numSeg,
colnames(toprint)[grepl("Breakpoint", colnames(toprint))])
toprint <- toprint[,mkSmallTable]
COLS <- gsub(".", " ", colnames(toprint), fixed=TRUE)
DT::datatable(toprint, rownames = FALSE, colnames = COLS,
selection = 'single',
options = list(
autoWidth = TRUE, scrollX=TRUE,
columnDefs = list(list(className='dt-center',targets = '_all'))
)) %>% DT::formatStyle(
columns = numSeg,
valueColumns = numSeg,
color = DT::styleEqual(c(-1, 0, 1), c('white', 'white',
'white')),
backgroundColor = DT::styleEqual(c(-1, 0, 1),
c('cornflowerblue', 'black', 'tomato')),
borderRightWidth = '5px', borderStyle = 'solid'
)
})
}
runApp(shinyApp(ui = ui, server = server))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.