[adegenet-commits] r278 - pkg/R

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

Author: jombart
Date: 2009-04-01 13:33:10 +0200 (Wed, 01 Apr 2009)
New Revision: 278

Modified:
   pkg/R/basicMethods.R
   pkg/R/classes.R
Log:
erased commented stuff. Fixed summary genpop PA


Modified: pkg/R/basicMethods.R
===================================================================
--- pkg/R/basicMethods.R	2009-04-01 11:26:54 UTC (rev 277)
+++ pkg/R/basicMethods.R	2009-04-01 11:33:10 UTC (rev 278)
@@ -234,10 +234,31 @@
   x <- object
   if(!inherits(x,"genpop")) stop("To be used with a genpop object")
 
+  ## BUILD THE OUTPUT ##
+  ## type-independent stuff
   res <- list()
 
   res$npop <- nrow(x at tab)
 
+  ## PA case ##
+  if(x at type=="PA"){
+      ## % of missing data
+      res$NA.perc <- 100*sum(is.na(x at tab))/prod(dim(x at tab))
+
+      ## display and return
+      listlab <- c("# Total number of genotypes: ",
+                   "# Percentage of missing data: ")
+      cat("\n",listlab[1],res[[1]],"\n")
+      for(i in 2){
+          cat("\n",listlab[i],"\n")
+          print(res[[i]])
+      }
+
+      return(invisible(res))
+  }
+
+
+  ## codom case ##
   res$loc.nall <- x at loc.nall
 
   res$pop.nall <- apply(x at tab,1,function(r) sum(r>0,na.rm=TRUE))

Modified: pkg/R/classes.R
===================================================================
--- pkg/R/classes.R	2009-04-01 11:26:54 UTC (rev 277)
+++ pkg/R/classes.R	2009-04-01 11:33:10 UTC (rev 278)
@@ -22,41 +22,7 @@
 
 
 
-## #######################
-## # Function rmspaces
-## #######################
-## # removes spaces and tab at the begining and the end of each element of charvec
-## .rmspaces <- function(charvec){
-##     charvec <- gsub("^([[:blank:]]*)([[:space:]]*)","",charvec)
-##     charvec <- gsub("([[:blank:]]*)([[:space:]]*)$","",charvec)
-##     return(charvec)
-## }
 
-
-
-## ###################
-## # Function .genlab
-## ###################
-## # recursive function to have labels of constant length
-## # base = a character string
-## # n = number of labels
-## .genlab <- function(base, n) {
-##   f1 <- function(cha,n){
-##     if(nchar(cha)<n){
-##       cha <- paste("0",cha,sep="")
-##       return(f1(cha,n))
-##     } else {return(cha)}
-##   }
-##   w <- as.character(1:n)
-##   max0 <- max(nchar(w))
-##   w <- sapply(w, function(cha) f1(cha,max0))
-##   return(paste(base,w,sep=""))
-## }
-
-
-
-
-
 ###############################################################
 ###############################################################
 # CLASSES DEFINITION