Lately when I run my code that uses coxph in the survival package
coxph(frml,data = data), I am now getting warning messages of the following type
1: In model.matrix.default(Terms, mf, contrasts = contrast.arg) :
partial argument match of 'contrasts' to 'contrasts.arg'
2: In seq.default(along = temp) :
partial argument match of 'along' to 'along.with'"
I'm not exactly sure why all of a sudden these partial argument match warnings started popping up, but I don't think they effect me.
However, when I get the following warning message, I want coxph(frml,data = data) = NA
3: In fitter(X, Y, strats, offset, init, control, weights = weights, :
Loglik converged before variable 2 ; beta may be infinite.
6: In coxph(frml, data = data) :
X matrix deemed to be singular; variable 1 3 4
I used tryCatch when I wasn't getting the partial argument match warning using this code where if the nested tryCatch got either a warning or error message it would return NA
coxphfit = tryCatch(tryCatch(coxph(frml,data = data), error=function(w) return(NA)), warning=function(w) return(NA))
However, now that I am getting the partial argument match warnings, I need to only return an NA if there is an error or if I get the above warning messages 3 and 4 . Any idea about how to capture these particular warning messages and return an NA in those instances?
It's actually interesting question, if you are looking for quick and dirty way of capturing warnings you could simply do:
withCallingHandlers({
warning("hello")
1 + 2
}, warning = function(w) {
w ->> w
}) -> res
In this example the object w created in parent environment would be:
>> w
<simpleWarning in withCallingHandlers({ warning("hello") 1 + 2}, warning = function(w) { w <<- w}): hello>
You could then interrogate it:
grepl(x = w$message, pattern = "hello")
# [1] TRUE
as
>> w$message
# [1] "hello"
Object res would contain your desired results:
>> res
[1] 3
It's not the super tidy way but I reckon you could always reference object w and check if the warning message has the phrase you are interested in.
Related
I have a list of inputs over which I loop using purrr::map.
Using a tweaked version of purrr::possibly (for more details see here)
Applying this version of "possibly" to my main function, I'm able to use purrr::map to loop over my input list and store the results, or, alternatively, the complete error or warning messages if the function (partially) fails.
While this works fine for inputs where the function works correctly and inputs where it fails so that an error is produced,
it is less optimal when a warning is produced. The resulting output from purrr::map will store only the warning, but not the result.
input <- list(10, -1 , "A")
possibly2 <- function (.f) {
.f <- purrr::as_mapper(.f)
function(...) {
tryCatch(.f(...),
error = function(e) {
return(paste0("Error: ", e$message))
}, warning = function(w) {
return(paste0("Warning: ", w$message))
}
)
}
}
safer_log <- possibly2(.f = log)
map(input, safer_log) %>%
set_names(c("1. good input", "2. warning", "3. error")) # just added for naming the list elements
This results in:
$`1. good input`
[1] 2.302585
$`2. warning`
[1] "Warning: NaNs produced"
$`3. error`
[1] "Error: non-numeric argument to mathematical function"
However, for the warnings, I would actually like to include the results as well.
Similar to:
> log(-1)
[1] NaN
Warning message:
In log(-1) : NaNs produced
But I'm not really sure where the result of the main function is stored and how I could adapt the code to return it together with the warning. Probably, in cases where this happens, it is also necessary to split the output into elements $result $warning.
You need to use a custom condition handler to capture warnings while
retaining the result. That’s because tryCatch() unwinds the call stack,
discarding the context from the lower level that signaled the condition.
Only the condition object (the warning) is available at that point.
withCallingHandlers() is the function to use to install a custom handler.
In order to prevent default behaviour, handlers need to invoke a restart.
This can be done with tryInvokeRestart(). warning() makes a
muffleWarning restart available to avoid printing the warning message.
Here I also demonstrate adding your own restart using withRestarts().
Our custom error handler uses that restart to avoid aborting when an error
is signaled, returning NULL instead. But you could just as well keep
the tryCatch() for errors.
Here’s the modified function:
catching <- function(f) {
function(...) {
error <- NULL
handleError <- function(e) {
error <<- conditionMessage(e)
tryInvokeRestart("useValue", NULL)
}
warnings <- list()
handleWarning <- function(w) {
msg <- conditionMessage(w)
warnings <<- append(warnings, msg)
tryInvokeRestart("muffleWarning")
}
result <- withCallingHandlers(
error = handleError,
warning = handleWarning,
withRestarts(f(...), useValue = identity)
)
list(result = result, error = error, warnings = warnings)
}
}
And some results:
lapply(list(1, -1, "a"), catching(log)) |> str()
#> List of 3
#> $ :List of 3
#> ..$ result : num 0
#> ..$ error : NULL
#> ..$ warnings: list()
#> $ :List of 3
#> ..$ result : num NaN
#> ..$ error : NULL
#> ..$ warnings:List of 1
#> .. ..$ : chr "NaNs produced"
#> $ :List of 3
#> ..$ result : NULL
#> ..$ error : chr "non-numeric argument to mathematical function"
#> ..$ warnings: list()
For more about R’s condition system, I found this article particularly
helpful: http://adv-r.had.co.nz/beyond-exception-handling.html.
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
My objective here is to capture the error that R throws and store it in an object.
Here are some dummy codes:
for(i in 1:length(a)){try(
if (i==4)(print(a[i]/"b"))else(print(a[i]/b[i]))
)}
[1] -0.125
[1] -0.2857143
[1] -0.5
Error in a[i]/"b" : non-numeric argument to binary operator
[1] -1.25
[1] -2
[1] -3.5
[1] -8
[1] Inf
[1] 10
So I want to capture that on the 4th iteration the error was: Error in a[i]/"b" : non-numeric argument to binary operator into an object say:
error<-()
iferror(error[i]<-geterrmessage())
I am aware that iferror as a function is not available in R, but I am trying to give the idea, because geterrmessage captures only the last error it sees
So for the example i want say for error[1:3]<-'NA'and error[5:10]<-'NA' because no error but
error[4]<-"Error in a[i]/"b" : non-numeric argument to binary operator"
So that later I can check error object and understand where and what error happened
If you can help me write a code that would be excellent and highly appreciated
I hope the following function helps:
a <- c(0:6)
b <- c(-3:3)
create_log <- function(logfile_name, save_path) {
warning("Error messages not visible. Use closeAllConnections() in the end of the script")
if (file.exists(paste0(save_path, logfile_name))) {
file.remove(paste0(save_path, logfile_name))
}
fid <- file(paste0(save_path, logfile_name), open = "wt")
sink(fid, type = "message", split = F) # warnings are NOT displayed. split=T not possible.
sink(fid, append = T, type = "output", split = T) # print, cat
return(NULL)
}
create_log("test.csv", "C:/Test/")
for(i in 1:length(a)){try(
if (i==4)(print(a[i]/"b"))else(print(a[i]/b[i]))
)}
closeAllConnections()
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
In R, if execution stops because of an error, I can evaluate traceback() to see which function the error occurred in, which function was that function called from, etc. It'll give something like this:
8: ar.yw.default(x, aic = aic, order.max = order.max, na.action = na.action,
series = series, ...)
7: ar.yw(x, aic = aic, order.max = order.max, na.action = na.action,
series = series, ...)
6: ar(x[, i], aic = TRUE)
5: spectrum0.ar(x)
4: effectiveSize(x)
Is there a way to find what arguments were passed to these functions? In this case, I'd like to know what arguments were passed to effectiveSize(), i.e. what is x.
The error does not occur in my own code, but in a package function. Being new to R, I'm a bit lost.
Not knowing how to do this properly, I tried to find the package function's definition and modify it, but where the source file should be I only find an .rdb file. I assume this is something byte-compiled.
I'd suggest setting options(error=recover) and then running the offending code again. This time, when an error is encountered, you'll be thrown into an interactive debugging environment in which you are offered a choice of frames to investigate. It will look much like what traceback() gives you, except that you can type 7 to enter the evaluation environment of call 7 on the call stack. Typing ls() once you've entered a frame will give you the list of its arguments.
An example (based on that in ?traceback) is probably the best way to show this:
foo <- function(x) { print(1); bar(2) }
bar <- function(x) { x + a.variable.which.does.not.exist }
## First with traceback()
foo(2) # gives a strange error
# [1] 1
# Error in bar(2) : object 'a.variable.which.does.not.exist' not found
traceback()
# 2: bar(2) at #1
# 1: foo(2)
## Then with options(error=recover)
options(error=recover)
foo(2)
# [1] 1
# Error in bar(2) : object 'a.variable.which.does.not.exist' not found
#
# Enter a frame number, or 0 to exit
#
# 1: foo(2)
# 2: #1: bar(2)
Selection: 1
# Called from: top level
Browse[1]> ls()
# [1] "x"
Browse[1]> x
# [1] 2
Browse[1]> ## Just press return here to go back to the numbered list of envts.
#
# Enter a frame number, or 0 to exit
#
# 1: foo(2)
# 2: #1: bar(2)
R has many helpful debugging tools, most of which are discussed in the answers to this SO question from a few years back.
You can use trace() to tag or label a function as requiring a "detour" to another function, the logical choice being browser().
?trace
?browser
> trace(mean)
> mean(1:4)
trace: mean(1:4)
[1] 2.5
So that just displayed the call. This next mini-session shows trace actually detouring into the browser:
> trace(mean, browser)
Tracing function "mean" in package "base"
[1] "mean"
> mean(1:4)
Tracing mean(1:4) on entry
Called from: eval(expr, envir, enclos)
Browse[1]> x #once in the browser you can see what values are there
[1] 1 2 3 4
Browse[1]>
[1] 2.5
> untrace(mean)
Untracing function "mean" in package "base"
As far as seeing what is in a function, if it is exported, you can simply type its name at the console. If it is not exported then use: getAnywhere(fn_name)