>>>>> Hervé Pagès <hpa...@fhcrc.org> >>>>> on Tue, 27 Nov 2012 17:03:05 -0800 writes:
> Some formatting issues when copy/pasting the patch in the > body of the email so I've attached the diff file. Thank you, Hervé. I have committed (a slightly simplified version of) your patch to R-devel (to become 2.16.0). Backporting to '2.15.2 patched' would be a bit of work -- mapply's C interface is not .Internal() there -- so I've kept it in R-devel. > On 11/27/2012 04:56 PM, Hervé Pagès wrote: >> Hi, >> >> Here is a patch for this (against current R-devel). The "caching" of >> the .Primitive for 'length' is taken from seq_along() C code (in >> R-devel/src/main/seq.c). >> >> hpages@thinkpad:~/svn/R$ svn diff R-devel >> Index: R-devel/src/main/mapply.c >> =================================================================== >> --- R-devel/src/main/mapply.c (revision 61172) >> +++ R-devel/src/main/mapply.c (working copy) [.............] >> lengths = (R_xlen_t *) R_alloc(m, sizeof(R_xlen_t)); >> for(i = 0; i < m; i++){ >> - lengths[i] = xlength(VECTOR_ELT(varyingArgs, i)); >> + int dispatch_ok = 0; >> + tmp1 = VECTOR_ELT(varyingArgs, i); >> + if (isObject(tmp1)) { >> + /* Looks like DispatchOrEval() needs a pairlist. We reproduce what >> + pairlist(tmp1) would do i.e. tmp2 <- as.pairlist(list(tmp1)). >> + Is there a more direct way to go from tmp1 to tmp2? */ indeed, there is a more direct way: tmp2 = lang1(tmp1) and that's what I've used in the commit. >> + PROTECT(tmp2 = allocVector(VECSXP, 1)); >> + SET_VECTOR_ELT(tmp2, 0, tmp1); >> + PROTECT(tmp2 = coerceVector(tmp2, LISTSXP)); >> + dispatch_ok = DispatchOrEval(call, length_op, "length", >> + tmp2, rho, &ans, 0, 1); >> + UNPROTECT(2); >> + } >> + lengths[i] = dispatch_ok ? asInteger(ans) : xlength(tmp1); >> if(lengths[i] == 0) zero++; >> if (lengths[i] > longest) longest = lengths[i]; >> } >> >> Hopefully the bug can be fixed. Thanks! Many thanks to you, Hervé! Martin >> On 11/14/2012 09:42 PM, Hervé Pagès wrote: >>> Hi, >>> >>> Starting with ordinary vectors, so we know what to expect: >>> >>> > mapply(function(x, y) {x * y}, 101:106, rep(1:3, 2)) >>> [1] 101 204 309 104 210 318 >>> >>> > mapply(function(x, y) {x * y}, 101:106, 1:3) >>> [1] 101 204 309 104 210 318 >>> >>> Now with an S4 object: >>> >>> setClass("A", representation(aa="integer")) >>> a <- new("A", aa=101:106) >>> >>> > length(a) >>> [1] 1 >>> >>> Implementing length(): >>> >>> setMethod("length", "A", function(x) length(x@aa)) >>> >>> Testing length(): >>> >>> > length(a) # sanity check >>> [1] 6 >>> >>> No [[ yet for those objects so the following error is expected: >>> >>> > mapply(function(x, y) {x * y}, a, rep(1:3, 2)) >>> Error in dots[[1L]][[1L]] : this S4 class is not subsettable >>> >>> Implementing [[: >>> >>> setMethod("[[", "A", function(x, i, j, ...) x@aa[[i]]) >>> >>> Testing [[: >>> >>> > a[[1]] >>> [1] 101 >>> > a[[5]] >>> [1] 105 >>> >>> Trying mapply again: >>> >>> > mapply(function(x, y) {x * y}, a, rep(1:3, 2)) >>> [1] 101 202 303 101 202 303 >>> >>> Wrong. It looks like internally a[[1]] is always used instead of a[[i]]. >>> >>> The real problem it seems is that 'a' is treated as if it was of >>> length 1: >>> >>> > mapply(function(x, y) {x * y}, a, 1:3) >>> [1] 101 202 303 >>> > mapply(function(x, y) {x * y}, a, 5) >>> [1] 505 >>> >>> In other words, internal dispatch works for [[ but not for length(). >>> >>> Thanks, >>> H. >>> >> > -- > Hervé Pagès > Program in Computational Biology > Division of Public Health Sciences > Fred Hutchinson Cancer Research Center > 1100 Fairview Ave. N, M1-B514 > P.O. Box 19024 > Seattle, WA 98109-1024 > E-mail: hpa...@fhcrc.org > Phone: (206) 667-5791 > Fax: (206) 667-1319 > [DELETED ATTACHMENT external: mapply.diff, text/x-patch] ______________________________________________ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel