[Zooimage-commits] r105 - pkg/zooimage/R

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

Author: romain
Date: 2009-04-27 09:38:23 +0200 (Mon, 27 Apr 2009)
New Revision: 105

Modified:
   pkg/zooimage/R/utilities.r
   pkg/zooimage/R/zie.r
Log:
unloop getList using Filter

Modified: pkg/zooimage/R/utilities.r
===================================================================
--- pkg/zooimage/R/utilities.r	2009-04-21 12:42:48 UTC (rev 104)
+++ pkg/zooimage/R/utilities.r	2009-04-27 07:38:23 UTC (rev 105)
@@ -45,7 +45,7 @@
 	# Keep only those objects
 	varlist <- varlist[Filter]	
 	if (length(varlist) == 0) {	# No such objects in .GlobalEnv
-		warnOrStop( "There is no object of class ", paste(class, collapse = " "), " in the user workspace!" )
+		warnOrStop( "There is no object of class '", paste(class, collapse = " "), "' in the user workspace!" )
 		varsel <- "" 
 	} else {
 		if (default == "") default <- varlist[1]
@@ -64,33 +64,21 @@
 	# Get lists of items of specified class
 	(require(utils) || stop("Package 'utils' is required!"))
 	
-	varlist <- objects(pos = 1)		# Get objects in .GlobalEnv
-	# Filter this list to keep only list objects...
-	Filter <- NULL
-	for (i in 1:length(varlist)) Filter[i] <- inherits(get(varlist[i]), "list")
-	varlist <- varlist[Filter]	# Keep only those objects
-	if (length(varlist) == 0) {	# No such objects in .GlobalEnv
-		warnOrStop( "There is no list objects in the user workspace" )
-		return("") 
-	} else {
-		# Filter the list objects to keep only those having 'class' objects as items
-		Filter <- rep(TRUE, length(varlist))
-		for (i in 1:length(varlist)){
-			Var <- get(varlist[i])
-			for (j in 1:length(Var)){
-				if (!inherits(Var[[j]], class)){
-					Filter[i] <- FALSE
-				}
-			}
-		}
-		varlist <- varlist[Filter]	# Keep only those objects
-		if (length(varlist) == 0) { 	# No such objects in .GlobalEnv
-			warnOrStop( "There is no list of ", class, " objects in the user workspace" )
-		}	
-		if (default == "") default <- varlist[1]
-		varsel <- select.list(varlist, preselect = default, multiple = multi, title = title)
+	# Get objects in .GlobalEnv
+	filter <- function(x) {
+		item <- get(x)
+		is.list(item) && all( sapply( item, function(y) inherits( y, class ) ) )
 	}
-    return(varsel)		
+	varlist <- Filter( filter , objects(pos = 1) )	
+	if( length(varlist) == 0 ){
+		warnOrStop( "There is no list of ", class, " objects in the user workspace" )
+		return("")
+	}
+	if (default == ""){
+		default <- varlist[1]
+	}
+	varsel <- select.list(varlist, preselect = default, multiple = multi, title = title)
+	return(varsel)		
 }
 # }}}
 

Modified: pkg/zooimage/R/zie.r
===================================================================
--- pkg/zooimage/R/zie.r	2009-04-21 12:42:48 UTC (rev 104)
+++ pkg/zooimage/R/zie.r	2009-04-27 07:38:23 UTC (rev 105)
@@ -290,9 +290,10 @@
 	cat("Checking all lines in the .zie file for raw images...\n")
 	allImages <- character(0)
 	for (i in 1:nLines) {
-		### TODO: allow restarting from a given point and eliminate previous lines for which there are no images (considered as already processed!)
+		### TODO: allow restarting from a given point and eliminate previous 
+		###       lines for which there are no images (considered as already processed!)
 		Progress(i, nLines)
-		if (length(grep("^[-][>]", Lines[i])) == 0) {	# This is not a state change command
+		if ( !grepl("^[-][>]", Lines[i]) ) {	# This is not a state change command
 			File <- MakeImageName(trim(sub("[=].*$", "", Lines[i])))
 			checkFileExists( File )
 			if (File %in% allImages) {