Skip to content

Commit

Permalink
implement NO_REMAP
Browse files Browse the repository at this point in the history
  • Loading branch information
@rsbivand
rsbivand committed Dec 24, 2024
1 parent 5c9930d commit 31c17c7
Show file tree
Hide file tree
Showing 7 changed files with 69 additions and 65 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: spatialreg
Version: 1.3-7
Date: 2024-12-02
Date: 2024-12-24
Title: Spatial Regression Analysis
Encoding: UTF-8
Authors@R: c(person("Roger", "Bivand", role = c("cre", "aut"), email = "Roger.Bivand@nhh.no", comment=c(ORCID="0000-0003-2392-6140")),
Expand Down
1 change: 1 addition & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
# Version 1.3-7 (development)

* convert `error` to `Rf_error` in `src/ml_sse.c` to accommodate R_NO_REMAP

# Version 1.3-6 (2024-12-02)

Expand Down
28 changes: 14 additions & 14 deletions src/eminmaxC.c
View file
Original file line number Diff line number Diff line change
@@ -1,10 +1,10 @@
/* Copyright 2015 by Roger S. Bivand. */
/* Copyright 2015-24 by Roger S. Bivand. */

#include "spatialreg.h"


SEXP lmin21(SEXP nb, SEXP y, SEXP cy, SEXP card) {
int i, j, k, nswitch=0, n=length(card), pc=0;
int i, j, k, nswitch=0, n=Rf_length(card), pc=0;
SEXP ans;
double t1, t2, ytemp;
double *Y, *CY;
Expand Down Expand Up @@ -52,20 +52,20 @@ SEXP lmin21(SEXP nb, SEXP y, SEXP cy, SEXP card) {
}

SEXP lmin22(SEXP nb, SEXP y, SEXP cy, SEXP card, SEXP beta) {
int i, j, k, nswitch=0, n=length(card), pc=0;
int i, j, k, nswitch=0, n=Rf_length(card), pc=0;
SEXP ans;
double t1, t2, ytemp, yhat;
double *Y, *CY, *B;

Y = (double *) R_alloc((size_t) n, sizeof(double));
CY = (double *) R_alloc((size_t) n, sizeof(double));
B = (double *) R_alloc((size_t) length(beta), sizeof(double));
B = (double *) R_alloc((size_t) Rf_length(beta), sizeof(double));

for (i=0; i<n; i++) {
Y[i] = NUMERIC_POINTER(y)[i];
CY[i] = NUMERIC_POINTER(cy)[i];
}
for (i=0; i<length(beta); i++) {
for (i=0; i<Rf_length(beta); i++) {
B[i] = NUMERIC_POINTER(beta)[i];
}

Expand Down Expand Up @@ -105,20 +105,20 @@ SEXP lmin22(SEXP nb, SEXP y, SEXP cy, SEXP card, SEXP beta) {
}

SEXP lmin23(SEXP nb, SEXP y, SEXP cy, SEXP card, SEXP beta, SEXP tol) {
int i, j, k, nswitch=0, n=length(card), pc=0;
int i, j, k, nswitch=0, n=Rf_length(card), pc=0;
SEXP ans;
double tmp, var, yhat;
double *Y, *CY, *B;

Y = (double *) R_alloc((size_t) n, sizeof(double));
CY = (double *) R_alloc((size_t) n, sizeof(double));
B = (double *) R_alloc((size_t) length(beta), sizeof(double));
B = (double *) R_alloc((size_t) Rf_length(beta), sizeof(double));

for (i=0; i<n; i++) {
Y[i] = NUMERIC_POINTER(y)[i];
CY[i] = NUMERIC_POINTER(cy)[i];
}
for (i=0; i<length(beta); i++) {
for (i=0; i<Rf_length(beta); i++) {
B[i] = NUMERIC_POINTER(beta)[i];
}
PROTECT(ans = NEW_LIST(2)); pc++;
Expand Down Expand Up @@ -151,20 +151,20 @@ SEXP lmin23(SEXP nb, SEXP y, SEXP cy, SEXP card, SEXP beta, SEXP tol) {
}

SEXP lmin3(SEXP nb, SEXP ev1, SEXP ev1_lag, SEXP n_nei, SEXP beta, SEXP tol) {
int i, j, k, nswitch=0, n=length(n_nei), pc=0;
int i, j, k, nswitch=0, n=Rf_length(n_nei), pc=0;
SEXP ans;
double tmp, var, yhat, ntmp;
double *Y, *CY, *B;

Y = (double *) R_alloc((size_t) n, sizeof(double));
CY = (double *) R_alloc((size_t) n, sizeof(double));
B = (double *) R_alloc((size_t) length(beta), sizeof(double));
B = (double *) R_alloc((size_t) Rf_length(beta), sizeof(double));

for (i=0; i<n; i++) {
Y[i] = NUMERIC_POINTER(ev1)[i];
CY[i] = NUMERIC_POINTER(ev1_lag)[i];
}
for (i=0; i<length(beta); i++) {
for (i=0; i<Rf_length(beta); i++) {
B[i] = NUMERIC_POINTER(beta)[i];
}
PROTECT(ans = NEW_LIST(2)); pc++;
Expand Down Expand Up @@ -200,20 +200,20 @@ SEXP lmin3(SEXP nb, SEXP ev1, SEXP ev1_lag, SEXP n_nei, SEXP beta, SEXP tol) {


SEXP lmin3S(SEXP nb, SEXP ev1, SEXP ev1_lag, SEXP n_nei, SEXP card, SEXP beta, SEXP tol) {
int i, j, k, nswitch=0, n=length(card), pc=0;
int i, j, k, nswitch=0, n=Rf_length(card), pc=0;
SEXP ans;
double tmp, var, yhat, ntmp;
double *Y, *CY, *B;

Y = (double *) R_alloc((size_t) n, sizeof(double));
CY = (double *) R_alloc((size_t) n, sizeof(double));
B = (double *) R_alloc((size_t) length(beta), sizeof(double));
B = (double *) R_alloc((size_t) Rf_length(beta), sizeof(double));

for (i=0; i<n; i++) {
Y[i] = NUMERIC_POINTER(ev1)[i];
CY[i] = NUMERIC_POINTER(ev1_lag)[i];
}
for (i=0; i<length(beta); i++) {
for (i=0; i<Rf_length(beta); i++) {
B[i] = NUMERIC_POINTER(beta)[i];
}
PROTECT(ans = NEW_LIST(2)); pc++;
Expand Down
4 changes: 2 additions & 2 deletions src/listw2Matrix.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ SEXP listw2dsT(SEXP nbs, SEXP wts, SEXP card, SEXP ncard2)
NUMERIC_POINTER(VECTOR_ELT(ans, 2))[ii] =
NUMERIC_POINTER(VECTOR_ELT(wts, i))[j];
if (ii >= INTEGER_POINTER(ncard2)[0])
error("ncard2 incorrectly given");
Rf_error("ncard2 incorrectly given");
ii++;
}
}
Expand All @@ -50,7 +50,7 @@ SEXP listw2dgR(SEXP nbs, SEXP wts, SEXP card, SEXP ncard)
NUMERIC_POINTER(VECTOR_ELT(ans, 1))[ii] =
NUMERIC_POINTER(VECTOR_ELT(wts, i))[j];
if (ii >= INTEGER_POINTER(ncard)[0])
error("ncard incorrectly given");
Rf_error("ncard incorrectly given");
ii++;
}
}
Expand Down
84 changes: 42 additions & 42 deletions src/ml_sse.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,18 +63,18 @@ void opt_error_set(SEXP env) {
SEXP y, x, wy, WX;
int i, n, p, np, pc=0;

n = INTEGER_POINTER(findVarInFrame(env, install("n")))[0];
p = INTEGER_POINTER(findVarInFrame(env, install("p")))[0];
n = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("n")))[0];
p = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("p")))[0];
np = n*p;

pt = (OPT_ERROR_SSE *) R_ExternalPtrAddr(findVarInFrame(env,
install("ptr")));
if (pt->set) error("opt_error_set: function called out of order");
pt = (OPT_ERROR_SSE *) R_ExternalPtrAddr(Rf_findVarInFrame(env,
Rf_install("ptr")));
if (pt->set) Rf_error("opt_error_set: function called out of order");

PROTECT(y = findVarInFrame(env, install("y"))); pc++;
PROTECT(x = findVarInFrame(env, install("x"))); pc++;
PROTECT(wy = findVarInFrame(env, install("wy"))); pc++;
PROTECT(WX = findVarInFrame(env, install("WX"))); pc++;
PROTECT(y = Rf_findVarInFrame(env, Rf_install("y"))); pc++;
PROTECT(x = Rf_findVarInFrame(env, Rf_install("x"))); pc++;
PROTECT(wy = Rf_findVarInFrame(env, Rf_install("wy"))); pc++;
PROTECT(WX = Rf_findVarInFrame(env, Rf_install("WX"))); pc++;

pt->y = R_Calloc(n, double);
pt->x = R_Calloc(np, double);
Expand Down Expand Up @@ -149,18 +149,18 @@ void hess_error_set(SEXP env) {
SEXP y, x, wy, WX;
int i, n, p, np, pc=0;

n = INTEGER_POINTER(findVarInFrame(env, install("n")))[0];
p = INTEGER_POINTER(findVarInFrame(env, install("p")))[0];
n = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("n")))[0];
p = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("p")))[0];
np = n*p;

pt = (HESS_ERROR_SSE *) R_ExternalPtrAddr(findVarInFrame(env,
install("ptr")));
if (pt->set) error("hess_error_set: function called out of order");
pt = (HESS_ERROR_SSE *) R_ExternalPtrAddr(Rf_findVarInFrame(env,
Rf_install("ptr")));
if (pt->set) Rf_error("hess_error_set: function called out of order");

PROTECT(y = findVarInFrame(env, install("y"))); pc++;
PROTECT(x = findVarInFrame(env, install("x"))); pc++;
PROTECT(wy = findVarInFrame(env, install("wy"))); pc++;
PROTECT(WX = findVarInFrame(env, install("WX"))); pc++;
PROTECT(y = Rf_findVarInFrame(env, Rf_install("y"))); pc++;
PROTECT(x = Rf_findVarInFrame(env, Rf_install("x"))); pc++;
PROTECT(wy = Rf_findVarInFrame(env, Rf_install("wy"))); pc++;
PROTECT(WX = Rf_findVarInFrame(env, Rf_install("WX"))); pc++;

pt->y = R_Calloc(n, double);
pt->x = R_Calloc(np, double);
Expand Down Expand Up @@ -228,17 +228,17 @@ void hess_lag_set(SEXP env) {
SEXP y, x, wy;
int i, n, p, np, pc=0;

n = INTEGER_POINTER(findVarInFrame(env, install("n")))[0];
p = INTEGER_POINTER(findVarInFrame(env, install("m")))[0];
n = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("n")))[0];
p = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("m")))[0];
np = n*p;

