Commit 90df1ee1 authored by Radford Neal's avatar Radford Neal

bug fix, changes meaning of GRADN

parent 434d4b5b
......@@ -497,7 +497,7 @@ typedef struct {
setprim_ptr->primsxp.whole \
= (R_FunTab[setprim_value].eval/1000000)&1; \
setprim_ptr->primsxp.gradn \
= (R_FunTab[setprim_value].eval/10000000)%10; \
= (R_FunTab[setprim_value].eval/10000000)%100; \
} while (0)
#define PRIMOFFSET(x) \
......
......@@ -379,8 +379,9 @@ struct primsxp_struct { /* table offset of this and other info is in gp */
unsigned int whole:1; /* Do special processing for .Internal
when VARIANT_WHOLE_BODY (BUILTIN only) */
unsigned int padbit:1;
unsigned int gradn:3; /* # of internal args that might have gradient,
(with fudge, see 'eval' field in names.c) */
unsigned int gradn:5; /* gradn&7 is # of internal arguments that might
have gradient; gradn>>3 is number of initial
args that don't have gradient. See names.c */
#if USE_COMPRESSED_POINTERS && SIZEOF_CHAR_P == 4
int32_t padding1, padding2;
#endif
......
......@@ -3591,8 +3591,9 @@ attribute_hidden FUNTAB R_FunTab_arithmetic[] =
{
/* printname c-entry offset eval arity pp-kind precedence rightassoc */
/* Mathematical Functions */
/* primitives: these are group generic and so need to eval args (possibly internally) */
/* Mathematical Functions of one argument. These are primitives.
They are group generic and so need to eval args (possibly internally). */
{"round", do_Math2, 10001, 1000, -1, {PP_FUNCALL, PREC_FN, 0}},
{"signif", do_Math2, 10004, 1000, -1, {PP_FUNCALL, PREC_FN, 0}},
{"log", do_math1, 10003, 1000, -1, {PP_FUNCALL, PREC_FN, 0}},
......@@ -3630,7 +3631,7 @@ attribute_hidden FUNTAB R_FunTab_arithmetic[] =
{"trigamma", do_math1, 43, 1000, 1, {PP_FUNCALL, PREC_FN, 0}},
/* see "psigamma" below !*/
/* Mathematical Functions of Two Numeric (+ 1-2 int) Variables */
/* Mathematical Functions of Two Numeric (+ 1-2 int) Variables. Internal. */
{"atan2", do_math2, 1, 21000011, 2, {PP_FUNCALL, PREC_FN, 0}},
......@@ -3644,15 +3645,15 @@ attribute_hidden FUNTAB R_FunTab_arithmetic[] =
{"qchisq", do_math2, 8, 21000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"dexp", do_math2, 9, 21000011, 2+1, {PP_FUNCALL, PREC_FN, 0}},
{"pexp", do_math2, 10, 21000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"qexp", do_math2, 11, 21000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"pexp", do_math2, 10, 21000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"qexp", do_math2, 11, 21000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"dgeom", do_math2, 12, 51000011, 2+1, {PP_FUNCALL, PREC_FN, 0}},
{"pgeom", do_math2, 13, 51000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"dgeom", do_math2, 12, 101000011, 2+1, {PP_FUNCALL, PREC_FN, 0}},
{"pgeom", do_math2, 13, 101000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"qgeom", do_math2, 14, 1000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"dpois", do_math2, 15, 51000011, 2+1, {PP_FUNCALL, PREC_FN, 0}},
{"ppois", do_math2, 16, 51000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"dpois", do_math2, 15, 101000011, 2+1, {PP_FUNCALL, PREC_FN, 0}},
{"ppois", do_math2, 16, 101000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"qpois", do_math2, 17, 1000011, 2+2, {PP_FUNCALL, PREC_FN, 0}},
{"dt", do_math2, 18, 21000011, 2+1, {PP_FUNCALL, PREC_FN, 0}},
......@@ -3675,8 +3676,8 @@ attribute_hidden FUNTAB R_FunTab_arithmetic[] =
{"pbeta", do_math3, 2, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qbeta", do_math3, 3, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dbinom", do_math3, 4, 61000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pbinom", do_math3, 5, 61000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dbinom", do_math3, 4, 191000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pbinom", do_math3, 5, 191000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qbinom", do_math3, 6, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dcauchy", do_math3, 7, 31000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
......@@ -3699,9 +3700,9 @@ attribute_hidden FUNTAB R_FunTab_arithmetic[] =
{"plogis", do_math3, 20, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qlogis", do_math3, 21, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dnbinom", do_math3, 22, 1000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pnbinom", do_math3, 23, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qnbinom", do_math3, 24, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dnbinom", do_math3, 22, 191000011,3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pnbinom", do_math3, 23, 191000011,3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qnbinom", do_math3, 24, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dnorm", do_math3, 25, 31000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pnorm", do_math3, 26, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
......@@ -3715,13 +3716,13 @@ attribute_hidden FUNTAB R_FunTab_arithmetic[] =
{"pweibull", do_math3, 32, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qweibull", do_math3, 33, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dnchisq", do_math3, 34, 31000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pnchisq", do_math3, 35, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qnchisq", do_math3, 36, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dnchisq", do_math3, 34, 1000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pnchisq", do_math3, 35, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qnchisq", do_math3, 36, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dnt", do_math3, 37, 31000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pnt", do_math3, 38, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qnt", do_math3, 39, 31000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dnt", do_math3, 37, 1000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pnt", do_math3, 38, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"qnt", do_math3, 39, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
{"dwilcox", do_math3, 40, 1000011, 3+1, {PP_FUNCALL, PREC_FN, 0}},
{"pwilcox", do_math3, 41, 1000011, 3+2, {PP_FUNCALL, PREC_FN, 0}},
......
......@@ -2684,15 +2684,17 @@ SEXP attribute_hidden evalList_v (SEXP el, SEXP rho, int variant)
} /* evalList_v */
/* Version of evalList_v that also asks for gradients of some arguments,
attaching them as attributes of the CONS cells holding the arguments.
The n argument must be non-zero. If n is 1, 2, 3, or 4, that number
of leading arguments are evaluated with VARIANT_GRADIENT. If n is
5, 6, or 7, the first 1, 2, or 3 arguments are evaluated without asking
for gradients, but a gradient is requested for the next argument (only). */
/* Version of evalList_v that also asks for gradients of some arguments,
attaching them as attributes of the CONS cells holding the
arguments. The n argument must be non-zero, with n&7 being number
of arguments that might have gradient, and n>>3 being number of
initial arguments that don't. Will always have (n>>3) < (n&7). */
SEXP attribute_hidden evalList_gradient (SEXP el, SEXP rho, int variant, int n)
{
int m = n>>3;
n &= 7;
/* Handle 0 or 1 arguments (not ...) specially, for speed. */
if (CDR(el) == R_NilValue) { /* Note that CDR(R_NilValue) == R_NilValue */
......@@ -2700,7 +2702,7 @@ SEXP attribute_hidden evalList_gradient (SEXP el, SEXP rho, int variant, int n)
return R_NilValue;
if (CAR(el) != R_DotsSymbol) {
SEXP r = cons_with_tag (EVALV (CAR(el), rho,
n > 4 ? variant : variant | VARIANT_GRADIENT),
m > 0 ? variant : variant | VARIANT_GRADIENT),
R_NilValue, TAG(el));
if (R_variant_result & VARIANT_GRADIENT_FLAG)
SET_ATTRIB (r, R_gradient);
......@@ -2716,8 +2718,6 @@ SEXP attribute_hidden evalList_gradient (SEXP el, SEXP rho, int variant, int n)
SEXP ev, ev_el;
int i = 0;
int m = 0;
if (n > 4) { m = n-4; n -= 3; }
head = R_NilValue;
tail = R_NilValue;
......
......@@ -75,13 +75,11 @@
* offset: the 'op' (offset pointer) above; used for C functions
* which deal with more than one R function...
*
* eval: = STUVWXYZ (8 digits) --- where e.g. '1' means '00000001'
* S (for internals only) If S is 0, don't ask for for gradient
* of any arguments; otherwise, if S is 1, 2, 3, or 4, ask
* for gradient for first 1, 2, 3, or 4 arguments, and if
* s is 5, 6, or 7 don't ask for gradient of first 1, 2, or 3
* arguments, but do ask for following argument. Values for
* S of 8 or 9 are not currently used. Gradients are attached
* eval: = STUVWXYZ (8/9 digits) --- where e.g. '1' means '00000001'
* S (for internals only, possibly two digits) If S is 0, don't
* ask for for gradient of any arguments; otherwise, S&7 is
* the number of arguments that might have gradient, except
* that S>>3 initial ones don't. Gradients are attached
* to CONS cells holding arguments by evalList_gradient.
* T=1 says do special processing for BUILTIN internal function
* when called with VARIANT_WHOLE_BODY
......
......@@ -987,25 +987,25 @@ attribute_hidden FUNTAB R_FunTab_random[] =
{
/* printname c-entry offset eval arity pp-kind precedence rightassoc */
{"rchisq", do_random1, 0, 51000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rexp", do_random1, 1, 51000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rchisq", do_random1, 0, 101000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rexp", do_random1, 1, 101000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rgeom", do_random1, 2, 1000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rpois", do_random1, 3, 1000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rt", do_random1, 4, 51000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rt", do_random1, 4, 101000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rsignrank", do_random1, 5, 1000011, 2, {PP_FUNCALL, PREC_FN, 0}},
{"rbeta", do_random2, 0, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rbeta", do_random2, 0, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rbinom", do_random2, 1, 1000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rcauchy", do_random2, 2, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rf", do_random2, 3, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rgamma", do_random2, 4, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rlnorm", do_random2, 5, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rlogis", do_random2, 6, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rcauchy", do_random2, 2, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rf", do_random2, 3, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rgamma", do_random2, 4, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rlnorm", do_random2, 5, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rlogis", do_random2, 6, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rnbinom", do_random2, 7, 1000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rnorm", do_random2, 8, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"runif", do_random2, 9, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rweibull", do_random2, 10, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rnorm", do_random2, 8, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"runif", do_random2, 9, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rweibull", do_random2, 10, 111000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rwilcox", do_random2, 11, 1000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rnchisq", do_random2, 12, 61000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rnchisq", do_random2, 12, 1000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rnbinom_mu", do_random2, 13, 1000011, 3, {PP_FUNCALL, PREC_FN, 0}},
{"rhyper", do_random3, 0, 1000011, 4, {PP_FUNCALL, PREC_FN, 0}},
{"sample", do_sample, 0, 1000011, 4, {PP_FUNCALL, PREC_FN, 0}},
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment