I want to cat() some information to the console in the case a test fails (I'm getting confident this won't happen but I can't prove it wont) so I can investigate the issue.
Now I have code that is approximately like this:
testthat::test_that('Maybe fails', {
seed <- as.integer(Sys.time())
set.seed(seed)
testthat::expect_true(maybe_fails(runif(100L)))
testthat::expect_equal(long_vector(runif(100L)), target, tol = 1e-8)
if (failed()) {
cat('seed: ', seed, '\n')
}
})
Unfortunately, failed() doesn't exist.
Return values of expect_*() don't seem useful, they just return the actual argument.
I'm considering to just check again using all.equal() but that is a pretty ugly duplication.
Instead of using cat, you could use the info argument managed by testthat and its reporters for all expect functions (argument kept for compatibility reasons):
library(testthat)
testthat::test_that("Some tests",{
testthat::expect_equal(1,2,info=paste('Test 1 failed at',Sys.time()))
testthat::expect_equal(1,1,info=paste('Test 2 failed at',sys.time()))
})
#> -- Failure (<text>:5:3): Some tests --------------------------------------------
#> 1 not equal to 2.
#> 1/1 mismatches
#> [1] 1 - 2 == -1
#> Test 1 failed at 2021-03-03 17:25:37
Related
I'm writing unit tests for a package and there are some tests where I don't want the tests to throw errors if they fail but to instead give warnings.
This isn't my real code, but let's say I want to test something like:
add_x_y <- function(x, y) x + y
expect_equal( add_x_y(2, 2), 3 )
The output is an error:
Error: add_x_y(2, 2) not equal to 3.
1/1 mismatches
[1] 4 - 3 == 1
Is there a variant or alternative function that would throw a warning rather than an error for this check?
In the absence of an approach specific to testthat you could use general error handling to output a warning in place of an error.
expect_equal_or_warn <- function(...) tryCatch(expect_equal(...),
error = function(e) warning(e))
expect_equal_or_warn(add_x_y(2,2), 3)
Warning message:
add_x_y(2, 2) not equal to 3.
1/1 mismatches
[1] 4 - 3 == 1
when using the MRM function in the package Ecodist, I get the following error:
Error in xj[i, , drop = FALSE] : incorrect number of dimensions
I get this error no matter what I do, I even get it with the example code in the documentation:
data(graze)
# Abundance of this grass is related to forest cover but not location
MRM(dist(LOAR10) ~ dist(sitelocation) + dist(forestpct), data=graze, nperm=10)
I don't know what's going on. I have tried other computers and get the same error, so it's not even confined to my machine (windows 10, fully updated).
Best,
Joe
Thanks to Torsten Biemann for pointing me at this. I don't check stackoverflow regularly, but you are always welcome to email me at the ecodist maintainer address or open an issue at https://github.com/phiala/ecodist
As pointed out above, the example works correctly in a clean R session, but fails if spdep is loaded. I haven't figured out the conflict yet, but the problem is in the implict coercion of distance object to vector within the mechanics of using a formula. If you do that explicitly, the command works properly. I'll work on a patch, which will first be at the github above, and sent to CRAN after testing.
# R --vanilla --no-save
library(ecodist)
data(graze)
# Works
set.seed(1234)
MRM(dist(LOAR10) ~ dist(sitelocation) + dist(forestpct), data=graze, nperm=10)
$coef
dist(LOAR10) pval
Int 6.9372046 1.0
dist(sitelocation) -0.4840631 0.6
dist(forestpct) 0.1456083 0.1
$r.squared
R2 pval
0.04927212 0.10000000
$F.test
F F.pval
31.66549 0.10000
library(spdep)
# Fails
MRM(dist(LOAR10) ~ dist(sitelocation) + dist(forestpct), data=graze, nperm=10)
Error in xj[i, , drop = FALSE] : incorrect number of dimensions
# Explicit conversion to vector
graze.d <- with(graze, data.frame(LOAR10 = as.vector(dist(LOAR10)), sitelocation = as.vector(dist(sitelocation)), forestpct = as.vector(dist(forestpct))))
# Works
set.seed(1234)
MRM(LOAR10 ~ sitelocation + forestpct, data=graze.d, nperm=10)
$coef
LOAR10 pval
Int 6.9372046 1.0
sitelocation -0.4840631 0.6
forestpct 0.1456083 0.1
$r.squared
R2 pval
0.04927212 0.10000000
$F.test
F F.pval
31.66549 0.10000
I'm writing test for my package and I want to use macro economical data rather than artificially randomized. The problem is that when I'm using read.csv('my_file.csv') and then running test_that, all tests using my data are ignored. For example
library('tseries')
library('testthat')
data<-read.csv('my_file.csv')
test_that('ADF test',{
vec<-data[,2]
expect_is(adf.test(vec),'htest')
})
After running 'testpackage' I get no information about failure or passing of my test. where is the problem ?
testthat only returns an error in console if the test didn't succeed:
library(testthat)
data<-iris
test_that('test1',{
expect_is(data$Petal.Length,'numeric')
})
test_that('test2',{
expect_is(data$Species,'numeric')
})
#> Error: Test failed: 'test2'
#> * <text>:8: data$Species inherits from `factor` not `numeric`.
Created on 2020-09-21 by the reprex package (v0.3.0)
You can use test_file or test_dir to get the results:
res <- test_file('mytest.R',
reporter = "list",
env = test_env(),
start_end_reporter = TRUE,
load_helpers = TRUE,
wrap = TRUE)
√ | OK F W S | Context
x | 1 1 | mytest
--------------------------------------------------------------------------------
mytest.R:8: failure: test2
data$Species inherits from `factor` not `numeric`.
--------------------------------------------------------------------------------
== Results =====================================================================
OK: 1
Failed: 1
Warnings: 0
Skipped: 0
Warning message:
`encoding` is deprecated; all files now assumed to be UTF-8
first of all, this simmer_vignette and this linkadvanced_simmer_usage seem to indicate that the error stems from the fact that "get_name, get_attribute and get_prioritization are meant to be used inside a trajectory; otherwise, there will be no arrival running and these functions will throw an error"
A minimal workable example:
patient_traj <- trajectory(name = "patient_trajectory") %>%
set_attribute("my_key", 123) %>%
timeout(5) %>%
set_attribute("my_key", function() get_attribute(env, "my_key") + 1) %>%
timeout(5) %>%
set_attribute("dependent_key", function() ifelse(get_attribute(env, "my_key")<=123, 1, 0)) %>%
timeout(5) %>%
set_attribute("independent_key", function() runif(1))
env<- simmer() %>%
add_generator("patient", patient_traj, at(0), mon = 2)
env %>% run()
#> simmer environment: anonymous | now: 15 | next:
#> { Generator: patient | monitored: 2 | n_generated: 1 }
get_mon_attributes(env)
#> time name key value replication
#> 1 0 patient0 my_key 123.0000000 1
#> 2 5 patient0 my_key 124.0000000 1
#> 3 10 patient0 dependent_key 0.0000000 1
#> 4 15 patient0 independent_key 0.9234335 1
Now this works as it's supposed to work, the problem starts when I try to call get_attribute() in any other sense. Adding this line after set_attribute() at the very end of the trajectory definition:
log_(get_attribute(env, "independent_key"))
throws the abovementioned error.
What I actually want to do is call the "leave" function and give it as a probability an attribute. I still do this in the trajectory.
leave(prob = get_attribute(env, "independent_key"))
Needless to say, this also throws the error "Error in get_attribute_(private$sim_obj, key, global) : there is no arrival running".
Does anyone know what might cause this? I feel like the only option is the above explanatio "get_attribute is meant to be used inside a trajectory" - but I feel like I am doing this.
Thanks already!
Okay, I am embarrased to say this but the problem was rather easily fixed. It seems as if the problem was to access the attribute directly.
So log_(get_attribute(env, "independent_key")) does not work, but log_(function() get_attribute(env, "independent_key")) does.
That's all it takes.
If anyone has an explanation as to why that is all it takes, I would highly appreciate it.
I'm new to R and confused with the way the pos() function works. Here's why:
Example:
library(qdap)
s1<-c("Hello World")
pos(s1)
This produces the correct output saying the word count
wrd.cnt - 2
NN -1(50%)
UH-1(50%)
whereas the following to operations throws errors:
s2<-"Hello"
pos(s2)
Error in apply(pro, 2, paster, digits = digits, symbol = s.ymb, override = override) :
dim(X) must have a positive length
s3<-c("Hello Hello")
pos(s3)
Error in apply(pro, 2, paster, digits = digits, symbol = s.ymb, override = override) :
dim(X) must have a positive length
I'm not able to understand why this is caused.
You have found a bug in this version of qdap cause by not using drop = FALSE while indexing.
The dev version will behave as expected. You can download it easily with this code:
if (!require("pacman")) install.packages("pacman"); library(pacman)
p_install_gh("trinker/qdap")
The following has been added to the NEWS file as well:
pos threw an error if only one word was passed to text.var. Fix:
drop = FALSE has been added to data frame indexing. Caught by
StackOverflow user G_1991 R-How dos the pos() function work for parts-of-speech tagging.
Here's the updated output:
library(qdap)
s1<-c("Hello World")
pos(s1)
## wrd.cnt NN UH
## 1 2 1(50%) 1(50%)
s2<-"Hello"
pos(s2)
## wrd.cnt UH
## 1 1 1(100%)