Commit 90f92f69 authored by fsoubes's avatar fsoubes

cleaning some bugs

parent 1b47a0b9
#Source https://stackoverflow.com/questions/33839543/shiny-server-session-time-out-doesnt-work
# but seems to not work
inactivity <- "function idleTimer() {
var t = setTimeout(logout, 5000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer; // catches mouse clicks
window.onscroll = resetTimer; // catches scrolling
window.onkeypress = resetTimer; //catches keyboard actions
function logout() {
window.close(); //close the window
}
function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 5000); // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"
#The following html are sourced from https://github.com/aghozlane/shaman/blob/master/css/owncss.R
spincss <- "
#plot-container {
z-index: 0;
position: relative;
}
#loading-spinner {
position: absolute;
left: 50%;
top: 50%;
z-index: -1;
margin-top: 33px; /* half of the spinner's height */
margin-left: -33px; /* half of the spinner's width */
}
.recalculating {
z-index: -2;
background-color: #fff;
}
"
#' addNews is a function that render a pretty table for news
#'
#' @param date
#' @param title
#' @param text
#' @author Amine Ghozlane
#' Source https://github.com/aghozlane/shaman/blob/master/Rfunctions/Data_Management.R
#'
#' @return
#' @export
#'
#' @examples
#'
addNews <- function(date ="",title="",text=""){
res=list()
res$r1 = paste("<b><font size='+1'>",date,"</font></b>", " - ", "<b><font size='+1'>",title,"</font></b><br/>")
res$r2 = paste("<p><font color='grey'>",text,"</font></p><hr/>")
return(HTML(unlist(res)))
}
......@@ -147,6 +147,8 @@ position: static;
z-index: 800;
}
.shiny-output-error { visibility: visible; color: orange; font-size: larger;}
.irs-bar { height: 8px; top: 25px; border-top: 1px solid #337ab7; border-bottom: 1px solid #337ab7; background: #337ab7; } .irs-bar-edge { height: 8px; top: 25px; width: 14px; border: 1px solid #337ab7; border-right: 0; background: #337ab7; border-radius: 16px 0 0 16px; -moz-border-radius: 16px 0 0 16px; }
......@@ -210,6 +212,31 @@ div.outer {
}
}
#loading-content {
position: absolute;
background: #182b42;
opacity: 0.9;
z-index: 100;
left: 0;
right: 0;
top: 30px;
height: 100%;
text-align: center;
color: #FFFFFF;
}
#loading-content-bar {
position: absolute;
background: #182b42;
opacity: 0.9;
z-index: 100;
left: 0;
right: 0;
height: 100%;
text-align: center;
color: #FFFFFF;
}
.dt-button.buttons-columnVisibility {
background: #FF0000 !important;
color: white !important;
......@@ -257,3 +284,8 @@ a.my-tool-tip, a.my-tool-tip:hover, a.my-tool-tip:visited {
color: black;
}
......@@ -171,7 +171,7 @@ lapply(1:NROW(myentz), function(x)
davidquery <- function(entrezids, species, mycat) {
test = lapply(1:NROW(entrezids), function(x) {
david <- DAVIDWebService$new(email = "franck.soubes@inra.fr", url = "https://david.ncifcrf.gov/webservice/services/DAVIDWebService.DAVIDWebServiceHttpSoap12Endpoint/")
david <- DAVIDWebService$new(email = "get-trix@genotoul.fr", url = "https://david.ncifcrf.gov/webservice/services/DAVIDWebService.DAVIDWebServiceHttpSoap12Endpoint/")
RDAVIDWebService::setTimeOut(david, 90000)
result <-
addList(
......@@ -208,7 +208,7 @@ davidquery <- function(entrezids, species, mycat) {
davidqueryvenn <- function(entrezids, species){
david <- DAVIDWebService$new(email = "franck.soubes@inra.fr", url = "https://david.ncifcrf.gov/webservice/services/DAVIDWebService.DAVIDWebServiceHttpSoap12Endpoint/")
david <- DAVIDWebService$new(email = "get-trix@genotoul.fr", url = "https://david.ncifcrf.gov/webservice/services/DAVIDWebService.DAVIDWebServiceHttpSoap12Endpoint/")
RDAVIDWebService::setTimeOut(david, 90000)
addList(
david,
......@@ -239,7 +239,7 @@ davidqueryvenn <- function(entrezids, species){
mygotabres <- function(davtab){
lapply(seq(unique(davtab$Category)), function(x){
return(davtab %>% select(Category, Term,Fold.Enrichment,Benjamini,Count,List.Total)%>%
return(davtab %>% select(Category, Term,Fold.Enrichment,Benjamini,Count,List.Total,Pop.Hits)%>%
filter(Category == unique(davtab$Category)[[x]]) %>%
top_n(10, Fold.Enrichment) %>% arrange(desc(Fold.Enrichment))%>% tibble::rownames_to_column("Top")
)})
......
......@@ -18,6 +18,7 @@ DftoHighjson <- function(data, param) {
tempData$Topgenes <- data$Top
tempData$percent <- data$percent
unifiedData <- reshape(tempData, varying=paste0("y",1),
direction="long", idvar="Top",sep="",timevar="x")
......
......@@ -33,7 +33,7 @@ suppressPackageStartupMessages(library(x,character.only=TRUE))})
library(shinyFiles)
source("function/delayinput.R")
source("css/owncss.R")
source("css/csstips.R")
source("function/formating.R")
source("function/PCA.R")
source("function/heatmtruncated.R")
......
"" "app" "users"
"1" "server/app" "0"
"2" "server/MA_Trix_App" "0"
"3" "server/2" "1"
"4" "server/1" "1"
......@@ -76,22 +76,51 @@ shinyServer(function(input, output,session) {
return(toupper(mycol))
}
})
#findfamily <- debounce(input$findfamily, 2000)
family_input <- reactive({
input$findfamily
})
family_d <- shiny::debounce(family_input, 900)
familytopdisp <- reactive({
if(is.null(input$findfamily))
if(is.null(family_d))
return(NULL)
else{
if(!input$findfamily == ""){
genfam = grep(pattern = toupper(input$findfamily), toupper(csvf()[[3]]$GeneName)) %>% slice(csvf()[[3]],.)%>% select(GeneName) %>% unlist() %>% as.character()
if(!family_d() == ""){
genfam = grep(pattern = toupper(family_d()), toupper(csvf()[[3]]$GeneName)) %>% slice(csvf()[[3]],.)%>% select(GeneName) %>% unlist() %>% as.character()
}
else
genfam =""
return(toupper(genfam))
}
})
observe({
if(input$findfamily != ""){
shinyjs::disable("topvolc")
shinyjs::disable("fillvolc")
}
else if(input$fillvolc != ""){
shinyjs::disable("topvolc")
shinyjs::disable("findfamily")
}
else if(!is.na(input$topvolc)){
shinyjs::disable("findfamily")
shinyjs::disable("fillvolc")
}
else{
shinyjs::enable("topvolc")
shinyjs::enable("findfamily")
shinyjs::enable("fillvolc")
}
})
volcano <- reactive({
......@@ -210,11 +239,17 @@ shinyServer(function(input, output,session) {
session$sendCustomMessage(type="updatejcol", col2js)
})
jvennc_input <- reactive({
input$fill
})
jvenncol <- debounce(input$fill, 1000)
jvenncol <- shiny::debounce(jvennc_input, 500)
mycol <- reactive({
if(!input$fill == ""){
if(!jvenncol() == ""){
mycol = gsub("^\\s+|\\s+$", "", unlist(strsplit(jvenncol(), ",")))
}
......
......@@ -84,7 +84,7 @@ vennfinal <- reactive({
resfinal <- csvf()[[3]] %>%
filter(ProbeName %in% venninter()[[reordchoice]]) %>%
#filter(ProbeName %in% input$jvennlist) %>%
select(GeneName, paste0("logFC_", choix_cont())) %>%
select(ProbeName, GeneName, paste0("logFC_", choix_cont())) %>%
mutate_if(is.numeric, funs(format(., digits = 3)))
}
else if (!input$Allcont && input$dispvenn == "genes")
......
......@@ -257,7 +257,7 @@ observe({
lengthofmyclust = sapply(1:NROW(unique( hmobj$hm$cluster)),function(x)
return(length(which(hmobj$hm$cluster ==x)))) %>%
cbind(.,sapply(1:NROW(unique( hmobj$hm$cluster)),function(x)
return(length(which(mydfhmgen$cluster ==x))))) %>% as.data.frame()%>%
return(length(which(mydfhmgen$cluster ==x))))) %>% as.data.frame() %>%
setNames(.,c("total number of probes","total number of genes"))
rownames(lengthofmyclust) <- sapply(1:NROW(unique(hmobj$hm$cluster)), function(x)
return(paste("cluster", x)))
......
......@@ -4,6 +4,7 @@
### Where: GET-TRiX's facility
### Application: MATRiX is a shiny application for Microarray Analysis on Transcriptomic impact of Xenobiotics
### Licence: GPL-3.0
### TODO comment
......@@ -16,17 +17,20 @@ axisParameters <- list(
)
filteredata<- reactive({
#d <- NULL
req(myresdavitab())
# paraltest <- myresdavitab()
# cl <- makeCluster(getOption("cl.cores", 4))
# clusterExport(cl,c("paraltest"),envir=environment())
# clusterEvalQ(cl, library(dplyr))
reumdiff = lapply(1:length(myresdavitab()),function(x)return(sapply(length(myresdavitab()[[x]]$Count), function(y){
return(as.numeric(as.character(myresdavitab()[[x]]$Count))/as.numeric(as.character(myresdavitab()[[x]]$List.Total))*100)})) %>%
mutate(myresdavitab()[[x]],percent = .)) %>% rbind.fill()
return(as.numeric(as.character(myresdavitab()[[x]]$Count))/as.numeric(as.character(myresdavitab()[[x]]$Pop.Hits))*100)})) %>%
mutate(myresdavitab()[[x]],percent = .)) %>% bind_rows()#rbind.fill()
return(reumdiff)
# d = parLapply(cl, 1:length(paraltest),function(x)return(sapply(length(paraltest[[x]]$Count), function(y){
# return(as.numeric(as.character(paraltest$Count))/as.numeric(as.character(paraltest[[x]]$List.Total))*100)})) %>%
# mutate(paraltest[[x]],percent = .))
......@@ -44,7 +48,6 @@ plotDataenrichment <- reactive({
})
observe({
req(plotDataenrichment())
newData <- c(axisParameters$topcatdav, list(series=plotDataenrichment()))
......
### Author: Franck Soubès
### Bioinformatics Master Degree - University of Bordeaux, France
### Link: https://github.com/fsoubes/MA_Trix_App
### Where: GET-TRiX's facility
### Application: MATRiX is a shiny application for Microarray Analysis on Transcriptomic impact of Xenobiotics
### Licence: GPL-3.0
#https://shiny.rstudio.com/gallery/chat-room.html
# Create a spot for reactive variables specific to this particular session
......
......@@ -134,6 +134,6 @@ Venncluster <- eventReactive(input$GOvenn, {
})
})
pdf(NULL)
return(mygodavid)
})
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -84,8 +84,7 @@ sidebar <- dashboardSidebar(
# }
# ")), # analyse par microréseau de l'impact transcriptomique des xénobiotiques
useShinyjs(),
inlineCSS(appCSS),
tags$style(type="text/css", Errorcss),
#inlineCSS(appCSS),
tags$style(type="text/css", inactivity),
shinyjs::extendShinyjs(text = shinyjscode),
......@@ -134,7 +133,6 @@ body <- dashboardBody(
#tags$head(includeScript("google-analytics.js")),
tags$style(type="text/css", inactivity),
tags$style(type="text/css", Errorcss),
useShinyjs(),
......@@ -148,7 +146,7 @@ body <- dashboardBody(
.tabbable > .nav > li > a[data-value='cutpan'] {background-color: blue; color:white}
")),
inlineCSS(appCSS),
#inlineCSS(appCSS),
includeCSS("./css/style.css"),
div(
id = "loading-content",
......@@ -169,9 +167,9 @@ body <- dashboardBody(
tags$h3("MATRiX is a shiny application for Microarray Analysis on Transcriptomic impact of Xenobiotics."),
p("This project initiated by Yannick Lippi aims to facilitate access to biologist in order to publish graphs such as heatmap, PCA or Venn diagram related to specifics data produced by TRiX's facility.", tags$br(),"
MATRiX is an application dedicated to DNA chip analysis, this application incorporates quality control with Principal components analysis to summarizes microarray and differential analysis with various methods such as Venn diagram, Heatmap clustering and GO Enrichment analysis by querying the DWS (DAVID WEB SERVICES).",tags$br(),"
MATRiX is an application dedicated to DNA chip analysis, this application incorporates quality control with Principal components analysis to summarizes microarray data and differential analysis with various methods such as Venn diagram, Heatmap clustering and GO Enrichment analysis by querying the DWS (DAVID WEB SERVICES).",tags$br(),"
MATRiX app is working with specific data produced by the limma package, resulting p-values are adjusted according to the Benjamini and Hochberg procedure [Benjamini and Hochberg 1995]. PCA is computed with the FactoMineR package and the plot is produced with the factoextra package, for the Heatmap and Venn diagram the graphs are obtained respectively with the gplots and VennDiagram package, those packages are available on CRAN This application works only with specific data produced by the plateau TRiX, you can check the example file (MA_Trix_App/sampleData.zip)."),
MATRiX app is working with specific data produced by the limma package, resulting p-values are adjusted according to the Benjamini and Hochberg procedure [Benjamini and Hochberg 1995]. PCA is computed with the FactoMineR package and the plot is produced with the factoextra package, for the Heatmap and Venn diagram the graphs are obtained respectively with the gplots and VennDiagram package, those packages are available on CRAN. This application works only with specific data produced by the plateau TRiX, you can check the example file (MA_Trix_App/sampleData.zip)."),
p("Hereafter is the global workflow passing by the statistical analysis to the visualization:"),tags$br(),
div(id="workflow",
......@@ -263,9 +261,9 @@ MATRiX app is working with specific data produced by the limma package, resultin
box(
title = "What's new in MATRiX", width = NULL, status = "primary",
div(style = 'overflow-y: scroll; height: 500px',
addNews("Nov 30th 2018", "MATRiX", "Add tootlip for distance, its now possible to export acyclic graph in pdf and eps, correct bugs for classification enrichment with 0 nodes by inactivating donwload button"),
addNews("Nov 30th 2018", "MATRiX", "Add tootlip for distance, its now possible to export acyclic graphs in pdf and eps, correct bugs for classification enrichment with 0 nodes by inactivating donwload button"),
addNews("Nov 29th 2018", "Venn Diagram/HTML", "Correct bugs now venn diagram table is based on genes and not probes."),
addNews("Npv 5th 2018", "Venn Diagram", "Remove non annotated genes."),
addNews("Nov 5th 2018", "Venn Diagram", "Remove non annotated genes."),
addNews("Oct 19th 2018", "Volcano plot", "Search group of genes based on regular expression."),
addNews("Oct 15th 2018", "Venn Diagram", "Change the library to Jvenn."),
addNews("Aug 15th 2018", "Presentation/Video", "Added a video to present MATRiX and add modules to import files."),
......@@ -329,7 +327,7 @@ MATRiX app is working with specific data produced by the limma package, resultin
tags$img(src = "pdata.png"),
tags$img(src = "wotkingset.png"),
tags$img(src = "restable.png")
tags$img(src = "Restable.png")
),
......@@ -411,14 +409,14 @@ MATRiX app is working with specific data produced by the limma package, resultin
p(" Highlight your selected gene(s) in the volcano plot with a comma-separated list of input ")
),
textInput(inputId = "fillvolc",label = NULL,value = "",
textInput(inputId = "fillvolc",label = NULL,value = NULL,
placeholder = "FOXP2,OT,AVPR1a",width = "100%"
),
div(id = "mytextvolcgrep",
p(" Highlight a family of gene in the volcano plot")
),
textInput(inputId = "findfamily",label = NULL,
textInput(inputId = "findfamily",label = NULL, value = NULL,
placeholder = "Cyp",width = "100%"),
numericInput(
'topvolc',
......@@ -597,7 +595,8 @@ MATRiX app is working with specific data produced by the limma package, resultin
downloadButton('downloadvennset', "Download the filtered data",
style ="color: #fff; background-color: #337ab7; border-color: #2e6da4;"))
)),
)
),
conditionalPanel(condition = '!output.bool',
uiOutput(outputId = "image")
......@@ -609,7 +608,8 @@ MATRiX app is working with specific data produced by the limma package, resultin
tags$script(src="tooltip.js"),
fluidRow(column(6,br(),br(),
tags$script(src="jvenn.js"),
tags$div(id="jvenn-container", style = "background-color: white; width: 600px;")
tags$div(id="jvenn-container", style = "background-color: white; width: 100%; height:100%")
#tags$div(id="jvenn-container", style = "background-color: white; width: 600px;")
),
column(6,
......
......@@ -118,10 +118,6 @@ $(document).ready(function () {
//$("div#jvenn-container .test").addClass('draggable');
//$("div#jvenn-container .test").draggable();
// $('button').click(function(){
// $(this).css("background", "red").siblings().css("background", "green");
// });
//
$('.btn-group button').on('click', function(){
$(this).siblings().removeClass('active')
$(this).addClass('active');
......@@ -184,7 +180,6 @@ $(document).ready(function () {
$('[id^="ff"]').click(function() {
fontFamily = $(this).html();
//Shiny.onInputChange("updamod",fontFamily);
updateJvenn();
});
......
This source diff could not be displayed because it is too large. You can view the blob instead.
www/whatmaen.png

200 KB | W: | H:

www/whatmaen.png

151 KB | W: | H:

www/whatmaen.png
www/whatmaen.png
www/whatmaen.png
www/whatmaen.png
  • 2-up
  • Swipe
  • Onion skin
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment