static double R_dist_binary(double *x, int nr, int nc, int i1, int i2)
{
int total, count, dist;
int j;
total = 0;
count = 0;
dist = 0;
for(j = 0 ; j < nc ; j++) {
if(both_non_NA(x[i1], x[i2])) {
if(!both_FINITE(x[i1], x[i2])) {
warning(_("treating non-finite values as NA"));
}
else {
if(x[i1] || x[i2]) {
count++;
if( ! (x[i1] && x[i2]) ) dist++;
}
total++;
}
}
i1 += nr;
i2 += nr;
}
if(total == 0) return NA_REAL;
if(count == 0) return 0;
return (double) dist / count;
}
static double cosine(double *x, double *y, int nx, int ny, int nc)
{
double prod, xy, xx, yy;
int count;
int j;
xy = xx = yy = 0;
count = 0;
for (j = 0; j < nc; j++) {
if (both_non_NA(*x, *y)) {
prod = *x * *y;
if (!ISNAN(prod)) {
xy += prod;
xx += *x * *x;
yy += *y * *y;
count++;
}
}
x += nx;
y += ny;
}
if (count == 0) return NA_REAL;
if (!R_FINITE(xy)) return NA_REAL;
xy /= sqrt(xx) * sqrt(yy);
if (ISNAN(xy))
if (xx < DBL_MIN && yy < DBL_MIN)
return 1;
else
if (xx < DBL_MIN || yy < DBL_MIN)
return 0;
else
return NA_REAL;
return xy;
}
static double canberra(double *x, double *y, int nx, int ny, int nc)
{
double dev, dist, sum, diff;
int count, j;
count = 0;
dist = 0;
for (j = 0 ;j < nc; j++) {
if (both_non_NA(*x, *y)) {
sum = fabs(*x + *y);
diff = fabs(*x - *y);
if (sum > DBL_MIN || diff > DBL_MIN) {
dev = diff/sum;
if (!ISNAN(dev) ||
(!R_FINITE(diff) && diff == sum &&
/* use Inf = lim x -> oo */ (dev = 1.))) {
dist += dev;
count++;
}
}
}
x += nx;
y += ny;
}
if (count == 0) return NA_REAL;
if (count != nc) dist /= ((double)count/nc);
return dist;
}
static double ebinary(double *x, double *y, int nx, int ny, int nc)
{
double dev, prod, dist, xy;
int count;
int j;
dist = xy = 0;
count = 0;
for (j = 0; j < nc; j++) {
if (both_non_NA(*x, *y)) {
dev = (*x - *y);
prod = *x * *y;
if (!ISNAN(dev) && !ISNAN(prod)) {
dist += dev * dev;
xy += prod;
count++;
}
}
x += nx;
y += ny;
}
if (count == 0) return NA_REAL;
if (!R_FINITE(xy)) return NA_REAL;
dist = dist / dfp + xy;
xy /= dist;
if (ISNAN(xy))
if (dist < DBL_MIN)
return 1;
else
return NA_REAL;
return xy;
}
double minkowski(t_index i1, t_index i2) const {
double dev, dist;
int count, j;
count= 0;
dist = 0;
double * p1 = x+i1*nc;
double * p2 = x+i2*nc;
for(j = 0 ; j < nc ; ++j) {
if(both_non_NA(*p1, *p2)) {
dev = (*p1 - *p2);
if(!ISNAN(dev)) {
dist += R_pow(fabs(dev), p);
++count;
}
}
++p1;
++p2;
}
if(count == 0) return NA_REAL;
if(count != nc) dist /= (static_cast<double>(count)/static_cast<double>(nc));
//return R_pow(dist, 1.0/p);
// raise to the (1/p)-th power later
return dist;
}
static double R_canberra(double *x, int nr, int nc, int i1, int i2)
{
double dev, dist, sum, diff;
int count, j;
count = 0;
dist = 0;
for(j = 0 ; j < nc ; j++) {
if(both_non_NA(x[i1], x[i2])) {
sum = fabs(x[i1] + x[i2]);
diff = fabs(x[i1] - x[i2]);
if (sum > DBL_MIN || diff > DBL_MIN) {
dev = diff/sum;
if(!ISNAN(dev) ||
(!R_FINITE(diff) && diff == sum &&
/* use Inf = lim x -> oo */ (dev = 1.))) {
dist += dev;
count++;
}
}
}
i1 += nr;
i2 += nr;
}
if(count == 0) return NA_REAL;
if(count != nc) dist /= ((double)count/nc);
return dist;
}
static double matching(double *x, double *y, int nx, int ny, int nc)
{
int total, count;
int j;
total = count = 0;
for (j = 0; j < nc; j++) {
if (both_non_NA(*x, *y)) {
if (*x != *y)
count++;
total++;
}
x += nx;
y += ny;
}
if (total == 0) return NA_REAL;
if (count == 0) return 0;
return (double) count / total;
}
static double R_manhattan(double *x, int nr, int nc, int i1, int i2)
{
double dev, dist;
int count, j;
count = 0;
dist = 0;
for(j = 0 ; j < nc ; j++) {
if(both_non_NA(x[i1], x[i2])) {
dev = fabs(x[i1] - x[i2]);
if(!ISNAN(dev)) {
dist += dev;
count++;
}
}
i1 += nr;
i2 += nr;
}
if(count == 0) return NA_REAL;
if(count != nc) dist /= ((double)count/nc);
return dist;
}
static double R_maximum(double *x, int nr, int nc, int i1, int i2)
{
double dev, dist;
int count, j;
count = 0;
dist = -DBL_MAX;
for(j = 0 ; j < nc ; j++) {
if(both_non_NA(x[i1], x[i2])) {
dev = fabs(x[i1] - x[i2]);
if(!ISNAN(dev)) {
if(dev > dist)
dist = dev;
count++;
}
}
i1 += nr;
i2 += nr;
}
if(count == 0) return NA_REAL;
return dist;
}
static double R_minkowski(double *x, int nr, int nc, int i1, int i2, double p)
{
double dev, dist;
int count, j;
count= 0;
dist = 0;
for(j = 0 ; j < nc ; j++) {
if(both_non_NA(x[i1], x[i2])) {
dev = (x[i1] - x[i2]);
if(!ISNAN(dev)) {
dist += R_pow(fabs(dev), p);
count++;
}
}
i1 += nr;
i2 += nr;
}
if(count == 0) return NA_REAL;
if(count != nc) dist /= ((double)count/nc);
return R_pow(dist, 1.0/p);
}
static double manhattan(double *x, double *y, int nx, int ny, int nc)
{
double dev, dist;
int count, j;
count = 0;
dist = 0;
for (j = 0; j < nc; j++) {
if (both_non_NA(*x, *y)) {
dev = fabs(*x - *y);
if (!ISNAN(dev)) {
dist += dev;
count++;
}
}
x += nx;
y += ny;
}
if (count == 0) return NA_REAL;
if (count != nc) dist /= ((double)count/nc);
return dist;
}
double dist_binary(t_index i1, t_index i2) const {
int total, count, dist;
int j;
total = 0;
count = 0;
dist = 0;
double * p1 = x+i1*nc;
double * p2 = x+i2*nc;
for(j = 0 ; j < nc ; ++j) {
if(both_non_NA(*p1, *p2)) {
if(!both_FINITE(*p1, *p2)) {
// warning(_("treating non-finite values as NA"));
}
else {
#if HAVE_DIAGNOSTIC
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wfloat-equal"
#endif
if(*p1 || *p2) {
++count;
if( ! (*p1 && *p2) ) {
++dist;
}
}
#if HAVE_DIAGNOSTIC
#pragma GCC diagnostic pop
#endif
++total;
}
}
++p1;
++p2;
}
if(total == 0) return NA_REAL;
if(count == 0) return 0;
return static_cast<double>(dist) / static_cast<double>(count);
}
static double minkowski(double *x, double *y, int nx, int ny, int nc)
{
double dev, dist;
int count, j;
count = 0;
dist = 0;
for (j = 0; j < nc; j++) {
if (both_non_NA(*x, *y)) {
dev = (*x - *y);
if (!ISNAN(dev)) {
dist += R_pow(fabs(dev), dfp);
count++;
}
}
x += nx;
y += ny;
}
if (count == 0) return NA_REAL;
if (count != nc) dist /= ((double)count/nc);
return R_pow(dist, 1.0/dfp);
}
// FIXME why treat not both finite as NA?
static double binary(double *x, double *y, int nx, int ny, int nc)
{
int total, count, dist;
int j;
total = count = dist = 0;
for (j = 0; j < nc; j++) {
if (both_non_NA(*x, *y)) {
if (*x || *y) {
count++;
if (!(*x && *y))
dist++;
}
total++;
}
x += nx;
y += ny;
}
if (total == 0) return NA_REAL;
if (count == 0) return 0;
return (double) dist / count;
}
double maximum(t_index i1, t_index i2) const {
double dev, dist;
int count, j;
count = 0;
dist = -DBL_MAX;
double * p1 = x+i1*nc;
double * p2 = x+i2*nc;
for(j = 0 ; j < nc ; ++j) {
if(both_non_NA(*p1, *p2)) {
dev = fabs(*p1 - *p2);
if(!ISNAN(dev)) {
if(dev > dist)
dist = dev;
++count;
}
}
++p1;
++p2;
}
if(count == 0) return NA_REAL;
return dist;
}
double manhattan(t_index i1, t_index i2) const {
double dev, dist;
int count, j;
count = 0;
dist = 0;
double * p1 = x+i1*nc;
double * p2 = x+i2*nc;
for(j = 0 ; j < nc ; ++j) {
if(both_non_NA(*p1, *p2)) {
dev = fabs(*p1 - *p2);
if(!ISNAN(dev)) {
dist += dev;
++count;
}
}
++p1;
++p2;
}
if(count == 0) return NA_REAL;
if(count != nc) dist /= (static_cast<double>(count)/static_cast<double>(nc));
return dist;
}
static double mutual(double *x, double *y, int nx, int ny, int nc)
{
double dist;
int total, count, cx, cy, j;
total = count = cx = cy = 0;
for (j = 0; j < nc; j++) {
if (both_non_NA(*x, *y)) {
if (*x && *y)
count++;
cx += (*x && 1);
cy += (*y && 1);
total++;
}
x += nx;
y += ny;
}
if (total == 0) return NA_REAL;
if (cx == 0 || cy == 0 || cx == total || cy == total) return 0;
dist = 0;
if (count > 0)
dist += (double) count / total * log((double) count / cx / cy * total);
cy = total - cy;
count = cx - count;
if (count > 0)
dist += (double) count / total * log((double) count / cx / cy * total);
cx = total - cx;
count = cy - count;
if (count > 0)
dist += (double) count / total * log((double) count / cx / cy * total);
cy = total - cy;
count = cx - count;
if (count > 0)
dist += (double) count / total * log((double) count / cx / cy * total);
if (total != nc) dist /= ((double)total/nc);
return dist ;
}
double sqeuclidean(t_index const i1, t_index const i2) const {
double dev, dist;
int count, j;
count = 0;
dist = 0;
double * p1 = x+i1*nc;
double * p2 = x+i2*nc;
for(j = 0 ; j < nc ; ++j) {
if(both_non_NA(*p1, *p2)) {
dev = (*p1 - *p2);
if(!ISNAN(dev)) {
dist += dev * dev;
++count;
}
}
++p1;
++p2;
}
if(count == 0) return NA_REAL;
if(count != nc) dist /= (static_cast<double>(count)/static_cast<double>(nc));
//return sqrt(dist);
// we take the square root later
if (check_NaN) {
#if HAVE_DIAGNOSTIC
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wfloat-equal"
#endif
if (fc_isnan(dist))
throw(nan_error());
#if HAVE_DIAGNOSTIC
#pragma GCC diagnostic pop
#endif
}
return dist;
}
double canberra(t_index i1, t_index i2) const {
double dev, dist, sum, diff;
int count, j;
count = 0;
dist = 0;
double * p1 = x+i1*nc;
double * p2 = x+i2*nc;
for(j = 0 ; j < nc ; ++j) {
if(both_non_NA(*p1, *p2)) {
sum = fabs(*p1 + *p2);
diff = fabs(*p1 - *p2);
if (sum > DBL_MIN || diff > DBL_MIN) {
dev = diff/sum;
#if HAVE_DIAGNOSTIC
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wfloat-equal"
#endif
if(!ISNAN(dev) ||
(!R_FINITE(diff) && diff == sum &&
/* use Inf = lim x -> oo */ (dev = 1.))) {
dist += dev;
++count;
}
#if HAVE_DIAGNOSTIC
#pragma GCC diagnostic pop
#endif
}
}
++p1;
++p2;
}
if(count == 0) return NA_REAL;
if(count != nc) dist /= (static_cast<double>(count)/static_cast<double>(nc));
return dist;
}
