[adegenet-commits] r801 - in pkg: R src

[noreply at r-forge.r-project.org]

Author: jombart
Date: 2011-02-09 20:26:02 +0100 (Wed, 09 Feb 2011)
New Revision: 801

Modified:
   pkg/R/glFunctions.R
   pkg/src/GLfunctions.c
   pkg/src/snpbin.c
   pkg/src/snpbin.h
Log:
Now GLdotProd can use absolute or relative frequencies.
Problem is it no longer works. have to check if casting of arrays is valid.


Modified: pkg/R/glFunctions.R
===================================================================
--- pkg/R/glFunctions.R	2011-02-09 13:32:37 UTC (rev 800)
+++ pkg/R/glFunctions.R	2011-02-09 19:26:02 UTC (rev 801)
@@ -151,18 +151,18 @@
 ## computes all pairs of dot products
 ## between centred/scaled vectors
 ## of SNPs
-glDotProd <- function(x, center=FALSE, scale=FALSE){
+glDotProd <- function(x, center=FALSE, scale=FALSE, alleleAsUnit=FALSE){
     if(!inherits(x, "genlight")) stop("x is not a genlight object")
 
     ## GET INPUTS TO C PROCEDURE ##
     if(center){
-        mu <- glMean(x,alleleAsUnit=FALSE)
+        mu <- glMean(x,alleleAsUnit=alleleAsUnit)
     } else {
         mu <- rep(0, nLoc(x))
     }
 
     if(scale){
-        s <- sqrt(glVar(x,alleleAsUnit=FALSE))
+        s <- sqrt(glVar(x,alleleAsUnit=alleleAsUnit))
         if(any(s<1e-10)) {
             warning("Null variances have been detected; corresponding alleles won't be standardized.")
         }
@@ -178,7 +178,8 @@
     resSize <- lowerTriSize + nInd(x)
 
     ## CALL C FUNCTION ##
-    temp <- .C("GLdotProd", vecbyte, nbVec, length(x at gen[[1]]@snp[[1]]), nbNa, naPosi, nInd(x), nLoc(x), ploidy(x), as.double(mu), as.double(s), double(resSize), PACKAGE="adegenet")[[11]]
+    temp <- .C("GLdotProd", vecbyte, nbVec, length(x at gen[[1]]@snp[[1]]), nbNa, naPosi, nInd(x), nLoc(x), ploidy(x),
+               as.double(mu), as.double(s), as.integer(!alleleAsUnit), double(resSize), PACKAGE="adegenet")[[12]]
 
     res <- temp[1:lowerTriSize]
     attr(res,"Size") <- nInd(x)

Modified: pkg/src/GLfunctions.c
===================================================================
--- pkg/src/GLfunctions.c	2011-02-09 13:32:37 UTC (rev 800)
+++ pkg/src/GLfunctions.c	2011-02-09 19:26:02 UTC (rev 801)
@@ -20,7 +20,7 @@
 /* Function to compute all dot products between individuals */
 /* centring and scaling is always used */
 /* but need to pass vectors of 0 and 1*/
-void GLdotProd(unsigned char *gen, int *nbvecperind, int *byteveclength, int *nbnaperind, int *naposi, int *nind, int *nloc, int *ploidy, double *mean, double *sd, double *res){
+void GLdotProd(unsigned char *gen, int *nbvecperind, int *byteveclength, int *nbnaperind, int *naposi, int *nind, int *nloc, int *ploidy, double *mean, double *sd, bool *freq, double *res){
 	struct genlightC dat;
 	int i, j, k=0;
 
@@ -37,7 +37,7 @@
 	for(i=0; i< (*nind-1); i++){
 		for(j=i+1; j< *nind; j++){
 			/* printf("\n == pair %i-%i ==\n", i+1,j+1); */
-			res[k] = snpbin_dotprod(&dat.x[i], &dat.x[j], mean, sd);
+			res[k] = snpbin_dotprod(&dat.x[i], &dat.x[j], mean, sd, freq);
 			++k;
 		}
 	}
@@ -45,7 +45,7 @@
 	/* add the diagonal to the end of the array */
 	for(i=0; i< *nind; i++){
 		/* printf("\n == pair %i-%i == \n", i+1,i+1); */
-		res[k] = snpbin_dotprod(&dat.x[i], &dat.x[i], mean, sd);
+		res[k] = snpbin_dotprod(&dat.x[i], &dat.x[i], mean, sd, freq);
 		++k;
 	}
 }

Modified: pkg/src/snpbin.c
===================================================================
--- pkg/src/snpbin.c	2011-02-09 13:32:37 UTC (rev 800)
+++ pkg/src/snpbin.c	2011-02-09 19:26:02 UTC (rev 801)
@@ -322,18 +322,27 @@
 /* Function to compute one dot products between two individuals */
 /* centring and scaling is always used */
 /* but need to pass vectors of 0 and 1*/
-double snpbin_dotprod(struct snpbin *x, struct snpbin *y, double *mean, double *sd){
+double snpbin_dotprod(struct snpbin *x, struct snpbin *y, double *mean, double *sd, bool *freq){
 	/* define variables, allocate memory */
-	int P = nLoc(x), i, *vecx, *vecy;
-	short int isna;
+	int P = nLoc(x), i;
+	short isna;
 	double res = 0.0;
-	vecx = (int *) calloc(P, sizeof(int));
-	vecy = (int *) calloc(P, sizeof(int));
+	double *vecx, *vecy;
+	vecx = (double *) calloc(P, sizeof(double));
+	vecy = (double *) calloc(P, sizeof(double));
 
-	/* conversion to integers */
-	snpbin2intvec(x, vecx);
-	snpbin2intvec(y, vecy);
 
+	/* conversion to integers or frequencies*/
+	if(*freq){
+		snpbin2freq(x, vecx);
+		snpbin2freq(y, vecy);
+	} else {
+		snpbin2intvec(x, (int *) vecx);
+		snpbin2intvec(y, (int *) vecy);
+	}
+
+
+
 	/* printf("\nvector x: \n"); */
 	/* for(i=0;i<P;i++){ */
 	/* 	printf("%i", vecx[i]); */

Modified: pkg/src/snpbin.h
===================================================================
--- pkg/src/snpbin.h	2011-02-09 13:32:37 UTC (rev 800)
+++ pkg/src/snpbin.h	2011-02-09 19:26:02 UTC (rev 801)
@@ -78,7 +78,7 @@
 void snpbin2freq(struct snpbin *x, double *out);
 void printsnpbin(struct snpbin *x);
 short int snpbin_isna(struct snpbin *x, int i);
-double snpbin_dotprod(struct snpbin *x, struct snpbin *y, double *mean, double *sd);
+double snpbin_dotprod(struct snpbin *x, struct snpbin *y, double *mean, double *sd, bool *freq);
 struct genlightC genlightTogenlightC(unsigned char *gen, int *nbvecperind, int *byteveclength, int *nbnaperind, int *naposi, int *nind, int *nloc, int *ploidy);