[Rd] How can I catch errors thrown from c via the Rcpperror()function?
luke at stat.uiowa.edu
luke at stat.uiowa.edu
Fri Apr 17 14:20:13 CEST 2009
Thanks -- that looks like a reasonable change. I'll have a more
careful look in the next couple of days and apply if I don't run into
any unexpected issues.
luke
On Thu, 16 Apr 2009, William Dunlap wrote:
> A possible fix for this is to filter the 'unsused' list before
> printing the error message and replacing the promises with
> their PRCODE expressions.
>
> Index: match.c
> ===================================================================
> --- match.c (revision 48329)
> +++ match.c (working copy)
> @@ -355,9 +355,28 @@
> }
>
> if(last != R_NilValue) {
> + /* show bad arguments in call without evaluating them */
> + SEXP unusedForError = R_NilValue, last = R_NilValue ;
> + for(b=unused ; b!=R_NilValue ; b=CDR(b)) {
> + SEXP tagB = TAG(b) ;
> + SEXP carB = CAR(b) ;
> + if (TYPEOF(carB)==PROMSXP) {
> + carB = PRCODE(carB) ;
> + }
> + if (last==R_NilValue) {
> + PROTECT(last = CONS(carB, R_NilValue));
> + SET_TAG(last, tagB);
> + unusedForError = last ;
> + } else {
> + SETCDR(last, CONS(carB, R_NilValue));
> + last = CDR(last) ;
> + SET_TAG(last, tagB);
> + }
> + }
> errorcall(R_GlobalContext->call,
> _("unused argument(s) %s"),
> - CHAR(STRING_ELT(deparse1line(unused, 0), 0)) + 4);
> + CHAR(STRING_ELT(deparse1line(unusedForError, 0),
> 0)) + 4);
> + /* '+4' is to remove 'list' from
> 'list(badTag1,...)' */
> }
> }
> UNPROTECT(1);
>
> E.g.,
>> f<-function(x,y)x+y
>> f(print(1),y=print(2),x=print(3),stop("oops"))
> Error in f(print(1), y = print(2), x = print(3), stop("oops")) :
> unused argument(s) (print(1), stop("oops"))
>> f(print(1),y=print(2),x=print(3),z=stop("oops"))
> Error in f(print(1), y = print(2), x = print(3), z = stop("oops")) :
> unused argument(s) (print(1), z = stop("oops"))
>> f(print(1),y=print(2),z=print(3),x=stop("oops"))
> Error in f(print(1), y = print(2), z = print(3), x = stop("oops")) :
> unused argument(s) (print(1), z = print(3))
>
> These calls used to give:
>
>> f(print(1),y=print(2),x=print(3),stop("oops"))
> [1] 1
> Error in f(print(1), y = print(2), x = print(3), stop("oops")) : oops
>> f(print(1),y=print(2),x=print(3),z=stop("oops"))
> [1] 1
> Error in f(print(1), y = print(2), x = print(3), z = stop("oops")) :
> oops
>> f(print(1),y=print(2),z=print(3),x=stop("oops"))
> [1] 1
> [1] 3
> Error in f(print(1), y = print(2), z = print(3), x = stop("oops")) :
> unused argument(s) (1, z = 3)
>
> Bill Dunlap
> TIBCO Software Inc - Spotfire Division
> wdunlap tibco.com
>
>> -----Original Message-----
>> From: r-devel-bounces at r-project.org
>> [mailto:r-devel-bounces at r-project.org] On Behalf Of William Dunlap
>> Sent: Thursday, April 16, 2009 10:05 AM
>> To: luke at stat.uiowa.edu
>> Cc: r-devel at r-project.org; Dirk Eddelbuettel
>> Subject: Re: [Rd] How can I catch errors thrown from c via
>> the Rcpperror()function?
>>
>>> -----Original Message-----
>>> From: luke at stat.uiowa.edu [mailto:luke at stat.uiowa.edu]
>>> Sent: Thursday, April 16, 2009 9:27 AM
>>> To: William Dunlap
>>> Cc: Dirk Eddelbuettel; Kieran O'Neill; r-devel at r-project.org
>>> Subject: Re: [Rd] How can I catch errors thrown from c via
>>> the Rcpperror() function?
>>>
>>> Something seems amiss in the process of generating the errormessage:
>>>
>>>> f <- function(x){}
>>>> f(y = print("foo"))
>>> [1] "foo"
>>> Error in f(y = print("foo")) : unused argument(s) (y = "foo")
>>>
>>> The argument seems to be getting evaluated and its value is
>>> being used.
>>>
>>> luke
>>
>> It is in match.c, where errorcall() calls deparse1line(unused,0)
>> to get the name (and value) of the argument:
>>
>> 357 if(last != R_NilValue) {
>> 358 errorcall(R_GlobalContext->call,
>> 359 _("unused argument(s) %s"),
>> 360 CHAR(STRING_ELT(deparse1line(unused, 0),
>> 0)) + 4);
>>
>> Before deparse1line is called unused is (in my example)
>> (gdb) call Rf_PrintValue(unused)
>> $badTag
>> <promise: 0x9aff4d4>
>> and deparse1line must be evaluating the promise. Just showing the
>> bad tag's name would suffice in the error message, if it is a problem
>> jury rigging deparse1line to avoid the evaluation in this case.
>>
>>>
>>> On Thu, 16 Apr 2009, William Dunlap wrote:
>>>
>>>> Note that Kieren's example labelled the first
>>>> argument to try() with an improper label res30=,
>>>> not expr= (or is that a mailer turning something
>>>> into '30='?). If it really is an improper argument
>>>> tag then this could be showing a buglet in reporting
>>>> on wrongly named arguments:
>>>>
>>>> > invisible(rm(x,y))
>>>> > x<-try(silent=TRUE, badTag=stop("Oops"))
>>>> Error in try(silent = TRUE, badTag = stop("Oops")) : Oops
>>>> > x
>>>> Error: object "x" not found
>>>> > y<-try(silent=TRUE, expr=stop("Oops"))
>>>> > y
>>>> [1] "Error in try(silent = TRUE, expr = stop(\"Oops\")) : Oops\n"
>>>> attr(,"class")
>>>> [1] "try-error"
>>>>
>>>> In the first example I would expect an error message like
>>>> unused argument(s) (badTag = stop("Oops"))
>>>> but it is appropriate that try() would abort if it
>>>> is called in a bad way. Perhaps it is trying to make that
>>>> error message and that triggered the evaluation of the argument,
>>>> as in
>>>> > grep(mypattern=stop("Oops"), "wxyz")
>>>> Error in grep(mypattern = stop("Oops"), "wxyz") : Oops
>>>> where one might expect an error message regarding the wrongly
>>>> named argument, as in:
>>>> > grep(mypattern="x", "wxyz")
>>>> Error in grep(mypattern = "x", "wxyz") :
>>>> unused argument(s) (mypattern = "x")
>>>>
>>>> Bill Dunlap
>>>> TIBCO Software Inc - Spotfire Division
>>>> wdunlap tibco.com
>>>>
>>>>> -----Original Message-----
>>>>> From: r-devel-bounces at r-project.org
>>>>> [mailto:r-devel-bounces at r-project.org] On Behalf Of Dirk
>>> Eddelbuettel
>>>>> Sent: Wednesday, April 15, 2009 7:14 PM
>>>>> To: Kieran O'Neill
>>>>> Cc: r-devel at r-project.org
>>>>> Subject: Re: [Rd] How can I catch errors thrown from c via
>>>>> the Rcpperror() function?
>>>>>
>>>>>
>>>>> Kieran,
>>>>>
>>>>> On 15 April 2009 at 18:03, Kieran O'Neill wrote:
>>>>> | I am using the flowClust package from BioConductor, which
>>>>> is largely
>>>>> | implemented in c. For some of my data, the package
>>>>> occasionally (and
>>>>> | quite stochastically) encounters a particular condition
>>>>> which halts its
>>>>> | operation. At this point, it calls the error() function
>>>>> defined by Rcpp,
>>>>> | and halts.
>>>>> |
>>>>> | What I would like to be able to do is to catch the error
>>>>> thrown, and
>>>>> | retry the operation a few times before giving up.
>>>>> |
>>>>> | However, when I wrap the call to flowClust in try() or
>>>>> tryCatch(), the
>>>>> | error seems to completely bypass them:
>>>>> |
>>>>> | Examples:
>>>>> |
>>>>> | 1. This is a trivial example just to test the try()
>> function, and
>>>>> | correctly assigns the error to the variable x:
>>>>> |
>>>>> | > x <- try(stop(simpleError('blah')))
>>>>> | Error : blah
>>>>> | > x
>>>>> | [1] "Error : blah\n"
>>>>> | attr(,"class")
>>>>> | [1] "try-error"
>>>>> |
>>>>> | 2. This is an example using flowClust (using real
>> data, set up to
>>>>> | guarantee that the error is thrown):
>>>>> |
>>>>> | > x <- try(res30 = flowClust(tFrame, K=30, B=1000,
>>>>> varNames=c('CD4',
>>>>> | 'CD8','KI67', 'CD45RO', 'CD28', 'CD57', 'CCR5', 'CD19',
>>>>> 'CD27', 'CCR7',
>>>>> | 'CD127')))
>>>>> | Error in flowClust(tFrame, K = 30, B = 1000, varNames =
>>>>> c("CD4", "CD8", :
>>>>> |
>>>>> | The covariance matrix is near singular!
>>>>> | Try running the program with a different initial
>>>>> configuration or less
>>>>> | clusters
>>>>> | > x
>>>>> | Error: object "x" not found
>>>>> |
>>>>> |
>>>>> | The c code throwing the error is as follows (from flowClust.c):
>>>>> |
>>>>> | if(status!=0)
>>>>> | {
>>>>> | error("\n The covariance matrix is near singular! \n
>>>>> Try running
>>>>> | the program with a different initial configuration or
>>> less clusters
>>>>> | \n"); }
>>>>> |
>>>>> |
>>>>> | I looked up the error() function in Writing R Extensions
>>>>> and it states:
>>>>> | "The basic error handling routines are the equivalents
>>> of stop and
>>>>> | warning in R code, and use the same interface."
>>>>> |
>>>>> | Yet, it seems that they are not caught by R's error
>>> handling code.
>>>>> |
>>>>> | So:
>>>>> |
>>>>> | 1. Is this the general case (that Rcpp error()s are not
>>>>> handled by try()
>>>>> | and related methods in R)? (I'm sure this could be tested
>>>>> with a trivial
>>>>> | example, but I'm not yet familiar enough with wrapping c
>>>>> code in R to do
>>>>> | so.)
>>>>>
>>>>> Allow me to take the narrow view here as Rcpp maintainer.
>>>>> What you can do
>>>>> with Rcpp is to provide a C++ layer of try/catch around inner
>>>>> code which may
>>>>> throw C++ exception. This will usually be caught, and (as
>>>>> shown in the Rcpp
>>>>> docs and examples) we can pass the exception message back
>>> up to R as a
>>>>> regular error message. This is very useful as it gives you
>>>>> control back at
>>>>> the R prompt rather than just going belly-up.
>>>>>
>>>>> Now, R's try() and tryCatch() are completely separate and not
>>>>> tied into the
>>>>> exception mechanism Rcpp deals with, which is at a much
>>> lower level.
>>>>>
>>>>> Likewise, you may be out of luck with flowClust if it is C
>>>>> program. You
>>>>> could try to add a C++ layer that tried to catch error and
>>>>> allows you do
>>>>> continue your loops. I did something like that 15 years
>> ago in my
>>>>> dissertation research to ensure I survived the occassional
>>>>> numerical error
>>>>> from Fortran during longer Monte Carlo runs,
>>>>>
>>>>> | 2. If so, what is the correct way to handle them in R?
>>>>>
>>>>> Tricky. See 1. :)
>>>>>
>>>>> | 3. If not, do you have any suggestions as to what may
>> have caused
>>>>> | flowClust to behave in this way? (So that I can contact
>>> the package
>>>>> | maintainers and report the bug.)
>>>>>
>>>>> You could always contact them anyway and ask for advice.
>>>>>
>>>>> Hth, Dirk
>>>>>
>>>>> --
>>>>> Three out of two people have difficulties with fractions.
>>>>>
>>>>> ______________________________________________
>>>>> R-devel at r-project.org mailing list
>>>>> https://stat.ethz.ch/mailman/listinfo/r-devel
>>>>>
>>>>
>>>> ______________________________________________
>>>> R-devel at r-project.org mailing list
>>>> https://stat.ethz.ch/mailman/listinfo/r-devel
>>>>
>>>
>>> --
>>> Luke Tierney
>>> Chair, Statistics and Actuarial Science
>>> Ralph E. Wareham Professor of Mathematical Sciences
>>> University of Iowa Phone: 319-335-3386
>>> Department of Statistics and Fax: 319-335-3017
>>> Actuarial Science
>>> 241 Schaeffer Hall email: luke at stat.uiowa.edu
>>> Iowa City, IA 52242 WWW: http://www.stat.uiowa.edu
>>>
>>
>> ______________________________________________
>> R-devel at r-project.org mailing list
>> https://stat.ethz.ch/mailman/listinfo/r-devel
>>
>
--
Luke Tierney
Chair, Statistics and Actuarial Science
Ralph E. Wareham Professor of Mathematical Sciences
University of Iowa Phone: 319-335-3386
Department of Statistics and Fax: 319-335-3017
Actuarial Science
241 Schaeffer Hall email: luke at stat.uiowa.edu
Iowa City, IA 52242 WWW: http://www.stat.uiowa.edu
More information about the R-devel
mailing list