pt = (HESS_LAG_SSE *) R_ExternalPtrAddr(findVarInFrame(env,
install("ptr")));
if (pt->set) error("hess_lag_set: function called out of order");
pt = (HESS_LAG_SSE *) R_ExternalPtrAddr(Rf_findVarInFrame(env,
Rf_install("ptr")));
if (pt->set) Rf_error("hess_lag_set: function called out of order");

PROTECT(y = findVarInFrame(env, install("y"))); pc++;
PROTECT(x = findVarInFrame(env, install("x"))); pc++;
PROTECT(wy = findVarInFrame(env, install("wy"))); pc++;
PROTECT(y = Rf_findVarInFrame(env, Rf_install("y"))); pc++;
PROTECT(x = Rf_findVarInFrame(env, Rf_install("x"))); pc++;
PROTECT(wy = Rf_findVarInFrame(env, Rf_install("wy"))); pc++;

pt->y = R_Calloc(n, double);
pt->x = R_Calloc(np, double);
Expand Down Expand Up @@ -299,16 +299,16 @@ SEXP R_ml_sse_env(SEXP env, SEXP coef) {
int pc=0, first_time;
OPT_ERROR_SSE *pt;

first_time = LOGICAL_POINTER(findVarInFrame(env, install("first_time")))[0];
first_time = LOGICAL_POINTER(Rf_findVarInFrame(env, Rf_install("first_time")))[0];
if (first_time) {
opt_error_set(env);
}

n = INTEGER_POINTER(findVarInFrame(env, install("n")))[0];
p = INTEGER_POINTER(findVarInFrame(env, install("p")))[0];
n = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("n")))[0];
p = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("p")))[0];
np = n*p;
pt = (OPT_ERROR_SSE *) R_ExternalPtrAddr(findVarInFrame(env,
install("ptr")));
pt = (OPT_ERROR_SSE *) R_ExternalPtrAddr(Rf_findVarInFrame(env,
Rf_install("ptr")));

