implementing NO_REMAP

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spdep
 Version: 1.3-9
-Date: 2024-12-20
+Date: 2024-12-24
 Title: Spatial Dependence: Weighting Schemes, Statistics
 Encoding: UTF-8
 Authors@R: c(person("Roger", "Bivand", role = c("cre", "aut"), 

NEWS.md

@@ -1,5 +1,7 @@
 # Version 1.3-9 (development)
 
+* convert `error` to `Rf_error` in `src/ml_sse.c` to accommodate R_NO_REMAP
+
 * re-instate **rgeoda** references
 
 # Version 1.3-8 (2024-12-02)

src/card.c

@@ -4,17 +4,17 @@
 
 SEXP card(SEXP nb)
 {
-	int i, n=length(nb), pc=0, first_value, li;
+	int i, n=Rf_length(nb), pc=0, first_value, li;
 	SEXP ans;
 	PROTECT(ans = NEW_INTEGER(n)); pc++;
 
 	for (i=0; i < n; i++) {
 
-            li = length(VECTOR_ELT(nb, i));
+            li = Rf_length(VECTOR_ELT(nb, i));
             if (li > 0) 
                 first_value = INTEGER_POINTER(VECTOR_ELT(nb, i))[0];
             else
-                error("zero length neighbour vector");
+                Rf_error("zero length neighbour vector");
 
 	    if (first_value == 0) 
 		INTEGER_POINTER(ans)[i] = 0;

src/dfs_ncomp.c

@@ -11,7 +11,7 @@ void dfs(SEXP nblst, SEXP cmpnm, SEXP visited, int curcmp, int nodeid){
 
   INTEGER(cmpnm)[nodeid]=curcmp;
   INTEGER(visited)[nodeid]=BLACK;
-  n=length(VECTOR_ELT(nblst,nodeid));
+  n=Rf_length(VECTOR_ELT(nblst,nodeid));
 
   for(i=0;i<n;i++){
     if(INTEGER(visited)[(INTEGER(VECTOR_ELT(nblst,nodeid))[i]-1)]==WHITE){ 
@@ -26,8 +26,8 @@ SEXP g_components(SEXP nblst, SEXP cmpnm){
   int i, curcmp=1, nvert;
   SEXP visited;
 
-  nvert=length(nblst);
-  PROTECT(visited=allocVector(INTSXP,nvert));
+  nvert=Rf_length(nblst);
+  PROTECT(visited=Rf_allocVector(INTSXP,nvert));
 
   for(i=0; i < nvert; i++){
     INTEGER(visited)[i]=WHITE;

src/dnn.c

@@ -17,8 +17,8 @@ SEXP dnearneigh1(SEXP din1, SEXP din2, SEXP pnte, SEXP test, SEXP cands)
     SEXP idx;
     dn0 = NUMERIC_POINTER(din1)[0];
     dn = NUMERIC_POINTER(din2)[0];
-    dn0_equal = LOGICAL_POINTER(getAttrib(din1, install("equal")))[0];
-    dn_equal = LOGICAL_POINTER(getAttrib(din2, install("equal")))[0];
+    dn0_equal = LOGICAL_POINTER(Rf_getAttrib(din1, Rf_install("equal")))[0];
+    dn_equal = LOGICAL_POINTER(Rf_getAttrib(din2, Rf_install("equal")))[0];
     nte = INTEGER_POINTER(pnte)[0];
     PROTECT(ans = NEW_LIST(nte)); pc++;
 
@@ -39,7 +39,7 @@ SEXP dnearneigh1(SEXP din1, SEXP din2, SEXP pnte, SEXP test, SEXP cands)
 		pos[kn] = jidx;
 		if (++kn == nte - 1 && jidx == nte) {
 			Rprintf("%d %d %d\n", kn, nte, j);
-		    error("position array overrun");
+		    Rf_error("position array overrun");
 		}
 	    }
 	}
@@ -68,8 +68,8 @@ dnearneigh(SEXP din1, SEXP din2, SEXP pnte, SEXP p, SEXP test, SEXP lonlat)
 
     dn0 = NUMERIC_POINTER(din1)[0];
     dn = NUMERIC_POINTER(din2)[0];
-    dn0_equal = LOGICAL_POINTER(getAttrib(din1, install("equal")))[0];
-    dn_equal = LOGICAL_POINTER(getAttrib(din2, install("equal")))[0];
+    dn0_equal = LOGICAL_POINTER(Rf_getAttrib(din1, Rf_install("equal")))[0];
+    dn_equal = LOGICAL_POINTER(Rf_getAttrib(din2, Rf_install("equal")))[0];
     nte = INTEGER_POINTER(pnte)[0];
     ll = INTEGER_POINTER(lonlat)[0];
     PROTECT(ans = NEW_LIST(nte)); pc++;
@@ -94,7 +94,7 @@ dnearneigh(SEXP din1, SEXP din2, SEXP pnte, SEXP p, SEXP test, SEXP lonlat)
 		pos[kn] = j;
 		if (++kn == nte - 1 && j == nte) {
 			Rprintf("%d %d %d\n", kn, nte, j);
-		    error("position array overrun");
+		    Rf_error("position array overrun");
 		}
 	    }
 	}

src/gabriel.c

@@ -43,7 +43,7 @@ void compute_gabriel(int *no_nodes, int *g1, int *g2, int *nogab,
 	     }
 /* bug Dan Putler 090121 */
 	   if ((no_gab+1) > *ngaballoc) 
-		error("number of neighbours overrun - increase nnmult");
+		Rf_error("number of neighbours overrun - increase nnmult");
 	   if(l==*no_nodes)
 	     {
 	       g1[no_gab]=i+1; g2[no_gab++]=j+1;

src/gearyw.c

@@ -4,7 +4,7 @@
 
 SEXP gearyw(SEXP nb, SEXP weights, SEXP x, SEXP card, SEXP zeropolicy,
 	SEXP ftype) {
-	int i, j, k, n=length(card), pc=0;
+	int i, j, k, n=Rf_length(card), pc=0;
 	double sum, wt, diff, xi, res;
 	SEXP ans;
 	PROTECT(ans = NEW_NUMERIC(n)); pc++;

src/gsymtest.c

@@ -4,7 +4,7 @@
 
 SEXP gsymtest(SEXP nb, SEXP glist, SEXP card)
 {
-	int i, icard, j, k, k1, n=length(nb), pc=0, l=TRUE;
+	int i, icard, j, k, k1, n=Rf_length(nb), pc=0, l=TRUE;
 	double g, g0, d=0.0, d1=0.0;
 	SEXP ans;
 	PROTECT(ans = NEW_LIST(2)); pc++;

src/jc.c

@@ -3,7 +3,7 @@
 #include "spdep.h"
 
 SEXP jcintern(SEXP nb, SEXP weights, SEXP dum, SEXP card) {
-	int i, j, k, n=length(card), pc=0;
+	int i, j, k, n=Rf_length(card), pc=0;
 	double sum, sum1, wt;
 	SEXP ans;
 	PROTECT(ans = NEW_NUMERIC(1)); pc++;

src/knn.c

@@ -63,7 +63,7 @@ knearneigh(int *kin, int *pnte, int *p, double *test, int *res, double *dists,
 /* Keep an extra distance if the largest current one ties with current kth */
 			if (nndist[kn] <= nndist[kinit - 1])
 			    if (++kn >= MAX_TIES - 1)
-				error("too many ties in knearneigh");
+				Rf_error("too many ties in knearneigh");
 			break;
 		    }
 	    nndist[kn] = 0.99 * DBL_MAX;

src/lagw.c

@@ -4,7 +4,7 @@
 
 SEXP lagw(SEXP nb, SEXP weights, SEXP x, SEXP card, SEXP zeropolicy,
    SEXP naok) {
-	int i, j, k, n=length(card), pc=0, naOK=LOGICAL_POINTER(naok)[0],
+	int i, j, k, n=Rf_length(card), pc=0, naOK=LOGICAL_POINTER(naok)[0],
             nas;
 	double sum, wt, tmp;
 	SEXP ans;
@@ -13,7 +13,7 @@ SEXP lagw(SEXP nb, SEXP weights, SEXP x, SEXP card, SEXP zeropolicy,
         if (naOK == FALSE) {
             for (i=0; i < n; i++) 
                 if (!R_FINITE(NUMERIC_POINTER(x)[i]))
-                    error("Variable contains non-finite values");
+                    Rf_error("Variable contains non-finite values");
         }
 
 	for (i=0; i < n; i++) {
@@ -29,7 +29,7 @@ SEXP lagw(SEXP nb, SEXP weights, SEXP x, SEXP card, SEXP zeropolicy,
                 nas = 0;
 		for (j=0; j<INTEGER_POINTER(card)[i]; j++) {
 		    k = INTEGER_POINTER(VECTOR_ELT(nb, i))[j];
-                    if (k > n || k <= 0) error("weights index out of range");
+                    if (k > n || k <= 0) Rf_error("weights index out of range");
 		    wt = NUMERIC_POINTER(VECTOR_ELT(weights, i))[j];
 		    tmp = NUMERIC_POINTER(x)[k-ROFFSET];
 		    if (R_FINITE(tmp)) sum += tmp * wt;

src/nbdists.c

@@ -16,14 +16,14 @@ SEXP nbdists(SEXP nb, SEXP x, SEXP np, SEXP dim, SEXP lonlat)
 
 	SET_VECTOR_ELT(ans, 0, NEW_LIST(n));
 	d = INTEGER_POINTER(dim)[0];
-	if (d > 2) error("Only 2D coordinates allowed");
+	if (d > 2) Rf_error("Only 2D coordinates allowed");
 	PROTECT(class = NEW_CHARACTER(1)); pc++;
 	SET_STRING_ELT(class, 0, COPY_TO_USER_STRING("nbdist"));
-	setAttrib(VECTOR_ELT(ans, 0), R_ClassSymbol, class);
+	Rf_setAttrib(VECTOR_ELT(ans, 0), R_ClassSymbol, class);
 
 	for (i=0; i < n; i++) {
                 R_CheckUserInterrupt();
-		k = length(VECTOR_ELT(nb, i));
+		k = Rf_length(VECTOR_ELT(nb, i));
 /*		if (k == 1 && INTEGER_POINTER(VECTOR_ELT(nb, i))[0] == 0) {
 			SET_VECTOR_ELT(VECTOR_ELT(ans, 0), i,
 				NEW_NUMERIC(1));
@@ -34,7 +34,7 @@ SEXP nbdists(SEXP nb, SEXP x, SEXP np, SEXP dim, SEXP lonlat)
                 if (k > 0) 
                     first_value = INTEGER_POINTER(VECTOR_ELT(nb, i))[0];
                 else
-                    error("zero length neighbour vector");
+                    Rf_error("zero length neighbour vector");
 
 		if (first_value > 0) {
 			SET_VECTOR_ELT(VECTOR_ELT(ans, 0), i,

src/perm_no_replace.c

@@ -12,7 +12,7 @@ SEXP perm_no_replace(SEXP nsim0, SEXP n0, SEXP crdi0) {
     int n = INTEGER_POINTER(n0)[0];
     int crdi = INTEGER_POINTER(crdi0)[0];
     GetRNGstate();
-    PROTECT(y = allocVector(INTSXP, crdi*nsim));
+    PROTECT(y = Rf_allocVector(INTSXP, crdi*nsim));
     for (int k = 0; k < nsim; k++) {
         yk = draw_no_replace(n, crdi);
         for (int i = 0; i < crdi; i++) {
@@ -33,7 +33,7 @@ SEXP perm_no_replace(SEXP nsim0, SEXP n0, SEXP crdi0) {
 
 SEXP draw_no_replace(int n, int crdi) {
     SEXP y;
-    PROTECT(y = allocVector(INTSXP, crdi));
+    PROTECT(y = Rf_allocVector(INTSXP, crdi));
     int *iy = INTEGER(y);
     int *x = (int *)R_alloc(n, sizeof(int));
     for (int i = 0; i < n; i++) x[i] = i;

src/polypoly.c

@@ -68,109 +68,6 @@ SEXP spOverlap(SEXP bbbi, SEXP bbbj) {
 	return(ans);
 }
 
-/* SEXP poly_loop(SEXP n, SEXP i_findInBox, SEXP bb, SEXP pl, SEXP nrs,
-    SEXP dsnap, SEXP criterion, SEXP scale) {
-
-    int nn = INTEGER_POINTER(n)[0];
-    int crit = INTEGER_POINTER(criterion)[0];
-    int Scale = INTEGER_POINTER(scale)[0];
-    int uBound = nn*Scale;
-    int i, j, jj, k, li, pc = 0;
-    int ii = 0;
-    int *card, *icard, *is, *jjs;
-
-    SEXP bbi, bbj, jhit, khit, ans, pli, plj, nrsi, nrsj;
-
-    int xx, yy, zz, ww;
-
-    card = (int *) R_alloc((size_t) nn, sizeof(int));
-    icard = (int *) R_alloc((size_t) nn, sizeof(int));
-    is = (int *) R_alloc((size_t) uBound, sizeof(int));
-    jjs = (int *) R_alloc((size_t) uBound, sizeof(int));
-
-    for (i=0; i<nn; i++) {
-        card[i] = 0;
-        icard[i] = 0;
-   
-    }
-    for (i=0; i<uBound; i++) {
-        is[i] = 0;
-        jjs[i] = 0;
-    }
-
-    PROTECT(bbi = NEW_NUMERIC(4)); pc++;
-    PROTECT(bbj = NEW_NUMERIC(4)); pc++;
-    PROTECT(jhit = NEW_INTEGER(1)); pc++;
-    PROTECT(khit = NEW_INTEGER(1)); pc++;
-    PROTECT(nrsi = NEW_INTEGER(1)); pc++;
-    PROTECT(nrsj = NEW_INTEGER(1)); pc++;
-
-    for (i=0; i<(nn-1); i++) {
-        li = length(VECTOR_ELT(i_findInBox, i));
-        INTEGER_POINTER(nrsi)[0] = INTEGER_POINTER(nrs)[i];
-        for (k=0; k<4; k++) 
-            NUMERIC_POINTER(bbi)[k] = NUMERIC_POINTER(bb)[i+(k*nn)];
-        for (j=0; j<li; j++) {
-            jj = INTEGER_POINTER(VECTOR_ELT(i_findInBox, i))[j] - ROFFSET;
-            for (k=0; k<4; k++) 
-                NUMERIC_POINTER(bbj)[k] = NUMERIC_POINTER(bb)[jj+(k*nn)];
-            jhit = spOverlap(bbi, bbj);
-            if (INTEGER_POINTER(jhit)[0] > 0) {
-                INTEGER_POINTER(khit)[0] = 0;
-                INTEGER_POINTER(nrsj)[0] = INTEGER_POINTER(nrs)[jj];
-                if (INTEGER_POINTER(nrsi)[0]*INTEGER_POINTER(nrsj)[0] > 0){
-                    khit = polypoly(VECTOR_ELT(pl, i), nrsi, VECTOR_ELT(pl, jj),
-                        nrsj, dsnap);
-                }
-                if (INTEGER_POINTER(khit)[0] > crit) {
-                    card[i]++;
-                    card[jj]++;
-                    is[ii] = i;
-                    jjs[ii] = jj;
-                    ii++;
-                    if (ii == uBound) error("memory error, scale problem");
-                }
-            }
-        }
-    }
-
-    PROTECT(ans = NEW_LIST(nn)); pc++;
-
-    for (i=0; i<nn; i++) {
-        if (card[i] == 0) {
-            SET_VECTOR_ELT(ans, i, NEW_INTEGER(1));
-            INTEGER_POINTER(VECTOR_ELT(ans, i))[0] = 0;
-        } else {
-            SET_VECTOR_ELT(ans, i, NEW_INTEGER(card[i]));
-        }
-    }
-
-    for (i=0; i<ii; i++) {
-        xx = is[i];
-        yy = jjs[i];
-        zz = icard[yy];
-        ww = icard[xx];
-        if (zz == card[yy]) error("memory error, overflow");
-        if (ww == card[xx]) error("memory error, overflow");
-        INTEGER_POINTER(VECTOR_ELT(ans, yy))[zz] = xx + ROFFSET;
-        INTEGER_POINTER(VECTOR_ELT(ans, xx))[ww] = yy + ROFFSET;
-        icard[yy]++;
-        icard[xx]++;
-    }
-
-    for (i=0; i<nn; i++) {
-        if ((li = length(VECTOR_ELT(ans, i))) > 1) {
-            for (j=0; j<li; j++)
-                icard[j] = INTEGER_POINTER(VECTOR_ELT(ans, i))[j];
-            R_isort(icard, li);
-            for (j=0; j<li; j++)
-                INTEGER_POINTER(VECTOR_ELT(ans, i))[j] = icard[j];
-        }
-    }
-
-    UNPROTECT(pc);
-    return(ans);
-} */
 
 
 int spOverlapC(double bbi1, double bbi2, double bbi3, double bbi4, double bbj1, double bbj2, double bbj3, double bbj4) {
@@ -279,13 +176,12 @@ SEXP poly_loop2(SEXP n, SEXP i_findInBox, SEXP bb, SEXP pl, SEXP nrs,
             plx[jj] = NUMERIC_POINTER(VECTOR_ELT(pl, i))[j];
             ply[jj] = NUMERIC_POINTER(VECTOR_ELT(pl, i))[j+nrsi];
             jj++;
-/*            if (i < (nn-1) && jj == li) error("polygon memory overflow");*/
         }
     }
 
     for (i=0; i<(nn-1); i++) {
         R_CheckUserInterrupt();
-        li = length(VECTOR_ELT(i_findInBox, i));
+        li = Rf_length(VECTOR_ELT(i_findInBox, i));
         nrsi = NRS[i];
         for (j=0; j<li; j++) {
             jj = INTEGER_POINTER(VECTOR_ELT(i_findInBox, i))[j] - ROFFSET;
@@ -304,7 +200,6 @@ SEXP poly_loop2(SEXP n, SEXP i_findInBox, SEXP bb, SEXP pl, SEXP nrs,
                     is[ii] = i;
                     jjs[ii] = jj;
                     ii++;
-/*                    if (ii == uBound) error("memory error, scale problem");*/
                 }
             }
         }
@@ -327,8 +222,6 @@ SEXP poly_loop2(SEXP n, SEXP i_findInBox, SEXP bb, SEXP pl, SEXP nrs,
         yy = jjs[i];
         zz = icard[yy];
         ww = icard[xx];
-/*        if (zz == card[yy]) error("memory error, overflow");
-        if (ww == card[xx]) error("memory error, overflow");*/
         INTEGER_POINTER(VECTOR_ELT(ans, yy))[zz] = xx + ROFFSET;
         INTEGER_POINTER(VECTOR_ELT(ans, xx))[ww] = yy + ROFFSET;
         icard[yy]++;
@@ -337,7 +230,7 @@ SEXP poly_loop2(SEXP n, SEXP i_findInBox, SEXP bb, SEXP pl, SEXP nrs,
 
     for (i=0; i<nn; i++) {
         R_CheckUserInterrupt();
-        if ((li = length(VECTOR_ELT(ans, i))) > 1) {
+        if ((li = Rf_length(VECTOR_ELT(ans, i))) > 1) {
             for (j=0; j<li; j++)
                 icard[j] = INTEGER_POINTER(VECTOR_ELT(ans, i))[j];
             R_isort(icard, li);

src/relative.c

@@ -32,7 +32,7 @@ void compute_relative(int *no_nodes, int *g1, int *g2, int *nogab,
 
 /* bug Dan Putler 090121 */
 	  if ((no_gab+1) > *ngaballoc) 
-		error("number of neighbours overrun - increase nnmult");
+		Rf_error("number of neighbours overrun - increase nnmult");
 	  if(l==*no_nodes)
 	    {
 	      g1[no_gab]=i+1; g2[no_gab++]=j+1;

src/spdep.h

@@ -1,6 +1,11 @@
-/* Copyright 2010-2021 by Roger S. Bivand. */
+/* Copyright 2010-2024 by Roger S. Bivand. */
 
-#define USE_FC_LEN_T
+#ifndef USE_FC_LEN_T
+# define USE_FC_LEN_T
+#endif
+#ifndef R_NO_REMAP
+# define R_NO_REMAP
+#endif
 #include <R.h>
 #include <Rmath.h>
 #include <Rdefines.h>

src/symtest.c

@@ -4,7 +4,7 @@
 
 SEXP symtest(SEXP nb, SEXP card, SEXP verbose)
 {
-	int i, icard, j, k, k1, flag, fstop, n=length(nb), pc=0;
+	int i, icard, j, k, k1, flag, fstop, n=Rf_length(nb), pc=0;
 	SEXP ans;
 	PROTECT(ans = NEW_LOGICAL(1)); pc++;
 	LOGICAL_POINTER(ans)[0] = TRUE;