[adegenet-commits] r1052 - in pkg: . R

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

Author: jombart
Date: 2012-11-15 16:50:59 +0100 (Thu, 15 Nov 2012)
New Revision: 1052

Modified:
   pkg/DESCRIPTION
   pkg/R/sequences.R
Log:
Ape is now in dependencies.
Still working on graphMutations.


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2012-11-13 10:43:45 UTC (rev 1051)
+++ pkg/DESCRIPTION	2012-11-15 15:50:59 UTC (rev 1052)
@@ -7,8 +7,8 @@
 Contributed datasets from: Katayoun Moazami-Goudarzi, Denis Laloe,
   Dominique Pontier, Daniel Maillard, Francois Balloux
 Maintainer: Thibaut Jombart <t.jombart at imperial.ac.uk>
-Suggests: genetics, spdep, tripack, ape, pegas, seqinr, adehabitat, multicore, akima, maps, splancs, hierfstat
-Depends: R (>= 2.10), methods, MASS, ade4, igraph
+Suggests: genetics, spdep, tripack, pegas, seqinr, adehabitat, multicore, akima, maps, splancs, hierfstat
+Depends: R (>= 2.10), methods, MASS, ade4, igraph, ape
 Description: Classes and functions for genetic data analysis within the multivariate framework.
 Collate: classes.R basicMethods.R handling.R auxil.R setAs.R SNPbin.R glHandle.R glFunctions.R glSim.R find.clust.R hybridize.R scale.R fstat.R import.R seqTrack.R chooseCN.R genind2genpop.R loadingplot.R sequences.R gstat.randtest.R makefreq.R colorplot.R monmonier.R spca.R coords.monmonier.R haploGen.R old2new.R spca.rtests.R dapc.R haploPop.R PCtest.R dist.genpop.R Hs.R propShared.R export.R HWE.R propTyped.R inbreeding.R glPlot.R gengraph.R simOutbreak.R zzz.R
 License: GPL (>=2)

Modified: pkg/R/sequences.R
===================================================================
--- pkg/R/sequences.R	2012-11-13 10:43:45 UTC (rev 1051)
+++ pkg/R/sequences.R	2012-11-15 15:50:59 UTC (rev 1052)
@@ -159,19 +159,20 @@
 ## findMutations
 #################
 
-## generic
+## GENERIC
 findMutations <- function(...){
     UseMethod("findMutations")
 }
 
-## method for DNAbin
-findMutations.DNAbin <- function(x, pairs=NULL, ...){
+## METHOD FOR DNABIN
+findMutations.DNAbin <- function(x, from=NULL, to=NULL, ...){
     ## CHECKS ##
     if(!require(ape)) stop("the ape package is needed")
     if(!inherits(x,"DNAbin")) stop("x is not a DNAbin object")
     x <- as.matrix(x)
 
     ## function to pull out mutations from sequence a to b ##
+    NUCL <- c('a','t','g','c')
     f1 <- function(a,b){
         seqa <- as.character(x[a,])
         seqb <- as.character(x[b,])
@@ -179,21 +180,28 @@
         ori <- seqa[temp]
         mut <- seqb[temp]
         names(ori) <- names(mut) <- temp
-        toRemove <- !ori %in% c('a','t','g','c') | !mut %in% c('a','t','g','c')
+        toRemove <- !ori %in% NUCL | !mut %in% NUCL
         ori <- ori[!toRemove]
         mut <- mut[!toRemove]
+        if(all(toRemove)) return(NULL)
         res <- data.frame(ori,mut)
         names(res) <- rownames(x)[c(a,b)]
         res$short <- paste(row.names(res),":",res[,1],"->",res[,2],sep="")
         return(res)
     }
 
-    ## get list of pairs to compare ##
-    if(is.null(pairs)){
-        pairs <- expand.grid(1:nrow(x),1:nrow(x))
-        pairs <- pairs[pairs[,1]!=pairs[,2],,drop=FALSE]
-    }
+    ## GET LIST OF PAIRS TO COMPARE ##
+    ## handle NULL
+    if(is.null(from)) from <- 1:nrow(x)
+    if(is.null(to)) to <- 1:nrow(x)
 
+    ## get pairs
+    pairs <- expand.grid(from, to)
+
+    ## remove unwanted comparisons
+    pairs <- pairs[pairs[,1]!=pairs[,2],,drop=FALSE]
+
+    ## GET NUMBER OF MUTATIONS ##
     out <- lapply(1:nrow(pairs), function(i) f1(pairs[i,1], pairs[i,2]))
     names(out) <- paste(rownames(x)[pairs[,1]], rownames(x)[pairs[,2]],sep="->")
 
@@ -206,36 +214,40 @@
 
 
 
-## ##################
-## ## graphMutations
-## ##################
-## graphMutations <- function(x, plot=TRUE, ...){
-##     if(!require(igraph)) stop("igraph is required")
 
-##     ## GET GRAPH ##
-##     from.old <- gsub("->.*","",names(x))
-##     to.old <- gsub(".*->","",names(x))
-##     vnames <- sort(unique(c(from.old,to.old)))
-##     from <- match(from.old,vnames)
-##     to <- match(to.old,vnames)
-##     dat <- data.frame(from,to,stringsAsFactors=FALSE)
-##     out <- graph.data.frame(dat, directed=TRUE)
+##################
+## graphMutations
+##################
 
-##     ## SET VERTICES LABELS ##
-##     V(out)$label <- vnames
+## GENERIC
+graphMutations <- function(...){
+    UseMethod("graphMutations")
+}
 
-##     ## SET ANNOTATIONS FOR THE BRANCHES ##
-##     annot <- unlist(lapply(x, function(e) paste(e$short, collapse="\n")))
-##     E(out)$label <- annot
+## METHOD FOR DNABIN
+graphMutations.DNAbin <- function(x, from=NULL, to=NULL, plot=TRUE, edge.curved=TRUE, ...){
+    if(!require(igraph)) stop("igraph is required")
 
-##     ## PLOT / RETURN ##
-##     if(plot) plot(out, ...)
+    ## GET MUTATIONS ##
+    x <- findMutations(x, from=from, to=to)
 
-##     return(out)
-## } # end graphMutations
+    ## GET GRAPH ##
+    from <- gsub("->.*","",names(x))
+    to <- gsub(".*->","",names(x))
+    vnames <- sort(unique(c(from,to)))
+    dat <- data.frame(from,to,stringsAsFactors=FALSE)
+    out <- graph.data.frame(dat, directed=TRUE, vertices=data.frame(vnames, label=vnames))
 
+    ## SET ANNOTATIONS FOR THE BRANCHES ##
+    annot <- unlist(lapply(x, function(e) paste(e$short, collapse="\n")))
+    E(out)$label <- annot
+    E(out)$curved <- edge.curved
 
+    ## PLOT / RETURN ##
+    if(plot) plot(out, ...)
 
+    return(out)
+} # end graphMutations
 
 
 
@@ -247,6 +259,9 @@
 
 
 
+
+
+
 ## ###############
 ## ## transiProb
 ## ###############