diff --git a/R/app_config.R b/R/app_config.R
index 9bc528b..fffe936 100644
--- a/R/app_config.R
+++ b/R/app_config.R
@@ -22,14 +22,9 @@ app_sys <- function(...) {
#' @noRd
get_golem_config <- function(
value,
- config = Sys.getenv(
- "GOLEM_CONFIG_ACTIVE",
- Sys.getenv(
- "R_CONFIG_ACTIVE",
- "default"
- )
- ),
- use_parent = TRUE) {
+ config = Sys.getenv("GOLEM_CONFIG_ACTIVE", Sys.getenv("R_CONFIG_ACTIVE", "default")),
+ use_parent = TRUE)
+{
config::get(
value = value,
config = config,
diff --git a/R/app_utils.R b/R/app_utils.R
index 4c9176d..a630120 100644
--- a/R/app_utils.R
+++ b/R/app_utils.R
@@ -558,7 +558,7 @@ verify_suggested <- function(pkg) {
#' @title auto_fill.
#' @description Fill all empty values (NA) of a vector with the last valid value.
#' @param x Vector of values possibly containing NA values.
-#' @return NULL.
+#' @return Vector of values without NA values (which are substituted).
#' @keywords internal
#' @noRd
auto_fill <- function(x) {
@@ -571,3 +571,25 @@ auto_fill <- function(x) {
return(x)
}
+#' @title get_fun_name.
+#' @description Get the name of a calling function.
+#' @param n Function level to go up.
+#' @return Character.
+#' @keywords internal
+#' @noRd
+get_fun_name <- function (n = 0) {
+ n = n + 1
+ cur_call <- sys.call(sys.parent(n))
+ fun_name <- as.character(cur_call)[1]
+ #fun_name = extract_root_and_last_member(fun_name)[["name"]]
+ return(fun_name)
+}
+
+e_msg <- function(x) {
+ if (get_golem_config("silent")) {
+ invisible(NULL)
+ } else {
+ #message("[", get_fun_name(n=1), "]: ", paste(as.character(list(...))))
+ message("[", get_fun_name(n=1), "]: ", x)
+ }
+}
\ No newline at end of file
diff --git a/R/fnc_c_filter_data.R b/R/fnc_c_filter_data.R
index 278169e..644b36b 100644
--- a/R/fnc_c_filter_data.R
+++ b/R/fnc_c_filter_data.R
@@ -16,7 +16,7 @@
#' @keywords internal
#' @noRd
c_filter_data <- function(x, c_apm) {
- if (!get_golem_config("silent")) message("[c_filter_data] filter certification dataset for analyte ", c_apm$name)
+ e_msg(paste("Filtering certification dataset for analyte", c_apm$name))
if (c_apm$name %in% x[, "analyte"]) {
x <- x[x[, "analyte"] %in% c_apm$name, ]
x <- x[!(x[, "ID"] %in% c_apm[["sample_filter"]]), ]
diff --git a/R/fnc_list2rv.R b/R/fnc_list2rv.R
index 84b845e..e989c32 100644
--- a/R/fnc_list2rv.R
+++ b/R/fnc_list2rv.R
@@ -25,7 +25,7 @@ list2rv <- function(x = NULL) {
# import functions for defined data_format schemes
if (x$General$dataformat_version == "2021-05-27") {
# Non-legacy upload #####
- if (!silent) message("RDataImport: Non-legacy upload started")
+ e_msg("Non-legacy upload started")
# rv should contain all variables from uploaded x except for deprecated once
# split must be false here, otherwise one name list is of class character
# the other of class list -> Error
@@ -71,13 +71,13 @@ list2rv <- function(x = NULL) {
# reset time_stamp with current
# $$ToDo think if this is really desirable
setValue(rv, c("General", "time_stamp"), Sys.time())
- if (!silent) message("RDataImport: Non-legacy upload finished")
+ e_msg("RDataImport: Non-legacy upload finished")
}
} else {
# Legacy upload
- if (!silent) message("[RDataImport]: Legacy upload started")
+ e_msg("Legacy upload started")
if ("Certification" %in% names(x) && !is.null(x$Certification)) {
- if (!silent) message("RDataImport_Server: Cert data transfered")
+ e_msg("Certification data transfered")
setValue(rv, c("Certification", "data"), x[["Certification"]][["data_input"]])
setValue(rv, c("Certification", "input_files"), x[["Certification"]][["input_files"]])
# save
@@ -104,7 +104,7 @@ list2rv <- function(x = NULL) {
setValue(rv, c("General", "apm"), apm)
}
if ("Homogeneity" %in% names(x) && !is.null(x$Homogeneity)) {
- if (!silent) message("RDataImport_Server: Homog data transfered")
+ e_msg("Homogeneity data transfered")
setValue(rv, c("Homogeneity", "data"), x[["Homogeneity"]][["h_dat"]])
setValue(rv, c("Homogeneity", "input_files"), x[["Homogeneity"]][["h_file"]])
# Processing
@@ -113,7 +113,7 @@ list2rv <- function(x = NULL) {
setValue(rv, c("Homogeneity", "h_Fig_width"), x[["Homogeneity"]][["h_Fig_width"]])
}
if ("Stability" %in% names(x) && !is.null(x$Stability)) {
- if (!silent) message("RDataImport_Server: Stab data transfered")
+ e_msg("Stability data transfered")
setValue(rv, c("Stability", "input_files"), x[["Stability"]][["s_file"]])
setValue(rv, c("Stability", "data"), x[["Stability"]][["s_dat"]])
setValue(rv, c("Stability", "s_vals"), x[["Stability"]][["s_vals"]])
diff --git a/R/fnc_prepTabV1.R b/R/fnc_prepTabV1.R
index 525aff3..53c4c59 100644
--- a/R/fnc_prepTabV1.R
+++ b/R/fnc_prepTabV1.R
@@ -20,6 +20,8 @@
#' @noRd
prepTabV1 <- function(tab = NULL, a = NULL, alpha = 0.05, k = 3, flt_outliers = FALSE) {
+ e_msg("Preparing Tab.V1 (statistics) from imported data")
+
if (is.null(a)) a <- levels(factor(tab[,"Analyte"]))
stopifnot(all(a %in% levels(factor(tab[,"Analyte"]))))
diff --git a/R/fnc_styleTabV1.R b/R/fnc_styleTabV1.R
index 37b5967..8aa5760 100644
--- a/R/fnc_styleTabV1.R
+++ b/R/fnc_styleTabV1.R
@@ -15,6 +15,7 @@
#' @keywords internal
#' @noRd
style_tabV1 <- function(df, precision = 3, selected = 1) {
+ e_msg("Styling Tab.V1 for HTML output")
colnames(df) <- gsub("^P_KS_Res$", "PKS,Res", colnames(df))
colnames(df) <- gsub("^P_Neu_Res$", "PNeu,Res", colnames(df))
colnames(df) <- gsub("^P_Mandel$", "PMandel", colnames(df))
diff --git a/R/m_ExcelUpload.R b/R/m_ExcelUpload.R
index 0c3431e..d6c723c 100644
--- a/R/m_ExcelUpload.R
+++ b/R/m_ExcelUpload.R
@@ -83,7 +83,6 @@ m_ExcelUpload_UI <- function(id) {
#' @keywords internal
m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
ns <- shiny::NS(id)
- silent <- get_golem_config("silent")
shiny::moduleServer(id, function(input, output, session) {
# Certification, Homogeneity, Stability -----------------------------------
@@ -167,22 +166,23 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
out <- shiny::reactiveValues(data = NULL, input_files = NULL)
# load from Excel
- load_from_excel <- function() {
+ load_from_excel <- function(fn = current_file_input()$name, fmt = c("Stability", "Homogeneity", "Certification")) {
+ fmt <- match.arg(fmt)
load_result <- NULL
tab_flt <- rv_xlsx_range_select$tab
# Append File column
- out$input_files <- current_file_input()$name
+ out$input_files <- fn
# perform minimal validation checks
- if (exl_fmt() == "Homogeneity") {
+ if (fmt == "Homogeneity") {
x <- tab_flt[[1]]
x <- checkHdata(x)
- x[, "File"] <- rep(current_file_input()$name[1], nrow(x))
+ x[, "File"] <- rep(fn[1], nrow(x))
load_result <- x
- } else if (exl_fmt() == "Certification") {
- if (!silent) message("[m_ExcelUpload_Server] Load Certification data")
+ } else if (fmt == "Certification") {
+ e_msg("Load Certification data (m_ExcelUpload_Server)")
# append file info
for (i in 1:length(tab_flt)) {
- tab_flt[[i]][["File"]] <- rep(current_file_input()$name[i], nrow(tab_flt[[i]]))
+ tab_flt[[i]][["File"]] <- rep(fn[i], nrow(tab_flt[[i]]))
}
# try to convert to data frame
tabC0 <- tryCatch(
@@ -201,7 +201,7 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
attr(tabC0, "msg") <- "Range specification is on default value"
}
load_result <- tabC0
- } else if (exl_fmt() == "Stability") {
+ } else if (fmt == "Stability") {
# STABILITY data may come in 3 versions
# (1) as simple two column format (Date, Value) with separate tables for each analyte
# (2) as LTS format with a meta data header containing machine info, certification data etc.
@@ -238,7 +238,7 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
{
req(rv_xlsx_range_select$tab)
message("[m_ExcelUpload] Load-button clicked")
- tmp <- try(load_from_excel())
+ tmp <- try(load_from_excel(fn = current_file_input()$name, fmt = exl_fmt()))
if (inherits(tmp, "try-error") | !is.null(attr(tmp, "msg")) | is.null(tmp)) {
shinyWidgets::ask_confirmation(
inputId = "ignore_problems", btn_labels = c("Cancel upload", "Upload anyways"),
@@ -262,7 +262,7 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
shiny::observeEvent(input$ignore_problems, {
if (input$ignore_problems) {
- tmp <- try(load_from_excel())
+ tmp <- try(load_from_excel(fn = current_file_input()$name, fmt = exl_fmt()))
out$data <- tmp
}
})
@@ -270,7 +270,7 @@ m_ExcelUpload_Server <- function(id, rv = NULL, msession = NULL) {
# when Excel was uploaded with LOAD-Button...
shiny::observeEvent(out$data,
{
- if (!silent) message("[page_start-ExcelUpload] set rv.Data")
+ message("[page_start-ExcelUpload] set rv.Data")
setValue(rv, c(exl_fmt(), "data"), out$data)
setValue(rv, c(exl_fmt(), "input_files"), out$input_files)
if (exl_fmt() == "Certification") {
diff --git a/R/page_validation.R b/R/page_validation.R
index bbc50c9..b332450 100644
--- a/R/page_validation.R
+++ b/R/page_validation.R
@@ -221,13 +221,11 @@ page_validationServer <- function(id, test_data = NULL) {
# Table V1 ====
tab_V1 <- shiny::reactive({
req(tab_flt())
- message("prepTabV1")
prepTabV1(tab = tab_flt(), alpha = as.numeric(input$opt_tabV1_alpha), k = as.numeric(input$opt_tabV1_k), flt_outliers = input$opt_tabV1_fltLevels)
})
output$tab_V1 <- DT::renderDT({
req(tab_V1(), input$opt_tabV1_k, input$opt_tabV1_alpha, input$opt_tabV1_precision)
- message("style_tabV1")
a_name <- shiny::isolate(current_analyte$name)
a_row <- shiny::isolate(current_analyte$row)
# correct current row of tab V1 in case that analyte filter is applied
diff --git a/tests/testthat.R b/tests/testthat.R
index fe669ec..7577f3e 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,6 +1,9 @@
library(testthat)
library(eCerto)
+# setting this variable will suppress most eCerto message calls
+Sys.setenv("GOLEM_CONFIG_ACTIVE"="default")
+
## run all tests similar to Ctrl+Shift+T in RStudio
# testthat::test_check(package = "eCerto", reporter=c("minimal", "location"))