forked from joey711/shiny-phyloseq
-
Notifications
You must be signed in to change notification settings - Fork 0
/
ui.R
executable file
·201 lines (195 loc) · 8.24 KB
/
ui.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
# Define generic graphic-type select UI.
# `graphicFormats` is defined globally, called by global.R when it sources ggsave.R
graphicTypeUI = function(inputId, label="Format", choices=graphicFormats, selected="pdf"){
selectInput(inputId, label, choices, selected, multiple = FALSE, selectize = TRUE)
}
# Type for distance/network/ordination/etc. Samples/Taxa toggle
uitype = function(id="type", selected="taxa"){
selectInput(inputId=id, label="Type",
selected=selected,
choices=list("Taxa"="taxa", "Samples"="samples"))
}
# ui for point size
uiptsz = function(id, ...){
numericInputRow(inputId=id, label="Size", min=1, max=NA, value=5, step=1, ...)
}
# ui for point opacity slider
uialpha = function(id, ...){
numericInputRow(inputId=id, label="Opacity", min=0, max=1, value=1, step=0.1, ...)
}
# UI function to define palettes. Reused in many panels.
uipal = function(id, default="Set1"){
selectInput(id, "Palette",
choices = rownames(RColorBrewer::brewer.pal.info),
selected = default
)
}
# UI function to define ggplot2 themes. Reused in many panels.
uitheme = function(id, default="bl_wh"){
selectInput(id, "Theme",
choices = names(shiny_phyloseq_ggtheme_list),
selected = default
)
}
################################################################################
# Multi-Widget Definitions
################################################################################
# Figure Dimensions and Download. Should return a single fluidRow, all 12 cols
dim_and_down = function(suffix, secTitle='Dimensions & Download'){
fluidRow(column(
width = 12,
h4(secTitle),
div(class="col-md-3", numericInputRow(paste0("width", suffix), "Width", 8, 1, 100, 1, class="col-md-12")),
div(class="col-md-3", numericInputRow(paste0("height", suffix), "Height", 8, 1, 100, 1, class="col-md-12")),
div(class='col-md-3', graphicTypeUI(paste0("downtype", suffix))),
div(class='col-md-2', div(style="display:inline-block", tags$label("DL"),
downloadButton(paste0("download", suffix), ' ')))
))
}
# Theme and details. Some elements are optional. Suffix is required.
# Attempts to return a single row with palette, theme, and optionally point-size and opacity.
# `addList` is a list of additional elements for UI, attempt to add to row.
theme_ui_details = function(suffix, secTitle="Details", pal=TRUE, them=TRUE,
ptsz=FALSE, alpha=FALSE, addList=NULL){
elementList = list(width = 12, h4(secTitle))
if(pal){
elementList <- c(elementList, list(
div(class='col-md-4', uipal(paste0("pal", suffix)))
))
}
if(them){
elementList <- c(elementList, list(
div(class='col-md-4', uitheme(paste0("theme", suffix)))
))
}
if(ptsz){
elementList <- c(elementList, list(
div(class="col-md-3", uiptsz(paste0("size", suffix), class="col-md-12"))
))
}
if(alpha){
elementList <- c(elementList, list(
div(class="col-md-3", uialpha(paste0("alpha", suffix), class="col-md-12"))
))
}
# Add any additional row elements, if present
elementList <- c(elementList, addList)
return(fluidRow(do.call("column", args = elementList)))
}
# # Generic fluid row-split. r is number of elements in a row (max 12).
# ui_row_split = function(..., r=2L){
# elementList = list(width = 12L)
# spanN = paste0("col-md-", floor(12/r))
# elementList <- c(elementList,
# lapply(..., function(x, spanN){div(class=col-md-N, x)}, spanN))
# return(fluidRow(do.call("column", args = elementList)))
# }
################################################################################
# Generic distance UI stuff.
################################################################################
# Function to reate ui for distance method selection
# NOTE: not all distance methods are supported if "taxa" selected for type.
# For example, the UniFrac distance and DPCoA cannot be calculated for taxa-wise
# distances, because they use a taxa-wise tree as part of their calculation
# between samples, and there is no transpose-equivalent for this tree
uidist = function(id, selected="bray"){
return(selectInput(id, "Distance", distlist, selected=selected))
}
# Whether to use proportions or counts
uicttype = function(id="uicttype"){
selectInput(inputId=id, label="Data",
choices=c("Counts", "Proportions"),
selected="Counts")
}
################################################################################
# Generic Ordination UI stuff.
################################################################################
# Define the ordination options list.
# Make available to other panels, if relevant.
ordlist = as.list(phyloseq::ordinate("list"))
names(ordlist) <- ordlist
ordlist = ordlist[-which(ordlist %in% c("MDS", "PCoA"))]
ordlist = c(list("MDS/PCoA"="MDS"), ordlist)
################################################################################
# Define each fluid page
################################################################################
# Define in a single function, a standard definition of panel-page
make_fluidpage = function(fptitle="", sbp, outplotid, markdownDoc=""){
mdRow = fluidRow(column(width = 12, " "))
if(nchar(markdownDoc) > 0){
# If md doc specified, replace `mdRow` with actual doc.
mdRow <- fluidRow(column(width = 12,
includeMarkdown(file.path("panels/paneldoc", markdownDoc))
))
}
fluidPage(
headerPanel(fptitle, "windowTitle"),
fluidRow(sbp, column(width=8, plotOutput(outplotid))),
mdRow
)
}
################################################################################
source("panels/panel-ui-net.R", local = TRUE)
source("panels/panel-ui-bar.R", local = TRUE)
source("panels/panel-ui-ordination.R", local = TRUE)
source("panels/panel-ui-richness.R", local = TRUE)
source("panels/panel-ui-tree.R", local = TRUE)
source("panels/panel-ui-heatmap.R", local = TRUE)
source("panels/panel-ui-scatter.R", local = TRUE)
source("panels/panel-ui-d3.R", local = TRUE)
source("panels/panel-ui-data.R", local = TRUE)
source("panels/panel-ui-filter.R", local = TRUE)
source("panels/panel-ui-palette.R", local = TRUE)
source("panels/panel-ui-provenance.R", local = TRUE)
################################################################################
# Transform panel is only documentation. Define differently.
################################################################################
transpage = fluidPage(
headerPanel("Transform Widget Documentation"),
fluidRow(column(width = 12,
includeMarkdown("panels/paneldoc/Transform.md")
))
)
################################################################################
# Define general header tag list
# List of tags to display as a common header above all tabPanels.
################################################################################
source("js-scripts/inactivity.R")
headerTagList = list(
tags$style(type="text/css", ".phyloseq-print { font-size: 10px; }"),
tags$base(target="_blank")
)
################################################################################
# Define the full user-interface, `ui`
################################################################################
ui1 = function() {
navbarPage(
title = h4(a(href="http://joey711.github.io/shiny-phyloseq/", style="color:#F0F0F0", "Shiny-phyloseq")),
tabPanel("Dataset", datapage),
tabPanel("Filter", filterpage),
tabPanel("Alpha Diversity", richpage),
tabPanel("Network", netpage),
tabPanel("d3Network", d3netpage),
tabPanel("Ordination", ordpage),
tabPanel("Heatmap", heatpage),
tabPanel("Tree", treepage),
tabPanel("Scatter", scatpage),
tabPanel("Bar", barpage),
tabPanel("Palette", palpage),
tabPanel("Transform", transpage),
tabPanel("Provenance", provpage),
header = headerTagList,
collapsible = TRUE,
windowTitle = "Shiny-phyloseq"
)
}
ui2 <- function() {
tagList(
h4("You are unauthorized"),
actionButton(inputId='return', label="Go to Enthera",
icon = icon("th"),
onclick ="location.href='http://localhost/enthera-dev/';"))
}
ui = fluidPage( tags$script(inactivity),htmlOutput("page"))
shinyUI(ui)
################################################################################