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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Apr 15 17:32:46 CEST 2009


Author: romain
Date: 2009-04-15 17:32:46 +0200 (Wed, 15 Apr 2009)
New Revision: 79

Modified:
   pkg/zooimage/R/errorHandling.R
   pkg/zooimage/R/utilities.r
   pkg/zooimage/R/zid.r
   pkg/zooimage/R/zim.r
Log:
moving list.files.foo functions to utilities

Modified: pkg/zooimage/R/errorHandling.R
===================================================================
--- pkg/zooimage/R/errorHandling.R	2009-04-15 13:51:14 UTC (rev 78)
+++ pkg/zooimage/R/errorHandling.R	2009-04-15 15:32:46 UTC (rev 79)
@@ -138,8 +138,8 @@
 	"checkDirExists"  = "dir", 
 	"get.ZITrain"     = "dir",
 	"force.dir.create" = "path",
-	"checkEmptyDir" = "dir"
-	
+	"checkEmptyDir" = "dir", 
+	"make.RData" = "zidir"
 )
 # }}}
 

Modified: pkg/zooimage/R/utilities.r
===================================================================
--- pkg/zooimage/R/utilities.r	2009-04-15 13:51:14 UTC (rev 78)
+++ pkg/zooimage/R/utilities.r	2009-04-15 15:32:46 UTC (rev 79)
@@ -512,6 +512,22 @@
 	out
 }
 
+# {{{ list.zim, list.dat1.zim
+"list.zim" <- function(zidir, ...) {
+	list.files.ext( zidir, extension = "zim", ... )
+}
+"list.dat1.zim" <- function(zidir, ...) {
+	list.files.ext( zidir, extension = "_dat1.zim", ... )
+}
+list.zip <- function( zidir, ... ){
+	list.files.ext( zidir, extension = "zip", ... )
+}
+list.zid <- function( zidir, ... ){
+	list.files.ext( zidir, extension = "zid", ... )
+}
+# }}}
+
+
 #' transforms a file extension to a pattern for ignore.case matching of the 
 #' extension
 #' 

Modified: pkg/zooimage/R/zid.r
===================================================================
--- pkg/zooimage/R/zid.r	2009-04-15 13:51:14 UTC (rev 78)
+++ pkg/zooimage/R/zid.r	2009-04-15 15:32:46 UTC (rev 79)
@@ -102,16 +102,6 @@
 	return(invisible(ok))
 	
 }
-# attr( verify.zid, "catcher" ) <- function( call ){
-# 	
-# 	withCallingHandlers( eval( call ), 
-# 		"zooImageError_verify.zim" = function( e ){
-# 			# we get an error from verify.zim, we want to log the error
-# 			# but keep going
-# 			logError( e )			
-# 		} )
-# 	
-# }
 # }}}
 
 # {{{ verify.zid.all
@@ -119,13 +109,14 @@
     check.vignettes = TRUE, show.log = TRUE, bell = FALSE) {
 	
 	# {{{ Verify all of these directories
-	if (type != "ZI1") stop("only 'ZI1' is currently supported for 'type'!")
+	if (type != "ZI1") {
+		stop("only 'ZI1' is currently supported for 'type'!")
+	}
 	# }}}
 	
 	# {{{ First, switch to that directory
 	inidir <- getwd()
-	if (!file.exists(path) || !file.info(path)$isdir)
-		stop(path, " does not exist, or it is not a directory!")
+	checkDirExists( path )
 	setwd(path); on.exit(setwd(inidir))
 	path <- "."	# Indicate we are now in the right path
 	# }}}
@@ -143,67 +134,75 @@
 	# }}}
 	
 	# {{{ Start the process
-	ok <- TRUE
 	smax <- length(samples)
 	cat("Verification...\n")
-	for (s in 1:smax) {
-		Progress(s, smax)
-		withRestarts( withCallingHandlers( {
-			verify.zid(samples[s], type = type, check.vignettes = check.vignettes, show.log = FALSE)
-		} , zooImageError = function( e ){   # calling handler
-			logError( e )               
-			                                 #       about the sample being analysed
-			invokeRestart( "zooImageError" ) # go to the restart below
-		} ), zooImageError = function(e){    # restart
-			ok <<- FALSE # should this be depreciated ?
-		})  
-	}
-	# }}}
 	
-	# {{{ Dismiss the progress 
-	Progress (smax + 1, smax) # To dismiss the Progress() indication  
+	ok <- sapply( samples, function(s){
+		tryCatch( verify.zid( s, type = type, check.vignettes = check.vignettes, show.log = FALSE), 
+			zooImageError = function(e) -1 )
+	} )
 	# }}}
 	
 	# {{{ cleans up
-	finish.loopfunction( ok , bell = bell, show.log = show.log )
+	finish.loopfunction( all( ok ) , bell = bell, show.log = show.log )
 	# }}}
 }
 # }}}
 
 # {{{ make.RData
