library(shiny)
library(shinydashboard)
library(shinyjs)
library(flowCore)
library(doSNOW)
library(parallel)
server <- function(input, output, session)
{
useShinyjs()
#======================================================================================================================
#======================REACTIVE VALUES=================================================================================
#======================================================================================================================
current.project <- reactiveValues(
fcs.files = NULL,
fcs.files.backup = NULL,
fcs.files.ui.colnames = NULL,
modified.fcs.files = NULL,
nmb.cores = detectCores(),
file.info.table = NULL,
file.info.table.visible.rows = NULL
)
clustering.algorithms <- reactiveValues(
algorithms = NULL,
parameters = NULL
)
env.var <- reactiveValues(
tool.wd = system.file("shinyApp", "app", package = "ClusteringTool"),
activate.analysis = F,
clustering.done = F
)
write.enriched.FCS <- function(fcs, fcs.path)
{
keywords.to.save <- names(get.keywords.with.keypart.FCS(fcs, "MAPOP_pop_label"))
keywords.to.save <- c(unlist(keywords.to.save), names(get.keywords.with.keypart.FCS(fcs, "EXPPUR__")))
keywords.to.save <- c(unlist(keywords.to.save), names(get.keywords.with.keypart.FCS(fcs, "RF_pop_label")))
keywords.to.save <- c(unlist(keywords.to.save), names(get.keywords.with.keypart.FCS(fcs, "CLMETH__")))
write.FCS.CIPHE(fcs,fcs.path, keywords.to.save = keywords.to.save)
}
#======================================================================================================================
#======================================================================================================================
#==========================================LOAD FILES==================================================================
#======================================================================================================================
update.markers.list <- function(current.section, file.id)
{
markers.sel <- list()
selected.markers <- isolate(input[[paste0("t_1_3_",file.id,"_mark_sel")]])
lapply(1:ncol(current.project$fcs.files[[file.id]]@exprs), function(j)
{
markers.sel[[current.project$fcs.files.ui.colnames[[file.id]][[j]]]] <<- j
})
updateSelectInput(session, paste0(current.section,"_",file.id,"_mark_sel"),label = "Markers to use",
choices=markers.sel,
selected = selected.markers)
}
observe(#LOAD FILES INFORMATION
{
if(length(current.project$fcs.files)>0)
{
lapply(1:length(current.project$fcs.files), function(f)
{
if(is.defined(current.project$fcs.files[[f]]) && current.project$modified.fcs.files[[f]])
{
idf <- names(current.project$fcs.files)[f]
fcs <- current.project$fcs.files[[f]]
#POP COL LOADING---------------------
pop.col.sel <- 1:ncol(fcs@exprs)
names(pop.col.sel) <- lapply(1:ncol(fcs@exprs), function(j)
{
d <- fcs@description[[paste0("$P",j,"S")]]
if(is.null(d) || !is.na(d) || d != "" || d != " ")
{
d <- current.project$fcs.files.ui.colnames[[f]][[j]]
}
names(d) <- NULL
return(unlist(d))
})
curr.file.label <- NULL
if(keyword.exists.FCS(fcs,"RF_pop_label"))
{
curr.file.label <- as.numeric(get.keywords.with.keypart.FCS(fcs,"RF_pop_label")[[1]][[1]])
}
#UI CREATION------------------------
markers.sel <- list()
lapply(1:ncol(fcs@exprs), function(j)
{
markers.sel[[current.project$fcs.files.ui.colnames[[f]][[j]]]] <<- j
})
insertUI("#t_1_3",
"beforeEnd",
fluidRow
(
style="padding-left:1.7vw;padding-right:0.2vw;margin-right:7vw",
id=paste0("t_1_3_",f,"_fr"),
box
(
width=12,
box
(
width=3,height="12vh",
textInput(paste0("t_1_3_",f,"_dwnsmpl"), "Downsample (nmb events)", value=nrow(fcs@exprs)),
checkboxInput(paste0("t_1_3_",f,"_cbox"), "Select", value = F)
),
box
(
title=names(current.project$fcs.files)[f],collapsible=TRUE,width=8,collapsed=F,
id=paste0("t_1_3_",f),
selectInput(paste0("t_1_3_",f,"_mark_sel"),label = "Markers to use",
choices=markers.sel,
selected=markers.sel,
multiple = T),
actionButton(paste0("t_1_3_",f,"_mark_all"), "Select all"),
actionButton(paste0("t_1_3_",f,"_unmark_all"), "Deselect all")
)
)
)
)
insertUI("#t_3_4",
"beforeEnd",
fluidRow
(
style="margin-left:1.7vw;padding-right:0.2vw",id=paste0("t_3_4_",f,"_fr"),
box
(
width=12,
box
(
width=1,height="12vh", style="padding-top:2vh",
checkboxInput(paste0("t_3_4_",f,"_cbox"), "Select", value = F)
),
box
(
title=names(current.project$fcs.files)[f],collapsible=TRUE,width=10,collapsed=F,
id=paste0("t_3_4_",f),
selectInput(paste0("t_3_4_",f,"_mark_sel"),label = "Markers to use",
choices=markers.sel,
selected=markers.sel,
multiple = T),
actionButton(paste0("t_3_4_",f,"_mark_all"), "Select all"),
actionButton(paste0("t_3_4_",f,"_unmark_all"), "Deselect all")
)
)
)
)
current.project$modified.fcs.files[[f]] <<- F
#SELECT ALL BUTTON---------------------------------------------
observeEvent(input[[paste0("t_1_3_",f,"_mark_all")]],
{
markers.sel <- list()
lapply(1:ncol(current.project$fcs.files[[f]]@exprs), function(j)
{
markers.sel[[current.project$fcs.files.ui.colnames[[f]][[j]]]] <<- j
})
updateSelectInput(session, paste0("t_1_3_",f,"_mark_sel"),label = "Markers to use",
choices = markers.sel,
selected = markers.sel)
})
observeEvent(input[[paste0("t_1_3_",f,"_unmark_all")]],
{
markers.sel <- list()
lapply(1:ncol(current.project$fcs.files[[f]]@exprs), function(j)
{
markers.sel[[current.project$fcs.files.ui.colnames[[f]][[j]]]] <<- j
})
updateSelectInput(session, paste0("t_1_3_",f,"_mark_sel"),label = "Markers to use",
choices = markers.sel,
selected = NULL)
})
observeEvent(input[[paste0("t_3_4_",f,"_mark_all")]],
{
markers.sel <- list()
lapply(1:ncol(current.project$fcs.files[[f]]@exprs), function(j)
{
markers.sel[[current.project$fcs.files.ui.colnames[[f]][[j]]]] <<- j
})
updateSelectInput(session, paste0("t_3_4_",f,"_mark_sel"),label = "Markers to use",
choices = markers.sel,
selected = markers.sel)
})
observeEvent(input[[paste0("t_3_4_",f,"_unmark_all")]],
{
markers.sel <- list()
lapply(1:ncol(current.project$fcs.files[[f]]@exprs), function(j)
{
markers.sel[[current.project$fcs.files.ui.colnames[[f]][[j]]]] <<- j
})
updateSelectInput(session, paste0("t_3_4_",f,"_mark_sel"),label = "Markers to use",
choices = markers.sel,
selected = NULL)
})
}
})
}
})
observeEvent(input$t_1_1_add,#ADD FILES TO SESSION
{
shinyjs::disable("t_1_3")
m <- matrix(nrow=1,ncol=2)
m[1,1] = "FlowFrames"
m[1,2] = "*.csv;*.fcs"
temp.files <- choose.files(filters = m,multi = T)
if(length(temp.files) > 0)
{
progress.bar <- Progress$new()
progress.bar$set("LOADING FILES", value=0)
on.exit(progress.bar$close())
lapply(temp.files, function(f)
{
l <- length(f)
x <- NULL
if(grepl("csv",f))
{
x <- as.matrix(read.csv(f))
x <- flowFrame(x)
lapply(1:ncol(x@exprs), function(i)
{
nx <- x@description[[paste0("$P",i,"S")]]
if(!is.null(nx) && !is.na(nx) && nx != "" && nx != " ")
{
if( is.null(current.project$fcs.files.ui.colnames) )
{
current.project$fcs.files.ui.colnames <<- list()
}
if( is.null(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]] ))
{
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]] <<- list()
}
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]] <<-
c(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]],
nx)
}
else
{
if( is.null(current.project$fcs.files.ui.colnames) )
{
current.project$fcs.files.ui.colnames <<- list()
}
if( is.null(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]] ))
{
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]] <<- list()
}
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]] <<-
c(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files.ui.colnames))]],
colnames(x)[i])
}
})
}
else
{
x <- read.FCS(f,emptyValue = FALSE)
lapply(1:ncol(x@exprs), function(i)
{
nx <- x@description[[paste0("$P",i,"S")]]
if(!is.null(nx) && !is.na(nx) && nx != "" && nx != " ")
{
if( is.null(current.project$fcs.files.ui.colnames) )
{
current.project$fcs.files.ui.colnames <<- list()
}
if( is.null(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] ))
{
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<- list()
}
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<-
c(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]],
nx)
}
else
{
if(!is.null(nx) && !is.na(nx) && nx != "" && nx != " ")
{
if( is.null(current.project$fcs.files.ui.colnames) )
{
current.project$fcs.files.ui.colnames <<- list()
}
if( is.null(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] ))
{
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<- list()
}
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<-
c(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]],
nx)
}
else
{
if( is.null(current.project$fcs.files.ui.colnames) )
{
current.project$fcs.files.ui.colnames <<- list()
}
if( is.null(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] ))
{
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<- list()
}
current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<-
c(current.project$fcs.files.ui.colnames[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]],
colnames(x)[i])
}
}
})
}
if( is.null(current.project$fcs.files) )
{
current.project$fcs.files <<- list()
current.project$fcs.files.backup <<- list()
current.project$modified.fcs.files <<- list()
}
current.project$fcs.files.backup[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<- x
current.project$fcs.files[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<- x
current.project$modified.fcs.files[[paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))]] <<- T
progress.bar$inc(1/length(temp.files),detail=paste0("adding ",paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files))))
file.vec <- matrix(ncol=5,nrow=1)
file.vec[1,1] <- paste0(basename(substr(f,1,nchar(f)-4)),"_",length(current.project$fcs.files)-1)
file.vec[1,2] <- trunc(file.size(f)/1024/1024*1000)/1000
file.vec[1,3] <- ncol(x)
file.vec[1,4] <- nrow(x)
file.vec[1,5] <- nrow(x)
current.project$file.info.table <<- rbind(current.project$file.info.table,
file.vec)
current.project$file.info.table.visible.rows <<- c(current.project$file.info.table.visible.rows,
T)
colnames(current.project$file.info.table) <<- c("Filename", "Size (Mo)", "Number of markers", "Number of events", "Subsample")
})
progress.bar$close()
}
shinyjs::enable("t_1_3")
})
observeEvent(input$t_1_1_rm,#REMOVE SELECTED FILES
{
progress.bar <- Progress$new()
progress.bar$set("REMOVING FILES", value=0)
on.exit(progress.bar$close())
if( length(current.project$fcs.files) >0 )
{
nmb.files.to.remove <- 0
lapply(1:length(current.project$fcs.files), function(i)
{
if(input[[paste0("t_1_3_",i,"_cbox")]])
{
nmb.files.to.remove <<- nmb.files.to.remove+1
}
})
lapply(1:length(current.project$fcs.files), function(i)
{
if(input[[paste0("t_1_3_",i,"_cbox")]])
{
current.project$fcs.files[[i]] <<- NA
current.project$fcs.files.backup[[i]] <<- NA
current.project$modified.fcs.files[[i]] <<- F
current.project$fcs.files.ui.colnames[[i]] <<- NA
progress.bar$inc(1/nmb.files.to.remove, detail=paste0("File ", i, " removed"))
removeUI(paste0("#t_3_4_",i,"_fr"))
removeUI(paste0("#t_1_3_",i,"_fr"))
current.project$file.info.table.visible.rows[[i]] <<- F
}
})
}
})
observeEvent(input$t_1_1_compensate,#COMPENSATE SELECTED FILES
{
selected.files <- 0
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(i)
{
if(input[[paste0("t_1_3_",i,"_cbox")]] && is.defined(current.project$fcs.files[[i]]))
{
selected.files <<- selected.files + 1
}
})
}
if(selected.files>0)
{
progress.bar <- Progress$new()
progress.bar$set("COMPENSATION", value=0)
progress.bar$inc(0,detail="please wait")
if( length(current.project$fcs.files) >0 )
{
tmp.fcs.files <- isolate(reactiveValuesToList(current.project))$fcs.files
tmp.fcs.files.names <- names(isolate(reactiveValuesToList(current.project))$fcs.files)
tmp.input <- isolate(reactiveValuesToList(input))
files.sizes <- unlist(sapply(tmp.fcs.files, function(curr.f){return(object.size(curr.f))}))
nmb.cl <- get.nmb.cores.max(files.sizes, available.cores = current.project$nmb.cores, x.cores = 0.1,
x.ram = 0.3, correction.coef = 1.05, separate.by.files = T)
# cl <- makeCluster(nmb.cl)
# registerDoSNOW(cl)
progress.fct <- function(i)
{
par.name <- names(tmp.fcs.files)[i]
progress.bar$inc(1/selected.files,
detail=paste0(par.name))
}
in.time <- Sys.time()
# tmp.fcs.files <- foreach(f.id=1:length(tmp.fcs.files),
# .options.snow = list(progress=progress.fct),
# .packages = c("flowCore"),
# .export = c("m.compensate","is.defined")) %dopar%
# {
tmp.fcs.files <- lapply(1:length(tmp.fcs.files), function(f.id)
{
fcs <- tmp.fcs.files[[f.id]]
if(is.defined(fcs))
{
if(tmp.input[[paste0("t_1_3_",f.id,"_cbox")]])
{
print(colnames(fcs@exprs))
print(fcs@description[["SPILL"]])
print("=============")
fcs <- m.compensate(fcs)
}
}
return(fcs)
})
print("EXEC TIME: ")
print(Sys.time()-in.time)
# stopCluster(cl)
current.project$fcs.files <<- tmp.fcs.files
names(current.project$fcs.files) <<- tmp.fcs.files.names
}
progress.bar$close()
}
else
{
progress.bar <- Progress$new()
progress.bar$set("NOTHING TO BE DONE", value=1)
delay(1500, progress.bar$close())
}
})
observeEvent(input$t_1_2_transform,#TRANSFORM SELECTED FILES
{
selected.files <- 0
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(i)
{
if(input[[paste0("t_1_3_",i,"_cbox")]] && is.defined(current.project$fcs.files[[i]]))
{
selected.files <<- selected.files+1
}
})
}
if(selected.files>0)
{
progress.bar <- Progress$new()
progress.bar$set("TRANSFORMATION: ", value=0)
progress.bar$inc(0,detail="please wait")
if( length(current.project$fcs.files) >0 )
{
tmp.fcs.files <- isolate(reactiveValuesToList(current.project))$fcs.files
tmp.fcs.files.names <- names(isolate(reactiveValuesToList(current.project))$fcs.files)
tmp.input <- isolate(reactiveValuesToList(input))
selected.algo <- m.transform.logicle
selected.algo.params <- NULL
if(is.defined(input$t_1_2_select_transform) && input$t_1_2_select_transform != "" &&
input$t_1_2_select_transform != " ")
{
selected.transform <- as.numeric(input$t_1_2_select_transform)
if(selected.transform == 1)
{
selected.algo <- m.transform.logicle
selected.algo.params <- NULL
}
else
{
selected.algo <- m.transform.asinh
selected.algo.params <- as.numeric(tmp.input$t_1_2_sel_arcsinh)
}
}
files.sizes <- unlist(sapply(tmp.fcs.files, function(curr.f){return(object.size(curr.f))}))
nmb.cl <- get.nmb.cores.max(files.sizes, available.cores = current.project$nmb.cores, x.cores = 0.1,
x.ram = 0.3, correction.coef = 1.05, separate.by.files = T)
cl <- makeCluster(nmb.cl)
registerDoSNOW(cl)
progress.fct <- function(i)
{
par.name <- names(tmp.fcs.files)[i]
progress.bar$inc(1/selected.files,
detail=paste0(par.name))
}
in.time <- Sys.time()
tmp.fcs.files <- foreach(f.id=1:length(tmp.fcs.files),
.options.snow = list(progress=progress.fct),
.packages = c("flowCore"),
.export = c("selected.algo", "selected.algo.params", "is.defined")) %dopar%
{
fcs <- tmp.fcs.files[[f.id]]
if(is.defined(fcs))
{
if(tmp.input[[paste0("t_1_3_",f.id,"_cbox")]])
{
fcs.col <- colnames(fcs@exprs)[as.numeric(tmp.input[[paste0("t_1_3_",f.id,"_mark_sel")]])]
fcs <- selected.algo(fcs, fcs.col, selected.algo.params)
}
}
return(fcs)
}
print("EXEC TIME: ")
print(Sys.time()-in.time)
stopCluster(cl)
current.project$fcs.files <<- tmp.fcs.files
names(current.project$fcs.files) <<- tmp.fcs.files.names
}
progress.bar$close()
}
else
{
progress.bar <- Progress$new()
progress.bar$set("NOTHING TO BE DONE", value=1)
delay(1500, progress.bar$close())
}
})
observe(#CHANGE TRANSFORM UI
{
if(is.defined(input$t_1_2_select_transform) && input$t_1_2_select_transform != "" &&
input$t_1_2_select_transform != " ")
{
selected.transform <- as.numeric(input$t_1_2_select_transform)
if(selected.transform == 1)
{
removeUI("#t_1_2_sel_fr")
}
else
{
insertUI("#t_1_2_sel_box",
"beforeEnd",
fluidRow
(
id="t_1_2_sel_fr", style="width:90%;margin-left:4.8%",
textInput("t_1_2_sel_arcsinh", "Arcsinh cofactor", value = "5")
)
)
}
}
})
observe(#ACTIVATE UI
{
if(env.var$activate.analysis)
{
shinyjs::enable("t_1_1_rm")
shinyjs::enable("t_1_1_compensate")
shinyjs::enable("t_1_1_select_all")
shinyjs::enable("t_1_1_deselect_all")
shinyjs::enable("t_1_2_transform")
}
else
{
shinyjs::disable("t_1_1_rm")
shinyjs::disable("t_1_1_compensate")
shinyjs::disable("t_1_1_select_all")
shinyjs::disable("t_1_1_deselect_all")
shinyjs::disable("t_1_2_transform")
}
})
observeEvent(input$t_1_1_select_all,#SELECT ALL FILES
{
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(f)
{
if(is.defined(current.project$fcs.files[[f]]))
{
updateCheckboxInput(session, paste0("t_1_3_",f,"_cbox"), value = T)
}
})
}
})
observeEvent(input$t_1_1_deselect_all,#DESELECT ALL FILES
{
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(f)
{
if(is.defined(current.project$fcs.files[[f]]))
{
updateCheckboxInput(session, paste0("t_1_3_",f,"_cbox"), value = F)
}
})
}
})
file.table.fct <- function()
{
l <- sum(unlist(current.project$file.info.table.visible.rows))
tmp.mat <- current.project$file.info.table[unlist(current.project$file.info.table.visible.rows),]
if(l==1)
{
tmp.mat <- t(tmp.mat)
colnames(current.project$file.info.table) <<- c("Filename", "Size (Mo)", "Number of markers", "Number of events", "Subsample")
}
return(tmp.mat)
}
output$t_1_4_fileInfo <- renderTable(file.table.fct()) #FILES INFORMATION
output$t_2_4_fileInfo <- renderTable(file.table.fct()) #FILES INFORMATION
output$t_3_4_fileInfo <- renderTable(file.table.fct()) #FILES INFORMATION
observe(#SHOW/HIDE FILES INFORMATION
{
if(!is.null(current.project$file.info.table))
{
l <- sum(unlist(current.project$file.info.table.visible.rows))
if(l > 0)
{
shinyjs::show("t_3_4")
shinyjs::show("t_2_4")
shinyjs::show("t_1_4")
}
else
{
shinyjs::hide("t_3_4")
shinyjs::hide("t_2_4")
shinyjs::hide("t_1_4")
}
}
else
{
shinyjs::hide("t_1_4")
shinyjs::hide("t_2_4")
shinyjs::hide("t_3_4")
}
})
observe(#UPDATE FILES SIZE (INFORMATION)
{
if(length(current.project$fcs.files)>0)
{
if(input$t_2_1_dwnsmpl)
{
for(i in 1:length(current.project$fcs.files))
{
if(is.defined(current.project$fcs.files[[i]]))
{
dwnsmpl <- as.integer(as.numeric(input$t_2_1_dwnsmpl_rate)/100*nrow(current.project$fcs.files.backup[[i]]@exprs))
current.project$file.info.table[i,5] <<- dwnsmpl
}
}
}
else
{
for(i in 1:length(current.project$fcs.files))
{
if(is.defined(current.project$fcs.files[[i]]))
{
dwnsmpl <- as.integer(min(as.numeric(input[[paste0("t_1_3_",i,"_dwnsmpl")]]), nrow(current.project$fcs.files.backup[[i]]@exprs)))
current.project$file.info.table[i,5] <<- dwnsmpl
}
}
}
}
})
#======================================================================================================================
#======================================================================================================================
#==========================================CLUSTERING==================================================================
#======================================================================================================================
observe(#ACTIVATE BUTTON
{
if(length(current.project$fcs.files)>0)
{
if(sum(is.na(unlist(current.project$fcs.files)))<length(current.project$fcs.files))
{
env.var$activate.analysis = T
}
else
{
env.var$activate.analysis = F
}
}
else
{
env.var$activate.analysis = F
}
})
observe(#SHOW UI
{
if(env.var$activate.analysis)
{
shinyjs::show("t_2_fr")
}
else
{
shinyjs::hide("t_2_fr")
}
})
observe(#LISTS AVAILABLE ALGORITHMS
{
if( length(clustering.algorithms$algorithms)==0 )
{
temp.dir <- paste0(env.var$tool.wd,"/MethodsFolder/")
methods.files <- list.files(temp.dir, pattern = ".R", full.names = F)
if( is.null(clustering.algorithms$algorithls) )
{
clustering.algorithms$algorithms <- list()
}
if( is.null(clustering.algorithms$parameters) )
{
clustering.algorithms$parameters <- list()
}
if( is.null(clustering.algorithms$parameters.description) )
{
clustering.algorithms$parameters.description <- list()
}
lapply(methods.files, function(f)
{
source(paste0(temp.dir,f))
clustering.algorithms$algorithms[[strsplit(f,".R", fixed = T)[[1]][1]]] <<- strsplit(f,".R", fixed = T)[[1]][1]
clustering.algorithms$parameters[[strsplit(f,".R", fixed = T)[[1]][1]]] <<- fct.parameters
clustering.algorithms$parameters.description[[strsplit(f,".R", fixed = T)[[1]][1]]] <<- fct.parameters.description
})
}
if(length(clustering.algorithms$algorithms)>0)
{
algo <- names(clustering.algorithms$algorithms)
names(algo) <- algo
updateSelectInput(session, "t_2_1_sel", "Select Algorithms", choices=algo, selected = algo)
}
})
observe(#PLOTS UI DEPENDING ON SELECTED ALGORITHMS
{
removeUI("#t_2_3")
if( length(current.project$fcs.files)>0 && is.defined(input$t_2_1_sel) )
{
insertUI("#t_2_fr",
"beforeEnd",
fluidRow
(
id="t_2_3", style="padding-left:1.2%"
)
)
lapply(1:length(input$t_2_1_sel), function(k)
{
insertUI("#t_2_3",
"beforeEnd",
box
(
title=paste0(input$t_2_1_sel[[k]], ": Parameters"), id=paste0("t_2_3_",k),style="padding:2vw",
width=11, collapsible=T, collapsed=F
)
)
if( !is.null(clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]]) )
{
lapply(1:length(clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]]), function(p)
{
par <- clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]][[p]]
par.name <- names(clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]])[p]
insertUI(paste0("#t_2_3_",k),
"beforeEnd",
div
(
div
(
sliderInput(paste0("t_2_3_",k,"_",p),par.name,min = as.numeric(par[1]),max=as.numeric(par[3]),
step=as.numeric(par[2]),value=c(as.numeric(par[4]),as.numeric(par[4]))),
style="float:left;width:65%;margin-bottom:2.1vh"
),
div
(
textInput(paste0("t_2_3_",k,"_",p,"_step"), "Step", value=as.numeric(par[2])),
style="float:left;width:10%;margin-top:2vh;margin-left:1.2vw"
),
div
(
p(clustering.algorithms$parameters.description[[input$t_2_1_sel[[k]]]][[p]]),
style="float:left;width:20%;margin-top:2vh;margin-left:1.2vw;max-height:10vh;
overflow:auto;padding-top:2vh"
)
)
)
})
}
})
}
})
observe(#UPDATE ALGORITHMS UI
{
if( length(current.project$fcs.files)>0 && is.defined(input$t_2_1_sel) )
{
lapply(1:length(input$t_2_1_sel), function(k)
{
if( !is.null(clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]]) )
{
lapply(1:length(clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]]), function(p)
{
if(is.defined(input[[paste0("t_2_3_",k,"_",p,"_step")]]) && input[[paste0("t_2_3_",k,"_",p,"_step")]] != "" &&
input[[paste0("t_2_3_",k,"_",p,"_step")]] != " ")
{
par <- clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]][[p]]
par.name <- names(clustering.algorithms$parameters[[input$t_2_1_sel[[k]]]])[p]
updateSliderInput(session, paste0("t_2_3_",k,"_",p),
step=as.numeric(input[[paste0("t_2_3_",k,"_",p,"_step")]]),
value=as.numeric(input[[paste0("t_2_3_",k,"_",p)]]))
}
})
}
})
}
})
observe(#UPDATE DOWNSAMPLING UI
{
if( is.defined(input$t_2_1_dwnsmpl_rate_step) && input$t_2_1_dwnsmpl_rate_step != "" && input$t_2_1_dwnsmpl_rate_step != " ")
{
updateSliderInput(session, "t_2_1_dwnsmpl_rate",
step=as.numeric(input$t_2_1_dwnsmpl_rate_step),
value=as.numeric(input$t_2_1_dwnsmpl_rate))
}
})
observeEvent(input$t_2_1_run,#RUNS ANALYSES
{
shinyjs::disable("t_2_1_run")
if(length(current.project$fcs.files)>0)
{
run.notif <- showNotification("RUNNING CLUSTERINGS - please wait", duration = NULL)
#DOWNSAMPLE FILES============================================================================================
if(input$t_2_1_dwnsmpl)
{
for(i in 1:length(current.project$fcs.files))
{
if(is.defined(current.project$fcs.files[[i]]))
{
dwnsmpl <- as.integer(as.numeric(input$t_2_1_dwnsmpl_rate)/100*nrow(current.project$fcs.files.backup[[i]]@exprs))
dwnsmpl <- sample(1:nrow(current.project$fcs.files.backup[[i]]@exprs), dwnsmpl, replace = F)
if(nrow(current.project$fcs.files.backup[[i]]@exprs) == nrow(current.project$fcs.files[[i]]@exprs))
{
current.project$fcs.files[[i]]@exprs <<- current.project$fcs.files[[i]]@exprs[dwnsmpl,]
}
else
{
current.project$fcs.files[[i]]@exprs <<- current.project$fcs.files.backup[[i]]@exprs[dwnsmpl,]
}
}
}
}
else
{
for(i in 1:length(current.project$fcs.files))
{
if(is.defined(current.project$fcs.files[[i]]))
{
dwnsmpl <- as.integer(min(as.numeric(input[[paste0("t_1_3_",i,"_dwnsmpl")]]), nrow(current.project$fcs.files.backup[[i]]@exprs)))
dwnsmpl <- sample(1:nrow(current.project$fcs.files.backup[[i]]@exprs), dwnsmpl, replace = F)
if(nrow(current.project$fcs.files.backup[[i]]@exprs) == nrow(current.project$fcs.files[[i]]@exprs))
{
current.project$fcs.files[[i]]@exprs <<- current.project$fcs.files[[i]]@exprs[dwnsmpl,]
}
else
{
current.project$fcs.files[[i]]@exprs <<- current.project$fcs.files.backup[[i]]@exprs[dwnsmpl,]
}
}
}
}
#RUN ANALYSES============================================================================================
if(is.defined(input$t_2_1_sel) && length(input$t_2_1_sel)>0)
{
#CHECK IF HCLUST IS USABLE===================================================================================
launch.analyses <- T
if("hclust" %in% unlist(input$t_2_1_sel))
{
for(i in 1:length(current.project$fcs.files))
{
if(is.defined(current.project$fcs.files[[i]]))
{
if(nrow(current.project$fcs.files[[i]]@exprs) > 40000)
{
launch.analyses <- F
}
}
}
}
if(launch.analyses)
{
removeUI("#t_2_1_error_h4")
lapply(1:length(input$t_2_1_sel), function(alg.id)
{
curr.algo <- input$t_2_1_sel[[alg.id]]
if(length(clustering.algorithms$parameters[[curr.algo]]) > 0)
{
params <- list()
params <- lapply(1:length(clustering.algorithms$parameters[[curr.algo]]), function(p)
{
x <- list(1,2,3)
values <- c()
if(is.defined(input[[paste0("t_2_3_",alg.id,"_",p)]]))
{
tmp <- input[[paste0("t_2_3_",alg.id,"_",p)]]
x[[1]] <- as.numeric(tmp)[[1]]
x[[2]] <- as.numeric(tmp)[[2]]
x[[3]] <- as.numeric(input[[paste0("t_2_3_",alg.id,"_",p,"_step")]])
}
if(is.defined(x[[3]]))
{
values <- seq(as.numeric(x[[1]]),as.numeric(x[[2]]),as.numeric(x[[3]]))
}
return(values)
})
names(params) <- names(clustering.algorithms$parameters[[curr.algo]])
}
runs.params.list <- run.algo.param.combi(params)
#DEFINES PARALLEL WORK=========================================================================
nmb.runs <- length(runs.params.list)
runs.per.core <- nmb.runs/current.project$nmb.cores
#Store reactive and global values
tmp.curr.proj <- isolate(reactiveValuesToList(current.project))
tmp.input <- isolate(reactiveValuesToList(input))
tmp.tool.wd <- isolate(reactiveValuesToList(env.var))$tool.wd
tmp.algo.params <- isolate(reactiveValuesToList(clustering.algorithms))$parameters
tmp.L1 <- lapply(1:length(runs.params.list), function(tmp.id)
{
return(list(runs.params.list[[tmp.id]], tmp.id))
})
tmp.L2 <- lapply(1:length(tmp.curr.proj$fcs.files), function(tmp.id)
{
return(list(tmp.curr.proj$fcs.files[[tmp.id]], names(tmp.curr.proj$fcs.files)[tmp.id], tmp.id))
})
tmp.foreach.list <- run.algo.combi(list(tmp.L1, tmp.L2))
L1.1 <- lapply(1:length(tmp.foreach.list), function(i)
{
return(tmp.foreach.list[[i]][[1]])
})
L1.2 <- lapply(1:length(tmp.foreach.list), function(i)
{
return(tmp.foreach.list[[i]][[2]])
})
L2.1 <- lapply(1:length(tmp.foreach.list), function(i)
{
return(tmp.foreach.list[[i]][[3]])
})
L2.2 <- lapply(1:length(tmp.foreach.list), function(i)
{
return(tmp.foreach.list[[i]][[4]])
})
L2.3 <- lapply(1:length(tmp.foreach.list), function(i)
{
return(tmp.foreach.list[[i]][[5]])
})
files.sizes <- unlist(sapply(L2.1, function(curr.f){return(object.size(curr.f))}))
nmb.cl <- get.nmb.cores.max(files.sizes, available.cores = current.project$nmb.cores, x.cores = 0.5,
x.ram = 0.4, correction.coef = 1.05)
cl <- makeCluster(nmb.cl)
registerDoSNOW(cl)
progress.bar <- Progress$new()
progress.bar$set(paste0("ALGORITHM: ", curr.algo), value=0)
progress.bar$inc(0,detail="fetching parameters")
progress.bar.fct <- function(i)
{
par.val <- unlist(L1.1[[as.integer(i)]])
par.name <- names(tmp.algo.params[[curr.algo]])
progress.bar$inc(1/length(L1.1),
detail=paste0(par.name,": ",par.val))
}
in.time <- Sys.time()
temp.out <- foreach(run.id=L1.2, run.parameters.values=L1.1, fcs=L2.1, fcs.name=L2.2, f.id=L2.3,
.options.snow = list(progress=progress.bar.fct),
.packages=c("flowCore","microbenchmark", "SPADECiphe","cluster","FlowSOM"),
.export = c("is.defined","benchmark.method","benchmark.source.method","add.keyword.to.fcs","alg.id",
"curr.algo","enrich.FCS", "params","tmp.input","tmp.tool.wd","tmp.algo.params")) %dopar%
{
added.keyword <- NULL
added.keyword.name <- NULL
if(is.defined(fcs))
{
markers_col <- 1
if( is.defined(tmp.input[[paste0("t_1_3_",f.id,"_mark_sel")]]) )
{
markers_col <- tmp.input[[paste0("t_1_3_",f.id,"_mark_sel")]]
}
benchmark.source.method(paste0(tmp.tool.wd,"/MethodsFolder/"),curr.algo)
method.output <- benchmark.method(curr.algo, fcs, run.parameters.values, markers_col)
tmp.labels <- method.output[[1]]
fcs <- enrich.FCS(fcs,tmp.labels)
added.keyword <- paste0("CLMETH__",curr.algo,"__",ncol(fcs@exprs),"__")
markers.txt <- "NULL"
if(length(markers_col) > 0)
{
markers.txt <- ""
lapply(1:length(markers_col), function(i)
{
markers.txt <<- paste0(markers.txt,markers_col[[i]],".-.")
})
}
params.txt <- "NULL"
if(length(run.parameters.values) > 0)
{
params.txt <- ""
lapply(1:length(run.parameters.values), function(i)
{
p.name <- names(params)[i]
p.val <- run.parameters.values[[i]]
params.txt <<- paste0(params.txt,p.name,"-",p.val,".-.")
})
}
added.keyword <- paste0(added.keyword,markers.txt,"__",params.txt)
added.keyword.name <- paste0("CLMETH__",curr.algo,"__",ncol(fcs@exprs))
return(list(fcs@exprs[,ncol(fcs@exprs)], colnames(fcs@exprs)[ncol(fcs@exprs)],
added.keyword, added.keyword.name,
fcs.name))
}
else
{
return(NULL)
}
}
progress.bar$inc(0,detail="finalizing clustering")
stopCluster(cl)
print(paste("EXECUTION TIME:"))
print(Sys.time()-in.time)
fcs.files <- current.project$fcs.files
lapply(1:length(temp.out), function(file.id)
{
if(is.defined(temp.out[[file.id]]))
{
tmp.file.labels <- matrix(temp.out[[file.id]][[1]],ncol=1)
tmp.name <- ""
tmp.val <- strsplit(temp.out[[file.id]][[2]], ".", T)[[1]]
if(length(tmp.val)>1)
{
lapply(1:(length(tmp.val) - 1), function(s.id)
{
tmp.name <<- paste0(tmp.name, tmp.val[[s.id]], ".")
})
}
tmp.name <- paste0(tmp.name, ncol(fcs.files[[ temp.out[[file.id]][[5]] ]])+1)
colnames(tmp.file.labels) <- tmp.name
fcs.files[[ temp.out[[file.id]][[5]] ]] <<- enrich.FCS(fcs.files[[ temp.out[[file.id]][[5]] ]], tmp.file.labels)
new.key <- modify.keyword.value(temp.out[[file.id]][[3]], "__", 3,
ncol(fcs.files[[ temp.out[[file.id]][[5]] ]]@exprs))
new.key.name <- modify.keyword.value(temp.out[[file.id]][[4]], "__", 3,
ncol(fcs.files[[ temp.out[[file.id]][[5]] ]]@exprs))
fcs.files[[ temp.out[[file.id]][[5]] ]] <<- add.keyword.to.fcs(fcs.files[[ temp.out[[file.id]][[5]] ]],
new.key,
new.key.name)
current.project$fcs.files.ui.colnames[[ temp.out[[file.id]][[5]] ]] <<-
c(current.project$fcs.files.ui.colnames[[ temp.out[[file.id]][[5]] ]],
tmp.name)
}
})
current.project$fcs.files <<- fcs.files
for(f in 1:length(current.project$fcs.files))
{
current.project$fcs.files[[i]]@description[["SPILL"]] <- current.project$fcs.files.backup[[i]]@description[["SPILL"]]
if(is.defined(current.project$fcs.files[[f]]))
{
update.markers.list(current.section="t_1_3",f)
update.markers.list(current.section="t_3_4",f)
}
}
progress.bar$close()
})
}
else
{
removeUI("#t_2_1_error_h4")
insertUI("#t_2_1_error",
"beforeEnd",
div
(
h4("HCLUST: downsample your files (< 40k events)",style="color:red"),
id="t_2_1_error_h4"
)
)
}
}
removeNotification(run.notif)
}
shinyjs::delay(ms=500,expr=enable("t_2_1_run"))
})
#======================================================================================================================
#======================================================================================================================
#==========================================DOWNLOAD FILES==============================================================
#======================================================================================================================
observeEvent(input$t_3_2_icompensate,#INVERSE COMPENSATION
{
selected.files <- 0
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(i)
{
if(input[[paste0("t_3_4_",i,"_cbox")]] && is.defined(current.project$fcs.files[[i]]))
{
selected.files <<- selected.files + 1
}
})
}
if(selected.files>0)
{
progress.bar <- Progress$new()
progress.bar$set("INVERTING COMPENSATION", value=0)
progress.bar$inc(0,detail="please wait")
if( length(current.project$fcs.files) >0 )
{
tmp.fcs.files <- isolate(reactiveValuesToList(current.project))$fcs.files
tmp.fcs.files.names <- names(isolate(reactiveValuesToList(current.project))$fcs.files)
tmp.input <- isolate(reactiveValuesToList(input))
files.sizes <- unlist(sapply(tmp.fcs.files, function(curr.f){return(object.size(curr.f))}))
nmb.cl <- get.nmb.cores.max(files.sizes, available.cores = current.project$nmb.cores, x.cores = 0.1,
x.ram = 0.3, correction.coef = 1.05, separate.by.files = T)
# cl <- makeCluster(nmb.cl)
# registerDoSNOW(cl)
progress.fct <- function(i)
{
par.name <- names(tmp.fcs.files)[i]
progress.bar$inc(1/selected.files,
detail=paste0(par.name))
}
in.time <- Sys.time()
# tmp.fcs.files <- foreach(f.id=1:length(tmp.fcs.files),
# .options.snow = list(progress=progress.fct),
# .packages = c("flowCore"),
# .export = c("m.inv.compensate","is.defined")) %dopar%
# {
tmp.fcs.files <- lapply(1:length(tmp.fcs.files), function(f.id)
{
fcs <- tmp.fcs.files[[f.id]]
if(is.defined(fcs))
{
if(tmp.input[[paste0("t_3_4_",f.id,"_cbox")]])
{
print(colnames(fcs@exprs))
print(fcs@description[["SPILL"]])
print("=============")
fcs <- m.inv.compensate(fcs)
}
}
return(fcs)
})
print("EXEC TIME: ")
print(Sys.time()-in.time)
# stopCluster(cl)
current.project$fcs.files <<- tmp.fcs.files
names(current.project$fcs.files) <<- tmp.fcs.files.names
}
progress.bar$close()
}
else
{
progress.bar <- Progress$new()
progress.bar$set("NOTHING TO BE DONE", value=1)
delay(1500, progress.bar$close())
}
})
observeEvent(input$t_3_1_itransform,#INVERSE TRANSFORMATION
{
selected.files <- 0
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(i)
{
if(input[[paste0("t_3_4_",i,"_cbox")]] && is.defined(current.project$fcs.files[[i]]))
{
selected.files <<- selected.files+1
}
})
}
if(selected.files>0)
{
progress.bar <- Progress$new()
progress.bar$set("INVERTING TRANSFORMATION: ", value=0)
progress.bar$inc(0,detail="please wait")
if( length(current.project$fcs.files) >0 )
{
tmp.fcs.files <- isolate(reactiveValuesToList(current.project))$fcs.files
tmp.fcs.files.names <- names(isolate(reactiveValuesToList(current.project))$fcs.files)
tmp.input <- isolate(reactiveValuesToList(input))
selected.algo <- m.inv.transform.logicle
selected.algo.params <- NULL
if(is.defined(input$t_3_1_select_transform) && input$t_3_1_select_transform != "" &&
input$t_3_1_select_transform != " ")
{
selected.transform <- as.numeric(input$t_3_1_select_transform)
if(selected.transform == 1)
{
selected.algo <- m.inv.transform.logicle
selected.algo.params <- NULL
}
else
{
selected.algo <- m.inv.transform.asinh
selected.algo.params <- as.numeric(tmp.input$t_3_1_sel_arcsinh)
}
}
files.sizes <- unlist(sapply(tmp.fcs.files, function(curr.f){return(object.size(curr.f))}))
nmb.cl <- get.nmb.cores.max(files.sizes, available.cores = current.project$nmb.cores, x.cores = 0.1,
x.ram = 0.3, correction.coef = 1.05, separate.by.files = T)
cl <- makeCluster(nmb.cl)
registerDoSNOW(cl)
progress.fct <- function(i)
{
par.name <- names(tmp.fcs.files)[i]
progress.bar$inc(1/selected.files,
detail=paste0(par.name))
}
in.time <- Sys.time()
tmp.fcs.files <- foreach(f.id=1:length(tmp.fcs.files),
.options.snow = list(progress=progress.fct),
.packages = c("flowCore"),
.export = c("selected.algo", "selected.algo.params", "is.defined")) %dopar%
{
fcs <- tmp.fcs.files[[f.id]]
if(is.defined(fcs))
{
if(tmp.input[[paste0("t_3_4_",f.id,"_cbox")]])
{
fcs.col <- colnames(fcs@exprs)[as.numeric(tmp.input[[paste0("t_3_4_",f.id,"_mark_sel")]])]
fcs <- selected.algo(fcs, fcs.col, selected.algo.params)
}
}
return(fcs)
}
print("EXEC TIME: ")
print(Sys.time()-in.time)
stopCluster(cl)
current.project$fcs.files <<- tmp.fcs.files
names(current.project$fcs.files) <<- tmp.fcs.files.names
}
progress.bar$close()
}
else
{
progress.bar <- Progress$new()
progress.bar$set("NOTHING TO BE DONE", value=1)
delay(1500, progress.bar$close())
}
})
observeEvent(input$t_3_2_select_all,#SELECT ALL FILES
{
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(f)
{
if(is.defined(current.project$fcs.files[[f]]))
{
updateCheckboxInput(session, paste0("t_3_4_",f,"_cbox"), value = T)
}
})
}
})
observeEvent(input$t_3_2_deselect_all,#DESELECT ALL FILES
{
if( length(current.project$fcs.files) >0 )
{
lapply(1:length(current.project$fcs.files), function(f)
{
if(is.defined(current.project$fcs.files[[f]]))
{
updateCheckboxInput(session, paste0("t_3_4_",f,"_cbox"), value = F)
}
})
}
})
observe(#CHANGE INV TRANSFORM UI
{
if(is.defined(input$t_3_1_select_transform) && input$t_3_1_select_transform != "" &&
input$t_3_1_select_transform != " ")
{
selected.transform <- as.numeric(input$t_3_1_select_transform)
if(selected.transform == 1)
{
removeUI("#t_3_1_sel_fr")
}
else
{
insertUI("#t_3_1_sel_box",
"beforeEnd",
fluidRow
(
id="t_3_1_sel_fr", style="width:90%;margin-left:4.8%",
textInput("t_3_1_sel_arcsinh", "Arcsinh cofactor", value = "5")
)
)
}
}
})
observe(#ACTIVATE UI
{
if(env.var$activate.analysis)
{
shinyjs::enable("t_3_2_select_all")
shinyjs::enable("t_3_2_deselect_all")
shinyjs::enable("t_3_2_icompensate")
shinyjs::enable("t_3_1_itransform")
shinyjs::enable("t_3_3_dl")
}
else
{
shinyjs::disable("t_3_1_itransform")
shinyjs::disable("t_3_2_select_all")
shinyjs::disable("t_3_2_deselect_all")
shinyjs::disable("t_3_2_icompensate")
shinyjs::disable("t_3_3_dl")
}
})
output$t_3_3_dl <- downloadHandler(
filename = function()
{
paste0("output.zip")
},
content = function(file)
{
download.notif <- showNotification("ZIPPING FILES - this may take a while", duration = NULL)
f.names <- c()
if(length(current.project$fcs.files)>0)
{
lapply(1:length(current.project$fcs.files), function(f)
{
if(is.defined(current.project$fcs.files[[f]]))
{
idf <- names(current.project$fcs.files)[f]
fcs <- current.project$fcs.files[[f]]
save.name <- paste0(idf,".fcs")
write.enriched.FCS(fcs,save.name)
f.names <<- c(f.names, save.name)
}
})
}
zip(file,f.names)
file.remove(f.names)
removeNotification(download.notif)
}
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.