`testthat::expect_silent()` does not seem to notice ggplot2 errors - r

I'm having trouble understanding the following behaviour of the expect_silent() function from testthat.
expect_silent() is supposed to fail when the test code returns any output, for example an error or warning:
library(testthat)
test_that("expect_silent works as expected", {
expect_silent( {
stop()
} )
} )
#> Error: Test failed: 'expect_silent works as expected'
#> *
#> 1: expect_silent({
#> stop()
#> }) at <text>:5
#> 2: quasi_capture(enquo(object), evaluate_promise)
#> 3: capture(act$val <- eval_bare(get_expr(quo), get_env(quo)))
#> 4: withr::with_output_sink(temp, withCallingHandlers(withVisible(code), warning = handle_warning,
#> message = handle_message))
#> 5: force(code)
#> 6: withCallingHandlers(withVisible(code), warning = handle_warning, message = handle_message)
#> 7: withVisible(code)
#> 8: eval_bare(get_expr(quo), get_env(quo))
#> 9: stop() at <text>:6
(The above is the expected behaviour: expect_silent() detects the error produced by stop(), and the test fails.)
However, for some reason it doesn't seem to detect errors that occur in ggplot2 expressions. For example, the following ggplot2 code produces an error due to a misspelling:
library(ggplot2)
ggplot(diamonds, aes(x = carrot, y = price)) +
geom_point()
#> Error in FUN(X[[i]], ...): object 'carrot' not found
But expect_silent() doesn't seem to detect the error:
test_that("expect_silent fails when ggplot2 throws an error", {
expect_silent( {
ggplot(diamonds, aes(x = carrot, y = price)) +
geom_point()
} )
} )
(No output is produced.)
Am I misunderstanding the purpose of expect_silent()? This is causing me a real headache as I'm trying to use it to test a ggplot2 extension.

Try capturing the output from ggplot and then testing if it can be printed:
library(ggplot2)
library(testthat)
# First test should succeed (no output)
test_that("silent when ggplot2 succeeds", {
working.plot <- ggplot(diamonds, aes(x = carat, y = price)) + geom_point()
expect_silent(print(working.plot))
} )
# Second test should fail
test_that("fails when ggplot2 throws an error", {
broken.plot <- ggplot(diamonds, aes(x = carrot, y = price)) + geom_point()
expect_silent(print(broken.plot))
} )
The second test fails with copious output which I've curtailed below:
Error: Test failed: 'expect_silent fails when ggplot2 throws an error'
* object 'carrot' not found
Update - 15th Dec 2018
Regarding your comment about why print() is necessary:
The ggplot() function returns an object of class ggplot. The ggplot2 package overloads the print() function, so instead of printing the object to STDOUT in the R session terminal, it prints the chart. The interactive mode in the R session terminal assumes that most of the commands are run through the print() function.
The testthat tests are evaluated in their own environments. The testthat environments are non-interactive, so the running through the print() function assumption no longer holds. You can test this with the interactive() function that comes with base R. It should report TRUE in the R session terminal and FALSE within a test_that() call.

Related

tryCatch() does not suppress the error messages

I would like to create a function that does not print any error messages.
Let's say I have the following data:
library(fitdistrplus)
vec <- rnorm(100)
Then the following gives an error message:
fitdist(vec, "exp")
#> Error in computing default starting values.
#> Error in manageparam(start.arg = start, fix.arg = fix.arg, obs = data, : Error in start.arg.default(obs, distname) :
#> values must be positive to fit an exponential distribution
Now I would like to create a function that does return NULL. I tried this with tryCatch(). The problem is that fit_fn() still returns the error 'Error in computing default starting values':
fit_fn <- function(x){
tryCatch(fitdist(x, "exp"), error = function(e){ NULL })
}
fit_fn(vec)
#> Error in computing default starting values.
#> NULL
What is the way to do this? Only NULL should be printed here:
fit_fn(vec)
#> NULL
Created on 2021-11-02 by the reprex package (v2.0.1)
Desipte the fact that it says it's an error, the message that's being displayed is done not via the error mechanism, but the output is being printed directly to the console because it's already in it's own error handler. If you want to suppress that message, you'll need to capture the output of the function. Then you can ignore that output.
You can do that with
fit_fn <- function(x){
capture.output(result <- tryCatch(fitdist(x, "exp"),
error = function(e){ NULL }))
result
}
fit_fn(vec)
# NULL

What determines the 'flipped_aes' occurence in ggplot2 objects?

I am currently writing swirl lessons where im trying to test if a ggplot2 object created by the user is somewhat equal (all.equal()) to an object i create in a custom AnswerTest. however the plot object which i receive from swirl api by accessing e$val often inherits an flipped_aes = FALSE attribute which i cannot create in my own plots and hence all.equal(e$val, someplot) fails allthough they look equal.
I would really appreciate some ideas how to work around it or control its occurence!
if it occurs all.equal() fails with the following message:
"Component “layers”: Component 1: Component 4: Length mismatch: comparison on first 2 components"
my current test looks like this:
calculates_same_graph <- function(expression){ #If ggplot expression must be written in curly brackets in Yaml file
e <- get("e", parent.frame())
eSnap <- cleanEnv(e$snapshot)
val <- expression
passed <- isTRUE(all.equal(val[-8], e$val[-8]))
assign("e", e$val, envir = globalenv()) #only for diagnostics, changes
#when new answer is put in
return(passed)
}
Ok, I agree that this is a bit weird, but I found out that the flipped_aes parameter only comes into existance after printing a plot. The weird bit is that is appears to be an object-modifying side-effect of printing the plot. This only makes sense if the paramter is being cached somehow.
Suppose we have two plots that have opposite aesthetic flipping:
library(ggplot2)
# Should have flipped_aes = FALSE
plot1 <- ggplot(iris, aes(Species, Sepal.Width)) +
geom_col()
# Should have flipped_aes = TRUE
plot2 <- ggplot(iris, aes(Sepal.Width, Species)) +
geom_col()
We can see that these unprinted objects do not have flipped.aes in their geom parameters.
# Before printing plot
plot1$layers[[1]]$geom_params
#> $width
#> NULL
#>
#> $na.rm
#> [1] FALSE
plot2$layers[[1]]$geom_params
#> $width
#> NULL
#>
#> $na.rm
#> [1] FALSE
Now we can print these plots to a temporary file. Just printing it in the console should work too, I just can't replicate that in a reprex.
# Printing as tempfile
tmp <- tempfile(fileext = ".png")
png(tmp)
plot1
plot2
dev.off()
#> png
#> 2
unlink(tmp)
Now after we've printed the plot, suddenly the plot objects have the flipped_aes parameter.
# After printing plot
plot1$layers[[1]]$geom_params
#> $width
#> NULL
#>
#> $na.rm
#> [1] FALSE
#>
#> $flipped_aes
#> [1] FALSE
plot2$layers[[1]]$geom_params
#> $width
#> NULL
#>
#> $na.rm
#> [1] FALSE
#>
#> $flipped_aes
#> [1] TRUE
Created on 2021-03-10 by the reprex package (v1.0.0)
I don't know what the best way is to deal with this weirdness in your swirl test, but it appears that the printing of the plot influences that parameter.

Suppress any emission of a particular warning message

