Skip to content

Commit ddb2fcd

Browse files
RLumSKRLumSK
committed
A little bit of code polish
1 parent 76d8243 commit ddb2fcd

3 files changed

Lines changed: 38 additions & 54 deletions

File tree

‎global.R‎

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ require(knitr)
1818
require(digest)
1919

2020
##Shiny settings
21-
options(shiny.maxRequestSize=30*1024^2)
21+
options(shiny.maxRequestSize = 30 * 1024 ^ 2)
2222
enableBookmarking(store = "server")
2323
current_env <- environment()
2424

@@ -28,21 +28,19 @@ calibration_data <- sort(list.files(path = "calibration_data/", full.names = TRU
2828
##load initial set
2929
##calibration data
3030
##make sure nothing breaks here if no file is available
31-
if(length(calibration_data) == 0){
31+
if (length(calibration_data) == 0){
3232
results_CT <- NULL
3333
results_ITC <- NULL
3434
sourceDR_FINAL <- NULL
3535
calibration_data <- "not available"
3636

3737
}else{
3838
##make sure that the example data is only loaded if needed
39-
if(length(calibration_data) > 1){
39+
if (length(calibration_data) > 1){
4040
calibration_data <- calibration_data[
4141
!grepl(pattern = "Example_Calibration.Rdata", x = calibration_data, fixed = TRUE)]
4242

4343
}
44-
45-
4644
}
4745

4846

@@ -58,13 +56,18 @@ df <- NULL
5856
df_reactive <- NULL
5957
verify <- TRUE
6058
dosimeter_type <- c("field", "travel")
59+
60+
## codes are used to avoid that users upload weird sequences never
61+
## approved and then complain
62+
## to create a new valid hash code:
63+
## temp <- Luminescence::read_XSYG2R(...)
64+
## digest::digest(names(temp)
65+
## (if temp is list, type temp[[1]])
6166
verification_hash <- c(
6267
"c2bba3c97909e573a3f7b25dad61380d",
6368
"9d6657ac360ac62b123f45737fe07b43",
6469
"90a0b766b152243abab71c7e9a676828")
6570

66-
67-
6871
# Helper functions ----------------------------------------------------------------------------
6972

7073
##+++++++++++++++++++

‎server.R‎

Lines changed: 27 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@
77
shinyServer(function(input, output, session) {
88

99
# PANEL IMPORT------------------------------------------------------------------------------------
10-
1110
##=============================##
1211
##import data
1312
##=============================##
@@ -35,7 +34,7 @@ shinyServer(function(input, output, session) {
3534
input$file_data_example,
3635
input$file_data), {
3736

38-
if(!is.null(file_data)){
37+
if (!is.null(file_data)){
3938
##set tabs
4039
output$tabs <- renderUI({
4140

@@ -61,7 +60,7 @@ shinyServer(function(input, output, session) {
6160
input$file_data_example,
6261
input$file_data),{
6362

64-
if(!is.null(file_data)){
63+
if (!is.null(file_data)){
6564
##initialise sample
6665
sample_info_full <<- reactiveValues(
6766
data = data.frame(
@@ -111,19 +110,18 @@ shinyServer(function(input, output, session) {
111110

112111
})
113112

114-
115113
##=============================##
116114
##table - updated event
117115
##=============================##
118116
observe({
119-
if(!is.null(input$sample_info)){
117+
if (!is.null(input$sample_info)){
120118

121119
##create hash from row names
122120
hashA <- sum(as.numeric(row.names(sample_info_full$data[which(file_info[["wheels"]] == input$wheels), ])))
123121
hashB <- sum(as.numeric(row.names(hot_to_r(input$sample_info))))
124122

125123
##update table values if rownumbers match, otherwise we overwrite
126-
if(hashA == hashB){
124+
if (hashA == hashB){
127125
sample_info_full$data[which(file_info[["wheels"]] == input$wheels), ] <<- hot_to_r(input$sample_info)
128126

129127
##update plot
@@ -135,7 +133,7 @@ shinyServer(function(input, output, session) {
135133
)
136134
}
137135

138-
if(!any(sample_info_full$data[["INCLUDE"]])){
136+
if (!any(sample_info_full$data[["INCLUDE"]])){
139137
showModal(modalDialog(
140138
title = "Important message",
141139
"Smart move, nothing included, nothing can go wrong...",
@@ -148,22 +146,20 @@ shinyServer(function(input, output, session) {
148146

149147
})
150148

151-
152149
# PANEL Analyse ------------------------------------------------------------------------------
153-
154150
##=============================##
155151
##Calibration dataset selection
156152
##=============================##
157153
observeEvent(input$calibration_data,{
158154
##load calibration dataset
159-
if(!"Own dataset loaded" %in% unlist(input$calibration_data) && input$calibration_data != "not available" ){
155+
if (!"Own dataset loaded" %in% unlist(input$calibration_data) && input$calibration_data != "not available" ){
160156
load(calibration_data[[grep(pattern = input$calibration_data,
161157
x = calibration_data,
162158
fixed = TRUE)]], envir = current_env)
163159
}
164160

165161
##show applied dose rate
166-
if(!is.null(sourceDR_FINAL)){
162+
if (!is.null(sourceDR_FINAL)){
167163
DR_today <- calc_SourceDoseRate(
168164
measurement.date = Sys.Date(),
169165
calib.date = sourceDR_FINAL[["CAL_DATE"]],
@@ -181,7 +177,7 @@ shinyServer(function(input, output, session) {
181177

182178
})
183179

184-
}else{
180+
} else {
185181
output$sourceDR_FINAL <- renderText({"NA ± NA"})
186182

187183
}
@@ -196,7 +192,7 @@ shinyServer(function(input, output, session) {
196192
output$analysis_error <- renderText(NULL)
197193

198194
##make sure that the app does not crash
199-
if(!is.null(file_data) && any(sample_info_full$data[["INCLUDE"]])){
195+
if (!is.null(file_data) && any(sample_info_full$data[["INCLUDE"]])){
200196

201197
##remove all values previously deselected
202198
file_data[!sample_info_full$data[["INCLUDE"]]] <- NULL
@@ -205,7 +201,7 @@ shinyServer(function(input, output, session) {
205201
travel_dosimeters <- which(
206202
sample_info_full$data[["TYPE"]][sample_info_full$data[["INCLUDE"]]] == 'travel')
207203

208-
if(length(travel_dosimeters) == 0 || !input$settings_travel_dosimeter)
204+
if (length(travel_dosimeters) == 0 || !input$settings_travel_dosimeter)
209205
travel_dosimeters <- NULL
210206

211207
##initialise values
@@ -217,7 +213,7 @@ shinyServer(function(input, output, session) {
217213
message = "Analysing data ...", min = 0, max = length(file_data), {
218214

219215
##run analysis for the plots
220-
for(i in 1:length(file_data)){
216+
for (i in 1:length(file_data)){
221217
incProgress(i)
222218
temp_files[[i]] <<- paste0(temp_dir,"/ALQ_",i,".png")
223219
png(file = temp_files[[i]], bg = "transparent", width = 700, height = 400)
@@ -322,7 +318,7 @@ shinyServer(function(input, output, session) {
322318

323319
##add download button if results are available
324320
output$export_analysis_results <- renderUI({
325-
if(length(results) > 0)
321+
if (length(results) > 0)
326322
downloadButton(
327323
outputId = "download_analysis_results",
328324
label = "Download results")
@@ -357,16 +353,15 @@ shinyServer(function(input, output, session) {
357353
timestamp = FALSE,
358354
show_report = FALSE,
359355
quiet = TRUE,
360-
clean = TRUE
361-
)
356+
clean = TRUE)
362357

363358
##create ZIP-file
364359
zip(zipfile = file, files = fs, flags = "-j")
365360
},
366361
contentType = "application/zip"
367362
)
368363

369-
}else{
364+
} else {
370365
output$analysis_error <- renderText("Error: No file imported!")
371366

372367
}
@@ -375,10 +370,9 @@ shinyServer(function(input, output, session) {
375370

376371
#observe selection change in table
377372
observe({
378-
if(!is.null(input$analysis_results)){
373+
if (!is.null(input$analysis_results))
379374
df_reactive$data <<- hot_to_r(input$analysis_results)
380375

381-
}
382376
})
383377

384378
##provide graphical output environment for plot output
@@ -403,12 +397,11 @@ shinyServer(function(input, output, session) {
403397

404398
# PANEL Post-processing -------------------------------------------------------------------------
405399
observeEvent(input$navbar,{
406-
407-
if(input$navbar == "post_processing_run"){
400+
if (input$navbar == "post_processing_run") {
408401
##reset error message
409402
output$post_processing_error <- renderText(NULL)
410403

411-
if(!is.null(df_reactive$data)){
404+
if (!is.null(df_reactive$data)) {
412405
##add infotext
413406
output$post_processing_table_info_text <- renderText(
414407
"Sample summary | Source dose rate re-calculated to measurement date.")
@@ -419,7 +412,7 @@ shinyServer(function(input, output, session) {
419412

420413
##error weighted mean for each position
421414
df_combined <- t(vapply(1:length(df_grouped), function(x){
422-
if(any(is.na(df_grouped[[x]][,c("DE","DE_ERROR")]))){
415+
if (any(is.na(df_grouped[[x]][,c("DE","DE_ERROR")]))) {
423416
c(NA_real_,NA_real_)
424417

425418
}else{
@@ -442,8 +435,8 @@ shinyServer(function(input, output, session) {
442435
df_grouped <- cbind(df_grouped, CV = abs(df_grouped[["SD"]]/df_grouped[["MEAN"]] * 100))
443436

444437
# ##translate to µGy
445-
if(!is.null(sourceDR_FINAL)){
446-
source_dose_rate <- calc_SourceDoseRate(
438+
if (!is.null(sourceDR_FINAL)) {
439+
source_dose_rate <- Luminescence::calc_SourceDoseRate(
447440
measurement.date = as.Date(strtrim(file_info$startDate[1],8), format = "%Y%m%d"),
448441
calib.date = as.Date(sourceDR_FINAL$CAL_DATE),
449442
calib.dose.rate = c(sourceDR_FINAL$DR),
@@ -466,7 +459,7 @@ shinyServer(function(input, output, session) {
466459
))
467460

468461
##add columns if they do not yet exist
469-
if(!("DURATION" %in% colnames(results_final$data))){
462+
if (!("DURATION" %in% colnames(results_final$data))) {
470463
results_final$data <- cbind(
471464
results_final$data,
472465
DATE_IN = Sys.Date(),
@@ -557,16 +550,13 @@ shinyServer(function(input, output, session) {
557550

558551
##monitor post-processing table
559552
observe({
560-
if(!is.null(input$postprocessing_results)){
553+
if (!is.null(input$postprocessing_results))
561554
results_final$data <- hot_to_r(input$postprocessing_results)
562555

563-
}
564-
565556
})
566557

567558
##update post-processing table
568559
observeEvent(input$post_processing_update, {
569-
570560
##update DURATION
571561
results_final$data[["DURATION \n [days]"]] <- as.integer(
572562
results_final$data[["DATE_OUT"]] - results_final$data[["DATE_IN"]])
@@ -584,14 +574,12 @@ shinyServer(function(input, output, session) {
584574
results_final$data[["DOSE_CORR.ERROR \n [µGy]"]] <- sqrt((results_final$data[["TUBE ATTENUATION \n CORRECTION FACTOR"]] * results_final$data[["DOSE.ERROR \n [µGy]"]])^2 +
585575
((-results_final$data[["TUBE ATTENUATION \n CORRECTION FACTOR"]] + 1) * results_final$data[["COSMIC_DOSE.ERROR \n [µGy]"]])^2)
586576

587-
588577
##update DR and DR.ERROR
589578
results_final$data[["FINAL DR \n [µGy/a]"]] <- results_final$data[["DOSE_CORR \n [µGy]"]] * 365.25 / results_final$data[["DURATION \n [days]"]]
590579
results_final$data[["FINAL DR.ERROR \n [µGy/a]" ]] <- ((results_final$data[["DOSE_CORR \n [µGy]"]] * 365.25) /
591580
as.numeric(results_final$data[["DURATION \n [days]"]])) *
592581
results_final$data[["DOSE_CORR.ERROR \n [µGy]"]] / results_final$data[["DOSE_CORR \n [µGy]"]]
593582

594-
595583
##Replace all Inf values with 0
596584
results_final$data[["FINAL DR \n [µGy/a]"]][is.infinite(results_final$data[["FINAL DR \n [µGy/a]"]])] <- 0
597585
results_final$data[["FINAL DR.ERROR \n [µGy/a]" ]][is.infinite( results_final$data[["FINAL DR.ERROR \n [µGy/a]"]])] <- 0
@@ -602,7 +590,6 @@ shinyServer(function(input, output, session) {
602590
results_final$data[["FINAL GAMMA_DR.ERROR \n [%]"]] <- abs(results_final$data[["FINAL GAMMA_DR.ERROR \n [µGy/a]"]] /
603591
results_final$data[["FINAL GAMMA_DR \n [µGy/a]"]] * 100)
604592

605-
606593
##create table output
607594
output$postprocessing_results <- renderRHandsontable({
608595
rhandsontable(data = results_final$data, readOnly = TRUE, selectCallback = TRUE) %>%
@@ -640,13 +627,14 @@ shinyServer(function(input, output, session) {
640627
observeEvent(input$postprocessing_results_select, {
641628
df_hot <- as.data.frame(hot_to_r(input$postprocessing_results), stringsAsFactors = FALSE)
642629
##set selection
643-
if(length(input$postprocessing_results_select$select$cAll) == 1){
630+
if (length(input$postprocessing_results_select$select$cAll) == 1) {
644631
x_sel <- 1
645632
y_sel <- min(input$postprocessing_results_select$select$cAll)
646633

647-
}else{
634+
} else {
648635
x_sel <- min(input$postprocessing_results_select$select$cAll)
649636
y_sel <- max(input$postprocessing_results_select$select$cAll)
637+
650638
}
651639

652640
output$postprocessing_boxplot <- renderPlot({
@@ -663,8 +651,6 @@ shinyServer(function(input, output, session) {
663651
theme(axis.text.x = element_text(angle = 45, hjust = 1))
664652
}, width = 800)
665653

666-
667-
668654
})
669655

670656
# PANEL Settings----- -------------------------------------------------------------------------
@@ -685,13 +671,12 @@ shinyServer(function(input, output, session) {
685671
##inspect content
686672
load(input$upload_calibrationdata$datapath, safe <- new.env())
687673

688-
if(length(ls(safe)) == 3 && all(c("results_CT", "results_ITC", "sourceDR_FINAL") %in% ls(safe))){
674+
if (length(ls(safe)) == 3 && all(c("results_CT", "results_ITC", "sourceDR_FINAL") %in% ls(safe))) {
689675
#reset data
690676
results_CT <<- NULL
691677
results_ITC <<- NULL
692678
sourceDR_FINAL <<- NULL
693679

694-
695680
##load data
696681
load(input$upload_calibrationdata$datapath, envir = current_env)
697682

@@ -700,7 +685,7 @@ shinyServer(function(input, output, session) {
700685
session, "calibration_data",
701686
choices = "Own dataset loaded")
702687

703-
}else{
688+
} else {
704689
showModal(modalDialog(
705690
title = "Error",
706691
"The uploaded calibration dataset is not supported, please only upload allowed data!",
@@ -713,13 +698,11 @@ shinyServer(function(input, output, session) {
713698

714699
##clear own dataset
715700
observeEvent(input$clear_calibrationdata, {
716-
717701
##correct input path
718702
updateSelectInput(
719703
session, "calibration_data",
720704
choices = basename(sort(list.files(path = "calibration_data/", full.names = TRUE), decreasing = TRUE)))
721705

722-
723706
})
724707

725708
# Static pages --------------------------------------------------------------------------------
@@ -732,4 +715,3 @@ shinyServer(function(input, output, session) {
732715
})
733716

734717
})#last brackets
735-

‎ui.R‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
## Title: Al2O3:C Analysis App
33
## Authors: Sebastian Kreutzer, IRAMAT-CRP2A, Université Bordeaux Montaigne (France)
44
## Contact: [email protected]
5-
## Initial data: 2018-06-07
5+
## Initial date: 2018-06-07
66
##+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
77
shinyUI(
88
navbarPage(
@@ -231,4 +231,3 @@ shinyUI(
231231
)##navbarPage
232232
)##ShinyUI
233233

234-

0 commit comments

Comments
 (0)