######################## Libraries -----------------------------
library(shiny)
library(shinythemes)
library(shinydashboard)
#>
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#>
#> box
library(shinycssloaders)
library(shinyWidgets)
library(shinyBS)
library(shinyjs)
#>
#> Attaching package: 'shinyjs'
#> The following object is masked from 'package:shinyWidgets':
#>
#> alert
#> The following object is masked from 'package:shiny':
#>
#> runExample
#> The following objects are masked from 'package:methods':
#>
#> removeClass, show
library(DT)
#>
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#>
#> dataTableOutput, renderDataTable
library(tidyverse)
library(lubridate)
#>
#> Attaching package: 'lubridate'
#> The following objects are masked from 'package:dplyr':
#>
#> intersect, setdiff, union
#> The following objects are masked from 'package:base':
#>
#> date, intersect, setdiff, union
library(xts)
#> Loading required package: zoo
#>
#> Attaching package: 'zoo'
#> The following objects are masked from 'package:base':
#>
#> as.Date, as.Date.numeric
#>
#> Attaching package: 'xts'
#> The following objects are masked from 'package:dplyr':
#>
#> first, last
library(audio)
library(flowCore)
#>
#> Attaching package: 'flowCore'
#> The following object is masked from 'package:tibble':
#>
#> view
##### DEFINE UI -------
######################## Header -----------------------------
dbHeader <- dashboardHeader(title = "cytoChain")
######################## Sidebar -----------------------------
dbSidebar <- dashboardSidebar(
sidebarMenu(
menuItem("FlowSet optimization Workflow", tabName = "preClustering", icon = icon("vials"))))
######################## Purpose TabPanel -----------------------------
tabPurpose <- tabPanel("Loading & parsing samples", icon = icon("home", lib = "glyphicon"),
column(width=12,
valueBoxOutput(outputId = "entryEvents", width = 3)),br(),br(),
column(width=12,
p("This is a", strong("workflow"), "to prepare and to analyse your high dimensional flow cytometry data")),
# em is masked by nclust package, that's why I have to specify shiny::em
h3(textOutput("checktxt")),
h3("your selected items are the following:"),
h3("Load your samples"),
fileInput(inputId = "fSinput", label = h4("File input"), multiple = T,
buttonLabel = "FCS files", placeholder = "upload your flowFrames"),
p("The samples must be valid FCS files of version 3.0"),
tags$hr(style="border-color: green;"),
h3("Perform loading & parsing process"),
actionButton("runLoad", "Load and parse your samples", icon("paper-plane"),
style="color: #fff; background-color: #ff0000; border-color: #2e6da4"),
h3(textOutput("checktxt_parsing_fS")),
conditionalPanel(
condition = ("output.load_panelStatus"),
tags$audio(src = "shipsbell.wav", type = "audio/wav", autoplay = NA),
actionButton('runLoadShow', "Showing samples' details"),
h3(textOutput("checktxt_loading_fS")), br(),
conditionalPanel(
condition = ("input.runLoadShow !== 0"),
h4("The following is a table with all the samples each one with its amount of event - Notice than the sample name is
a temporary id assigned by this web app environement"),
DTOutput(outputId = "samples")%>% withSpinner(), br())
)#conditional panel input.runLoad
) # tabPanel "Loading & parsing samples"
######################### sidebar panel flowSet optimization-----------------------------------------------------
sidebar_panel_pre <- sidebarPanel(width = 3,br(),
tags$head(
tags$style(HTML("hr {border-top: 1px solid #008000;}"))
),
h4("console messages"),
verbatimTextOutput("console_output_pre", placeholder = T),
bsPopover(id = "console_output_pre",
title = paste0('This collects the report from the various processes executed along the several steps ',
'of the selected workflow. Before to move along with the next procedure, please wait ',
'until you get some feedback from the previous commands (namely, wait before pushing ',
'the next button!)')),
tags$hr(style="border-color: green;"),
# Input: Select the cleaning parameters ---
numericInput(inputId = "set_seed", label = "set.seed() function", value = 0608, min = 1, max = 10000),
bsPopover(id = "set_seed",
title = paste0('This number fixes the seed for the pseudo-random number generation, which is ',
'important for most of the procedures within cytoChain. Based on this you can ',
'also choose the color combination of your samples in the first "Loading and parsing" ',
' tab')))
######################## body ---------------------------------------------------------------------------
dbBody <- dashboardBody(
tabItems(
### flowSet optimization tabItem ----------------------------------------------
tabItem(tabName = "preClustering",
titlePanel("flowSet optimization"),
# Sidebar layout with input and output definitions ---
sidebarLayout(
# Sidebar panel for inputs ---
sidebar_panel_pre,
# Main panel for displaying outputs ---
mainPanel(
navbarPage(title="Workflow", id = "preClusteringWorkflow", inverse = T, position = "static-top",
#tabsetPanel(
tabPurpose,
# id = "preClusteringWorkflow", type = "tabs"),
fluid = T)))) #end of preClustering tabItem
)#end of tabItem
)#end of dashBoardBody
### main UI ----
UI <- dashboardPage(header = dbHeader, sidebar = dbSidebar, body = dbBody, skin = "green")
################################################### SERVER FUNCTION -----
server <- function(input, output, session) {
################################################### session setup -----
onStop(function() cat("Session stopped\n"))
### for the onStop and on onStart see https://shiny.rstudio.com/reference/shiny/1.0.5/onStop.html
onStart = function() {
cat("Doing application setup\n")
onStop(function() {
cat("Doing application cleanup\n")})}
app_dir <<- getwd()
data_dir <<- paste0(app_dir, "/tmpdata")
################################################### process checkbox -----
output$checktxt <- renderText({
validate(need(expr = (!is.null(input$process)), "Please select a module!"))
})
dI <- reactiveVal(NULL)
dI_val <- reactiveValues(inFile = NULL, pieColor = NULL, fS_table = NULL, fS_plot = NULL, fS_summary = NULL, fS_dim = NULL, fS_p = NULL)
bell <- load.wave(where = "www/shipsbell.wav")
observeEvent(eventExpr = input$runLoad, {
validate(need(expr = !is.null(input$fSinput), message = "please select some samples"))
print("start parsing process")
output$console_output_pre <- renderPrint("start parsing process - waiting...")
options(warn = 0)
dI(NULL);
dI_val$inFile <- NULL; dI_val$fS_table <- NULL;
temp_dir = "./tmpdata"
if (!dir.exists(temp_dir)) {
dir.create(temp_dir)} else
#Delete files if they exist
{old_file <- list.files(path = temp_dir, pattern = "\\.fcs$|\\.zip$|\\.png$|\\.csv$")
if (!(length(old_file)==0)){
old_file <- paste(temp_dir, old_file, sep = "/")
unlink(old_file, recursive = FALSE)}}
dI_val$inFile <- input$fSinput
if(!is.null(input$fSinput)) {
inputfile = input$fSinput$datapath
fS_loaded <- read.flowSet(files = inputfile)
if(class(fS_loaded) == "flowSet"){
fFvectorName <- vector(mode = "character",length = length(fS_loaded))
for (i in seq_along(1:length(fS_loaded))){
if (i < 10) {fFvectorName[i] = paste0("sample", "_0", as.character(i))}
else
{fFvectorName[i] = paste0("sample", "_", as.character(i))}}
prefix <- paste0("^", "sample")
old_file <- list.files(path = "./tmpdata", pattern = prefix)
if (!(length(old_file)==0)){
old_file <- paste("./tmpdata", old_file, sep = "/")
unlink(old_file, recursive = FALSE)}
write.flowSet(x = fS_loaded, outdir = "./tmpdata", filename = fFvectorName)
fFfiles <- list.files(path = "./tmpdata", pattern= prefix, full.names = TRUE)
fS <- read.flowSet(files = fFfiles)
dI(fS)}
else
{dI(fS_loaded)}
if(class(dI()) == "flowSet"){
set.seed(input$set_seed)
dI_val$inFile <- input$fSinput
fSlength <- length(dI())
tablefS <- tibble(`sample name` = "name",`sample id` = "sample id", `number of events` = 1, .rows = length(dI()))
for (i in seq_along(1:fSlength)){
if (!is.null(dI_val$inFile$name)) tablefS$`sample name`[i] = dI_val$inFile$name[[i]]
else
{ if (class(dI())=="flowSet")
tablefS$`sample name`[i] = dI()@phenoData@data$name[i]
else
tablefS$`sample name`[i] = dI()@description[["$FIL"]]}
if (i < 10) tablefS$`sample id`[i] = paste0("sample_0", as.character(i))
else
tablefS$`sample id`[i] = paste0("sample_", as.character(i))
if (class(dI())=="flowSet")
tablefS$`number of events`[i] = dim(exprs(dI()[[i]]))[1]
else
tablefS$`number of events`[i] = dim(exprs(dI()))[1]}
fS_summary <- data.frame("Nr of samples" = length(dI()), "Total nr of events" = sum(tablefS$`number of events`),
"Minumum number of events through samples" = min(tablefS$`number of events`),
"Sample with the minimum number of events" = tablefS[tablefS$`number of events` == min(tablefS$`number of events`),]$`sample id`[1],
"Maximum number of events through samples" = max(tablefS$`number of events`),
"Sample with the maximum number of events" = tablefS[tablefS$`number of events` == max(tablefS$`number of events`),]$`sample id`[1],
"mean number of events through samples" = round(mean(tablefS$`number of events`), digits = 1),
"standard deviation of events through samples" = round(sd(tablefS$`number of events`),digits = 1),
check.names = FALSE)
#row.names = "flowSet statistic")
fS_summary <- t(fS_summary)
colnames(fS_summary) <- "Sample summary"
lista <- list(tablefS, fS_summary)
dI_val$fS_table <- lista[[1]]
dI_val$fS_summary <- lista[[2]]
output$load_panelStatus <- reactive({input$load_panelStatus=="show"})#??? this could be also used to select the sidebars
outputOptions(output, "load_panelStatus", suspendWhenHidden = FALSE)
if (Sys.info()["sysname"] == "Windows") play(x = bell)}
else {
flowSet_output <- dI()
dI(flowSet_output)}
output$checktxt_parsing_fS <- renderText({
if (!is.null(dI())){
if (class(dI())=="character")
{messaggio <- dI()
validate(need(expr = (class(dI())=="flowSet"), message = messaggio))}}})}
print("Parsing process ends")
output$console_output_pre <- renderPrint("parsing process ends")
})
################################################### runLoadShow ----
observeEvent(eventExpr = input$runLoadShow,{
validate(need(expr = !is.null(input$fSinput), message = "please select some samples"))
if(!is.null(input$fSinput)&(class(dI())=="flowSet")) {
print("start data visualization of the loaded flowSet - waiting...")
output$console_output_pre <- renderPrint("start data visualization of the loaded flowSet - waiting...")
validate(need(expr = (class(dI())=="flowSet"), message = "please select some samples"))
set.seed(input$set_seed)
output$samples <- renderDT(DT::datatable(dI_val$fS_table, options = list(pageLength = 20)))
output$entryEvents <- renderValueBox({
valueBox(value = dI_val$fS_summary[2],subtitle = "Total entry events", icon = icon("list"), color = "green")})
print("Visualization process ends")
output$console_output_pre <- renderPrint("visualization process ends")}
else{
result <- "please load your FCS files in order to be parsed from cytoChain"
dI(result)}
output$checktxt_loading_fS <- renderText({
if (!is.null(dI())){
if (class(dI())=="character")
{messaggio <- dI()
validate(need(expr = (class(dI())=="flowSet"), message = messaggio))}}})
})
} #end of server
#session$onSessionEnded(stopApp)
# Run the application
shinyApp(ui = ui, server = server)
#> Error in force(ui): object 'ui' not foundCreated on 2020-05-29 by the reprex package (v0.3.0)