-"make.RData" <-
-	function(zidir, type = "ZI1", replace = FALSE, show.log = TRUE) {
-	# Make a .RData file that collates together data from all the "_dat1.zim" files of a given sample
-	if (type != "ZI1") stop("only 'ZI1' is currently supported for 'type'!")
+#' Make a .RData file that collates together data from all the "_dat1.zim" files of a given sample
+"make.RData" <- function(zidir, type = "ZI1", replace = FALSE, show.log = TRUE) {
+	
+	if (type != "ZI1") {
+		stop("only 'ZI1' is currently supported for 'type'!")
+	}
 	RDataFile <- file.path(zidir, paste(basename(zidir), "_dat1.RData", sep = ""))
-	if (file.exists(RDataFile) && !replace) return(invisible(TRUE)) # File already exists
+	# File already exists
+	if (file.exists(RDataFile) && !replace){
+		return(invisible(TRUE))
+	}
+	
 	ok <- TRUE
 	dat1files <- list.dat1.zim(zidir)
 	if(length(dat1files) == 0) {
-		logProcess("has no '_dat1.zim' file!", zidir, stop = TRUE, show.log = show.log); return(invisible(FALSE)) }
-	if (length(dat1files) == 1 && is.na(dat1files)) {
-	 	logProcess("not found or not a directory!", zidir, stop = TRUE, show.log = show.log); return(invisible(FALSE)) }
+		stop("no '_dat1.zim' file!" ) 
+	}
 	dat1files <- sort(dat1files)
 	fractions <- get.sampleinfo(dat1files, "fraction")
+	
 	# Avoid collecting duplicate informations about fractions
 	fracdup <- duplicated(fractions)
+	
 	# For each of these files, read content in a variable
 	allmes <- NULL
 	allmeta <- NULL
 	for (i in 1:length(dat1files)) {
 		dat1path <- file.path(zidir, dat1files[i])
+		env <- environment()
 		
-		# TODO; this might generate an error, handle it
-		is.zim( dat1path )
+		doNext <- function( ) eval( quote( next ), envir = env )
 		
+		tryCatch( is.zim( dat1path ), zooImageError = function(e){
+			logError( e ) 
+			doNext()
+		} )
+		
 		# Read the header
-		Lines <- scan(dat1path, character(), sep = "\t", skip = 1, blank.lines.skip = FALSE, flush = TRUE, quiet = TRUE, comment.char = "#")
+		Lines <- scan(dat1path, character(), sep = "\t",
+			skip = 1, blank.lines.skip = FALSE,
+			flush = TRUE, quiet = TRUE, comment.char = "#")
 		if (length(Lines) < 1) {
-			logProcess("is empty, or is corrupted", dat1files[i]); ok <- FALSE; next }
+			logProcess("is empty, or is corrupted", dat1files[i]); 
+			ok <- FALSE; 
+			next 
+		}
+		
 		# Trim leading and trailing spaces in Lines
 		Lines <- trim(Lines)
-        # Convert underscore to space
+        
+		# Convert underscore to space
 		Lines <- underscore2space(Lines)
+		
 		# Determine where the table of measurements starts (it is '[Data]' header)
 		endhead <- (1:length(Lines))[Lines == "[Data]"]
 		if (length(endhead) == 0) endhead <- NULL else endhead <- endhead[length(endhead)]
@@ -212,6 +211,7 @@
 				Lines <- Lines[1:(endhead - 1)]
 			} else Lines <- NULL
 		}
+		
 		# Decrypt all lines, that is, split on first occurrence of "=" into 'tag', 'value'
 		# and separate into sections
 		if (!fracdup[i] && !is.null(Lines)) {
@@ -222,6 +222,7 @@
 				allmeta <- list.merge(allmeta, meta)
 			}
 		}
+		
 		# Calculate a data frame containing 'dilutions'
 		Sub <- allmeta$Subsample
 		Sub$Dil <- 1 / (Sub$SubPart * Sub$CellPart * Sub$Replicates * Sub$VolIni)

Modified: pkg/zooimage/R/zim.r
===================================================================
--- pkg/zooimage/R/zim.r	2009-04-15 13:51:14 UTC (rev 78)
+++ pkg/zooimage/R/zim.r	2009-04-15 15:32:46 UTC (rev 79)
@@ -94,19 +94,6 @@
 #' If it succeeds, return the number of measured items as numeric
 #' Otherwise, an error is generated by stop (see errorHandling for how errors are 
 #' thrown and captured using calling handlers)
-# TODO: check all functions calling verify.zim since it does not 
-#       return the problem anymore but rather calls stop with the 
-#       message
-# HANDLE: 
-# STOP: on extra verify function
-# STOP: if file is not zim
-# STOP: if file is empty (after first line)
-# STOP: missing fields
-# STOP: missing process fields
-# STOP: missing columns in the table
-# STOP: no data
-# STOP: unable to read table of measurements
-# STOP: no measurements found in the file
 "verify.zim" <- function(zimfile, check.ext = FALSE, 
 	is.dat1 = hasExtension( zimfile, "_dat1.zim"), check.table = FALSE) {
                                      
@@ -250,21 +237,6 @@
 }
 # }}}
 
-# {{{ list.zim, list.dat1.zim
-"list.zim" <- function(zidir, ...) {
-	list.files.ext( zidir, extension = "zim", ... )
-}
-"list.dat1.zim" <- function(zidir, ...) {
-	list.files.ext( zidir, extension = "_dat1.zim", ... )
-}
-list.zip <- function( zidir, ... ){
-	list.files.ext( zidir, extension = "zip", ... )
-}
-list.zid <- function( zidir, ... ){
-	list.files.ext( zidir, extension = "zid", ... )
-}
-# }}}
-
 # {{{ extract.zims
 # Extract notes from .zip files and place them in .zim files
 # STOP: All zip files must be located in the same directory!



More information about the Zooimage-commits mailing list