https://github.com/cran/spatstat
Tip revision: 4c0b5d0bfa215ca4a7c76ed9cac3b982da128bba authored by Adrian Baddeley on 11 November 2011, 11:19:29 UTC
version 1.24-2
version 1.24-2
Tip revision: 4c0b5d0
hardcore.c
#include <R.h>
#include <math.h>
#include "methas.h"
#include "dist2.h"
/* Conditional intensity computation for Hard core process */
/* Storage of parameters and precomputed/auxiliary data */
typedef struct Hardcore {
double h; /* hard core distance */
double h2;
double *period;
int per;
} Hardcore;
/* initialiser function */
Cdata *hardcoreinit(state, model, algo)
State state;
Model model;
Algor algo;
{
Hardcore *hardcore;
double h;
hardcore = (Hardcore *) R_alloc(1, sizeof(Hardcore));
/* Interpret model parameters*/
hardcore->h = h = model.ipar[0];
hardcore->h2 = h * h;
hardcore->period = model.period;
/* periodic boundary conditions? */
hardcore->per = (model.period[0] > 0.0);
return((Cdata *) hardcore);
}
/* conditional intensity evaluator */
double hardcorecif(prop, state, cdata)
Propo prop;
State state;
Cdata *cdata;
{
int npts, ix, ixp1, j;
double *x, *y;
double u, v;
double d2, h2, a;
Hardcore *hardcore;
hardcore = (Hardcore *) cdata;
h2 = hardcore->h2;
u = prop.u;
v = prop.v;
ix = prop.ix;
x = state.x;
y = state.y;
npts = state.npts;
if(npts == 0)
return((double) 1.0);
ixp1 = ix+1;
/* If ix = NONE = -1, then ixp1 = 0 is correct */
if(hardcore->per) { /* periodic distance */
if(ix > 0) {
for(j=0; j < ix; j++) {
d2 = dist2(u,v,x[j],y[j],hardcore->period);
if(d2 < h2) return((double) 0.0);
}
}
if(ixp1 < npts) {
for(j=ixp1; j<npts; j++) {
d2 = dist2(u,v,x[j],y[j],hardcore->period);
if(d2 < h2) return((double) 0.0);
}
}
}
else { /* Euclidean distance */
if(ix > 0) {
for(j=0; j < ix; j++) {
a = h2 - pow(u - x[j], 2);
if(a > 0) {
a -= pow(v - y[j], 2);
if(a > 0)
return((double) 0.0);
}
}
}
if(ixp1 < npts) {
for(j=ixp1; j<npts; j++) {
a = h2 - pow(u - x[j], 2);
if(a > 0) {
a -= pow(v - y[j], 2);
if(a > 0)
return((double) 0.0);
}
}
}
}
return ((double) 1.0);
}
Cifns HardcoreCifns = { &hardcoreinit, &hardcorecif, (updafunptr) NULL, FALSE};