diff --git a/Dockerfile b/Dockerfile index 119b715..b96fa0a 100644 --- a/Dockerfile +++ b/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 diff --git a/Start_ELN.sh b/Start_ELN.sh new file mode 100755 index 0000000..c30eb81 --- /dev/null +++ b/Start_ELN.sh @@ -0,0 +1,4 @@ +#!/bin/bash + +cd eln_prod +docker compose up diff --git a/Start_Server_App.R b/Start_Server_App.R new file mode 100644 index 0000000..eddbb9f --- /dev/null +++ b/Start_Server_App.R @@ -0,0 +1,4 @@ +Sys.setenv(RUN_MODE = "SERVER") +library(bs) +app <- bs::app() +shiny::shinyApp(app$ui, app$server) diff --git a/Start_Serverless_App.R b/Start_Serverless_App.R new file mode 100644 index 0000000..506fcb1 --- /dev/null +++ b/Start_Serverless_App.R @@ -0,0 +1,4 @@ +Sys.setenv(RUN_MODE = "BROWSER") +library(bs) +app <- bs::app() +shiny::shinyApp(app$ui, app$server) diff --git a/bs/.development/lm_glm_lm_mixed.R b/bs/.development/lm_glm_lm_mixed.R new file mode 100644 index 0000000..d93e59c --- /dev/null +++ b/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) + diff --git a/bs/R/DoseResponse.R b/bs/R/DoseResponse.R index 525d5b8..e05e45e 100644 --- a/bs/R/DoseResponse.R +++ b/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,6 +301,7 @@ 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) @@ -307,15 +309,18 @@ DoseResponseServer <- function(id, data, listResults) { 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 ) ) } diff --git a/bs/R/OperationsModule.R b/bs/R/OperationsModule.R index 09d4acb..4ea6be8 100644 --- a/bs/R/OperationsModule.R +++ b/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,6 +869,7 @@ 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) @@ -875,15 +877,18 @@ OperationEditorServer <- function(id, data, listResults) { 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 ) ) } diff --git a/bs/R/assumption.R b/bs/R/assumption.R index da0de66..36fb9ff 100644 --- a/bs/R/assumption.R +++ b/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 ) ) } diff --git a/bs/R/correlation.R b/bs/R/correlation.R index d9d58b8..a343655 100644 --- a/bs/R/correlation.R +++ b/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,6 +215,7 @@ 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) @@ -221,15 +223,18 @@ corrServer <- function(id, data, listResults) { 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 ) ) } diff --git a/bs/R/statisticalTests.R b/bs/R/statisticalTests.R index ada5eaa..bb20375 100644 --- a/bs/R/statisticalTests.R +++ b/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,6 +347,7 @@ 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) @@ -353,15 +355,18 @@ testsServer <- function(id, data, listResults) { 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 ) ) } diff --git a/bs/R/utils.R b/bs/R/utils.R index 947a01c..145ce52 100644 --- a/bs/R/utils.R +++ b/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" +} + diff --git a/bs/R/visualisation.R b/bs/R/visualisation.R index 4e7278c..0425d32 100644 --- a/bs/R/visualisation.R +++ b/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,6 +526,7 @@ 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) @@ -531,15 +534,18 @@ visServer <- function(id, data, listResults) { 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 ) ) } diff --git a/bs/inst/www/download.js b/bs/inst/www/download.js index cdda255..71c4cad 100644 --- a/bs/inst/www/download.js +++ b/bs/inst/www/download.js @@ -1,5 +1,6 @@ Shiny.addCustomMessageHandler('downloadZip', function(message) { var FileContent = message.FileContent; + var FileName = message.Filename; if( (typeof FileContent) == "string") { if (FileContent.startsWith("data:image")) { var fileName = 'file' + (i + 1) + '.png'; @@ -11,14 +12,14 @@ Shiny.addCustomMessageHandler('downloadZip', function(message) { } zip.file(fileName, byteArray, {binary: true}); zip.generateAsync({type: 'blob'}).then(function(content) { - saveAs(content, 'download.zip'); + saveAs(content, FileName); }); } else { var zipText = new JSZip(); var fileNameText = 'file' + 1 + '.txt'; zipText.file(fileNameText, FileContent); zipText.generateAsync({type: 'blob'}).then(function(content) { - saveAs(content, 'download.zip'); + saveAs(content, FileName); }); } } else { @@ -38,7 +39,7 @@ Shiny.addCustomMessageHandler('downloadZip', function(message) { } } zip.generateAsync({type: 'blob'}).then(function(content) { - saveAs(content, 'download.zip'); + saveAs(content, FileName); }); } -}); \ No newline at end of file +}); diff --git a/comeln/NAMESPACE b/comeln/NAMESPACE index c841569..829fc5a 100644 --- a/comeln/NAMESPACE +++ b/comeln/NAMESPACE @@ -1,4 +1,5 @@ # Generated by roxygen2: do not edit by hand +import(httr) export(download) export(upload) diff --git a/deploy_serverless_app.R b/deploy_serverless_app.R new file mode 100644 index 0000000..3a60eb5 --- /dev/null +++ b/deploy_serverless_app.R @@ -0,0 +1,7 @@ +shinylive::export("./bs/R/", "docs") +setwd("/home/konrad/Documents/Biostats/docs") +httpuv::runStaticServer(".") + +# setwd("/home/konrad/Documents/Biostats/BiostatsGithubPage") +# source("app.R") +# shinyApp(ui, server) diff --git a/eln_prod/docker-compose.yml b/eln_prod/docker-compose.yml new file mode 100644 index 0000000..ef6cf1f --- /dev/null +++ b/eln_prod/docker-compose.yml @@ -0,0 +1,57 @@ +services: + db: + image: postgres:13 + restart: unless-stopped + hostname: db + environment: + - POSTGRES_USER=postgres + - POSTGRES_PASSWORD=postgres + volumes: + - chemotion_db:/var/lib/postgresql/data/ + networks: + - chemotion + + worker: + image: ptrxyz/internal:eln-1.10.3 + restart: unless-stopped + environment: + - CONFIG_ROLE=worker + - SECRET_KEY_BASE=pleasechangeme + depends_on: + - db + - eln + volumes: + - chemotion_data:/chemotion/data/ + - chemotion:/chemotion/app + networks: + - chemotion + + eln: + image: ptrxyz/internal:eln-1.10.3 + restart: unless-stopped + environment: + - CONFIG_ROLE=eln + - SECRET_KEY_BASE=pleasechangeme + - PUBLIC_URL=http://0.0.0.0:4000 + depends_on: + - db + volumes: + - ./shared/pullin:/shared + - ./shared/backup:/backup + - chemotion_data:/chemotion/data/ + - chemotion:/chemotion/app + ports: + - 4000:4000 + networks: + - chemotion + +volumes: + chemotion: + name: chemotion_app + chemotion_data: + name: chemotion_data + chemotion_db: + name: chemotion_db + +networks: + chemotion: diff --git a/eln_prod/shared/pullin/.version b/eln_prod/shared/pullin/.version new file mode 100644 index 0000000..adfb00a --- /dev/null +++ b/eln_prod/shared/pullin/.version @@ -0,0 +1,4 @@ +CHEMOTION_REF=cfe6e7e +CHEMOTION_TAG=v1.10.3 +RELEASE=1.10.3 +VERSION=1.10.3