R-beta: NextMethod(.Generic) bug

[Thomas Lumley]

On Sat, 3 Jan 1998, Gordon Maclean wrote:
> I'm a day-old R newbie (but a war-weary S veteran), with couple of
> first-day questions: 
> 
> In R 0.61, this code fails.
> 
> 
> 	Ops.test <- function(e1,e2)
> 	{
>   	  e1 <- NextMethod(.Generic)
>   	  e1
> 	}
<snip>
> I assume it is a bug.  It works in Splus 3.4.  Is there a fix/workaround?

It is a bug.  When NextMethod looks to see where it has got to in the
class list it uses .Generic instead of .Group even for group methods.  It
can't find ">.test" and runs off the end of the list.  I have a patch for
objects.c in R0.61 that fixes this problem and is probably safe (I have
tested it on the survival4 examples file, which exercises the
object-oriented features quite a bit). It's at the bottom of this message. 

However, another problem with group methods shows up, which is that R will
always use any function method ahead of any group method. If you define
"Ops.foo", "Ops.baz" and ">.bar" and x has class c("foo","bar","baz") then
x+3 goes to "Ops.foo" then "Ops.baz" as it should, but x>2 goes to ">.bar"
and then to the default method. 

> Also, why doesn't the "!" operator work on numeric values?

There are a number of deliberate incompatibilities that fall under the
general heading of "idiot-proofing".  The feeling was that R should try
harder to convert programming errors into syntax errors. The use of ! on
numeric vectors was one of the  more controversial changes, but it is an
easy editing change and doesn't adversely affect non-programmers.



Thomas Lumley
------------------------------------------------------+------
Biostatistics		: "Never attribute to malice what  :
Uni of Washington	:  can be adequately explained by  :
Box 357232		:  incompetence" - Hanlon's Razor  :
Seattle WA 98195-7232	:				   :
------------------------------------------------------------

*** objects.c.old	Fri Jan  2 20:04:42 1998
--- objects.c	Sat Jan  3 10:26:09 1998
***************
*** 262,268 ****
  	SEXP sysp, m, formals, actuals, tmp, newcall;
  	RCNTXT *cptr;
  	int nargs,i,j;
! 
  
  	cptr=R_GlobalContext;
  	
--- 262,268 ----
  	SEXP sysp, m, formals, actuals, tmp, newcall;
  	RCNTXT *cptr;
  	int nargs,i,j;
! 	SEXP group,realgroup;
  
  	cptr=R_GlobalContext;
  	
***************
*** 353,358 ****
--- 353,369 ----
  	if( strlen(CHAR(STRING(generic)[0])) == 0 ) 
  		errorcall(call,"generic function not specified\n");
  
+ 	group=dynamicfindVar(install(".Group"),R_GlobalContext);
+ 	PROTECT(realgroup=duplicate(group));
+ 	if (group == R_UnboundValue){
+ 	  group=generic;
+ 	  realgroup=mkString("");
+ 	}
+ 	if (!isString(group) || length(group) > 1 )
+ 	  errorcall(call,"invalid group argument found in NextMethod\n");
+ 	if (strlen(CHAR(STRING(group)[0])) == 0 )
+ 	  group=generic;
+ 
  	/* we need the value of i on exit from the for loop to figure out 
  	   how many classes to drop
  	*/
***************
*** 361,367 ****
  	/* jump over the current call */
  	t=CAR(cptr->call);
  	for(j = 0; j<length(class); j++) {
! 		sprintf(buf,"%s.%s",CHAR(STRING(generic)[0]),
  				CHAR(STRING(class)[j]));
  		if(install(buf) == t)
  			break;
--- 372,378 ----
  	/* jump over the current call */
  	t=CAR(cptr->call);
  	for(j = 0; j<length(class); j++) {
! 		sprintf(buf,"%s.%s",CHAR(STRING(group)[0]),
  				CHAR(STRING(class)[j]));
  		if(install(buf) == t)
  			break;
***************
*** 373,378 ****
--- 384,394 ----
  		nextfun=findVar(install(buf),env);
  		if(isFunction(nextfun))
  			break;
+ 		sprintf(buf,"%s.%s",CHAR(STRING(group)[0]),
+ 				CHAR(STRING(class)[i]));
+ 		nextfun=findVar(install(buf),env);
+ 		if(isFunction(nextfun))
+ 			break;
  	}
  	if(!isFunction(nextfun)) {
  		sprintf(buf,"%s.default",CHAR(STRING(generic)[0]));
***************
*** 401,410 ****
--- 417,429 ----
  	method=install(buf);
  
  	defineVar(install(".Generic"), generic, m);
+ 	
+ 	defineVar(install(".Group"),realgroup,m);
  
  	CAR(newcall) = method;
  	ans = applyMethod(newcall, nextfun, matchedarg, env, m);
  	UNPROTECT(7);
+ 	UNPROTECT(1);
  	return(ans);
  }
  

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._