Commit 23671fd3 authored by svolant's avatar svolant
Browse files

Modif masque interface

parent f2b8aef9
options(download.file.method = 'wget')
if (!require("shinytoastr")){
source("https://install-github.me/mangothecat/shinytoastr")
library(shinytoastr)
}
if (!require("shinyWidgets")){
install.packages("shinyWidgets")
library(shinyWidgets)
}
if (!require("sendmailR")){
install.packages("sendmailR")
library(sendmailR)
}
if (!require("shinyBS")){
install.packages("shinyBS")
library(shinyBS)
......
......@@ -114,7 +114,6 @@ CheckTargetModel <- function(input,target,labeled,CT)
labels = rownames(target)
ind = which(colnames(CT)%in%labels)
# InterVar%in%
# uniq_column = (length(which(sapply(target[InterVar], function(x) length(unique(x))) == 1)) > 0)
# uniq_column_names = names(which(sapply(target[InterVar], function(x) length(unique(x))) == 1))
......@@ -238,20 +237,17 @@ CheckMasque <- function(input,values)
## Check password
if(is.null(Error) && input$password == ""){
Error = "<h6><strong>Empty key field </strong></h6>"
HowTo = "<h6><strong>Make sure that you have click the &laquo Get key &raquo button and that you have pasted the key sent by mail </strong></h6>"
}
if(is.null(Error) && input$password != ""){
pass = toupper(gsub(" ","",input$password))
if(!identical(pass,toupper(values$pass))){
Error = "<h6><strong>Invalid key </strong></h6>";
HowTo = "<h6><strong>Make sure that you have click the &laquo Get key &raquo button and that you have pasted the key sent by mail</strong></h6>"
}
# if(is.null(Error) && input$password == ""){
# Error = "<h6><strong>Empty key field </strong></h6>"
# HowTo = "<h6><strong>Make sure that you have click the &laquo Get key &raquo button and that you have pasted the key sent by mail </strong></h6>"
# }
#
if(is.null(Error) && is.null(values$login_email)){
Error = "<h6><strong>Invalid key </strong></h6>";
HowTo = "<h6><strong>Make sure that you have click the &laquo Get key &raquo button </strong></h6>"
}
## At least one fastq is detected
if(is.null(Error) && input$LoadFiles>0 && length(values$fastq_names_only)==0){
Error = "<h6><strong>The selected directory must contain at least one file in the following format : fastq, fastq.gz, or fq.</strong></h6>"
......@@ -359,7 +355,7 @@ CreateJSON <- function(input,values){
path_fastq_R1 = paste(tempdir(),"Masque_files_R1",sep= .Platform$file.sep)
path_fastq_R2 = paste(tempdir(),"Masque_files_R2",sep= .Platform$file.sep)
df = data.frame("paired"=FALSE,
df = data.frame("paired"=TRUE,
"path_R1"=path_fastq_R1,
"path_R2"=path_fastq_R2,
"host"=input$HostName,
......
......@@ -59,3 +59,37 @@ margin-bottom: -40px;
}
"
InfoBoxCSS <- "
.info-box:hover,
.info-box:hover .info-box-icon {
background-color: #aaa !important;
}
.info-box:active,
.info-box:active .info-box-icon {
background-color: #ccc !important;
}
"
withPopup <- function(tag,title="",img_src=NULL,width_img = "100%",height_img = "100%") {
if(!is.null(img_src)){
content <- div(title,style = "width: 120px; text-align: justify;",
img(src = img_src,width = width_img,height = height_img)
)
}
if(is.null(img_src)){
content <- div(title,style = "width: 120px; text-align: justify;")
}
tagAppendAttributes(
tag,
`data-toggle` = "popover",
`data-html` = "true",
`data-trigger` = "hover",
`data-content` = content
)
}
......@@ -16,3 +16,4 @@ source("Rfunctions/VisuPlot.R")
source("Rfunctions/CompPlot.R")
source("Rfunctions/DiffTable.R")
source('Rfunctions/directoryInput.R')
source('Rfunctions/internal_masque.R')
......@@ -20,7 +20,7 @@ shinyServer(function(input, output,session) {
## JSON name for masque
curdir = getwd()
json_name = tempfile(pattern = "file", tmpdir = paste(curdir,"www","masque","todo",sep= .Platform$file.sep), fileext = ".json")
## Pass for MASQUE
pass = gsub("file","",basename(file_path_sans_ext(json_name)))
......@@ -30,7 +30,7 @@ shinyServer(function(input, output,session) {
## Reactive target
values <- reactiveValues(TargetWorking = target,labeled=NULL,fastq_names_only=NULL,R1fastQ=NULL,R2fastQ=NULL,
json_name=json_name,num=0,pass=pass,login_email = NULL,is.valid =NULL,
biom_masque = NULL,tree_masque=NULL)
biom_masque = NULL,tree_masque=NULL,masque_key = NULL)
## Counts file
dataInputCounts <-reactive({
......@@ -494,7 +494,7 @@ shinyServer(function(input, output,session) {
data=dataInput()$data
if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0 && !is.null(tree))
{
tabBox(width = NULL, selected = "Count table",
tabBox(id="id_tabboxdata",width = NULL, selected = "Count table",
tabPanel("Count table",DT::dataTableOutput("DataCounts")),
tabPanel("Taxonomy",DT::dataTableOutput("DataTaxo")),
tabPanel("Summary",h5(strong("Percentage of annotation")),htmlOutput("SummaryView"),
......@@ -504,7 +504,7 @@ shinyServer(function(input, output,session) {
}
else if(!is.null(data$counts) && !is.null(data$taxo) && nrow(data$counts)>0 && nrow(data$taxo)>0)
{
tabBox(width = NULL, selected = "Count table",
tabBox(id="id_tabboxdata",width = NULL, selected = "Count table",
tabPanel("Count table",DT::dataTableOutput("DataCounts")),
tabPanel("Taxonomy",DT::dataTableOutput("DataTaxo")),
tabPanel("Summary",h5(strong("Percentage of annotation")),htmlOutput("SummaryView"),
......@@ -662,20 +662,21 @@ shinyServer(function(input, output,session) {
##
#############################################################
## Select a folder (for MASQUE)
shinyDirChoose(input, 'dir', roots = c(home = '~'),filetypes = c('', 'fastq','gz','fgz'))
shinyDirChoose(input, 'dir', roots = c(dir=""),filetypes = c('', 'fastq','gz','fgz'))
dir <- reactive(input$dir)
output$dirSel <- renderText({
home <- normalizePath("~")
home <- ""
path_glob = file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep))
})
path <- reactive({
home <- normalizePath("~")
# file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep),"*.pdf")
file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep),"*.f*q*")
home <- ""
file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep),"*.f*q*")
})
......@@ -695,13 +696,16 @@ shinyServer(function(input, output,session) {
observeEvent(input$submit,{
CMP = CheckMasque(input, values)
Error = CMP$Error
values$num = 1
isJSONalreadyExist = file.exists(paste(curdir,"www","masque","doing",basename(json_name),sep= .Platform$file.sep))
CreateFasta()
if(is.null(Error) && !isJSONalreadyExist)
{
CreateFasta()
values$num = 1
tmp = tempdir()
home <- normalizePath("~")
home <- ""
path_glob = file.path(home, paste(unlist(dir()$path[-1]), collapse = .Platform$file.sep))
......@@ -739,45 +743,55 @@ shinyServer(function(input, output,session) {
## Create JSON file
withProgress(message = 'Creating JSON file...',{CreateJSON(input,values)})
if(file.exists(values$json_name)) values$num = 1
info("Your data have been submitted. You will receive an e-mail once the computation over.\nThis can take few hours")
sendSweetAlert(messageId="SuccessMasque",
title = "Success",
text = paste("Your data have been submitted. You will receive an e-mail once the computation over. <br /> This can take few hours.
<br />
<br />
<br />
<em> Remind: You can close shaman and use your key to check the progression and get your results: </em>",values$pass),
type = "success",
html=TRUE
)
}
},priority = 1)
## FastQ list
output$FastQList_out <- renderUI({
input$LoadFiles
FastqLoad()
NullBox = h3(strong("0 FastQ file detected"),style="color:red; text-align: center")
res = NullBox
home <- normalizePath("~")
path_glob = file.path(home, paste(unlist(isolate(dir()$path[-1])), collapse = .Platform$file.sep))
fastq_names = Sys.glob(isolate(path()))
if(length(fastq_names)>0 && input$LoadFiles>0)
if(length(values$fastq_names_only)>0)
{
if(is.null(values$fastq_names_only) || length(values$fastq_names_only)==0) values$fastq_names_only = gsub(pattern = path_glob,x = fastq_names,replacement = "")
# res = box(title="Select your FastQ files",width = 6, status = "primary",
# selectInput("FastQList",label = "List of the fastq files in the selected directory",values$fastq_names_only,multiple =TRUE,selectize=FALSE,size = 6),
# actionButton("RemoveFastQbut",'Remove file(s)',icon=icon("remove"))
# )
res =list(
selectInput("FastQList",label = "List of the fastq files in the selected directory",values$fastq_names_only,multiple =TRUE,selectize=FALSE,size = 6),
actionButton("RemoveFastQbut",'Remove file(s)',icon=icon("remove"))
)
res =list(selectInput("FastQList",label = "List of the fastq files in the selected directory",values$fastq_names_only,multiple =TRUE,selectize=FALSE,size = 6),
actionButton("RemoveFastQbut",'Remove file(s)',icon=icon("remove")))
} else res = NullBox
return(res)
})
observeEvent(input$LoadFiles,{
values$fastq_names_only = NULL
FastqLoad <- reactive({
input$LoadFiles
## Reinitializing
if(!is.null(isolate(values$fastq_names_only))) values$fastq_names_only = NULL
## Get the fastq names
home <- normalizePath("~")
home <- ""
path_glob = file.path(home, paste(unlist(isolate(dir()$path[-1])), collapse = .Platform$file.sep))
fastq_names = Sys.glob(isolate(path()))
if(length(fastq_names)>0 && isolate(input$LoadFiles>0))
{
if(is.null(isolate(values$fastq_names_only)) || length(isolate(values$fastq_names_only))==0) values$fastq_names_only = gsub(pattern = path_glob,x = fastq_names,replacement = "")
}
})
......@@ -863,6 +877,17 @@ shinyServer(function(input, output,session) {
})
RemoveFastQ_R1R2_all <-eventReactive(input$LoadFiles,{
values$R1fastQ = NULL
updateSelectInput(session, "R1filesList","","")
values$R2fastQ = NULL
updateSelectInput(session, "R2filesList","","")
})
## Remove FastQ from R1, R2
observeEvent(input$RemoveFastQbut_R1R2,{
......@@ -871,6 +896,15 @@ shinyServer(function(input, output,session) {
},priority=1)
## Remove FastQ from R1, R2 (load button)
observeEvent(input$LoadFiles,{
RemoveFastQ_R1R2_all()
},priority=1)
# observe({
# CMP = CheckMasque(input, values)
# toggleState("submit",condition = is.null(CMP$Error))
......@@ -880,70 +914,218 @@ shinyServer(function(input, output,session) {
toggleState("box-match",condition = (input$PairedOrNot=="y"))
})
output$InfoMasque<- renderUI({
input$submit
CMP = isolate(CheckMasque(input, values))
if(!is.null(CMP$Error) && input$submit>0) {
box(title = "Error", status = "danger",width = 12,
HTML(CMP$Error)
)
} else return(NULL)
toastr_error(title="Error",message=HTML(CMP$Error),closeButton = TRUE,position ="bottom-right",preventDuplicates = TRUE,newestOnTop = TRUE,
progressBar = FALSE,showDuration = 300,showMethod="show",timeOut = 10000)
}
})
output$InfoMasqueHowTo<- renderUI({
input$submit
CMP = isolate(CheckMasque(input, values))
if(!is.null(CMP$HowTo) && input$submit>0) {
box(title = "How To", status = "success",width = 12,
HTML(CMP$HowTo)
)
} else return(NULL)
toastr_success(title="How to",message=HTML(CMP$HowTo),closeButton = TRUE,position ="bottom-right",preventDuplicates = TRUE,newestOnTop = TRUE,
progressBar = FALSE,showDuration = 300,showMethod="show",timeOut = 10000)
}
})
## plot gauge
output$gaugeMasque <-renderGauge({
input$submit
res = NULL;
# observeEvent(input$submit,{
#
# CMP = isolate(CheckMasque(input, values))
# if(!is.null(CMP$HowTo)) {
# toastr_success(title="How to",message=HTML(CMP$HowTo),closeButton = TRUE,position ="bottom-right",preventDuplicates = TRUE,newestOnTop = TRUE,
# progressBar = FALSE,showDuration = 300,showMethod="show",timeOut = 10000)
# }
#
# })
#
#
# observeEvent(input$submit,{
#
# CMP = isolate(CheckMasque(input, values))
# if(!is.null(CMP$Error)) {
# toastr_error(title="Error",message=HTML(CMP$Error),closeButton = TRUE,position ="bottom-right",preventDuplicates = TRUE,newestOnTop = TRUE,
# progressBar = FALSE,showDuration = 300,showMethod="show",timeOut = 10000)
# }
#
# })
######### ICONS ################
output$spinner_anim <- renderUI(
htmltools::HTML('<i class="fa fa-spinner fa-pulse fa-fw" style="color:white" ></i><span class="sr-only">Loading...</span>')
)
output$spinner_icon <- renderUI(
htmltools::HTML('<i class="fa fa-spinner" aria-hidden="true" style="color:white" ></i><span class="sr-only">Loading...</span>')
)
output$pause_icon <- renderUI(
htmltools::HTML('<i class="fa fa-pause" aria-hidden="true" style="color:white" ></i><span class="sr-only">Loading...</span>')
)
output$check_icon <- renderUI(
htmltools::HTML('<i class="fa fa-check" style="color:white" ></i><span class="sr-only">Loading...</span>')
)
output$key_icon <- renderUI(
htmltools::HTML('<i class="fa fa-key" style="color:white" ></i><span class="sr-only">Loading...</span>')
)
output$test_icon <- renderUI(
htmltools::HTML('<img src="icon.png" alt="dna" style="width:80px;height:80px;">')
)
output$amplicon_icon <- renderUI(
htmltools::HTML('<img src="icons/amplicon.png" alt="dna" style="width:80px;height:80px;">')
)
output$dereplication_icon <- renderUI(
htmltools::HTML('<img src="icons/dereplication.png" alt="dna" style="width:80px;height:80px;">')
)
output$singleton_icon <- renderUI(
htmltools::HTML('<img src="icons/singleton.png" alt="dna" style="width:80px;height:80px;">')
)
output$chimera_icon <- renderUI(
htmltools::HTML('<img src="icons/chimera.png" alt="dna" style="width:80px;height:80px;">')
)
#####################################
output$progressBoxMasque <- renderValueBox({
res = NULL
num = round(as.numeric(values$num),1)
res = valueBox("0 %",h6(strong("Waiting for the data...")), color = "light-blue",width=NULL,icon = uiOutput("spinner_icon"))
CMP = isolate(CheckMasque(input, values))
Error = CMP$Error
if(is.null(Error) || num>1) res = gauge(min(num,100), 0,100,symbol = '%',label= "Progress...")
if(is.null(Error) || num>=1) res = valueBox(paste(values$num,"%"),h6(strong("Analysis in progress...")), color = "green",width=NULL,icon = uiOutput("spinner_anim"))
if(num>=100) res = valueBox(paste("100 %"),h6(strong("Analysis completed ! Check your mail.")), color = "green",width=NULL,icon = uiOutput("check_icon"))
return(res)
})
# output$infoBoxPass <- renderInfoBox({
#
# res = NULL
# # pass = toupper(gsub(" ","",input$password))
# # passOK = identical(pass,toupper(values$pass))
# #
# if(input$password =="") res = infoBox("Get a key","Require a valid email address", color = "light-blue",width=NULL,icon = uiOutput("key_icon"),fill = TRUE)
#
# if(passOK) res = infoBox("Key created !",paste("Your key is ",values$pass), color = "green",width=NULL,icon = uiOutput("key_icon"),fill = TRUE)
# if(!passOK && input$password !="") res = infoBox("Invalid key","Use the key that you have received by mail", color = "red",width=NULL,icon = uiOutput("key_icon"),fill = TRUE)
# return(res)
# })
output$infoBoxPass <- renderInfoBox({
res = NULL
# pass = toupper(gsub(" ","",input$password))
# passOK = identical(pass,toupper(values$pass))
#
res = infoBox("Get a key","Require a valid email address", color = "light-blue",width=NULL,icon = uiOutput("key_icon"),fill = TRUE)
if(input$checkMail>=1 && isValidEmail(input$to)) res = infoBox("Key created !",paste("Your key is ",values$pass), color = "green",width=NULL,icon = uiOutput("key_icon"),fill = TRUE)
if(input$checkMail>=1 && !isValidEmail(input$to)) res = infoBox("Invalid emial","Enter a valid email address to get your key", color = "red",width=NULL,icon = uiOutput("key_icon"),fill = TRUE)
return(res)
})
output$infoBoxFastQ <- renderInfoBox({
FastqLoad()
res = NULL
res = infoBox("Fastq files","Load the fastq files ", color = "light-blue",width=NULL,icon = icon("play"),fill = TRUE)
if(input$LoadFiles>=1){
if(length(unique(values$fastq_names_only))==0) res = infoBox("Fastq files","Select a working directory with at least one fastq file", color = "red",width=NULL,icon = icon("play"),fill = TRUE)
if(length(unique(values$fastq_names_only))>0) res = infoBox("Fastq files",paste(length(unique(values$fastq_names_only)), "files are loaded"), color = "green",width=NULL,icon = icon("play"),fill = TRUE)
}
return(res)
})
output$infoBoxFastQ_match <- renderInfoBox({
res = NULL
SM = SamplesMasque(input,values)
if(input$PairedOrNot=="n"){ res = infoBox("Match the pairs","Only for paired-end sequencing", color = "black",width=NULL,icon = icon("exchange"),fill = TRUE)}
if(input$PairedOrNot=='y'){
if(input$MatchFiles_button==0) res = infoBox("Match the pairs","Identify forward and reverse files and then click the match button", color = "light-blue",width=NULL,icon = icon("exchange"),fill = TRUE)
if(input$MatchFiles_button>0 && length(SM$samples)>=1){res = infoBox("Pairs are matched",paste(length(SM$samples), "samples are detected"), color = "green",width=NULL,icon = icon("exchange"),fill = TRUE)}
if(input$MatchFiles_button>0 && length(SM$samples)<1){res = infoBox("Match the pairs","Failed. 0 samples detected", color = "red",width=NULL,icon = icon("exchange"),fill = TRUE)}
}
return(res)
})
## plot gauge
# output$gaugeMasque <-renderGauge({
# input$submit
#
# res = NULL;
# num = round(as.numeric(values$num),1)
#
# CMP = isolate(CheckMasque(input, values))
# Error = CMP$Error
# if(is.null(Error) || num>1) res = gauge(min(num,100), 0,100,symbol = '%',label= "Progress...")
#
# return(res)
# })
#
## Timer for the gauge
Timer <- reactiveTimer(20000)
Timer <- reactiveTimer(10000)
## Check masque progress
observe({
Timer()
# values$num = isolate(values$num)*5
Timer()
CMP = isolate(CheckMasque(input, values))
Error = CMP$Error
if(is.null(Error) && isolate(values$num)<100){
values$num = isolate(values$num)*100
progress_file = paste(curdir,"www","masque","doing",paste(basename(file_path_sans_ext(json_name)),"_progress",".txt",sep=""),sep= .Platform$file.sep)
if(file.exists(progress_file))
{
pf = read_lines(progress_file)
print(pf)
if(!is.null(pf)){
pf = as.numeric(pf)
if(!is.na(pf)){
pf = min(pf,100); pf = max(pf,0)
if(isolate(values$num)<pf) {values$num = pf}
if(isolate(values$num)<pf) {values$num = round(pf,1)}
}
}
}
}
})
......@@ -951,12 +1133,65 @@ shinyServer(function(input, output,session) {
observe({
toggleState("checkMail",condition = isValidEmail(input$to))
})
output$pass_Arg <- renderUI({
pass = toupper(gsub(" ","",input$password))
passOK = identical(pass,toupper(values$pass))
#
# Project_status <-reactive({
# input$Check_project_over
# input$Check_project
#
# passOK = FALSE;status = NULL;file = NULL
# print("OK")
# json_files = list.files(paste(curdir,"www","masque",sep= .Platform$file.sep),pattern = "json",recursive = TRUE)
# allpass = gsub(gsub(json_files,pattern = ".*file",replacement = ""),pattern = ".json",replacement = "")
#
# print(allpass)
#
# if(length(allpass)>0){
# passOK = any(isolate(input$password)==allpass)
# if(passOK){
# ind = which(isolate(input$password)==allpass)
# file = paste(curdir,"www","masque",json_files[ind],sep= .Platform$file.sep)
# status = gsub(json_files[ind],pattern = "/.*",replacement = "")
# }
# }
#
# return(list(status=status,file=file,passOK=passOK))
# })
#
# Project_current <-reactive({
# input$Check_project_over
#
# passOK = FALSE;status = NULL;file = NULL
#
# json_files = list.files(paste(curdir,"www","masque",sep= .Platform$file.sep),pattern = "json",recursive = TRUE)
# allpass = gsub(gsub(json_files,pattern = ".*file",replacement = ""),pattern = ".json",replacement = "")
#
# print(allpass)
#
# if(length(allpass)>0){
# passOK = any(isolate(values$pass)==allpass)
# if(passOK){
# ind = which(values$pass==allpass)
# file = paste(curdir,"www","masque",json_files[ind],sep= .Platform$file.sep)