[adegenet-commits] r107 - pkg/R

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

Author: jombart
Date: 2008-05-09 12:29:42 +0200 (Fri, 09 May 2008)
New Revision: 107

Modified:
   pkg/R/classes.R
Log:
Improved validObject for genind and genpop objects: now, duplicate strings in [ind/pop/loc].names issue a warning with a list of concerned strings.


Modified: pkg/R/classes.R
===================================================================
--- pkg/R/classes.R	2008-05-05 13:34:39 UTC (rev 106)
+++ pkg/R/classes.R	2008-05-09 10:29:42 UTC (rev 107)
@@ -99,6 +99,12 @@
     return(FALSE)
   }
 
+  temp <- table(object at loc.names[object at loc.names!=""])
+  if(any(temp>1)) {
+      warning("\nduplicate names in loc.names:\n")
+      print(temp[temp>1])
+  }
+
   if(length(unlist(object at all.names)) != p) {
     cat("\ninvalid length in all.names\n")
     return(FALSE)
@@ -142,29 +148,43 @@
 ###############
 .genind.valid <- function(object){
     if(!.gen.valid(object)) return(FALSE)
-    
+
     if(length(object at ind.names) != nrow(object at tab)) {
         cat("\ninvalid length in ind.names\n")
         return(FALSE)
     }
-    
+
+    temp <- table(object at ind.names[object at ind.names!=""])
+    if(any(temp>1)) {
+        warning("\nduplicate names in ind.names:\n")
+        print(temp[temp>1])
+    }
+
     if(!is.null(object at pop)){ # check pop
-        
+
         if(length(object at pop) != nrow(object at tab)) {
             cat("\npop is given but has invalid length\n")
             return(FALSE)
         }
-        
+
         if(is.null(object at pop.names)) {
             cat("\npop is provided without pop.names")
-        }  
-        
+        }
+
+
         if(length(object at pop.names) != length(levels(object at pop))) {
             cat("\npop.names has invalid length\n")
             return(FALSE)
         }
+
+        temp <- table(object at pop.names[object at pop.names!=""])
+        if(any(temp>1)) {
+            warning("\nduplicate names in pop.names:\n")
+            print(temp[temp>1])
+        }
+
     } # end check pop
-    
+
     return(TRUE)
 } #end .genind.valid
 
@@ -190,7 +210,13 @@
         cat("\ninvalid length in pop.names\n")
         return(FALSE)
     }
-    
+
+    temp <- table(object at pop.names[object at pop.names!=""])
+    if(any(temp>1)) {
+        warning("\nduplicate names in pop.names:\n")
+        print(temp[temp>1])
+    }
+
     return(TRUE)
 } #end .genpop.valid