added possibility to add filename of result

Dockerfile

@@ -18,6 +18,7 @@ ENV SHINY_LOG_STDERR=1
 RUN install2.r --error --skipinstalled \
     shiny \
     shinyjs \
+    shinyWidgets \
     jsonlite \
     ggplot2 \
     htmltools \
@@ -49,12 +50,14 @@ RUN mkdir /home/shiny/results
 
 COPY ./MTT/ /home/MTT
 COPY ./comeln/ /home/comeln
+COPY ./bs/ /home/bs
 USER root
 RUN bash -c "cd /home/MTT; R CMD INSTALL ."
 RUN bash -c "cd /home/comeln; R CMD INSTALL ."
+RUN bash -c "cd /home/bs; R CMD INSTALL ."
 
 EXPOSE 4001
-COPY ./bs/R /srv/shiny-server/
+COPY ./Start_Server_App.R /srv/shiny-server/app.R
 COPY ./run.sh .
 
 ENV SHINY_LOG_STDERR=1

Start_ELN.sh

@@ -0,0 +1,4 @@
+#!/bin/bash
+
+cd eln_prod
+docker compose up

Start_Server_App.R

@@ -0,0 +1,4 @@
+Sys.setenv(RUN_MODE = "SERVER")
+library(bs)
+app <- bs::app()
+shiny::shinyApp(app$ui, app$server)

Start_Serverless_App.R

@@ -0,0 +1,4 @@
+Sys.setenv(RUN_MODE = "BROWSER")
+library(bs)
+app <- bs::app()
+shiny::shinyApp(app$ui, app$server)

bs/.development/lm_glm_lm_mixed.R

@@ -0,0 +1,50 @@
+library(gamm4)
+library(mgcv)
+library(multcomp)
+library(emmeans)
+library(lme4)
+library(lmerTest)
+df <- CO2
+
+# ANOVA
+# Linear Model
+lm <- lm(uptake ~ Treatment, data = df)
+summary(aov(lm))
+# Generalized Linear Model
+glm <- glm(uptake ~ Treatment, data = df)
+anova(lm)
+anova(glm)
+# Mixed Linear Model
+lmm <- lmer(uptake ~ Treatment + (1 | Type), data = df)
+anova(lmm)
+# GAM Model
+gam_model <- gam(uptake ~ s(conc, k = 5), data = df)
+summary(gam_model)
+plot(gam_model, residuals = TRUE, pch = 16, rug = TRUE)
+# Fit a GAMM with a smooth term for conc and a random effect for Type
+gamm_model <- gamm4(uptake ~ s(conc, k = 5), random = ~(1 | Type), data = df)
+summary(gamm_model$gam)
+summary(gamm_model$mer)
+# Fit a GAM with a smooth term for conc and a categorical predictor
+gam_model <- gam(uptake ~ s(conc, k = 5) + Treatment, data = df)
+
+# POSTHOC TESTS
+emmeans_result <- emmeans(glm, pairwise ~ Treatment)
+summary(emmeans_result)
+glht_result <- glht(glm, linfct = mcp(Treatment = "Tukey"))
+summary(glht_result)
+glht_result <- glht(lmm, linfct = mcp(Treatment = "Tukey"))
+summary(glht_result)
+
+
+# Alternative for Continuous Predictor (e.g., conc)
+lm_cont <- lm(uptake ~ conc, data = df)
+summary(lm_cont)
+glm_cont <- glm(uptake ~ conc, data = df)
+summary(glm_cont)
+lmm_cont <- lmer(uptake ~ conc + (1 | Type), data = df)
+summary(lmm_cont)
+# Post hoc comparisons for Treatment levels with gam
+emmeans_result <- emmeans(gam_model, pairwise ~ Treatment)
+summary(emmeans_result)
+

bs/R/DoseResponse.R

