Hello. The Delaporte package works properly on all R-core platforms except Solaris SPARC, where it compiles properly but fails a number of its tests [1]. Not having access to a SPARC testbed, I'm limited in what kind of diagnostics I can do. One thing I have noticed is that a lot of the failures occur when I am passing non-default logicals (like lower tail or log). For example, the first failure at that link is when "log = true" is supposed to be passed, but the SPARC answers are the unlogged values. Of the 22 failed tests, 12 of them pass logicals.
I'll bring an example of how it is coded below, and if anyone recognizes where SPARC specifically goes wrong, I'd appreciate. I guess, if I absolutely had to, I could convert the logical to an integer in C and pass the integer to Fortran which should work even for SPARC, but I'd prefer not to if I could help it. Thank you, Avi [1] https://cran.r-project.org/web/checks/check_results_Delaporte.html *****Example Code***** R code: ddelap <- function(x, alpha, beta, lambda, log = FALSE){ if(!is.double(x)) {storage.mode(x) <- 'double'} if(!is.double(alpha)) {storage.mode(alpha) <- 'double'} if(!is.double(beta)) {storage.mode(beta) <- 'double'} if(!is.double(lambda)) {storage.mode(lambda) <- 'double'} if(any(x > floor(x))) { warning("Non-integers passed to ddelap. These will have 0 probability.") } .Call(ddelap_C, x, alpha, beta, lambda, log) } C code: void ddelap_f(double *x, int nx, double *a, int na, double *b, int nb, double *l, int nl, int *lg, double *ret); extern SEXP ddelap_C(SEXP x, SEXP alpha, SEXP beta, SEXP lambda, SEXP lg){ const int nx = LENGTH(x); const int na = LENGTH(alpha); const int nb = LENGTH(beta); const int nl = LENGTH(lambda); SEXP ret; PROTECT(ret = allocVector(REALSXP, nx)); ddelap_f(REAL(x), nx, REAL(alpha), na, REAL(beta), nb, REAL(lambda), nl, LOGICAL(lg), REAL(ret)); UNPROTECT(1); return(ret); } Fortran: (not posting ddelap_f_s as that doesn't handle the logging) subroutine ddelap_f(x, nx, a, na, b, nb, l, nl, lg, pmfv) bind(C, name="ddelap_f") integer(kind = c_int), intent(in), value :: nx, na, nb, nl ! Sizes real(kind = c_double), intent(in), dimension(nx) :: x ! Observations real(kind = c_double), intent(out), dimension(nx):: pmfv ! Result real(kind = c_double), intent(in) :: a(na), b(nb), l(nl)! Parameters logical(kind = c_bool), intent(in) :: lg ! Log flag integer :: i ! Integer !$omp parallel do default(shared) private(i) do i = 1, nx if (x(i) > floor(x(i))) then pmfv(i) = ZERO else pmfv(i) = ddelap_f_s(x(i), a(mod(i - 1, na) + 1), & b(mod(i - 1, nb) + 1), l(mod(i - 1, nl) + 1)) end if end do !$omp end parallel do if (lg) then pmfv = log(pmfv) end if end subroutine ddelap_f ______________________________________________ [email protected] mailing list https://stat.ethz.ch/mailman/listinfo/r-package-devel