I have a source file (in knitr) containing plots which use a particular font family. I'd like to suppress the warning messages
In grid.Call(L_textBounds, as.graphicsAnnot(x$label), ... : font
family not found in Windows font database
library(ggplot2)
ggplot(mtcars, aes(mpg, cyl, label = gear)) +
geom_text(family = "helvet")
I know I can suppress all warning messages in a script options(warn = -1), and I know how to use suppressWarnings. I can also surround a particular chunk in a tryCatch.
Is there a way to suppress only the grid.Call warning above throughout a file?
Use
withCallingHandlers({
<your code>
}, warning=function(w) {
if (<your warning>)
invokeRestart("muffleWarning")
})
For instance,
x = 1
withCallingHandlers({
warning("oops")
warning("my oops ", x)
x
}, warning=function(w) {
if (startsWith(conditionMessage(w), "my oops"))
invokeRestart("muffleWarning")
})
produces output
[1] 1
Warning message:
In withCallingHandlers({ : oops
>
The limitation is that the conditionMessage may be translated to another language (especially if from a base function) so that the text will not be reliably identified.
See Selective suppressWarnings() that filters by regular expression.

Error Handling in R when implementing association test

I am implementing a zero-inflated negative binomial in R. The code is here:
> ICHP<-read.table("ichip_data_recodeA.raw",header=TRUE)
ICHPdt<-data.table(ICHP)
covfile<-read.table("sorted.covfile.to.glm.out",header=TRUE)
covfiledt<-data.table(covfile)
library(pscl)
fhandle<-file("ichip_zi_nb_model_scoretest.csv","a")
for (i in seq(7, ncol(ICHPdt), 1)) {
notna<-which(!is.na(ICHPdt[[i]]))
string<-eval(parse(text = paste("ICHPdt$", colnames(ICHPdt)[i], sep="")))
nullglmmod<-zeroinfl(formula=OverllTot0[notna] ~ EurAdmix[notna] + Sex[notna] + DisDurMonths[notna] + BMI[notna] + Group[notna] + SmokingStatus[notna], data=covfiledt, dist="negbin")
nullsum<-coef(summary(nullglmmod))
glmmod<-zeroinfl(formula=OverllTot0[notna] ~ EurAdmix[notna] + Sex[notna] + DisDurMonths[notna] + BMI[notna] + Group[notna] + SmokingStatus[notna] + ICHPdt[[i]][notna], data=covfiledt, dist="negbin")
summ <- coef(summary(glmmod))
rownames(summ$zero)[8] <- paste0("ICHPdt$", colnames(ICHPdt)[i])
rownames(summ$count)[8] <- paste0("ICHPdt$", colnames(ICHPdt)[i])
writeLines("zero", con=fhandle)
writeLines(colnames(ICHPdt)[i], fhandle)
write.table(round(summ$zero, 4), file=fhandle)
writeLines("count", con=fhandle)
writeLines(colnames(ICHPdt)[i], fhandle)
write.table(round(summ$count, 4), file=fhandle)
}
The script errors when i=9246, and issues the following:
Error in solve.default(as.matrix(fit$hessian)) :
system is computationally singular: reciprocal condition number = 1.12288e-19
Overall, I need to go through ~100,000 markers, so I should expect ~11 such errors.
I would like to help implementing options, for instance with tryCatch() for catching such an error, skipping that marker, and moving on.
I recommend reading this page for a quick primer and this page for a more complete explanation of error handling, and you should eventually read ?conditions, but in short, there are two ways to handle errors. The first is with a try-catch, as in:
AS.NUMERIC <- function(x){
# for use in the warning handler
expectedWarning <- FALSE
result = tryCatch({
# a calculation that might raise an error or warning
as.numeric(x)
}, warning = function(w) {
# the typical way to identify the type of
# warning is via it's message attribure
if(grepl('^NAs introduced by coercion',w$message)){
cat('an expected warning was issued\n')
# assign the expected value using the scoping assignment
expectedWarning <<- TRUE
}else
cat('an unexpected warning was issued\n')
# reissue the warning
warning(w)
}, error = function(e) {
cat('an error occured\n')
# similar things go here but for handling errors
}, finally = {
# stuff goes here that should happen no matter what,
# such as closing connections or resetting global
# options such as par(ask), etc.
})
# you can handle errors similarly
if(expectedWarning)
result <- 5
return(result)
}
AS.NUMERIC('5')
#> [1] 5
AS.NUMERIC('five') # raises a warning
#> an expected warning was issued
#> [1] 5
#> Warning message:
#> In doTryCatch(return(expr), name, parentenv, handler) :
#> NAs introduced by coercion
The second way is to use try(), which is less nuanced:
x = try(stop('arbitrary error'),# raise an error
silent=TRUE)
# if there is an error, x will be an object with class 'try-error'
if(inherits(x,'try-error'))
# set the default value for x here
x = 5

ggplot is not working properly inside a function despite working outside it - R

I am trying to create a function that takes in 2 parameters & outputs the appropriate ggplot for them. The code works perfectly manually, but somehow I cannot make it work inside a function wrapper.
The error returned is
Error in eval(expr, envir, enclos) : object 'TimeVector' not found
I try to correct for that by coercing the objects not found, which are added to ggplot, as strings.
This in turn creates different trouble in form of
Error: Discrete value supplied to continuous scale
Removing the scale_x_continuous(breaks=0:24) fixes that second error, but outputs an empty graph, suggesting that ggplot is not fed with any data at all.
The data is a large data frame of observations of traffic density grouped by time. It looks like this:
ID Road Status Time Statusint Day Months Year Weekday
1 Me7war To Sheikh Zayid Orange 2012-10-01 00:03:00 3 1 October 12 Monday
1 Me7war To Sheikh Zayid Green 2012-10-01 05:00:00 2 1 October 12 Monday
1 Me7war To Sheikh Zayid Yellow 2012-10-01 05:24:00 5 1 October 12 Monday
I am trying to plot the "Statusint" variable, short for status integer ranging from 1 (good traffic) to 5 (Terrible traffic) against the "Time" variable. "Time" is formatted as Posix, so I create a numeric vector called "TimeVector" for the sole purpose of plotting against in ggplot.
The function is as follows:
Plotroad <- function( roadID , Day ) {
*** Working Code ***
else {
### THE PROBLEM CODE: Everything below works manually, but returns an error in the function
Roadsubset <- October[October$ID == as.numeric(roadID), ]
Timesubset <- subset(Roadsubset, format(Roadsubset$Time,'%d') == "Day" )
TimeVector <- as.numeric(gsub(":" , "." , strftime(Timesubset$Time, format="%H:%M")))
ggplot(Timesubset, aes( x = "TimeVector", y = "Timesubset$Statusint")) + geom_point() +
stat_smooth() + scale_x_continuous(breaks=0:24)
### The working code:
Roadsubset <- October[October$ID == as.numeric(roadID), ]
Timesubset <- subset(Roadsubset, subset = Roadsubset$Day == as.integer(Date) )
TimeVector <- as.numeric(gsub(":" , "." , strftime(Timesubset$Time, format="%H:%M")))
Timesubset$timevector <- TimeVector
print(ggplot( data = Timesubset, aes_string( x = "timevector" , y = "Statusint" )) + geom_point() + stat_smooth() + scale_x_continuous(breaks=0:24) + labs(list(title = as.character(Timesubset$Road[1]) , x = "Time of Day", y = "Status")))
}
}
I have seen some advice suggesting using print, as ggplot is invoked not in the command line. This, however does not fix the aforementioned errors.
This is my first post to stack overflow, so please point out how I can better format questions for the future, if in need. Thanks.
Aside from using variable names, there is an issue with scope. GGPlot carries out non-standard evaluation in the global environment, so anything defined in your function is not directly accessible, except for the "data" argument since that one is passed explicitly and not through non-standard evaluation. So one work around to this problem is to add your variable to the data argument. I've created an example that I think mimics your problem, but since I don't have your data it's not identical:
gg_fun <- function() {
data <- data.frame(a=1:10, b=1:10)
clr <- rep(c("a", "b"), 5)
ggplot(data, aes(x=a, y=b, color=clr)) + geom_point()
}
gg_fun()
# Error in eval(expr, envir, enclos) : object 'clr' not found
gg_fun <- function() {
data <- data.frame(a=1:10, b=1:10)
clr <- rep(c("a", "b"), 5)
data$clr <- clr
ggplot(data, aes(x=a, y=b, color=clr)) + geom_point()
}
gg_fun() # works
In your case, you need to add TimeVector to Timesubset (trivial), and then use the unquoted aes syntax:
ggplot(Timesubset, aes(x=TimeVector, y=Statusint)) ...

Resources