[Analogue-commits] r293 - pkg/src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jan 3 13:06:00 CET 2013


Author: gsimpson
Date: 2013-01-03 13:06:00 +0100 (Thu, 03 Jan 2013)
New Revision: 293

Modified:
   pkg/src/distxy.c
Log:
sync up working copy of distxy

Modified: pkg/src/distxy.c
===================================================================
--- pkg/src/distxy.c	2013-01-03 12:04:29 UTC (rev 292)
+++ pkg/src/distxy.c	2013-01-03 12:06:00 UTC (rev 293)
@@ -5,7 +5,7 @@
  * Based on code from vegdist by Jari Oksanen:
  *
  * (C) 2001-2009, Jari Oksanen
- * (C) 2009-2010 Gavin L. Simpson
+ * (C) 2009-2012 Gavin L. Simpson
  *
  * Licene: GPL 2
  */
@@ -561,6 +561,7 @@
     if (count == 0) return NA_REAL;
     return 1 - (dist / wsum);
 }
+
 /*
  * Gower's coefficient for mixed data
  *
@@ -581,81 +582,84 @@
 		int nc, int i1, int i2, int *vtype,
 		double *weights, double *R, double wsum)
 {
-	double dist, dev;
-	int count, j;
-	
-	count = 0;
-	dist = 0.0;
-	wsum = 0.0;
-	//curweights = weights; /* current weights */
-	
-	for (j=0; j<nc; j++) {
-		if (R_FINITE(x[i1]) && R_FINITE(y[i2])) {
-			if(vtype[j] == 1) { // Symmetric binary
-				dev = (x[i1] == y[i2]) ? 1 : 0;
-				dist += dev * weights[j];
-			}
-			if(vtype[j] == 2) { // Asymmetric binary
-				if((x[i1] != 0) || (y[i2] != 0)) {
-					// both x and y not zero for this variables
-					dev = (x[i1] == y[i2]) ? 1 : 0;
-					dist += dev * weights[j];
-				} else {
-					/* set jth current weight to zero and do not
-					   increment dist as ignoring double zero
-					   We actually subtract the weight as it gets added
-					   later on.
-					*/
-					wsum -= weights[j];
-				}
-			}
-			if(vtype[j] == 3) { // Nominal
-				dev = (x[i1] == y[i2]) ? 1 : 0;
-				dist += dev * weights[j];
-			}
-			if(vtype[j] == 4) { // Ordinal
-				/* ordinal data current not handled 
-				 * so don't call this yet
-				 */
-				/* switch(ord) {
-				case 1: { // classic gower as per nominal
-					dev = (x[i1] == y[i2]) ? 1 : 0;
-					dist += dev * weights[j];
-					break;
-				}
-				case 2: { // podanis rank version
-					if(x[i1] == y[i2]) {
-						dev = 1;
-					} else {
-						dev = (fabs(x[i1] - y[i2])) / 
-							(R[j] - (tmax - 1)/2 - (tmin - 1)/2);
-					}
-					break;
-				}
-				case 3: { // podanis metric version treat as Quantitative??
-					dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
-					dist += dev * weights[j];
-					break;
-				}
-				default: {
-					dist += 0;
-					break;
-				}
-				}*/
-			}
-			if(vtype[j] == 5) { // Quantitative
-				dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
-				dist += dev * weights[j];
-			}
-			count++;
-			// only summing weights for non-NA comparisons
-			wsum += weights[j];
+    double dist, dev;
+    int count, j;
+    
+    count = 0;
+    dist = 0.0;
+    wsum = 0.0;
+    //curweights = weights; /* current weights */
+    
+    for (j=0; j<nc; j++) {
+	if (R_FINITE(x[i1]) && R_FINITE(y[i2])) {
+	    if(vtype[j] == 1) { // Symmetric binary
+		dev = (x[i1] == y[i2]) ? 1 : 0;
+		dist += dev * weights[j];
+	    }
+	    if(vtype[j] == 2) { // Asymmetric binary
+		if((x[i1] != 0) || (y[i2] != 0)) {
+		    // both x and y not zero for this variables
+		    dev = (x[i1] == y[i2]) ? 1 : 0;
+		    dist += dev * weights[j];
+		} else {
+		    /* set jth current weight to zero and do not
+		       increment dist as ignoring double zero
+		       We actually subtract the weight as it gets added
+		       later on.
+		    */
+		    wsum -= weights[j];
 		}
-		i1 += nr1;
-		i2 += nr2;
+	    }
+	    if(vtype[j] == 3) { // Nominal
+		dev = (x[i1] == y[i2]) ? 1 : 0;
+		dist += dev * weights[j];
+	    }
+	    if(vtype[j] == 4) { // Ordinal
+		dev = (x[i1] == y[i2]) ? 1 : 0;
+		dist += dev * weights[j];
+		break;
+		/* ordinal data current not handled 
+		 * so don't call this yet
+		 */
+		/* switch(ord) {
+		   case 1: { // classic gower as per nominal
+		   dev = (x[i1] == y[i2]) ? 1 : 0;
+		   dist += dev * weights[j];
+		   break;
+		   }
+		   case 2: { // podanis rank version
+		   if(x[i1] == y[i2]) {
+		   dev = 1;
+		   } else {
+		   dev = (fabs(x[i1] - y[i2])) / 
+		   (R[j] - (tmax - 1)/2 - (tmin - 1)/2);
+		   }
+		   break;
+		   }
+		   case 3: { // podanis metric version treat as Quantitative??
+		   dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
+		   dist += dev * weights[j];
+		   break;
+		   }
+		   default: {
+		   dist += 0;
+		   break;
+		   }
+		   }*/
+	    }
+	    if(vtype[j] == 5) { // Quantitative
+		dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
+		dist += dev * weights[j];
+	    }
+	    count++;
+	    // only summing weights for non-NA comparisons
+	    wsum += weights[j];
 	}
-	if (count == 0) return NA_REAL;
-	return 1 - (dist / wsum);
+	i1 += nr1;
+	i2 += nr2;
+    }
+    if (count == 0) return NA_REAL;
+    return 1 - (dist / wsum);
 }
 
 double xy_calcTI(double *x, double *y, int nr1, int nr2, int nc, int i1, int i2)
@@ -704,21 +708,21 @@
 	      int *nc, double *d, int *vtype, double *weights, 
 	      double *R)
 {
-	int i, j, k, ij;
-	double wsum;
-	
-	wsum = 0.0;
-	
-	ij = 0;
-	
-	for(k=0; k <*nc; k++) {
-		wsum += weights[k];
+    int i, j, k, ij;
+    double wsum;
+    
+    wsum = 0.0;
+    
+    ij = 0;
+    
+    for(k=0; k <*nc; k++) {
+	wsum += weights[k];
+    }
+    
+    for(j=0; j < *nr1; j++) {
+	for(i=0; i < *nr2; i++) {
+	    d[ij++] = xy_MIXED(x, y, *nr1, *nr2, *nc, j, i,
+			       vtype, weights, R, wsum);
 	}
-	
-	for(j=0; j < *nr1; j++) {
-		for(i=0; i < *nr2; i++) {
-			d[ij++] = xy_MIXED(x, y, *nr1, *nr2, *nc, j, i,
-					   vtype, weights, R, wsum);
-		}
-	}
+    }
 }



More information about the Analogue-commits mailing list