Maintenance - Mise à jour mensuelle Lundi 7 Décembre 2021 entre 7h00 et 9h00

Commit 1b47a0b9 authored by fsoubes's avatar fsoubes
Browse files

modify code

parent 8e0f785c
<div class="btn-group" data-toggle="buttons-radio">
<button id="ds_yes" type="button" class="btn btn-mini active">Yes</button>
<button id="ds_yes" type="button" class="btn btn-mini active">Yes</button>
<button id="ds_no" type="button" class="btn btn-mini">No</button>
</div><br/>
<div class="btn-group" data-toggle="buttons-radio">
<button id="dsw_yes" type="button" class="btn btn-mini active">Yes</button>
<button id="dsw_no" type="button" class="btn btn-mini">No</button>
</div><br/>
<div class="btn-group" data-toggle="buttons-radio">
<button id="fs_8" type="button" class="btn btn-mini">8px</button>
<button id="fs_9" type="button" class="btn btn-mini">9px</button>
<button id="fs_10" type="button" class="btn btn-mini">10px</button>
<button id="fs_11" type="button" class="btn btn-mini">11px</button>
<button id="fs_12" type="button" class="btn btn-mini active">12px</button>
<button id="fs_13" type="button" class="btn btn-mini">13px</button>
<button id="fs_14" type="button" class="btn btn-mini">14px</button>
</div><br/>
</div><br/>
<div class="btn-group" data-toggle="buttons-radio">
<button id="dm_classic" type="button" class="btn btn-mini active">Classic</button>
<button id="dm_edwards" type="button" class="btn btn-mini">Edwards'</button>
</div>
\ No newline at end of file
<div class="btn-group" data-toggle="buttons-radio" >
<button id="dm_classic" class="btn btn-mini active" >Classic</button>
<button id="dm_edwards" class="btn btn-mini">Edwards'</button>
</div>
<!--div class="btn-group" role="group" aria-label="Basic example">
<button type="button" class="btn btn-secondary">Left</button>
<button type="button" class="btn btn-secondary">Middle</button>
<button type="button" class="btn btn-secondary">Right</button>
</div-->
<!--div class="btn-group">
<button class="btn" id="test0" autofocus="true">Mon</button>
<button class="btn" id="test1">Tue</button>
<button class="btn" id="test2">Wed</button>
<button class="btn" id="test3">Thu</button>
<button class="btn" id="test4">Fri</button>
<button class="btn" id="test5">Sat</button>
<button class="btn" id="test6">Sun</button>
</div-->
<div class="btn-group btn-group-toggle" data-toggle="buttons">
<label class="btn btn-secondary active">
<input type="radio" name="options" id="option1" autocomplete="off" checked> Classic
</label>
<label class="btn btn-secondary">
<input type="radio" name="options" id="option2" autocomplete="off"> Edwards
</label>
<label class="btn btn-secondary">
<input type="radio" name="options" id="option3" autocomplete="off"> Radio
</label>
</div>
<div style='margin-top: -10.8%;position:absolute; right:23%;'>
<a class='my-tool-tip' data-toggle="tooltip" data-placement="left" title="Tooltip here"> <!-- The class CANNOT be tooltip... -->
<i class='glyphicon glyphicon-info-sign'></i>
</a>
</div>
No preview for this file type
This diff is collapsed.
......@@ -21,7 +21,7 @@ inactivity <- "function idleTimer() {
idleTimer();"
#The following html are sourced from https://github.com/aghozlane/shaman/blob/master/css/owncss.R
spincss <- "
#plot-container {
z-index: 0;
......@@ -41,8 +41,8 @@ background-color: #fff;
}
"
Errorcss <-
".shiny-output-error { visibility: visible; color: #3c8dbc;}
Errorcss <-
".shiny-output-error { visibility: visible; color: orange; font-size: larger;}
.shiny-output-error:before {
color: #3c8dbc;
......@@ -90,40 +90,24 @@ margin-bottom: -40px;
#' addNews is a function that render a pretty table for news
#'
#' @param date
#' @param title
#' @param text
#' @author Amine Ghozlane
#' @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)))
}
#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;
#}
#"
......@@ -18,7 +18,7 @@ ul li {
position: static;
font-size: 18px;
}
}
.skin-blue .sidebar-menu > li.active > a,.skin-blue .sidebar-menu > li:hover > a {
color:#fff;
......@@ -41,6 +41,10 @@ h2 {
font-size: 20px;
}
#warningsheat {
background-color: #ecf0f5;
border: 1px solid #ecf0f5;
}
p {
/*
......@@ -54,7 +58,6 @@ p {
}
.skin-blue .main-header .logo {
background-color:#1D4D68;
}
......@@ -79,20 +82,38 @@ p {
height: 30%;
}
#advancedjvenn .btn{
border: none;
outline: none;
padding: 6px 11px;
cursor: pointer;
background-color: #337ab7;
}
#advancedjvenn .btn:hover .btn:active {
background-color: #666;
color: white;
}
#advancedjvenn .activate, .btn:hover , .activated {
background-color: #666;
color: white;
}
#advancedjvenn .btn:focus {
outline: none;
}
#advancedjvenn .élément{
color:black;
}
#advancedjvenn .active, .btn:hover {
#advancedjvenn .active .btn-mini:hover .btn-mini:focus {
background-color: #666;
color: white;
}
......@@ -232,4 +253,7 @@ div.outer {
bottom: 0px;
}
a.my-tool-tip, a.my-tool-tip:hover, a.my-tool-tip:visited {
color: black;
}
......@@ -25,46 +25,49 @@
#' @param type a character to select the plot to display heatmap, boxplot or stripchart
#' @param las a numeric value
#' @param distfun function used to compute the distance (dissimilarity) between both rows and columns.
#' @param palette.col a character vector
#' @param num an item of the heatmap object corresponding to a specific cluster choosen by the user
#' @param ...
#' @param palette.col a character vector
#' @param num an item of the heatmap object corresponding to a specific cluster choosen by the user
#' @param ...
#'
#' @return a ggplot object or heatmapply object
#'
#'
#' @export
cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,labrow = T,
fileType = "png",scale = "row",meanGrp = F,mypal = NULL,
col.hm = maPalette(low = "green",high = "red",mid = "black",k = 75),
#maPalette <- function (low = "green", high = "red", mid = NULL, k = 50)
cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,labrow = F,
fileType = "png",scales = "row",meanGrp = F,mypal = NULL,
#col.hm= maPalette(low="green",high="red",mid="black",k=75),
type = "None",las = 2,distfun = "cor",palette.col = NULL,num = 4,...)
{
require(ggplot2)
require(grid)
require(gridExtra)
plot.boxplot = ifelse(type == "Boxplot", T, F)
plot.stripchart = ifelse(type == "LB" | type == "WB", T, F)
hmp.plot = ifelse(type == "Heatmap", T, F)
probes.boxplot = ifelse(type == "WB", T, F)
if(is.null(mypal))
mypal = brewer.pal(8,"Dark2") %>%
list(brewer.pal(10,"Paired")) %>%
unlist()
if(!is.null(palette.col)){
palette(palette.col);
}else palette(mypal)
cl=palette(mypal);
# if (!is.null(palette.col)) {
# cl = palette(palette.col)
# }else cl=palette(c("black", "blue", "cyan", "magenta", "darkgray", "darkgoldenrod", "violet", "orange", "lightgreen","lightblue", "darkorchid", "darkred","darkslateblue", "darkslategray", "maroon", "burlywood1" , "darkolivegreen"));
# } else
# cl = palette(
......@@ -89,10 +92,10 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
# "#CC0000"
# )
# )
colid = colnames(exprData)
exprData = exprData[labels(hmp$rowDendrogram), ]
wdt = 900
wdte = 12
......@@ -113,7 +116,7 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
wdt = 600
wdte = 8
}
if (distfun == "cor") {
distfunTRIX = distcor
} else {
......@@ -121,7 +124,7 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
dist(x, method = method)
}
}
###=======================
## decoupage de la heatmap
###=======================
......@@ -130,36 +133,41 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
cut02 = cut(hmp$rowDendrogram, h = height)
#upper est une version tronquee de l'arbre de depart
#lower est une liste contenant les X sous-dendrogrammes generes par la coupure
cat("\n -> size of", length(cut02$lower), "sub-dendrograms\n")
print(sapply(cut02$lower, function(x)
length(labels(x))))
#Pour voir quels sont les effectifs de chaque sous-groupe de genes
###export toptable sous groupes hclust
cat(" ->export result tables for each subgroup \n")
gpcol = num2cols(as.numeric(groups))
# idx sondes de chaque cluster
HCgroupsLab = lapply(cut02$lower, function(x)
labels(x))
# expression de chaque cluster
HCgroupsLabExrs = lapply(HCgroupsLab, function(x)
exprData0[x, ])
## centrage reduction
HCgroupsLabExrsCenterScale = lapply(HCgroupsLabExrs, function(y) {
t(scale(t(y), center = T, scale = T))
})
## exr moyen par groupe et pour chaque cluster
grps = groups0
HCgroupsLabExrsCenterScaleMean = lapply(HCgroupsLabExrsCenterScale, function(y) {
gpcol=num2cols(as.numeric(groups))
# if(!is.null(palette.col)){
# gpcol=num2cols(as.numeric(groups),palette.col)
# }else gpcol=num2cols(as.numeric(groups))
# idx sondes de chaque cluster
HCgroupsLab=lapply(cut02$lower,function(x)labels(x))
# expression de chaque cluster
HCgroupsLabExrs=lapply(HCgroupsLab,function(x)exprData0[x,])
## centrage reduction
# HCgroupsLabExrsCenterScale <- ifelse(scales=="row",lapply(HCgroupsLabExrs,function(y){t(scale(t(y),center=T,scale=T))}),HCgroupsLabExrs)
if(scales=="row"){
HCgroupsLabExrsCenterScale <- lapply(HCgroupsLabExrs,function(y){t(scale(t(y),center=T,scale=T))})
}else HCgroupsLabExrsCenterScale <- HCgroupsLabExrs
## exr moyen par groupe et pour chaque cluster
grps=groups0
#print(grps)
#print(HCgroupsLabExrsCenterScale)
HCgroupsLabExrsCenterScaleMean = lapply(HCgroupsLabExrsCenterScale, function(y) {
t(apply(
y,
1,
......@@ -168,29 +176,29 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
}
))
})
if (plot.boxplot & !plot.stripchart) {
###=======================
## boxplot de la heatmap
###=======================
cat(" ->Expression boxplot for each subgroup \n")
library(Hmisc)
library(reshape2)
library(plotly)
#library(heatmaply)
myplots <- list()
for (i in 1:length(HCgroupsLabExrsCenterScaleMean)) {
#print(length(HCgroupsLabExrsCenterScaleMean))
local({
i <- i
dataCentS = HCgroupsLabExrsCenterScaleMean[[i]]
isplotable = apply(simplify2array(dataCentS), 1:2, sum, na.rm = TRUE)
nProbes = nrow(dataCentS)
......@@ -223,7 +231,7 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
size = 3
) +
#geom_boxplot(width = 0.1, fill = NA) +
labs(title = paste("Cluster", i),
subtitle = paste(caption = footnote)) +
theme(
......@@ -239,7 +247,7 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
),
axis.text.y = element_text(size = 12, colour = "#888888")
)
if (nProbes > 2)
myplots[[i]] <<-
(ggbplot +
......@@ -247,28 +255,28 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
geom_boxplot(width = 0.1, aes(fill = Group),alpha = 0.3))
else
myplots[[i]] <<- (ggbplot)
})
}
return(myplots[[as.numeric(num)]])
}
#############"
### ggplot2
#############"
if (plot.stripchart) {
cat(" ->Plotting Expression as stripchart for each subgroup \n")
#print(head(HCgroupsLabExrsCenterScale))
numProbes = lapply(HCgroupsLabExrsCenterScale, nrow)
myplotsstrip <- list()
for (i in 1:length(HCgroupsLabExrsCenterScale)) {
local({
i <- i
dataStacked = as.vector(HCgroupsLabExrsCenterScale[[i]])
dataStackeddt = cbind.data.frame(
Expression = dataStacked,
factor.trace = rep(grps, each = nrow(HCgroupsLabExrsCenterScale[[i]])),
......@@ -283,14 +291,14 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
)
dataStackeddt$Grp = dataStackeddt$factor.trace
nindiv = table(dataStackeddt$Grp) / numProbes[[i]]
# print(head(dataStackeddt))
if (all(nindiv == nindiv[1])) {
nindiv = as.character(nindiv[1])
} else
nindiv = paste(nindiv, collapse = ", ")
footnote <-
paste("mean expression Z-score +/- 95%CI; N=",
nindiv,
......@@ -298,20 +306,20 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
numProbes[[i]],
" probes",
sep = "")
if (!probes.boxplot) {
# print(footnote)
##=============
## plot stripchart
##
#### jitter classique
# d=data.frame(Grp=rep(c('before','after'), 2000), Expression=rexp(4000, 1))
# ggstrip= ggplot(d, aes(x=Grp, y = Expression)) +
# geom_jitter()
ggstrip = ggplot(dataStackeddt, aes(x = Grp, y = Expression)) +
# geom_jitter()
theme_bw() + theme(
......@@ -366,13 +374,13 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
),
axis.text.y = element_text(size = 12, colour = "#888888")
)
myplotsstrip[[i]] <<- (ggstrip)
}
else {
##### jitter classique avec boxplots par probe
ggstrip = ggplot(data = dataStackeddt, aes(
x = Grp,
y = Expression,
......@@ -421,73 +429,68 @@ cutHeatmaps = function(hmp,height,exprData,DEGres,groups,cexcol = 1,cexrow = 1,l
)
myplotsstrip[[i]] <<- (ggstrip)
}
})
}
return(myplotsstrip[[as.numeric(num)]])
}
####################"" END ggplot2
###=======================
## plot de la heatmap
###=======================
if (hmp.plot) {
cat(" ->plot heatmap for each subgroup \n")
# for (i in 1:length(cut02$lower)) {
# if (length(labels(cut02$lower[[num]])) > 1) {
# rowIds = NA
# if(length(labrow)>1){ rowIds=labrow[labels(cut02$lower[[i]])]
# }else if(labrow==T) rowIds=DEGres$ResTable$GeneName[labels(cut02$lower[[i]])]
#if(length(labrow)>1){ rowIds=labrow[labels(cut02$lower[[i]])]
if (labrow == T)
if (labrow == T)
rowIds = DEGres$ResTable[labels(cut02$lower[[num]]), "GeneName"]
# View(as.matrix(exprData[labels(cut02$lower[[num]]),]))
useRasterTF = T
#m02gp = heatmaply(
heatmaply(
as.matrix(exprData[labels(cut02$lower[[num]]),]),
height=900,col = col.hm,distfun = distfunTRIX,hclustfun = hclustfun,
scale = scale, Colv = hmp$colDendrogram
)%>%
layout(margin = list(l = 130, b = 100))
#Rowv = str(cut02$lower[[num]]),
# Colv = hmp$colDendrogram,
# col = col.hm,
# distfun = distfunTRIX,
# hclustfun = hclustfun,
# labRow = rowIds,
# labCol = colid,
# ColSideColors = gpcol,
# cexCol = cexcol,
# cexRow = cexrow,
# scale = scale,
# na.rm = T,
# margins = c(8, 8),
# useRaster = useRasterTF
# mtext(
# side = 3,
# sort(levels(groups)),
# adj = 1,
# padj = seq(0, by = 1.4, length.out = length(levels(groups))),
# col = cl[(1:length(levels(groups)))],
# cex = 1,
# line = 3
# )
#return(hm02gp)
#}
return(hm02gp)
# }
# useRasterTF = T
# hm02gp = heatmaply(
# heatmaply(
# as.matrix(exprData[labels(cut02$lower[[num]]),]),
# height=900,col = col.hm,distfun = distfunTRIX,hclustfun = hclustfun,
# scale = scale, Colv = hmp$colDendrogram