R-alpha: NextMethod replacement

Gregory R. Warnes (warnes@biostat.washington.edu)
Fri, 18 Oct 1996 08:44:00 -0700 (PDT)


Date: Fri, 18 Oct 1996 08:44:00 -0700 (PDT)
From: "Gregory R. Warnes" <warnes@biostat.washington.edu>
To: Ross Ihaka <ihaka@stat.auckland.ac.nz>
Subject: R-alpha: NextMethod replacement


I've written a replacement for NextMethod that allows you to call it with
no parameters--like the SPlus version.  It also seems to fix a couple of
other subtle incompatabilities in behavour between S and R when used. 
Thomas and I have tested it and it seems to work for us.  It is attached
below, please give it a try.

-------------------------------------------------------------------------------
    Gregory R. Warnes          | It is high time that the ideal of success
warnes@biostat.washington.edu  |  be replaced by the ideal of service.
                               |                       Albert Einstein
-------------------------------------------------------------------------------


NextMethod := function (name, object, ...) 
{
  call _ sys.call(sys.parent())  # store call
  env  _ sys.frame(sys.parent()) # store parent's environment

  if (missing(object))           
    object _ eval(call[[2]],sys.parent()) # get object from previous call #

  objclass _ class(object)       # store objects class

  #########################################
  # find out appropriate base method name #
  #########################################

  browser()
  
  if (missing(name ))
    {
    name _ call[1]
    sname _ strsplit(name, ".")[[1]]
    cname _ as.character(sname[[1]])
    counter _ 2;
    
    # loop through looking for the base method #
    while ( !(flag _ exists(cname, env, inherits=T)) && counter<=length(sname))
      {
	cname _ paste(cname,sname[[counter]],sep=".")
	counter _ counter+1;
      }

    if (!flag) stop("cannot find method called _from_!")
  }

  #############################################
  # find out what class to use in method call #
  #############################################

  if (counter<=length(sname) )  
    {  # some of methodname was class, use this to know what class is next #

      # construct class name for last call from method name #
      oldclass _ NULL
      while (counter <= length(sname))
	{
	  oldclass _ paste(oldclass, sname[[counter]],sep="")
	  counter _ counter+1
	}

      # the class we want to use is the one BEFORE the one used last time #
      which _ match(oldclass, objclass,nomatch=NA)-1

      # should never happen ... #
      if(is.na(which)) stop ("cannot find called class in class list")
      
    }
  else
    {  # use last element of objclass #
      which _ length(objclass)
    }

  # only call methods which exist! #
  if (is.na(which) || which<1)
    {
      newclass _ "default"
      newmethod _ paste(cname,newclass,sep=".")
    }
  else
    {
      newclass _ objclass[[which]]
      newmethod _ paste(cname,newclass,sep=".")
	  
      while( !(flag _ exists(newmethod,env, inherits=T)) && which > 1)
	    {
	      which _ which-1;
	      newclass _ objclass[[which]]
	      newmethod _ paste(cname,newclass,sep=".")
	    }

      if(which<=0 || !flag)
	newmethod _ paste(cname,"default",sep=".")
    }

  call[[1]] _  as.name(newmethod)
  newcall _ as.call(as.list(call))
  
  return(eval(newcall,env))
}

=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-testers mailing list -- To (un)subscribe, send
subscribe	or	unsubscribe
(in the "body", not the subject !)  To: r-testers-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-