Suppress any emission of a particular warning message - r

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.

Related

RStudio fails to read GBP pound sign

After a bit of a gap I updated RStudio and all packages this morning.
I have a little function that I use to prettify currencies
currency <- function(n, k=FALSE) {
n <- ifelse(!k, str_c("£", comma(round(n,0))), str_c("£", comma(round(n/1000,0)),"k"))
return(n)
}
It now fails to parse - the problem is the £ sign.
Error in parse(text = lines, n = -1, srcfile = srcfile) :
[path]/plot_helpers.R:72:
25: unexpected INCOMPLETE_STRING
71: currency <- function(n, k=FALSE) {
72: n <- ifelse(!k, str_c("
^
In addition: Warning message:
In readLines(con, warn = FALSE, n = n, ok = ok, skipNul = skipNul) :
invalid input found on input connection '/home/richardc/ownCloud/prodr/R/plot_helpers.R'
However I can run the code within the editor and it works fine. What is causing readLines to fail in this way ?
After some messing about today, I realise that the problem is in devtools. To recap here is a test project testencr.prj:
library(stringr)
library(devtools)
main <- function(n) {
n <- str_c("£", n)
return(n)
}
I can run the code fine from the console, but when I use devtools it barfs on the UTF-8 character:
> devtools::load_all()
Loading testencr
Error in parse(text = lines, n = -1, srcfile = srcfile) :
/home/richardc/ownCloud/test/R/test_enc.R:6:14: unexpected INCOMPLETE_STRING
5: main <- function(n) {
6: n <- str_c("
^
In addition: There were 27 warnings (use warnings() to see them)
But when I add a specific encoding into the DESCRIPTION
Encoding: UTF-8
It is all fine (this notwithstanding the project defaults are UTF8)
Loading testencr
There were 36 warnings (use warnings() to see them)```
I was having the same problem, specifically in a Shiny app (not the rest of the time). I managed to solve it by using this unicode instead of £:
enc2utf8("\u00A3")

Ignoring the symbol ° in R devtools function document()

I would like to create a package for internal usage (not to distribute somewhere). One of my functions contains the line
if (data$unit[i] != "°C") {
It works perfectly in the script, but if I want to create the documentation for my package using document() from devtools, i get the error
Error in parse(text = lines, keep.source = TRUE, srcfile = srcfilecopy(file, path_to_my_code: unexpected INCOMPLETE_STRING
279: if (! is.na(data$unit[i]){
280: if (data$unit[i] != "
addition: Warning message:
In readLines(con, warn = FALSE, n = n, ok = ok, skipNul = skipNul) :
invalid input found on input connection 'path_to_my_code'
If I delete the °-character, document() works. But I need this character there, so this is not an option.
When using double-\ in the if-clause, my function doesn't detect °C anymore as shown here:
test <- c("mg/l", "°C")
"\\°C" %in% test
[1] FALSE
If I use tryCatch, the documentation is also not created.
Replacing "°C" by gsub(pattern = '\\\\', replacement = "", x = '\\°C') causes the function to crash at the double-\ .
How can I tell document() that everything is fine and it should just create the files?

Log all warnings with futile.logger

Trying to log all errors and warnings with futile.logger.
Somewhat satisfied with this for dealing with errors:
library(futile.logger)
options(error = function() { flog.error(geterrmessage()) ; traceback() ; stop() })
log("a")
# Error in log("a") : argument non numérique pour une fonction mathématique
# ERROR [2016-12-01 21:12:07] Error in log("a") : argument non numérique pour une fonction mathématique
#
# No traceback available
# Erreur pendant l'emballage (wrapup) :
There is redundancy, but I can easily separate between stderr, stdout and log file, so it's not a problem. It's certainly not pretty, there is an additional "wrapup" error message somehow caused by the final stop() that I don't understand, so I'm open to suggestions.
I cannot find a similar solution for warnings. What I tried:
options(warn = 1L)
options(warning.expression = expression(flog.warn(last.warning)))
log(- 1)
# [1] NaN
But to no avail.
Follow-up question: Are there best practices that I am unknowingly ignoring?
How about:
options(warning.expression =
quote({
if(exists("last.warning",baseenv()) && !is.null(last.warning)){
txt = paste0(names(last.warning),collapse=" ")
try(suppressWarnings(flog.warn(txt)))
cat("Warning message:\n",txt,'\n',sep = "")
}
}))
In can contribute two options to log R conditions like warnings with futile.logger and catch all warnings no matter how deep the function call stack is:
Wrap your code with withCallingHandlers for a basic solution
Use my package tryCatchLog for an advanced solution (for compliance reason: I am the author)
To explain the solutions I have created a simple R script that produces warnings and errors:
# Store this using the file name "your_code_file.R"
# This could be your code...
f1 <- function(value) {
print("f1() called")
f2(value) # call another function to show what happens
print("f1() returns")
}
f2 <- function(value) {
print("f2() called")
a <- log(-1) # This throws a warning: "NaNs produced"
print(paste("log(-1) =", a))
b <- log(value) # This throws an error if you pass a string as value
print("f2() returns")
}
f1(1) # produces a warning
f1("not a number") # produces a warning and an error
Executed "as is" (without logging) this code produces this output:
[1] "f1() called"
[1] "f2() called"
[1] "log(-1) = NaN"
[1] "f2() returns"
[1] "f1() returns"
[1] "f1() called"
[1] "f2() called"
[1] "log(-1) = NaN"
Error in log(value) : non-numeric argument to mathematical function
Calls: source -> withVisible -> eval -> eval -> f1 -> f2
In addition: Warning messages:
1: In log(-1) : NaNs produced
2: In log(-1) : NaNs produced
Solution 1 (withCallingHandlers)
Create a new R file that is called by R and sources your unchanged (!) original R script:
# Store this using the file name "logging_injector_withCallingHandlers.R"
# Main function to inject logging of warnings without changing your original source code
library(futile.logger)
flog.threshold(INFO)
# Injecting the logging of errors and warnings:
tryCatch(withCallingHandlers({
source("your_code_file.R") # call your unchanged code by sourcing it!
}, error = function(e) {
call.stack <- sys.calls() # "sys.calls" within "withCallingHandlers" is like a traceback!
log.message <- e$message
flog.error(log.message) # let's ignore the call.stack for now since it blows-up the output
}, warning = function(w) {
call.stack <- sys.calls() # "sys.calls" within "withCallingHandlers" is like a traceback!
log.message <- w$message
flog.warn(log.message) # let's ignore the call.stack for now since it blows-up the output
invokeRestart("muffleWarning") # avoid warnings to "bubble up" to being printed at the end by the R runtime
})
, error = function(e) {
flog.info("Logging injector: The called user code had errors...")
})
If you execute this wrapper code the R output is:
$ Rscript logging_injector_withCallingHandlers.R
NULL
[1] "f1() called"
[1] "f2() called"
WARN [2017-06-08 22:35:53] NaNs produced
[1] "log(-1) = NaN"
[1] "f2() returns"
[1] "f1() returns"
[1] "f1() called"
[1] "f2() called"
WARN [2017-06-08 22:35:53] NaNs produced
[1] "log(-1) = NaN"
ERROR [2017-06-08 22:35:53] non-numeric argument to mathematical function
INFO [2017-06-08 22:35:53] Logging injector: The called user code had errors...
As you can see
warnings are logged now
the call stack could be output too (I have disabled this to avoid flooding this answer)
References: https://stackoverflow.com/a/19446931/4468078
Solution 2 - package tryCatchLog (I am the author)
Solution 1 has some drawbacks, mainly:
The stack trace ("traceback") does not contain file names and line numbers
The stack trace is flooded with internal function calls you don't want to see (believe me or try it with your non-trival R scripts ;-)
Instead of copying&pasting the above code snippet again and again I have developed a package that encapsulates the above withCallingHandlers logic in a function and adds additional features like
logging of errors, warnings and messages
identifying the origin of errors and warnings by logging a stack trace with a reference to the source file name and line number
support post-mortem analysis after errors by creating a dump file with all variables of the global environment (workspace) and each function called (via dump.frames) - very helpful for batch jobs that you cannot debug on the server directly to reproduce the error!
To wrap the above R script file using tryCatchLog create a wrapper file
# Store this using the file name "logging_injector_tryCatchLog.R"
# Main function to inject logging of warnings without changing your original source code
# install.packages("devtools")
# library(devtools)
# install_github("aryoda/tryCatchLog")
library(tryCatchLog)
library(futile.logger)
flog.threshold(INFO)
tryCatchLog({
source("your_code_file.R") # call your unchanged code by sourcing it!
#, dump.errors.to.file = TRUE # Saves a dump of the workspace and the call stack named dump_<YYYYMMDD_HHMMSS>.rda
})
and execute it via Rscript to get this (shortened!) result:
# $ Rscript -e "options(keep.source = TRUE); source('logging_injector_tryCatchLog.R')" > log.txt
[1] "f1() called"
[1] "f2() called"
WARN [2017-06-08 23:13:31] NaNs produced
Compact call stack:
1 source("logging_injector_tryCatchLog.R")
2 logging_injector_tryCatchLog.R#12: tryCatchLog({
3 logging_injector_tryCatchLog.R#13: source("your_code_file.R")
4 your_code_file.R#18: f1(1)
5 your_code_file.R#6: f2(value)
6 your_code_file.R#12: .signalSimpleWarning("NaNs produced", quote(log(-1)))
Full call stack:
1 source("logging_injector_tryCatchLog.R")
2 withVisible(eval(ei, envir))
...
<a lot of logging output omitted here...>
As you can see clearly at the call stack level 6 the source code file name and line number (#12) is logged as the source of the warning together with the source code snippet throwing the warning:
6 your_code_file.R#12 .signalSimpleWarning("NaNs produced", quote(log(-1)))
The way you should use futile.logger is shown in its documentation. Here us a quick example, of how it typically is used, and how to set the threshold.
# set log file to write to
flog.appender (appender.file ("mylog.log"))
# set log threshold, this ensures only logs at or above this threshold are written.
flog.threshold(WARN)
flog.info("DOES NOT LOG")
flog.warn ("Logged!")

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

Why can't I vectorize source_url in knitr?

I am trying to vectorize this call to source_url, in order to load some functions from GitHub:
library(devtools)
# Find ggnet functions.
fun = c("ggnet.R", "functions.R")
fun = paste0("https://raw.github.com/briatte/ggnet/master/", fun)
# Load ggnet functions.
source_url(fun[1], prompt = FALSE)
source_url(fun[2], prompt = FALSE)
The last two lines should be able to work in a lapply call, but for some reason, this won't work from knitr: to have this code work when I process a Rmd document to HTML, I have to call source_url twice.
The same error shows up with source_url from devtools and with the one from downloader: somehwere in my code, an object of type closure is not subsettable.
I suspect that this has something to do with SHA; any explanation would be most welcome.
It has nothing to do with knitr or devtools or vectorization. It is just an error in your(?) code, and it is fairly easy to find it out using traceback().
> library(devtools)
> # Find ggnet functions.
> fun = c("ggnet.R", "functions.R")
> fun = paste0("https://raw.github.com/briatte/ggnet/master/", fun)
> # Load ggnet functions.
> source_url(fun[1], prompt = FALSE)
SHA-1 hash of file is 2c731cbdf4a670170fb5298f7870c93677e95c7b
> source_url(fun[2], prompt = FALSE)
SHA-1 hash of file is d7d466413f9ddddc1d71982dada34e291454efcb
Error in df$Source : object of type 'closure' is not subsettable
> traceback()
7: which(df$Source == x) at file34af6f0b0be5#14
6: who.is.followed.by(df, "JacquesBompard") at file34af6f0b0be5#19
5: eval(expr, envir, enclos)
4: eval(ei, envir)
3: withVisible(eval(ei, envir))
2: source(temp_file, ...)
1: source_url(fun[2], prompt = FALSE)
You used df in the code, and df is a function in the stats package (density of the F distribution). I know you probably mean a data frame, but you did not declare that in the code.

Resources