From b61f6b17be09383c94b45e912f9213735aa62212 Mon Sep 17 00:00:00 2001 From: Roger Bivand Date: Tue, 24 Dec 2024 11:10:28 +0100 Subject: [PATCH] implementing NO_REMAP --- DESCRIPTION | 2 +- NEWS.md | 2 + src/card.c | 6 +-- src/dfs_ncomp.c | 6 +-- src/dnn.c | 12 ++--- src/gabriel.c | 2 +- src/gearyw.c | 2 +- src/gsymtest.c | 2 +- src/jc.c | 2 +- src/knn.c | 2 +- src/lagw.c | 6 +-- src/nbdists.c | 8 +-- src/perm_no_replace.c | 4 +- src/polypoly.c | 111 +----------------------------------------- src/relative.c | 2 +- src/spdep.h | 9 +++- src/symtest.c | 2 +- 17 files changed, 40 insertions(+), 140 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e1dc9476..6b2153ba 100644 --- a/DESCRIPTION +++ b/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"), diff --git a/NEWS.md b/NEWS.md index a2ab357f..80b34f79 100644 --- a/NEWS.md +++ b/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) diff --git a/src/card.c b/src/card.c index aebbab55..d0904853 100644 --- a/src/card.c +++ b/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; diff --git a/src/dfs_ncomp.c b/src/dfs_ncomp.c index 17d5ec1e..e3a482a4 100644 --- a/src/dfs_ncomp.c +++ b/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 *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; diff --git a/src/gearyw.c b/src/gearyw.c index 02eef0b3..9617f8ce 100644 --- a/src/gearyw.c +++ b/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++; diff --git a/src/gsymtest.c b/src/gsymtest.c index bbc2922e..186b3101 100644 --- a/src/gsymtest.c +++ b/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++; diff --git a/src/jc.c b/src/jc.c index 7ef4b204..052d8505 100644 --- a/src/jc.c +++ b/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++; diff --git a/src/knn.c b/src/knn.c index 250de6e1..198dd845 100644 --- a/src/knn.c +++ b/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; diff --git a/src/lagw.c b/src/lagw.c index 19aa0bd7..b09b1ba0 100644 --- a/src/lagw.c +++ b/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 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; diff --git a/src/nbdists.c b/src/nbdists.c index 6236cfa9..a6177f5e 100644 --- a/src/nbdists.c +++ b/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, diff --git a/src/perm_no_replace.c b/src/perm_no_replace.c index a12ae4ae..a8fc87b0 100644 --- a/src/perm_no_replace.c +++ b/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; diff --git a/src/polypoly.c b/src/polypoly.c index 05320086..e558917b 100644 --- a/src/polypoly.c +++ b/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 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 1) { - for (j=0; j 1) { + if ((li = Rf_length(VECTOR_ELT(ans, i))) > 1) { for (j=0; j *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; diff --git a/src/spdep.h b/src/spdep.h index 92d37f2c..4025204f 100644 --- a/src/spdep.h +++ b/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 #include #include diff --git a/src/symtest.c b/src/symtest.c index f0d12d23..e9096994 100644 --- a/src/symtest.c +++ b/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;