Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Midoux Cedric
easy16S
Commits
12ba9644
Commit
12ba9644
authored
Apr 14, 2020
by
Midoux Cedric
Browse files
Transformation
parent
902121ff
Changes
4
Hide whitespace changes
Inline
Side-by-side
panels/dataInput.R
View file @
12ba9644
### Upload Data ###
dataInput
<-
function
(
failed
=
FALSE
)
{
modalDialog
(
title
=
"Select your data"
,
...
...
@@ -167,6 +168,7 @@ observeEvent(input$okData, {
}
})
### Filter ###
filterSample
<-
function
()
{
modalDialog
(
title
=
"Select some sample"
,
...
...
@@ -254,6 +256,86 @@ observeEvent(input$selectData, {
}
})
### Transformation ###
transformSample
<-
function
()
{
modalDialog
(
title
=
"Transform abundance data"
,
radioButtons
(
inputId
=
"transformFun"
,
label
=
"Transform function : "
,
selected
=
character
(
0
),
choices
=
c
(
"Proportional Transformation"
=
"prop"
,
"Square Root Transformation"
=
"sqrt"
,
"Centered Log-Ratio (CLR) Transformation"
=
"clr"
)
),
wellPanel
(
verbatimTextOutput
(
"transformFun"
)),
footer
=
tagList
(
modalButton
(
"Cancel"
),
actionButton
(
inputId
=
"okData"
,
label
=
"Refresh transformation"
),
actionButton
(
inputId
=
"transformData"
,
label
=
"Transforme"
)
)
)
}
output
$
transformFun
<-
renderText
({
validate
(
need
(
input
$
transformFun
,
""
))
switch
(
input
$
transformFun
,
"prop"
=
paste
(
"count_to_prop <- function(x) {return( x / sum(x) )}"
,
"data_prop <- transform_sample_counts(data, count_to_prop)"
,
sep
=
"\n"
),
"sqrt"
=
"data_sqrt <- transform_sample_counts(data, sqrt)"
,
"clr"
=
paste
(
"gm_mean <- function(x, na.rm=TRUE) {"
,
" exp(sum(log(x[x > 0 & !is.na(x)]), na.rm=na.rm) / length(x))"
,
" }"
,
"clr <- function(x, base=2) {"
,
" x <- log((x / gm_mean(x)), base)"
,
" x[!is.finite(x) | is.na(x)] <- 0.0"
,
" return(x)"
,
"}"
,
"data_clr <- transform_sample_counts(data, clr)"
,
sep
=
"\n"
)
)
})
observeEvent
(
input
$
transformData
,
{
if
(
is.null
(
input
$
transformData
))
{
removeModal
()
}
else
{
try
(
switch
(
input
$
transformFun
,
"prop"
=
{
count_to_prop
<-
function
(
x
)
{
return
(
x
/
sum
(
x
)
)}
physeq
(
transform_sample_counts
(
physeq
(),
count_to_prop
))
},
"sqrt"
=
{
physeq
(
transform_sample_counts
(
physeq
(),
sqrt
))
},
"clr"
=
{
gm_mean
<-
function
(
x
,
na.rm
=
TRUE
)
{
exp
(
sum
(
log
(
x
[
x
>
0
&
!
is.na
(
x
)]),
na.rm
=
na.rm
)
/
length
(
x
))
}
clr
<-
function
(
x
,
base
=
2
)
{
x
<-
log
((
x
/
gm_mean
(
x
)),
base
)
x
[
!
is.finite
(
x
)
|
is.na
(
x
)]
<-
0.0
return
(
x
)
}
physeq
(
transform_sample_counts
(
physeq
(),
clr
))
}
),
silent
=
TRUE
,
outFile
=
showModal
(
dataInput
(
failed
=
TRUE
)))
if
(
class
(
physeq
())
==
"phyloseq"
)
{
removeModal
()
}
else
{
showModal
(
dataInput
(
failed
=
TRUE
))
}
}
})
### Download Data ###
dataDownload
<-
function
()
{
modalDialog
(
title
=
"Download data"
,
...
...
@@ -280,6 +362,7 @@ output$okDownload <- downloadHandler(
}
)
### Download Plot ###
plotDownload
<-
function
()
{
modalDialog
(
title
=
"Download last modified plot"
,
...
...
panels/pca-server.R
View file @
12ba9644
...
...
@@ -8,8 +8,6 @@ output$pcaUI <- renderUI({
"pcaSetting"
,
label
=
"PCA setting"
,
choices
=
list
(
"Ratio normalization"
=
"norm"
,
"Square root normalization"
=
"sqrt"
,
"Center"
=
"center"
,
"Scale"
=
"scale"
),
...
...
@@ -78,22 +76,13 @@ output$pca <- metaRender2(renderPlot, {
need
(
length
(
input
$
pcaAxes
)
==
2
,
"Requires two projections axes"
))
data
<-
physeq
()
data_matrix
<-
if
(
"norm"
%in%
input
$
pcaSetting
&&
"sqrt"
%in%
input
$
pcaSetting
)
{
metaExpr
({
as.data.frame
(
t
(
otu_table
(
data
)))
%>%
{
.
/
rowSums
(
.
)}
%>%
sqrt
()
})
}
else
if
(
"norm"
%in%
input
$
pcaSetting
)
{
metaExpr
({
as.data.frame
(
t
(
otu_table
(
data
)))
%>%
{
.
/
rowSums
(
.
)}
})
}
else
if
(
"sqrt"
%in%
input
$
pcaSetting
)
{
metaExpr
({
as.data.frame
(
t
(
otu_table
(
data
)))
%>%
sqrt
()
})
}
else
{
metaExpr
({
as.data.frame
(
t
(
otu_table
(
data
)))
})
}
pca
<-
metaExpr
({
prcomp
(
data_matrix
[
colSums
(
data_matrix
)
!=
0
],
center
=
..
(
"center"
%in%
input
$
pcaSetting
),
scale
=
..
(
"scale"
%in%
input
$
pcaSetting
)
)
})
data_matrix
<-
as.data.frame
(
t
(
otu_table
(
data
)))
pca
<-
prcomp
(
data_matrix
[
colSums
(
data_matrix
)
!=
0
],
center
=
..
(
"center"
%in%
input
$
pcaSetting
),
scale
=
..
(
"scale"
%in%
input
$
pcaSetting
)
)
})
habillage
<-
if
(
!
is.null
(
checkNull
(
input
$
pcaHabillage
)))
{
metaExpr
({
...
...
@@ -137,8 +126,7 @@ output$pca <- metaRender2(renderPlot, {
)
metaExpr
({
data_matrix
<-
..
(
data_matrix
)
pca
<-
..
(
pca
)
..
(
pca
)
habillage
<-
..
(
habillage
)
p
<-
..
(
pcaType
)
p
+
theme_bw
()
...
...
server.R
View file @
12ba9644
...
...
@@ -38,6 +38,10 @@ shinyServer
showModal
(
filterSample
())
})
observeEvent
(
input
$
transformButton
,
{
showModal
(
transformSample
())
})
observeEvent
(
input
$
downloadButton
,
{
showModal
(
dataDownload
())
})
...
...
ui.R
View file @
12ba9644
...
...
@@ -24,13 +24,17 @@ dashboardHeader(title = "Easy16S"),
"Select some samples"
,
icon
=
icon
(
"filter"
),
style
=
"width: 80% ; color: black ; background-color: gray90"
),
actionButton
(
"transformButton"
,
"Transform abundance"
,
icon
=
icon
(
"square-root-alt"
),
style
=
"width: 80% ; color: black ; background-color: gray90"
),
actionButton
(
"downloadButton"
,
"Download data"
,
icon
=
icon
(
"download"
),
style
=
"width: 80% ; color: black ; background-color: gray90"
),
actionButton
(
"plotButton"
,
"Download last plot"
,
icon
=
icon
(
"
download
"
),
icon
=
icon
(
"
file-image
"
),
style
=
"width: 80% ; color: black ; background-color: gray90"
),
sidebarMenu
(
menuItem
(
"Summary"
,
tabName
=
"Summary"
,
icon
=
icon
(
"dna"
)),
...
...
Write
Preview
Markdown
is supported
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