Using geterrmessage() in a loop - R - r

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()

Related

Extraction of specific result in R outputs

I want to extract the values of "b1p" and "b2p" from the mardia's command and want to save it in bskew.
For this i have used the "psych" package R version is 4.0.3. I have tried several commands for extraction but failed.
bskew <- mardia$b1p
bskew <- mardia[b1p
bskew <- mardia[[b1p
for this i got the error "object of type 'closure' is not subsettable"
By using names() i got only names and by using class() i got "psych", "mardia".
By using summary() i got the message "Warning message:
In summary.psych(mardia(x)) :
I am sorry, I do not have a summary function for this object" and then i used mna$coefficients[[]] command
and i got the message "NULL".
I saved my mardia command in mna.
Minimum Working Example is:
n0 <- 5
p0 <- 2
m0 <- matrix(rep(0,p0),ncol=p0)
s0 <- diag(1,p0)
x <- rmvnorm(5,mean=m0, sigma=s0)
mardia$"b1p"
bskew <- mardia["b1p"]
bskew <- mardia[["b1p"]]
bkurt <- mardia[["b2p"]]
bskew <- mardia$b1p$
mna<-mardia(x)
class(mna)
names(mna)
summary(mardia(x))
summary(mna)
sk1 <- mna$coefficients[[3]]
mna$coefficients
the error is because you're trying to subset a function mardia which always throws the error you have, also you should subset the mna object instead of subsetting the actual function.
> mna$b1p
[1] 1.95888
> mna["b1p"]
$b1p
[1] 1.95888
> mna[["b1p"]]
[1] 1.95888
> mardia(x)$b1p
[1] 1.95888
> mardia$b1p
Error in mardia$b1p : object of type 'closure' is not subsettable
> mardia<-mardia(x)
> mardia$b1p
[1] 1.95888

How to capture particular warning message and execute call

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.

Unable to convert & assign character value to a numeric field

I have been struggling with the following issue:
I have the following variables:
class(HARdata)
[1] "data.frame"
dim(HARdata)
[1] 10299 88
class(activity_labels)
[1] "character"
length(activity_labels)
[1] 6
I have been trying to run the following loop:
for (i in 1:nrow(HARdata)) {
for (j in 1:length(activity_labels)){
if (as.numeric(HARdata[i, "traintype"]) == extract_numeric(activity_labels[j])) {
HARdata[i, "traintype"] <- activity_labels[j]
}
}
}
However, i get the following error:
Error in if (as.numeric(HARdata[i, "traintype"]) == extract_numeric(activity_labels[j])) { :
missing value where TRUE/FALSE needed
In addition: Warning message:
NAs introduced by coercion
If I replace HARdata[i, "traintype"] <- activity_labels[j] with HARdata[i, "traintype"] <- 10 , the code runs fine. So I suppose the problem is in this line. The left side is numeric while the right side is supposed to be character. I tried running as.character(HARdata[i, "traintype"]) <- "test" but this doesn't work. Can anyone see what could be the issue?
test <- scan()
0.27513126 0.39694439
0.54228045 0.82751195
0.18600784 0.96602747
0.55259276 0.52368149
0.28976503 0.74500213
0.17534195 0.04931733
0.08077429 0.82169260
0.72602526 0.94921645
0.65077605 0.06989442
0.81399236 0.1379080
test <- as.data.frame(matrix(test, ncol=2))
names(test) <- c('cartype', 'traintype')
library(tidyr)
activity_labels <- c("$0.08077429", "$0.65077605")
test[,"traintype"][match(extract_numeric(activity_labels), test[,"traintype"])] <- activity_labels

How to change value if error occurs in for loop?

I have a loop that reads HTML table data from ~ 440 web pages. The code on each page is not exactly the same, so sometimes I need table node 1 and sometime I need node 2. Right now I've just been setting the node number manually in a list and feeding it into the loop. My problem is that the page nodes have started changing and updating the node # list is getting to be a hassle.
If the loop encounters the wrong node # (ie: 1 instead of 2, or reverse) it gives an error and shuts down. Is there a way to have the loop replace the erroneous node number to the correct one if it encounters an error, and then keep running the loop as if nothing happened?
Here's the readHTML portion of the code in my loop with an example url:
url <- "http://espn.go.com/nba/player/gamelog/_/id/2991280/year/2013/"
html.page <- htmlParse(url)
tableNodes <- getNodeSet(html.page, "//table")
x <- as.numeric(Players$Nodes[s])
tbl = readHTMLTable(tableNodes[[x]], colClasses = c("character"),stringsAsFactors = FALSE)
Here's the error I get when the node # is wrong:
"Error in readHTMLTable(tableNodes[[x]], colClasses = c("character"), stringsAsFactors = FALSE) : error in evaluating the argument 'doc' in selecting a method for function 'readHTMLTable': Error in tableNodes[[x]] : subscript out of bounds"
Example code:
A <- c("dog", "cat")
Nodes <- as.data.frame(1:1)
#)Nodes <- as.data.frame(1:2) <-- This works without errors
colnames(Nodes)[1] <- "Col1"
Nodes2 <- 2
url <-c("http://espn.go.com/nba/player/gamelog/_/id/6639/year/2013/","http://espn.go.com/nba/player/gamelog/_/id/6630/year/2013/")
for (i in 1:length(A))
{
html.page <- htmlParse(url[i])
tableNodes <- getNodeSet(html.page, "//table")
x <- as.numeric(Nodes$Col1[i])
df = readHTMLTable(tableNodes[[x]], colClasses = c("character"),stringsAsFactors = FALSE)
#tryCatch(df) here.....no clue
assign(paste0("", A[i]), df)
}
If you get subscript out of bounds error msg, then you should try to with a lower x for sure. General demo with tryCatch based on the demo code you posted in the original question (although I have replaced x with 2 as I have no idea what is Players and s):
> msg <- tryCatch(readHTMLTable(tableNodes[[2]], colClasses = c("character"),stringsAsFactors = FALSE), error = function(e)e)
> str(msg)
List of 2
$ message: chr "error in evaluating the argument 'doc' in selecting a method for function 'readHTMLTable': Error in tableNodes[[2]] : subscript"| __truncated__
$ call : language readHTMLTable(tableNodes[[2]], colClasses = c("character"), stringsAsFactors = FALSE)
- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
> msg$message
[1] "error in evaluating the argument 'doc' in selecting a method for function 'readHTMLTable': Error in tableNodes[[2]] : subscript out of bounds\n"
> grepl('subscript out of bounds', msg$message)
[1] TRUE

What arguments were passed to the functions in the traceback?

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)

Resources