for (i=0; i<n; i++) pt->yl[i] = pt->y[i];
for (i=0; i<np; i++) pt->xlq[i] = pt->x[i];
Expand All @@ -319,7 +319,7 @@ SEXP R_ml_sse_env(SEXP env, SEXP coef) {

F77_CALL(dqrdc2)(pt->xlq, &n, &n, &p, &tol, &k, pt->qraux, pt->jpvt,
pt->work);
if (p != k) warning("Q looses full rank");
if (p != k) Rf_warning("Q looses full rank");
/* k = 0;
F77_CALL(dqrdc)(pt->xlq, &n, &n, &p, pt->qraux, pt->jpvt, pt->work, &k);*/

Expand Down Expand Up @@ -356,16 +356,16 @@ SEXP R_ml1_sse_env(SEXP env, SEXP lambda, SEXP beta) {
int pc=0, first_time;
HESS_ERROR_SSE *pt;

first_time = LOGICAL_POINTER(findVarInFrame(env, install("first_time")))[0];
first_time = LOGICAL_POINTER(Rf_findVarInFrame(env, Rf_install("first_time")))[0];
if (first_time) {
hess_error_set(env);
}

n = INTEGER_POINTER(findVarInFrame(env, install("n")))[0];
p = INTEGER_POINTER(findVarInFrame(env, install("p")))[0];
n = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("n")))[0];
p = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("p")))[0];
np = n*p;
pt = (HESS_ERROR_SSE *) R_ExternalPtrAddr(findVarInFrame(env,
install("ptr")));
pt = (HESS_ERROR_SSE *) R_ExternalPtrAddr(Rf_findVarInFrame(env,
Rf_install("ptr")));

