-
Notifications
You must be signed in to change notification settings - Fork 0
/
Spectral_analysis.R
196 lines (173 loc) · 7.25 KB
/
Spectral_analysis.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
#' Unlock the Spectrum: Easy, Educational, and Engaging Analysis of Light Spectra
#'
#' @param lang_setting A language for the application. Currently **Deutsch** for German and **English** (default) are implemented. Expects a *character*.
#' @param lang_link Only relevant for the App deployed on *Shinyapps.io*. Handles whether a link to the German/English Version of the App is present in the header. Expects a *logical* (default FALSE)
#' @param color_palette A color palette for the application. Currently `**Lang**` (default), `**Lang_bright**`, `**Dan_Bruton**`, and `**Rainbow**` are implemented. Expects a `*character*`. In terms of `color accuracy`, the decending order is likely `**Dan_Bruton**`, `**Lang**`, `**Lang_bright**`, and `**Rainbow**`. However, all of them are wrong in the sense, that monochromatic light can not well be recreated with RGB colors. Look at the documentation for [ColorP] for more information about these palettes.
#' @param ... Any other settings that get passed to shinyApp
#'
#' @return Open a viewer with the shiny app
#' @export
#'
#' @examples
#' if(interactive()) {
#' Spectran()}
#'
#' #try another language
#' if(interactive()) {
#' Spectran(lang_setting = "Deutsch")}
#'
#' #or try another color palette
#' if(interactive()) {
#' Spectran(color_palette = "Dan_Bruton")}
#'
Spectran <- function(lang_setting = "English",
lang_link = FALSE,
color_palette = "Lang",
...) {
#add a resource path to the www folder
shiny::addResourcePath(
"extr", system.file("app/www", package = "Spectran"))
# on.exit(shiny::removeResourcePath("extr"), add = TRUE)
#set the language and color palette for the program
the$language <- lang_setting
the$palette <- color_palette
#create an Environment that holds the plotwidths of users
theuser <- new.env(parent = emptyenv())
theuser$Plotbreite_temp <- 200
#UI
ui <-
shinydashboard::dashboardPage(
skin = "yellow",
#Header
UI_Header(lang_link),
#Sidebar
UI_Sidebar(),
#Body
shinydashboard::dashboardBody(
#Add a link to the css resource
htmltools::tags$link(
rel = "stylesheet", type="text/css", href="extr/style.css"),
shinydashboard::tabItems(
#add a tab for the introduction
shinydashboard::tabItem(tabName = "tutorial",
introductionUI("intro")),
#add a tab for the import
shinydashboard::tabItem(tabName = "import",
importUI("import")),
#add a tab for the analysis
shinydashboard::tabItem(tabName = "analysis",
analysisUI("analysis")),
#add a tab for the export
shinydashboard::tabItem(tabName = "export",
exportUI("export")),
#add a tab for the validity
shinydashboard::tabItem(tabName = "validity",
validityUI("validity")),
#add a tab for the impressum
shinydashboard::tabItem(tabName = "impressum",
impressumUI("impressum"))
),
shiny::fluidPage(
(shiny::plotOutput("Plotbreite", height = "1px"))),
waiter::useWaiter(),
# waiter::waiterOnBusy(html = waiter::spin_solar(),
# color = "#2874A625", fadeout = 100),
waiter::autoWaiter(html = waiter::spin_solar(),
color = "#2874A625", fadeout = 100),
waiter::waiterPreloader(
html = waiter::spin_solar(), color = "#2874A625", fadeout = 500)
)
)
#Server
server <- function(input, output, session) {
#allow reconnect
session$allowReconnect(TRUE)
#Introduction
zu_Import <- introductionServer("intro")
#Import
Spectrum <- importServer("import")
#Analysis
Analysis <- analysisServer("analysis",
Spectrum = Spectrum,
Tabactive = shiny::reactive(input$inTabset))
#Export
Export <- exportServer("export", Analysis, Spectrum,
Tabactive = shiny::reactive(input$inTabset))
output$Plotbreite <- shiny::renderPlot({
},
bg = "transparent")
# bg = "white")
# Delete Notifications between tab changes
notification_remover(shiny::reactive(input$inTabset))
#Update the Navbar, when the Introduction is finished
shiny::observe({
shiny::updateNavbarPage(
session, inputId = "inTabset" , selected = "import")
}) %>% shiny::bindEvent(
zu_Import(), ignoreInit = TRUE
)
#Enable/Disable the Analysis and Import Menus, when not ready
output$analysis <- shinydashboard::renderMenu({
if(!is.null(Analysis$Settings$Spectrum)) {
shinydashboard::menuItem(
lang$ui(23),
tabName = "analysis",
icon = shiny::icon(
"magnifying-glass-chart")
)
}
else {
shinydashboard::menuItem(
htmltools::HTML(
paste0("<span style='color:grey;'>",
lang$ui(23),
"</span>")),
tabName = "import",
icon = shiny::icon(
"lock")
)
}
})
output$export <- shinydashboard::renderMenu({
if(!is.null(Analysis$Settings$Spectrum)) {
shinydashboard::menuItem(
"Export",
tabName = "export",
icon = shiny::icon("file-export")
)
}
else {
shinydashboard::menuItem(
htmltools::HTML(
paste0("<span style='color:grey;'>",
"Export",
"</span>")),
tabName = "import",
icon = shiny::icon(
"lock")
)
}
})
#Update the Navbar when hitting the Export-Button in Analysis
shiny::observe({
shiny::updateNavbarPage(
session,
inputId = "inTabset",
selected = "export")
}) %>% shiny::bindEvent(Analysis$to_export)
#Update the Navbar when a Spectrum is imported
shiny::observe({
shiny::req(Spectrum$Spectrum, Spectrum$Destination)
if(Spectrum$Destination == lang$ui(69) &
input$inTabset == "import") {
shiny::updateNavbarPage(
session,
inputId = "inTabset",
selected = "analysis")
}
}) %>% shiny::bindEvent(Spectrum$Analysis, Analysis$Settings$Spectrum)
#close the waiting screen
# waiter::waiter_hide()
}
shiny::shinyApp(ui, server, ...)
}