[adegenet-commits] r1007 - misc pkg/R pkg/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 1 11:48:22 CEST 2012
Author: jombart
Date: 2012-06-01 11:48:22 +0200 (Fri, 01 Jun 2012)
New Revision: 1007
Added:
misc/seqTrack2.R
Modified:
pkg/R/auxil.R
pkg/man/auxil.Rd
Log:
Added function fac2col, a few palettes, and updated the doc.
Added: misc/seqTrack2.R
===================================================================
--- misc/seqTrack2.R (rev 0)
+++ misc/seqTrack2.R 2012-06-01 09:48:22 UTC (rev 1007)
@@ -0,0 +1,57 @@
+seqTrack2 <- function(x, x.names, x.dates, ...(){
+ ## CHECKS ##
+ if(!require(ape)) stop("package ape is required")
+
+ ## FIND NUMBER OF MUTATIONS / SEQUENCE LENGTH ##
+ L <- ifelse(is.matrix(x), ncol(x), length(x[[1]])) # haplo length
+ D <- as.matrix(dist.dna(x, model="raw")) * L # nb of mutations
+ N <- nrow(D)
+
+ ## AUXILLIARY FUNCTIONS ##
+ ## function generating infection durations
+ aug.infdur <- function(){
+
+ }
+
+ ## function generating infection dates
+
+ ## function moving nu1, nu2
+
+ ## function moving alpha_i
+
+ ## function moving pi
+
+
+ ## ESTIMATION ##
+ ## initialisation
+
+ ## run mcmc
+
+ ##
+
+}
+
+
+
+
+
+
+
+ ## NUCL <- c('a','t','g','c')
+ ## dist.nbmut <- function(a,b){
+ ## a[!a %in% NUCL] <- NA
+ ## b[!b %in% NUCL] <- NA
+ ## isNA <- is.na(a) | is.na(b)
+ ## a <- a[!isNA]
+ ## b <- b[!isNA]
+ ## return(sum(a!=b))
+ ## }
+
+ ## nbNuclCommon <- function(a,b){
+ ## NUCL <- c('a','t','g','c')
+ ## a[!a %in% NUCL] <- NA
+ ## b[!b %in% NUCL] <- NA
+ ## isNA <- is.na(a) | is.na(b)
+
+ ## return(sum(!isNA))
+ ## }
Modified: pkg/R/auxil.R
===================================================================
--- pkg/R/auxil.R 2012-05-28 17:58:34 UTC (rev 1006)
+++ pkg/R/auxil.R 2012-06-01 09:48:22 UTC (rev 1007)
@@ -215,3 +215,60 @@
res[is.na(res)] <- na.col
return(res)
}
+
+
+
+
+
+###########
+## fac2col
+###########
+## translate a factor into colors of a palette
+## colors are randomized based on the provided seed
+fac2col <- function(x, col.pal=funky, na.col="grey", seed=1){
+ ## get factors and levels
+ x <- factor(x)
+ lev <- levels(x)
+ nlev <- length(lev)
+
+ ## get colors corresponding to levels
+ set.seed(seed)
+ newseed <- round(runif(1,1,1e9))
+ on.exit(set.seed(newseed))
+ col <- sample(col.pal(nlev))
+
+ ## get output colors
+ res <- rep(na.col, length(x))
+ res[!is.na(x)] <- col[as.integer(x[!is.na(x)])]
+
+ ## return
+ return(res)
+}
+
+
+## pre-defined palettes ##
+## mono color
+bluepal <- colorRampPalette(c("white","blue"))
+redpal <- colorRampPalette(c("white","green"))
+greenpal <- colorRampPalette(c("white","red"))
+
+## bi-color
+flame <- colorRampPalette(c("gold","red"))
+
+## tri-color
+seasun <- colorRampPalette(c("blue","gold","red"))
+lightseasun <- colorRampPalette(c("deepskyblue2","gold","red1"))
+deepseasun <- colorRampPalette(c("blue2","gold","red2"))
+
+## psychedelic
+funky <- colorRampPalette(c("grey30","blue","green3","gold","orange","red","brown4","purple"))
+
+
+
+##
+## example:
+##
+## x <- c(rnorm(10), rnorm(15,3), rnorm(5,10))
+## f <- rep(letters[1:3], c(10,15,5))
+##
+##
Modified: pkg/man/auxil.Rd
===================================================================
--- pkg/man/auxil.Rd 2012-05-28 17:58:34 UTC (rev 1006)
+++ pkg/man/auxil.Rd 2012-06-01 09:48:22 UTC (rev 1007)
@@ -9,23 +9,50 @@
\alias{.readExt}
\alias{corner}
\alias{num2col}
+\alias{fac2col}
\alias{transp}
-\title{ Utilities functions for adegenet}
+\alias{bluepal}
+\alias{redpal}
+\alias{greenpal}
+\alias{flame}
+\alias{seasun}
+\alias{lightseasun}
+\alias{deepseasun}
+\alias{funky}
+\title{ Auxiliary functions for adegenet}
\description{
+ adegenet implements a number of auxiliary procedures that might be of
+ interest for users. These include graphical tools to translate
+ variables (numeric or factors) onto a color scale, adding transparency
+ to existing colors, pre-defined color palettes, extra functions to
+ access documentation, and low-level treatment of character vectors.
+
These functions are mostly auxiliary procedures used internally in
- adegenet, with the exception of \code{adegenetWeb}, which opens the
+ adegenet, with the exception of, which opens the
adegenet website in the default navigator.\cr
- The other functions are:\cr
+ These items include:\cr
+ - \code{adegenetWeb}: opens the adegenet website in a web navigator
+ - \code{num2col}: translates a numeric vector into colors. \cr
+ - \code{fac2col}: translates a numeric vector into colors. \cr
+ - \code{transp}: adds transparency to a vector of colors. Note that
+ transparent colors are not supported on some graphical devices.\cr
+ - \code{corner}: adds text to a corner of a figure. \cr
- \code{checkType}: checks the type of markers being used in a
function and issues an error if appropriate.\cr
- \code{.rmspaces}: remove peripheric spaces in a character string. \cr
- \code{.genlab}: generate labels in a correct alphanumeric ordering. \cr
- \code{.readExt}: read the extension of a given file. \cr
- - \code{corner}: adds text to a corner of a figure. \cr
- - \code{num2col}: translates a numeric vector into colors. \cr
- - \code{transp}: adds transparency to a vector of colors. Note that
- transparent colors are not supported on some graphical devices.\cr
+
+ Color palettes include:
+ - \code{bluepal}: white->blue
+ - \code{redpal}: white->red
+ - \code{greenpal}: white->green
+ - \code{flame}: gold->red
+ - \code{seasun}: blue->gold->red
+ - \code{lightseasun}: blue->gold->red (light variant)
+ - \code{deepseasun}: blue->gold->red (deep variant)
+ - \code{funky}: many colors
}
\usage{
adegenetWeb()
@@ -33,6 +60,7 @@
corner(text, posi="topleft", inset=0.1, \dots)
num2col(x, col.pal=heat.colors, reverse=FALSE,
x.min=min(x), x.max=max(x), na.col="green")
+fac2col(x, col.pal=funky, na.col="grey", seed=1)
transp(col, alpha=.5)
}
\arguments{
@@ -44,13 +72,16 @@
\item{inset}{a vector of two numeric values (recycled if needed)
indicating the inset, as a fraction of the plotting region.}
\item{\dots}{further arguments to be passed to \code{\link{text}}}
- \item{x}{a numeric vector}
+ \item{x}{a numeric vector (for \code{num2col}) or a vector converted
+ to a factor (for \code{fac2col}).}
\item{col.pal}{a function generating colors according to a given palette.}
\item{reverse}{a logical stating whether the palette should be
inverted (TRUE), or not (FALSE, default).}
\item{x.min}{the minimal value from which to start the color scale}
\item{x.max}{the maximal value from which to start the color scale}
\item{na.col}{the color to be used for missing values (NAs)}
+ \item{seed}{a seed for R's random number generated, used to fix the
+ random permutation of colors in the palette used.}
\item{col}{a vector of colors}
\item{alpha}{a numeric value between 0 and 1 representing the alpha
coefficient; 0: total transparency; 1: no transparency.}
@@ -74,7 +105,18 @@
## numeric values to color using num2col
plot(1:100, col=num2col(1:100), pch=20, cex=4)
-plot(1:100, col=num2col(1:100, col.pal=rainbow), pch=20, cex=4)
+plot(1:100, col=num2col(1:100, col.pal=bluepal), pch=20, cex=4)
+plot(1:100, col=num2col(1:100, col.pal=flame), pch=20, cex=4)
+plot(1:100, col=num2col(1:100, col.pal=seasun), pch=20, cex=4)
+plot(1:100, col=num2col(1:100, col.pal=seasun,rev=TRUE), pch=20, cex=4)
+## factor as colors using fac2col
+dat <- cbind(c(rnorm(50,8), rnorm(100), rnorm(150,3),
+rnorm(50,10)),c(rnorm(50,1),rnorm(100),rnorm(150,3), rnorm(50,5)))
+fac <- rep(letters[1:4], c(50,100,150,50))
+plot(dat, col=fac2col(fac), pch=19, cex=4)
+plot(dat, col=transp(fac2col(fac)), pch=19, cex=4)
+plot(dat, col=transp(fac2col(fac,seed=2)), pch=19, cex=4)
+
}
\keyword{manip}
\ No newline at end of file
More information about the adegenet-commits
mailing list