for (i=0; i<n; i++) pt->yl[i] = pt->y[i];
for (i=0; i<np; i++) pt->xl[i] = pt->x[i];
Expand Down Expand Up @@ -402,15 +402,15 @@ SEXP R_ml2_sse_env(SEXP env, SEXP rho, SEXP beta) {
int pc=0, first_time;
HESS_LAG_SSE *pt;

first_time = LOGICAL_POINTER(findVarInFrame(env, install("first_time")))[0];
first_time = LOGICAL_POINTER(Rf_findVarInFrame(env, Rf_install("first_time")))[0];
if (first_time) {
hess_lag_set(env);
}

n = INTEGER_POINTER(findVarInFrame(env, install("n")))[0];
p = INTEGER_POINTER(findVarInFrame(env, install("m")))[0];
pt = (HESS_LAG_SSE *) R_ExternalPtrAddr(findVarInFrame(env,
install("ptr")));
n = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("n")))[0];
p = INTEGER_POINTER(Rf_findVarInFrame(env, Rf_install("m")))[0];
pt = (HESS_LAG_SSE *) R_ExternalPtrAddr(Rf_findVarInFrame(env,
Rf_install("ptr")));

for (i=0; i<n; i++) pt->yl[i] = pt->y[i];
for (i=0; i<p; i++) pt->beta1[i] = NUMERIC_POINTER(beta)[i];
Expand Down
10 changes: 5 additions & 5 deletions src/mom_calc.c
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
/* Copyright 2010 by Roger S. Bivand. */
/* Copyright 2010-24 by Roger S. Bivand. */

#include "spatialreg.h"

Expand All @@ -7,10 +7,10 @@ static int c__1 = 1;
SEXP mom_calc_int2(SEXP is, SEXP m, SEXP nb, SEXP weights, SEXP card) {
SEXP Omega;
int hm = INTEGER_POINTER(m)[0];
int n = length(card);
int n = Rf_length(card);
double *eta, *zeta, *omega, sum, res;
int i, ii, j, k1, k2, k3;
int iis = length(is);
int iis = Rf_length(is);

omega = (double *) R_alloc((size_t) hm, sizeof(double));
eta = (double *) R_alloc((size_t) n, sizeof(double));
Expand Down Expand Up @@ -39,10 +39,10 @@ SEXP mom_calc_int2(SEXP is, SEXP m, SEXP nb, SEXP weights, SEXP card) {
}
res = F77_CALL(ddot)(&n, zeta, &c__1, eta, &c__1);
if (R_FINITE(res)) omega[(j-1)] += res;
else error("non-finite dot product %d, %d", i, j);
else Rf_error("non-finite dot product %d, %d", i, j);
res = F77_CALL(ddot)(&n, zeta, &c__1, zeta, &c__1);
if (R_FINITE(res)) omega[j] += res;
else error("non-finite dot product %d, %d", i, j);
else Rf_error("non-finite dot product %d, %d", i, j);
for (k1=0; k1<n; k1++) eta[k1] = zeta[k1];
}
}
Expand Down
5 changes: 4 additions & 1 deletion src/spatialreg.h
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,11 @@
/* Copyright 2019-2022 by Roger S. Bivand. */
/* Copyright 2019-2024 by Roger S. Bivand. */

#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>
Expand Down

0 comments on commit 31c17c7

Please sign in to comment.