[adegenet-commits] r850 - pkg/R

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

Author: jombart
Date: 2011-03-11 19:09:56 +0100 (Fri, 11 Mar 2011)
New Revision: 850

Modified:
   pkg/R/auxil.R
   pkg/R/glHandle.R
Log:
Added a few auxil graphic functions.


Modified: pkg/R/auxil.R
===================================================================
--- pkg/R/auxil.R	2011-03-10 16:42:42 UTC (rev 849)
+++ pkg/R/auxil.R	2011-03-11 18:09:56 UTC (rev 850)
@@ -140,3 +140,78 @@
 } # end checkType
 
 
+
+
+
+
+##########
+## transp
+##########
+## AUXIL FUNCTION TO USE TRANSPARENT COLORS
+transp <- function(col, alpha=.5){
+    res <- apply(col2rgb(col),2, function(c) rgb(c[1]/255, c[2]/255, c[3]/255, alpha))
+    return(res)
+}
+
+
+
+##########
+## corner
+##########
+## AUXIL FUNCTION TO ADD LETTER TO A PLOT
+corner <- function(text, posi="topleft",  inset=0.1, ...){
+    oxpd <- par("xpd")
+    on.exit(par(xpd=oxpd))
+    par(xpd=TRUE)
+    myUsr <- par("usr")
+    xrange <- myUsr[1:2]
+    yrange <- myUsr[3:4]
+    x.size <- abs(diff(xrange))
+    y.size <- abs(diff(yrange))
+    inset <- rep(inset, length=2)
+    x.inset <- inset[1]
+    y.inset <- inset[2]
+
+    if(length(grep("top", posi))==1){
+        y <- yrange[2] - y.size*y.inset
+    } else {
+        y <- yrange[1] + y.size*y.inset
+    }
+
+    if(length(grep("right", posi))==1){
+        x <- xrange[2] - x.size*x.inset
+    } else {
+        x <- xrange[1] + x.size*x.inset
+    }
+
+    text(x, y, lab=text, ...)
+}
+
+
+
+
+
+###########
+## num2col
+###########
+## translate numeric values into colors of a palette
+num2col <- function(x, col.pal=heat.colors, reverse=FALSE,
+                    x.min=min(x), x.max=max(x), na.col="green"){
+    if(any(is.na(x))) warning("NAs detected in x")
+    x[x < x.min] <- x.min
+    x[x > x.max] <- x.max
+    x <- x-x.min # min=0
+    x.max <- x.max-x.min # update x.max
+    x <- x/x.max # max=1
+    x <- round(x*100)
+    x[x<=0] <- 1
+    if(!reverse) {
+        pal <- col.pal(100)
+    } else {
+        pal <- rev(col.pal(100))
+    }
+
+    res <- pal[x]
+    res[is.na(res)] <- na.col
+    return(res)
+}

Modified: pkg/R/glHandle.R
===================================================================
--- pkg/R/glHandle.R	2011-03-10 16:42:42 UTC (rev 849)
+++ pkg/R/glHandle.R	2011-03-11 18:09:56 UTC (rev 850)
@@ -233,10 +233,18 @@
 
 
 
+##########
+## seploc
+##########
+setMethod("seploc", signature(x="genlight"), function(x, n.block, blockSize=NULL, random=FALSE){
+    ## HANDLE ARGUMENTS ##
+    ## blocksize
+    if(is.null(blockSize)){
+        
+    }
+})
 
 
-
-
 ###################
 ### TESTING
 ###################