Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Amine GHOZLANE
shaman
Commits
8932f428
Commit
8932f428
authored
Feb 25, 2016
by
svolant
Browse files
ajout scatterplot
parent
eef4fd9c
Changes
3
Show whitespace changes
Inline
Side-by-side
internal.R
View file @
8932f428
...
@@ -1111,6 +1111,83 @@ CheckCountsTable <- function(counts)
...
@@ -1111,6 +1111,83 @@ CheckCountsTable <- function(counts)
}
}
######################################################
##
## Scatter plot
##
######################################################
Plot_Visu_Scatterplot
<-
function
(
input
,
resDiff
,
export
=
FALSE
,
lmEst
=
FALSE
){
plot
=
NULL
regCoef
=
NULL
Rsq
=
NULL
dds
=
resDiff
$
dds
counts
=
as.data.frame
(
round
(
counts
(
dds
,
normalized
=
TRUE
)))
target
=
as.data.frame
(
resDiff
$
target
)
data
=
cbind
(
target
,
log2
(
t
(
counts
)
+1
))
## Get Input for ScatterPlot
Xvar
=
input
$
Xscatter
Yvar
=
input
$
Yscatter
ColBy
=
input
$
ColorBy
PchBy
=
input
$
PchBy
PointSize
=
input
$
PointSize
x_var
=
if
(
is.null
(
Xvar
))
NULL
else
data
[,
Xvar
]
y_var
=
if
(
is.null
(
Yvar
))
NULL
else
data
[,
Yvar
]
col_var
=
if
(
ColBy
==
"None"
||
is.null
(
ColBy
))
NULL
else
data
[,
ColBy
]
symbol_var
=
if
(
PchBy
==
"None"
||
is.null
(
PchBy
))
NULL
else
data
[,
PchBy
]
size_var
=
if
(
PointSize
==
"None"
||
is.null
(
PointSize
))
NULL
else
data
[,
PointSize
]
if
(
!
export
&&
!
input
$
AddRegScatter
&&
!
lmEst
){
plot
=
scatterD3
(
x
=
x_var
,
y
=
y_var
,
lab
=
rownames
(
data
),
xlab
=
Xvar
,
ylab
=
Yvar
,
col_var
=
col_var
,
col_lab
=
ColBy
,
symbol_var
=
symbol_var
,
symbol_lab
=
PchBy
,
size_var
=
size_var
,
size_lab
=
PointSize
,
key_var
=
rownames
(
data
),
height
=
input
$
heightVisu
,
point_opacity
=
0.7
,
labels_size
=
input
$
SizeLabelScatter
,
transitions
=
TRUE
)
return
(
plot
)
}
if
(
export
||
input
$
AddRegScatter
){
if
(
!
lmEst
){
col_var
=
if
(
ColBy
==
"None"
||
is.null
(
ColBy
))
1
else
data
[,
ColBy
]
symbol_var
=
if
(
PchBy
==
"None"
||
is.null
(
PchBy
))
factor
(
rep
(
1
,
nrow
(
data
)))
else
data
[,
PchBy
]
size_var
=
if
(
PointSize
==
"None"
||
is.null
(
PointSize
))
1
else
data
[,
PointSize
]
plot
=
ggplot
(
data
,
aes
(
x
=
x_var
,
y
=
y_var
))
+
geom_point
(
aes
(
color
=
col_var
,
size
=
size_var
,
shape
=
symbol_var
),
alpha
=
0.7
)
if
(
input
$
SizeLabelScatter
!=
0
)
plot
=
plot
+
geom_text
(
aes
(
label
=
rownames
(
data
),
color
=
col_var
,
size
=
input
$
SizeLabelScatter
/
20
),
vjust
=
0
,
nudge_y
=
0.05
)
plot
=
plot
+
xlab
(
Xvar
)
+
ylab
(
Yvar
)
if
(
input
$
AddRegScatter
)
plot
=
plot
+
geom_smooth
(
method
=
"lm"
)
return
(
plot
)
}
}
if
(
lmEst
)
{
res
=
lm
(
y_var
~
x_var
)
sumRes
=
summary
(
res
)
regCoef
=
sumRes
$
coefficients
rownames
(
regCoef
)
=
c
(
"Intercept"
,
Xvar
)
Rsq
=
sumRes
$
r.squared
return
(
list
(
regCoef
=
regCoef
,
Rsq
=
Rsq
))
}
}
######################################################
######################################################
##
##
## GLOBAL VIEW
## GLOBAL VIEW
...
...
server.R
View file @
8932f428
...
@@ -54,6 +54,12 @@ if (!require(biom)) {
...
@@ -54,6 +54,12 @@ if (!require(biom)) {
if
(
!
require
(
devtools
))
{
if
(
!
require
(
devtools
))
{
install.packages
(
'devtools'
)
install.packages
(
'devtools'
)
library
(
devtools
)
}
if
(
!
require
(
scatterD3
))
{
install.packages
(
'scatterD3'
)
library
(
scatterD3
)
}
}
if
(
!
require
(
rNVD3
))
{
if
(
!
require
(
rNVD3
))
{
...
@@ -67,7 +73,7 @@ if (!require(genefilter)) {
...
@@ -67,7 +73,7 @@ if (!require(genefilter)) {
biocLite
(
"genefilter"
)
biocLite
(
"genefilter"
)
library
(
genefilter
)
library
(
genefilter
)
}
}
library
(
shinyjs
)
# Allow to upload 50M files
# Allow to upload 50M files
options
(
shiny.maxRequestSize
=
50
*
1024
^
2
)
options
(
shiny.maxRequestSize
=
50
*
1024
^
2
)
source
(
"internal.R"
)
source
(
"internal.R"
)
...
@@ -87,10 +93,10 @@ shinyServer(function(input, output,session) {
...
@@ -87,10 +93,10 @@ shinyServer(function(input, output,session) {
## Create base for contrast
## Create base for contrast
rand
=
floor
(
runif
(
1
,
0
,
1e9
))
rand
=
floor
(
runif
(
1
,
0
,
1e9
))
namesfile
=
tempfile
(
pattern
=
"BaseContrast"
,
tmpdir
=
tempdir
(),
fileext
=
""
)
namesfile
=
tempfile
(
pattern
=
"BaseContrast"
,
tmpdir
=
tempdir
(),
fileext
=
""
)
#paste("/srv/shiny-server/sample-apps/SHAMAN/BaseContrast_",rand,".txt",sep="")
file.create
(
namesfile
,
showWarnings
=
FALSE
)
file.create
(
namesfile
,
showWarnings
=
FALSE
)
#namesfile = "www/All_Contrast.txt"
## Popup messages
observe
(
if
(
input
$
AddRegScatter
)
info
(
"By adding the regression line, you will loose interactivity."
))
## Counts file
## Counts file
dataInputCounts
<-
reactive
({
dataInputCounts
<-
reactive
({
...
@@ -1254,6 +1260,32 @@ output$RunButton <- renderUI({
...
@@ -1254,6 +1260,32 @@ output$RunButton <- renderUI({
},
env
=
new.env
())
},
env
=
new.env
())
output
$
ScatterplotD3
<-
renderScatterD3
({
resDiff
=
ResDiffAnal
()
if
(
!
is.null
(
resDiff
$
dds
))
withProgress
(
message
=
"Loading..."
,
Plot_Visu_Scatterplot
(
input
,
resDiff
))
})
output
$
Scatterplotgg
<-
renderPlot
({
resDiff
=
ResDiffAnal
()
if
(
!
is.null
(
resDiff
$
dds
))
withProgress
(
message
=
"Loading..."
,
Plot_Visu_Scatterplot
(
input
,
resDiff
,
lmEst
=
FALSE
))
})
## Regression coefficients Table
output
$
lmRegScatter
<-
renderDataTable
(
Plot_Visu_Scatterplot
(
input
,
ResDiffAnal
(),
lmEst
=
TRUE
)
$
regCoef
,
options
=
list
(
lengthMenu
=
list
(
c
(
10
,
50
,
-1
),
c
(
'10'
,
'50'
,
'All'
)),
pageLength
=
10
,
scrollX
=
TRUE
))
output
$
lmEquation
<-
renderPrint
({
res
=
Plot_Visu_Scatterplot
(
input
,
ResDiffAnal
(),
lmEst
=
TRUE
)
coef
=
res
$
regCoef
Rsq
=
res
$
Rsq
div
(
HTML
(
paste
(
h4
(
strong
(
"Linear equation: "
)),
"y ="
,
round
(
coef
[
2
,
1
],
2
),
'x '
,
ifelse
(
coef
[
1
,
1
]
>=
0
,
"+"
,
""
),
round
(
coef
[
1
,
1
],
2
),
'<br/>'
,
'<br/>'
,
h4
(
strong
(
"Adjusted R squared:"
)),
round
(
Rsq
,
5
)
*
100
,
" %"
)))
})
output
$
Boxplot
<-
renderPlot
({
output
$
Boxplot
<-
renderPlot
({
resDiff
=
ResDiffAnal
()
resDiff
=
ResDiffAnal
()
...
@@ -1305,6 +1337,8 @@ output$RunButton <- renderUI({
...
@@ -1305,6 +1337,8 @@ output$RunButton <- renderUI({
if
(
input
$
PlotVisuSelect
==
"Barplot"
)
res
=
showOutput
(
"PlotVisuBar"
)
if
(
input
$
PlotVisuSelect
==
"Barplot"
)
res
=
showOutput
(
"PlotVisuBar"
)
if
(
input
$
PlotVisuSelect
==
"Heatmap"
)
res
=
d3heatmapOutput
(
"heatmap"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Heatmap"
)
res
=
d3heatmapOutput
(
"heatmap"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Boxplot"
)
res
=
plotOutput
(
"Boxplot"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Boxplot"
)
res
=
plotOutput
(
"Boxplot"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Scatterplot"
&&
!
input
$
AddRegScatter
)
res
=
scatterD3Output
(
"ScatterplotD3"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Scatterplot"
&&
input
$
AddRegScatter
)
res
=
plotOutput
(
"Scatterplotgg"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Diversity"
)
res
=
plotOutput
(
"DiversityPlot"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Diversity"
)
res
=
plotOutput
(
"DiversityPlot"
,
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Rarefaction"
)
res
=
plotOutput
(
"RarefactionPlot"
,
dblclick
=
"RarefactionPlot_dblclick"
,
brush
=
brushOpts
(
id
=
"RarefactionPlot_brush"
,
resetOnNew
=
TRUE
),
height
=
input
$
heightVisu
+10
)
if
(
input
$
PlotVisuSelect
==
"Rarefaction"
)
res
=
plotOutput
(
"RarefactionPlot"
,
dblclick
=
"RarefactionPlot_dblclick"
,
brush
=
brushOpts
(
id
=
"RarefactionPlot_brush"
,
resetOnNew
=
TRUE
),
height
=
input
$
heightVisu
+10
)
...
@@ -1409,6 +1443,40 @@ output$RunButton <- renderUI({
...
@@ -1409,6 +1443,40 @@ output$RunButton <- renderUI({
}
}
})
})
output
$
VarIntVisuScatter
<-
renderUI
({
target
=
dataInputTarget
()
data
=
dataInput
()
$
data
taxo
=
input
$
TaxoSelect
resDiff
=
ResDiffAnal
()
res
=
list
()
namesTarget
=
colnames
(
target
)[
2
:
ncol
(
target
)]
if
(
!
is.null
(
data
$
counts
)
&&
!
is.null
(
data
$
taxo
)
&&
nrow
(
data
$
counts
)
>
0
&&
nrow
(
data
$
taxo
)
>
0
&&
!
is.null
(
taxo
)
&&
taxo
!=
"..."
&&
!
is.null
(
target
))
{
counts
=
dataMergeCounts
()
$
counts
## Get numeric variables from target
typesTarget
=
sapply
(
target
,
class
)
numInd
=
(
typesTarget
==
"numeric"
)[
2
:
ncol
(
target
)]
Available_x
=
sort
(
rownames
(
counts
))
if
(
any
(
numInd
))
Available_x
=
c
(
Available_x
,
namesTarget
[
numInd
])
Available_y
=
Available_x
res
[[
1
]]
=
selectizeInput
(
"Xscatter"
,
h6
(
strong
(
"X variable"
)),
Available_x
,
selected
=
Available_x
[
1
],
multiple
=
FALSE
)
res
[[
2
]]
=
selectizeInput
(
"Yscatter"
,
h6
(
strong
(
"Y variable"
)),
Available_y
,
selected
=
Available_x
[
2
],
multiple
=
FALSE
)
res
[[
3
]]
=
selectizeInput
(
"ColorBy"
,
h6
(
strong
(
"Color variable"
)),
c
(
"None"
=
"None"
,
namesTarget
[
!
numInd
]),
multiple
=
FALSE
)
res
[[
4
]]
=
selectizeInput
(
"PchBy"
,
h6
(
strong
(
"Symbol variable"
)),
c
(
"None"
=
"None"
,
namesTarget
[
!
numInd
]),
multiple
=
FALSE
)
res
[[
5
]]
=
selectizeInput
(
"PointSize"
,
h6
(
strong
(
"Point size according to"
)),
c
(
"None"
=
"None"
,
Available_x
),
selected
=
NULL
,
multiple
=
FALSE
)
}
return
(
res
)
})
#####################################################
#####################################################
##
##
## KRONA
## KRONA
...
...
ui.R
View file @
8932f428
...
@@ -2,7 +2,7 @@ if(!require(shinydashboard)){
...
@@ -2,7 +2,7 @@ if(!require(shinydashboard)){
install.packages
(
'shinydashboard'
)
install.packages
(
'shinydashboard'
)
library
(
shinydashboard
)
library
(
shinydashboard
)
}
}
library
(
shinyjs
)
if
(
!
require
(
psych
))
{
if
(
!
require
(
psych
))
{
install.packages
(
'psych'
)
install.packages
(
'psych'
)
library
(
psych
)
library
(
psych
)
...
@@ -43,6 +43,11 @@ if (!require(RColorBrewer)) {
...
@@ -43,6 +43,11 @@ if (!require(RColorBrewer)) {
library
(
RColorBrewer
)
library
(
RColorBrewer
)
}
}
if
(
!
require
(
scatterD3
))
{
install.packages
(
'scatterD3'
)
library
(
scatterD3
)
}
if
(
!
require
(
gplots
))
{
if
(
!
require
(
gplots
))
{
install.packages
(
'gplots'
)
install.packages
(
'gplots'
)
library
(
gplots
)
library
(
gplots
)
...
@@ -394,12 +399,27 @@ body <- dashboardBody(
...
@@ -394,12 +399,27 @@ body <- dashboardBody(
tabItem
(
tabName
=
"Visu"
,
tabItem
(
tabName
=
"Visu"
,
fluidRow
(
fluidRow
(
column
(
width
=
9
,
column
(
width
=
9
,
uiOutput
(
"plotVisu"
)
uiOutput
(
"plotVisu"
),
conditionalPanel
(
condition
=
"input.PlotVisuSelect=='Scatterplot' && !input.AddRegScatter"
,
useShinyjs
(),
br
(),
p
(
actionButton
(
"scatterD3-reset-zoom"
,
HTML
(
"<span class='glyphicon glyphicon-search' aria-hidden='true'></span> Reset Zoom"
)),
Align
=
"right"
)
),
conditionalPanel
(
condition
=
"input.PlotVisuSelect=='Scatterplot' && input.AddRegScatter"
,
column
(
width
=
6
,
br
(),
box
(
title
=
"Regression coefficients"
,
width
=
NULL
,
status
=
"primary"
,
solidHeader
=
TRUE
,
collapsible
=
TRUE
,
collapsed
=
TRUE
,
dataTableOutput
(
"lmRegScatter"
)
)
),
column
(
width
=
6
,
br
(),
htmlOutput
(
"lmEquation"
))
)
),
),
column
(
width
=
3
,
column
(
width
=
3
,
box
(
title
=
"Select your plot"
,
width
=
NULL
,
status
=
"primary"
,
solidHeader
=
TRUE
,
collapsible
=
FALSE
,
collapsed
=
FALSE
,
box
(
title
=
"Select your plot"
,
width
=
NULL
,
status
=
"primary"
,
solidHeader
=
TRUE
,
collapsible
=
FALSE
,
collapsed
=
FALSE
,
selectizeInput
(
"PlotVisuSelect"
,
""
,
c
(
"Barplot"
=
"Barplot"
,
"Heatmap"
=
"Heatmap"
,
"Boxplot"
=
"Boxplot"
,
"Diversity"
=
"Diversity"
,
"Rarefaction"
=
"Rarefaction"
),
selected
=
"
Ba
rplot"
)
selectizeInput
(
"PlotVisuSelect"
,
""
,
c
(
"Barplot"
=
"Barplot"
,
"Heatmap"
=
"Heatmap"
,
"Boxplot"
=
"Boxplot"
,
"
Scatterplot"
=
"Scatterplot"
,
"
Diversity"
=
"Diversity"
,
"Rarefaction"
=
"Rarefaction"
),
selected
=
"
Scatte
rplot"
)
),
),
...
@@ -409,19 +429,22 @@ body <- dashboardBody(
...
@@ -409,19 +429,22 @@ body <- dashboardBody(
###
###
########################################################################
########################################################################
box
(
title
=
"Options"
,
width
=
NULL
,
status
=
"primary"
,
solidHeader
=
TRUE
,
collapsible
=
TRUE
,
collapsed
=
FALSE
,
box
(
title
=
"Options"
,
width
=
NULL
,
status
=
"primary"
,
solidHeader
=
TRUE
,
collapsible
=
TRUE
,
collapsed
=
FALSE
,
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction'"
,
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction'
&& input.PlotVisuSelect!='Scatterplot'
"
,
uiOutput
(
"VarIntVisu"
),
uiOutput
(
"VarIntVisu"
),
h5
(
strong
(
"Select the modalities"
)),
h5
(
strong
(
"Select the modalities"
)),
uiOutput
(
"ModVisu"
)
uiOutput
(
"ModVisu"
)
),
),
conditionalPanel
(
condition
=
"input.PlotVisuSelect=='Scatterplot' "
,
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity'"
,
uiOutput
(
"VarIntVisuScatter"
),
checkboxInput
(
"AddRegScatter"
,
"Add regression line"
,
FALSE
)
),
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity' && input.PlotVisuSelect!='Scatterplot'"
,
radioButtons
(
"SelectSpecifTaxo"
,
"Select the features"
,
c
(
"Most abundant"
=
"Most"
,
"All"
=
"All"
,
"Differential features"
=
"Diff"
,
"Non differential features"
=
"NoDiff"
))
radioButtons
(
"SelectSpecifTaxo"
,
"Select the features"
,
c
(
"Most abundant"
=
"Most"
,
"All"
=
"All"
,
"Differential features"
=
"Diff"
,
"Non differential features"
=
"NoDiff"
))
),
),
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity' && (input.SelectSpecifTaxo=='Diff' || input.SelectSpecifTaxo=='NoDiff') "
,
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity' &&
input.PlotVisuSelect!='Scatterplot' &&
(input.SelectSpecifTaxo=='Diff' || input.SelectSpecifTaxo=='NoDiff') "
,
selectizeInput
(
"ContrastList_table_Visu"
,
""
,
choices
=
""
,
multiple
=
FALSE
)
selectizeInput
(
"ContrastList_table_Visu"
,
""
,
choices
=
""
,
multiple
=
FALSE
)
),
),
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity'"
,
conditionalPanel
(
condition
=
"input.PlotVisuSelect!='Rarefaction' && input.PlotVisuSelect!='Diversity'
&& input.PlotVisuSelect!='Scatterplot'
"
,
uiOutput
(
"TaxoToPlotVisu"
)
uiOutput
(
"TaxoToPlotVisu"
)
),
),
...
@@ -507,6 +530,16 @@ body <- dashboardBody(
...
@@ -507,6 +530,16 @@ body <- dashboardBody(
column
(
width
=
6
,
sliderInput
(
"lowerMargin"
,
h6
(
"Lower"
),
min
=
0
,
max
=
20
,
value
=
6
,
step
=
1
))
column
(
width
=
6
,
sliderInput
(
"lowerMargin"
,
h6
(
"Lower"
),
min
=
0
,
max
=
20
,
value
=
6
,
step
=
1
))
)
)
),
),
##################
## Scatterplot
##################
conditionalPanel
(
condition
=
"input.PlotVisuSelect=='Scatterplot'"
,
fluidRow
(
column
(
width
=
12
,
sliderInput
(
"SizeLabelScatter"
,
h6
(
"Label size"
),
min
=
0
,
max
=
50
,
value
=
10
,
step
=
1
))
)
),
##################
##################
## ALL
## ALL
##################
##################
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment