R-alpha: <primitive> vs .Internal(.) [was "Problem with `rpois'"]

Martin Maechler Martin Maechler <maechler@stat.math.ethz.ch>
Mon, 14 Jul 1997 16:24:07 +0200


This is more a `request for comment' than anything else.

>>>>> "Fredr" == Fredrik Glockner <fredrigl@math.uio.no> writes:

    Fredr> There is a problem with `rpois'.  It does seem to take care
    Fredr> about the order of the arguments.  This is an example:

    >> rpois(n=1,lambda=2)
    Fredr> [1] 3
    >> rpois(lambda=2,n=1)
    Fredr> [1] 2 0

    Fredr> It obviously uses the first argument as the number of samples to
    Fredr> be drawn, which is wrong.

    Fredr> I used Version 0.49 Beta (April 23, 1997).

I assume that all you R-devel'ers thought something like

	"Well yes, we know this is because 'rpois' is a primitive function
	and  R&R  once had this problem on their  TODO / TASKS list ".

However, there was no answer going through  R-help or even CC'ed to
R-devel.

I've been think about this dilemma a little bit myself,
have looked at		main/names.c    a little bit,
and ``concluded'' (i.e. "wildly guessed")
that

	i. a) <primitive> functions must be somewhat more efficient than
		.Internal(foo(..)) ones.
           
	   b) How much more efficient? [CPU / memory] ??

	
	ii. From the point of view of the
			``robust / portable / defensive'' programming paradigm
	    it is really quit undesirable to have these <primitive>
	    functions.
	    R programmers have no reliable way of finding out the argument
	    specifications of these functions, unless by searching for the
	    corresponding "do_FOO" function and reading it's C code.

	    I know there's  help(.)   and yes, this helps (!) -- but still....
	  
	    The above <bug report> of   Fredrik  is really are reason for using
	    "proper" (non-primitive) R functions as much as possible. 

	iii.   ????
		    <<< The things  Ross and Luke and ?? will tell us.
	
--
In summary, my proposal is to use   <primitive>s  much less than currently.
But I'm more than willing to learn why this would not be a good idea.

Finally:

I've spent 2 hours or so to wade through the  probability distribution
codes and 'patch' all these functions such as to use  
	function(..) .Internal(..)
code instead of being primitve.

The following patch applies cleanly .. and seems to do just what I want.
Of course, it solves Fredrik's problem.

Martin Maechler <maechler@stat.math.ethz.ch>		 <><
Seminar fuer Statistik, SOL G1
ETH (Federal Inst. Technology)	8092 Zurich	 SWITZERLAND
phone: x-41-1-632-3408		fax: ...-1086
http://www.stat.math.ethz.ch/~maechler/


--- src/library/base/funs/distn.~1~	Mon Nov 25 11:42:00 1996
+++ src/library/base/funs/distn	Mon Jul 14 15:52:55 1997
@@ -42,3 +38,49 @@
 qweibull <- function(p, shape, scale=1) .Internal(qweibull(p, shape, scale))
 rweibull <- function(n, shape, scale=1) .Internal(rweibull(n, shape, scale))
 
+
+##--- Argument names taken from  ../man/Beta :
+dbeta <- function(x, a, b) .Internal(dbeta(x, a, b))
+pbeta <- function(q, a, b) .Internal(pbeta(q, a, b))
+qbeta <- function(p, a, b) .Internal(qbeta(p, a, b))
+rbeta <- function(n, a, b) .Internal(rbeta(n, a, b))
+##--- Argument names taken from  ../man/Binomial :
+dbinom <- function(x, n, p) .Internal(dbinom(x, n, p))
+pbinom <- function(q, n, p) .Internal(pbinom(q, n, p))
+qbinom <- function(prob, n, p) .Internal(qbinom(prob, n, p))
+rbinom <- function(nobs, n, p) .Internal(rbinom(nobs, n, p))
+##--- Argument names taken from  ../man/Chisquare :
+dchisq <- function(x, df) .Internal(dchisq(x, df))
+pchisq <- function(q, df) .Internal(pchisq(q, df))
+qchisq <- function(p, df) .Internal(qchisq(p, df))
+rchisq <- function(n, df) .Internal(rchisq(n, df))
+##--- Argument names taken from  ../man/F :
+df <- function(x, n1, n2) .Internal(df(x, n1, n2))
+pf <- function(q, n1, n2) .Internal(pf(q, n1, n2))
+qf <- function(p, n1, n2) .Internal(qf(p, n1, n2))
+rf <- function(n, n1, n2) .Internal(rf(n, n1, n2))
+##--- Argument names taken from  ../man/Geometric :
+dgeom <- function(x, p) .Internal(dgeom(x, p))
+pgeom <- function(q, p) .Internal(pgeom(q, p))
+qgeom <- function(prob, p) .Internal(qgeom(prob, p))
+rgeom <- function(n, p) .Internal(rgeom(n, p))
+##--- Argument names taken from  ../man/Hypergeometric :
+dhyper <- function(x, N1, N2, n) .Internal(dhyper(x, N1, N2, n))
+phyper <- function(q, N1, N2, n) .Internal(phyper(q, N1, N2, n))
+qhyper <- function(p, N1, N2, n) .Internal(qhyper(p, N1, N2, n))
+rhyper <- function(nobs, N1, N2, n) .Internal(rhyper(nobs, N1, N2, n))
+##--- Argument names taken from  ../man/NegBinomial :
+dnbinom <- function(x, n, p) .Internal(dnbinom(x, n, p))
+pnbinom <- function(q, n, p) .Internal(pnbinom(q, n, p))
+qnbinom <- function(prob, n, p) .Internal(qnbinom(prob, n, p))
+rnbinom <- function(nobs, n, p) .Internal(rnbinom(nobs, n, p))
+##--- Argument names taken from  ../man/Poisson :
+dpois <- function(x, lambda) .Internal(dpois(x, lambda))
+ppois <- function(q, lambda) .Internal(ppois(q, lambda))
+qpois <- function(p, lambda) .Internal(qpois(p, lambda))
+rpois <- function(n, lambda) .Internal(rpois(n, lambda))
+##--- Argument names taken from  ../man/T
+dt <- function(x, df) .Internal(dt(x, df))
+pt <- function(q, df) .Internal(pt(q, df))
+qt <- function(p, df) .Internal(qt(p, df))
+rt <- function(n, df) .Internal(rt(n, df))
--- src/main/names.c.~2~	Fri Jul  4 16:42:42 1997
+++ src/main/names.c	Mon Jul 14 15:52:33 1997
@@ -210,25 +210,25 @@
 {"lchoose",	do_math2,	4,	1,	2,	PP_FUNCALL,	0},
 {"choose",	do_math2,	5,	1,	2,	PP_FUNCALL,	0},
 
-{"dchisq",	do_math2,	6,	1,	2,	PP_FUNCALL,	0},
-{"pchisq",	do_math2,	7,	1,	2,	PP_FUNCALL,	0},
-{"qchisq",	do_math2,	8,	1,	2,	PP_FUNCALL,	0},
+{"dchisq",	do_math2,	6,	11,	2,	PP_FUNCALL,	0},
+{"pchisq",	do_math2,	7,	11,	2,	PP_FUNCALL,	0},
+{"qchisq",	do_math2,	8,	11,	2,	PP_FUNCALL,	0},
 
 {"dexp",	do_math2,	9,	11,	2,	PP_FUNCALL,	0},
 {"pexp",	do_math2,	10,	11,	2,	PP_FUNCALL,	0},
 {"qexp",	do_math2,	11,	11,	2,	PP_FUNCALL,	0},
 
-{"dgeom",	do_math2,	12,	1,	2,	PP_FUNCALL,	0},
-{"pgeom",	do_math2,	13,	1,	2,	PP_FUNCALL,	0},
-{"qgeom",	do_math2,	14,	1,	2,	PP_FUNCALL,	0},
-
-{"dpois",	do_math2,	15,	1,	2,	PP_FUNCALL,	0},
-{"ppois",	do_math2,	16,	1,	2,	PP_FUNCALL,	0},
-{"qpois",	do_math2,	17,	1,	2,	PP_FUNCALL,	0},
-
-{"dt",		do_math2,	18,	1,	2,	PP_FUNCALL,	0},
-{"pt",		do_math2,	19,	1,	2,	PP_FUNCALL,	0},
-{"qt",		do_math2,	20,	1,	2,	PP_FUNCALL,	0},
+{"dgeom",	do_math2,	12,	11,	2,	PP_FUNCALL,	0},
+{"pgeom",	do_math2,	13,	11,	2,	PP_FUNCALL,	0},
+{"qgeom",	do_math2,	14,	11,	2,	PP_FUNCALL,	0},
+
+{"dpois",	do_math2,	15,	11,	2,	PP_FUNCALL,	0},
+{"ppois",	do_math2,	16,	11,	2,	PP_FUNCALL,	0},
+{"qpois",	do_math2,	17,	11,	2,	PP_FUNCALL,	0},
+
+{"dt",		do_math2,	18,	11,	2,	PP_FUNCALL,	0},
+{"pt",		do_math2,	19,	11,	2,	PP_FUNCALL,	0},
+{"qt",		do_math2,	20,	11,	2,	PP_FUNCALL,	0},
 
 
 #ifdef COMPLEX_DATA
@@ -244,21 +244,21 @@
 
 /* Mathematical Functions of Three Variables */
 
-{"dbeta",	do_math3,	1,	1,	3,	PP_FUNCALL,	0},
-{"pbeta",	do_math3,	2,	1,	3,	PP_FUNCALL,	0},
-{"qbeta",	do_math3,	3,	1,	3,	PP_FUNCALL,	0},
-
-{"dbinom",	do_math3,	4,	1,	3,	PP_FUNCALL,	0},
-{"pbinom",	do_math3,	5,	1,	3,	PP_FUNCALL,	0},
-{"qbinom",	do_math3,	6,	1,	3,	PP_FUNCALL,	0},
+{"dbeta",	do_math3,	1,	11,	3,	PP_FUNCALL,	0},
+{"pbeta",	do_math3,	2,	11,	3,	PP_FUNCALL,	0},
+{"qbeta",	do_math3,	3,	11,	3,	PP_FUNCALL,	0},
+
+{"dbinom",	do_math3,	4,	11,	3,	PP_FUNCALL,	0},
+{"pbinom",	do_math3,	5,	11,	3,	PP_FUNCALL,	0},
+{"qbinom",	do_math3,	6,	11,	3,	PP_FUNCALL,	0},
 
 {"dcauchy",	do_math3,	7,	11,	3,	PP_FUNCALL,	0},
 {"pcauchy",	do_math3,	8,	11,	3,	PP_FUNCALL,	0},
 {"qcauchy",	do_math3,	9,	11,	3,	PP_FUNCALL,	0},
 
-{"df",		do_math3,	10,	1,	3,	PP_FUNCALL,	0},
-{"pf",		do_math3,	11,	1,	3,	PP_FUNCALL,	0},
-{"qf",		do_math3,	12,	1,	3,	PP_FUNCALL,	0},
+{"df",		do_math3,	10,	11,	3,	PP_FUNCALL,	0},
+{"pf",		do_math3,	11,	11,	3,	PP_FUNCALL,	0},
+{"qf",		do_math3,	12,	11,	3,	PP_FUNCALL,	0},
 
 {"dgamma",	do_math3,	13,	11,	3,	PP_FUNCALL,	0},
 {"pgamma",	do_math3,	14,	11,	3,	PP_FUNCALL,	0},
@@ -272,9 +272,9 @@
 {"plogis",	do_math3,	20,	11,	3,	PP_FUNCALL,	0},
 {"qlogis",	do_math3,	21,	11,	3,	PP_FUNCALL,	0},
 
-{"dnbinom",	do_math3,	22,	1,	3,	PP_FUNCALL,	0},
-{"pnbinom",	do_math3,	23,	1,	3,	PP_FUNCALL,	0},
-{"qnbinom",	do_math3,	24,	1,	3,	PP_FUNCALL,	0},
+{"dnbinom",	do_math3,	22,	11,	3,	PP_FUNCALL,	0},
+{"pnbinom",	do_math3,	23,	11,	3,	PP_FUNCALL,	0},
+{"qnbinom",	do_math3,	24,	11,	3,	PP_FUNCALL,	0},
 
 {"dnorm",	do_math3,	25,	11,	3,	PP_FUNCALL,	0},
 {"pnorm",	do_math3,	26,	11,	3,	PP_FUNCALL,	0},
