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

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

Author: romain
Date: 2009-04-21 14:12:59 +0200 (Tue, 21 Apr 2009)
New Revision: 101

Modified:
   pkg/zooimage/R/ZIRes.r
   pkg/zooimage/R/utilities.r
Log:
simplified merge.ZITable using Reduce

Modified: pkg/zooimage/R/ZIRes.r
===================================================================
--- pkg/zooimage/R/ZIRes.r	2009-04-21 10:02:45 UTC (rev 100)
+++ pkg/zooimage/R/ZIRes.r	2009-04-21 12:12:59 UTC (rev 101)
@@ -379,36 +379,17 @@
 # {{{ merge.ZITable
 "merge.ZITable" <- function(x, y, ...) {
 	
-	mustbe(x, "ZITable")
-	mustbe(y, "ZITable")
+	data <- list( x, y, ... )
+	sapply( data, mustbe, "ZITable" )
 	
-	breaks.x <- attr(x, "breaks")
-	breaks.y <- attr(y, "breaks")
-	mustmatch( breaks.x, breaks.y, 
-		"breaks of all objects must match")
+	mustallmatch( .list = lapply( data, attr, "breaks" ), 
+		msg = "breaks of all objects must match")
 	
-	unit.x <- attr(x, "unit")
-	unit.y <- attr(y, "unit")
-	mustmatch( unit.x, unit.y, "units of all objects must match")
-	res <- x + y
-
-	# If the user provides more tables, merge them all
-	moreargs <- list(...)
-	if (length(moreargs) > 0) {
-		# Merge all provided tables
-		for (i in 1:length(moreargs)) {
-			tt <- moreargs[[i]]
-			mustbe( tt, "ZITable", msg = "all arguments must be 'ZITable' objects")
-			breaks.tt <- attr(tt, "breaks")
-			mustmatch( breaks.x, breaks.tt, "breaks of all objects must match")
-			unit.tt <- attr(tt, "unit")
-			mustmatch( unit.x, unit.tt, "units of all objects must match")
-			res <- res + tt
-		}
-	}
-	# In case we make the average of several images,
-	# coef divides and calculates the mean value
-	return(res)
+	mustallmatch( .list = lapply( data, attr, "unit" ), 
+		msg = "units of all objects must match")
+	
+	Reduce( "+", data ) 
+	
 }
 # }}}
 

Modified: pkg/zooimage/R/utilities.r
===================================================================
--- pkg/zooimage/R/utilities.r	2009-04-21 10:02:45 UTC (rev 100)
+++ pkg/zooimage/R/utilities.r	2009-04-21 12:12:59 UTC (rev 101)
@@ -797,8 +797,21 @@
 		if( missing(msg) ) msg <- sprintf( "'%s' and '%s' must match", deparse(substitute(x)), deparse(substitute(y)) )
 		stop( msg )
 	}
+	invisible( NULL )
 }
 
+mustallmatch <- function( ..., .list = list(...), msg = "all must match" ){
+	n <- length(.list)
+	if( n==0 || n == 1 ) {
+		stop("need at list 2 elements")
+	}
+	first <- .list[[1]]
+	for( i in 2:n){
+		mustmatch( first, .list[[i]], msg = msg )
+	}
+	invisible( NULL )
+}
+
 mustcontain <- function( container, element, msg ){
 	if( ! all(element %in% container) ){
 		if( missing(msg) ){