@@ -37,6 +37,7 @@ DoseResponseUI <- function(id) {
     h4(strong("Results of test:")),
     actionButton(NS(id, "dr_save"), "Add output to result-file"),
     actionButton(NS(id, "download_dr"), "Save results"),
+    textInput(NS(id, "user_filename"), "Set filename", value = ""),
     checkboxGroupInput(NS(id, "TableSaved"), "Saved results to file", NULL),
     tabsetPanel(
       id = NS(id, "results_tabs"),
@@ -300,22 +301,26 @@ DoseResponseServer <- function(id, data, listResults) {
     })
 
     observeEvent(input$download_dr, {
+      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
       lr <- unlist(listResults$all_names)
       indices <- sapply(input$TableSaved, function(x) {
         which(x == lr)
       })
       req(length(indices) >= 1)
       l <- listResults$all_data[indices]
       if (Sys.getenv("RUN_MODE") == "SERVER") {
+        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
         excelFile <- createExcelFile(l)
-        upload(session, excelFile, new_name = "Results.xlsx") # TODO: add possibility for desired file name
+        upload(session, excelFile, new_name = input$user_filename)
       } else {
+        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
         jsString <- createJSString(l)
         session$sendCustomMessage(
           type = "downloadZip",
           list(
             numberOfResults = length(jsString),
-            FileContent = jsString
+            FileContent = jsString,
+            Filename = input$user_filename
           )
         )
       }

bs/R/OperationsModule.R

@@ -245,6 +245,7 @@ OperatorEditorUI <- function(id) {
     uiOutput(NS(id, "head")),
     actionButton(NS(id, "save"), "Add output to result-file"),
     actionButton(NS(id, "download"), "Save results"),
+    textInput(NS(id, "user_filename"), "Set filename", value = ""),
     checkboxGroupInput(NS(id, "TableSaved"), "Saved results to file", NULL),
     uiOutput(NS(id, "intermediate_results"))
   )
@@ -868,22 +869,26 @@ OperationEditorServer <- function(id, data, listResults) {
     })
 
     observeEvent(input$download, {
+      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
       lr <- unlist(listResults$all_names)
       indices <- sapply(input$TableSaved, function(x) {
         which(x == lr)
       })
       req(length(indices) >= 1)
       l <- listResults$all_data[indices]
       if (Sys.getenv("RUN_MODE") == "SERVER") {
+        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
         excelFile <- createExcelFile(l)
-        upload(session, excelFile, new_name = "Results.xlsx") # TODO: add possibility for desired file name
+        upload(session, excelFile, new_name = input$user_filename)
       } else {
+        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
         jsString <- createJSString(l)
         session$sendCustomMessage(
           type = "downloadZip",
           list(
             numberOfResults = length(jsString),
-            FileContent = jsString
+            FileContent = jsString,
+            Filename = input$user_filename
           )
         )
       }

bs/R/assumption.R

@@ -67,6 +67,7 @@ assUI <- function(id) {
     verbatimTextOutput(NS(id, "ass_error")),
     actionButton(NS(id, "ass_save"), "Add output to result-file"),
     actionButton(NS(id, "download_ass"), "Save and exit"),
+    textInput(NS(id, "user_filename"), "Set filename", value = ""),
     checkboxGroupInput(NS(id, "TableSaved"), "Saved results to file", NULL),
     tableOutput(NS(id, "ass_result")),
     plotOutput(NS(id, "DiagnosticPlotRes"), width = "100%", height = "1000px")
@@ -293,23 +294,26 @@ assServer <- function(id, data, listResults) {
     })
 
     observeEvent(input$download_ass, {
+      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
       lr <- unlist(listResults$all_names)
       indices <- sapply(input$TableSaved, function(x) {
         which(x == lr)
       })
       req(length(indices) >= 1)
       l <- listResults$all_data[indices]
-
       if (Sys.getenv("RUN_MODE") == "SERVER") {
+        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
         excelFile <- createExcelFile(l)
-        upload(session, excelFile, new_name = "Results.xlsx") # TODO: add possibility for desired file name
+        upload(session, excelFile, new_name = input$user_filename)
       } else {
+        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
         jsString <- createJSString(l)
         session$sendCustomMessage(
           type = "downloadZip",
           list(
             numberOfResults = length(jsString),
-            FileContent = jsString
+            FileContent = jsString,
+            Filename = input$user_filename
           )
         )
       }

bs/R/correlation.R

@@ -50,6 +50,7 @@ corrUI <- function(id) {
     verbatimTextOutput(NS(id, "corr_error")),
     actionButton(NS(id, "corr_save"), "Add output to result-file"),
     actionButton(NS(id, "download_corr"), "Save results"),
+    textInput(NS(id, "user_filename"), "Set filename", value = ""),
     checkboxGroupInput(NS(id, "TableSaved"), "Saved results to file", NULL)
   )
 }
@@ -214,22 +215,26 @@ corrServer <- function(id, data, listResults) {
     })
 
     observeEvent(input$download_corr, {
+      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
       lr <- unlist(listResults$all_names)
       indices <- sapply(input$TableSaved, function(x) {
         which(x == lr)
       })
       req(length(indices) >= 1)
       l <- listResults$all_data[indices]
       if (Sys.getenv("RUN_MODE") == "SERVER") {
+        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
         excelFile <- createExcelFile(l)
-        upload(session, excelFile, new_name = "Results.xlsx") # TODO: add possibility for desired file name
+        upload(session, excelFile, new_name = input$user_filename)
       } else {
+        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
         jsString <- createJSString(l)
         session$sendCustomMessage(
           type = "downloadZip",
           list(
             numberOfResults = length(jsString),
-            FileContent = jsString
+            FileContent = jsString,
+            Filename = input$user_filename
           )
         )
       }

bs/R/statisticalTests.R

@@ -115,6 +115,7 @@ testsUI <- function(id) {
     verbatimTextOutput(NS(id, "test_error")),
     actionButton(NS(id, "test_save"), "Add output to result-file"),
     actionButton(NS(id, "download_test"), "Save results"),
+    textInput(NS(id, "user_filename"), "Set filename", value = ""),
     checkboxGroupInput(NS(id, "TableSaved"), "Saved results to file", NULL)
   )
 }
@@ -346,22 +347,26 @@ testsServer <- function(id, data, listResults) {
     })
 
     observeEvent(input$download_test, {
+      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
       lr <- unlist(listResults$all_names)
       indices <- sapply(input$TableSaved, function(x) {
         which(x == lr)
       })
       req(length(indices) >= 1)
       l <- listResults$all_data[indices]
       if (Sys.getenv("RUN_MODE") == "SERVER") {
+        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
         excelFile <- createExcelFile(l)
-        upload(session, excelFile, new_name = "Results.xlsx") # TODO: add possibility for desired file name
+        upload(session, excelFile, new_name = input$user_filename)
       } else {
+        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
         jsString <- createJSString(l)
         session$sendCustomMessage(
           type = "downloadZip",
           list(
             numberOfResults = length(jsString),
-            FileContent = jsString
+            FileContent = jsString,
+            Filename = input$user_filename
           )
         )
       }

bs/R/utils.R

@@ -393,3 +393,43 @@ Max <- function(x) {
   }
   max(x, na.rm = TRUE)
 }
+
+# Check filename
+is_valid_filename <- function(filename) {
+  try({
+    if (!is.character(filename)) {
+      return(FALSE)
+    }
+    if (grepl(" ", filename)) {
+      return(FALSE)
+    }
+    invalid_chars <- "[<>:\"/\\|?*]"
+    if (grepl(invalid_chars, filename)) {
+      return(FALSE)
+    }
+    if (nchar(filename) == 0) {
+      return(FALSE)
+    }
+    if (nchar(filename) >= 100) {
+      return(FALSE)
+    }
+    ex <- strsplit(basename(filename), split = "\\.")[[1]]
+    if (length(ex) == 1) { # no extension found
+      return(FALSE)
+    }
+    return(TRUE)
+  })
+}
+
+check_filename_for_server <- function(filename) {
+  ex <- strsplit(basename(filename), split = "\\.")[[1]]
+  ex <- ex[[length(ex)]]
+  ex == "xlsx"
+}
+
+check_filename_for_serverless <- function(filename) {
+  ex <- strsplit(basename(filename), split = "\\.")[[1]]
+  ex <- ex[[length(ex)]]
+  ex == "zip"
+}
+

bs/R/visualisation.R

@@ -119,7 +119,8 @@ visUI <- function(id) {
     fluidRow(
       column(
         12,
-        actionButton(NS(id, "downloadViss"), "Save results")
+        actionButton(NS(id, "downloadViss"), "Save results"),
+        textInput(NS(id, "user_filename"), "Set filename", value = "")
       )
     ),
     plotOutput(
@@ -469,6 +470,7 @@ visServer <- function(id, data, listResults) {
             )
           }
           ggplot_build(p) # NOTE: invokes errors and warnings by building but not rendering plot
+          p
         },
         warning = function(warn) {
           showNotification(warn$message)
@@ -524,22 +526,26 @@ visServer <- function(id, data, listResults) {
     })
 
     observeEvent(input$downloadViss, {
+      print_noti(is_valid_filename(input$user_filename), "Defined filename is not valid")
       lr <- unlist(listResults$all_names)
       indices <- sapply(input$TableSaved, function(x) {
         which(x == lr)
       })
       req(length(indices) >= 1)
       l <- listResults$all_data[indices]
       if (Sys.getenv("RUN_MODE") == "SERVER") {
+        print_noti(check_filename_for_server(input$user_filename), "Defined filename does not have xlsx as extension")
         excelFile <- createExcelFile(l)
-        upload(session, excelFile, new_name = "Results.xlsx") # TODO: add possibility for desired file name
+        upload(session, excelFile, new_name = input$user_filename)
       } else {
+        print_noti(check_filename_for_serverless(input$user_filename), "Defined filename does not have zip as extension")
         jsString <- createJSString(l)
         session$sendCustomMessage(
           type = "downloadZip",
           list(
             numberOfResults = length(jsString),
-            FileContent = jsString
+            FileContent = jsString,
+            Filename = input$user_filename
           )
         )
       }