@@ -288,39 +288,39 @@
 {"pweibull",	do_math3,	32,	11,	3,	PP_FUNCALL,	0},
 {"qweibull",	do_math3,	33,	11,	3,	PP_FUNCALL,	0},
 
-{"dnchisq",	do_math3,	34,	1,	3,	PP_FUNCALL,	0},
-{"pnchisq",	do_math3,	35,	1,	3,	PP_FUNCALL,	0},
-{"qnchisq",	do_math3,	36,	1,	3,	PP_FUNCALL,	0},
+{"dnchisq",	do_math3,	34,	11,	3,	PP_FUNCALL,	0},
+{"pnchisq",	do_math3,	35,	11,	3,	PP_FUNCALL,	0},
+{"qnchisq",	do_math3,	36,	11,	3,	PP_FUNCALL,	0},
 
 
 /* Mathematical Functions of Four Variables */
 
-{"dhyper",	do_math4,	1,	1,	4,	PP_FUNCALL,	0},
-{"phyper",	do_math4,	2,	1,	4,	PP_FUNCALL,	0},
-{"qhyper",	do_math4,	3,	1,	4,	PP_FUNCALL,	0},
+{"dhyper",	do_math4,	1,	11,	4,	PP_FUNCALL,	0},
+{"phyper",	do_math4,	2,	11,	4,	PP_FUNCALL,	0},
+{"qhyper",	do_math4,	3,	11,	4,	PP_FUNCALL,	0},
 
 
 /* Random Numbers */
 
-{"rchisq",	do_random1,	0,	1,	2,	PP_FUNCALL,	0},
+{"rchisq",	do_random1,	0,	11,	2,	PP_FUNCALL,	0},
 {"rexp",	do_random1,	1,	11,	2,	PP_FUNCALL,	0},
-{"rgeom",	do_random1,	2,	1,	2,	PP_FUNCALL,	0},
-{"rpois",	do_random1,	3,	1,	2,	PP_FUNCALL,	0},
-{"rt",		do_random1,	4,	1,	2,	PP_FUNCALL,	0},
+{"rgeom",	do_random1,	2,	11,	2,	PP_FUNCALL,	0},
+{"rpois",	do_random1,	3,	11,	2,	PP_FUNCALL,	0},
+{"rt",		do_random1,	4,	11,	2,	PP_FUNCALL,	0},
 
-{"rbeta",	do_random2,	0,	1,	3,	PP_FUNCALL,	0},
-{"rbinom",	do_random2,	1,	1,	3,	PP_FUNCALL,	0},
+{"rbeta",	do_random2,	0,	11,	3,	PP_FUNCALL,	0},
+{"rbinom",	do_random2,	1,	11,	3,	PP_FUNCALL,	0},
 {"rcauchy",	do_random2,	2,	11,	3,	PP_FUNCALL,	0},
-{"rf",		do_random2,	3,	1,	3,	PP_FUNCALL,	0},
+{"rf",		do_random2,	3,	11,	3,	PP_FUNCALL,	0},
 {"rgamma",	do_random2,	4,	11,	3,	PP_FUNCALL,	0},
 {"rlnorm",	do_random2,	5,	11,	3,	PP_FUNCALL,	0},
 {"rlogis",	do_random2,	6,	11,	3,	PP_FUNCALL,	0},
-{"rnbinom",	do_random2,	7,	1,	3,	PP_FUNCALL,	0},
+{"rnbinom",	do_random2,	7,	11,	3,	PP_FUNCALL,	0},
 {"rnorm",	do_random2,	8,	11,	3,	PP_FUNCALL,	0},
 {"runif",	do_random2,	9,	11,	3,	PP_FUNCALL,	0},
 {"rweibull",	do_random2,	10,	11,	3,	PP_FUNCALL,	0},
 
-{"rhyper",	do_random3,	0,	1,	4,	PP_FUNCALL,	0},
+{"rhyper",	do_random3,	0,	11,	4,	PP_FUNCALL,	0},
 
 {"sample",	do_sample,	0,	11,	3,	PP_FUNCALL,	0},
 
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-devel 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-devel-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-