diff --git a/DESCRIPTION b/DESCRIPTION index 16b0fcb211a68b2813636c437e6cd8e90229c84a..20fbb8ea53d1a52b48a06526b92c4b5403f44dba 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: stressaddition Type: Package Title: Modeling Tri-Phasic Concentration-Response Relationships -Version: 1.11.0 +Version: 1.11.1 Date: 2020-02-04 Authors@R: c(person("Sebastian", "Henz", diff --git a/R/ecxsys.R b/R/ecxsys.R index 20518569f1229d5bd361f0f1ec60b03ca7d59fd8..75f7adebccecdd2df6216e63804c584e4a77d239 100644 --- a/R/ecxsys.R +++ b/R/ecxsys.R @@ -209,12 +209,14 @@ ecxsys <- function(concentration, ) conc_interpolated <- 10^temp$x effect_tox_observed_interpolated_simple_model <- temp$y + original_options <- options() effect_tox_mod_simple <- drc::drm( effect_tox_observed_interpolated_simple_model ~ conc_interpolated, fct = drc::LL.5(fixed = c( NA, 0, effect_tox_observed_averaged[1], NA, NA )) ) + options(original_options) # because drm modifies options effect_tox_simple <- predict(effect_tox_mod_simple, data.frame(concentration)) output$effect_tox_mod_simple <- effect_tox_mod_simple output$effect_tox_simple <- effect_tox_simple * effect_max @@ -224,12 +226,14 @@ ecxsys <- function(concentration, effect_tox_env_observed_averaged, xout = temp$x )$y + original_options <- options() effect_tox_env_mod_simple <- drc::drm( effect_tox_env_observed_interpolated_simple_model ~ conc_interpolated, fct = drc::LL.5(fixed = c( NA, 0, effect_tox_env_observed_averaged[1], NA, NA )) ) + options(original_options) # because drm modifies options effect_tox_env_simple <- predict( effect_tox_env_mod_simple, data.frame(concentration) @@ -292,10 +296,12 @@ ecxsys <- function(concentration, effect_tox[1] <- 1 effect_to_fit_idx <- 2:(hormesis_index - 1) effect_tox[effect_to_fit_idx] <- NA + original_options <- options() effect_tox_mod <- drc::drm( effect_tox ~ concentration, fct = drc::W1.2() ) + options(original_options) # because drm modifies options effect_tox <- predict( effect_tox_mod, data.frame(concentration = concentration) @@ -319,10 +325,12 @@ ecxsys <- function(concentration, { # There is no other way to suppress that one error message # except by changing the options temporarily. + original_options <- options() options(show.error.messages = FALSE) drc::drm(sys_stress_tox ~ stress_tox, fct = drc::W1.3()) }, error = function(e) { + options(original_options) # because drm() modifies the "warn" option warning( "Using a horizontal linear model for sys_stress_tox_mod ", "because the Weibull model did not converge.", @@ -335,7 +343,7 @@ ecxsys <- function(concentration, sys_stress_tox <- c(0, 0) return(lm(sys_stress_tox ~ stress_tox)) }, - finally = options(show.error.messages = TRUE) + finally = options(original_options) ) output$sys_stress_tox_mod <- sys_stress_tox_mod sys_stress_tox <- unname( @@ -373,10 +381,12 @@ ecxsys <- function(concentration, { # There is no other way to suppress that one error message # except by changing the options temporarily. + original_options <- options() options(show.error.messages = FALSE) drc::drm(sys_stress_tox_env ~ stress_tox, fct = drc::W1.3()) }, error = function(e) { + options(original_options) # because drm() modifies the "warn" option warning( "Using a horizontal linear model for ", "sys_stress_tox_env_mod because the Weibull model did ", @@ -390,7 +400,7 @@ ecxsys <- function(concentration, sys_stress_tox_env <- c(0, 0) return(lm(sys_stress_tox_env ~ stress_tox)) }, - finally = options(show.error.messages = TRUE) + finally = options(original_options) ) output$sys_stress_tox_env_mod <- sys_stress_tox_env_mod sys_stress_tox_env <- unname( diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R new file mode 100644 index 0000000000000000000000000000000000000000..e56a332d865ceaa1a6e5421e56633b97bc1998e4 --- /dev/null +++ b/tests/testthat/test-options.R @@ -0,0 +1,23 @@ +context("options") + + +test_that("user options are not permanently changed by ecxsys()", { + # drc::drm() messes with the options and fails to return them to their + # previous values. And options are temporarily modified in ecxsys(). This + # test checks if all options are returned to their values from before + # calling ecxsys(). + + # This problem becomes visible only if the user changes the default options: + options(show.error.messages = FALSE) # default is TRUE + options(warn = 1) # default is 0 + + original_options <- options() + model <- ecxsys( + concentration = c(0, 0.03, 0.3, 3, 10), + effect_tox_observed = c(85, 76, 94, 35, 0), + effect_tox_env_observed = c(24, 23, 32, 0, 0), + hormesis_concentration = 0.3 + ) + new_options <- options() + expect_identical(original_options, new_options) +})