[R-pkg-devel] Solaris SPARC, Fortran, and logical errors?

[J C Nash]

Possibly tangential, but has there been any effort to set up a Sparc testbed? It
seems we could use a network-available (virtual?) machine, since this platform is
often the unfortunate one. Unless, of course, there's a sunset date.

For information, I mentioned SPARC at our local linux group, and apparently there
are a couple of folk who have them running, but I didn't find out the state of the
OS etc.

JN


On 2017-03-15 10:40 AM, Avraham Adler wrote:
> 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
>
> ______________________________________________
> R-package-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-package-devel
>