[Zooimage-commits] r120 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 27 15:14:14 CEST 2009
Author: romain
Date: 2009-04-27 15:14:14 +0200 (Mon, 27 Apr 2009)
New Revision: 120
Modified:
pkg/zooimage/R/zim.r
Log:
using a sapply instead of a for ;loop
Modified: pkg/zooimage/R/zim.r
===================================================================
--- pkg/zooimage/R/zim.r 2009-04-27 13:06:40 UTC (rev 119)
+++ pkg/zooimage/R/zim.r 2009-04-27 13:14:14 UTC (rev 120)
@@ -25,27 +25,23 @@
#
# {{{ make.zim
-# HANDLE: verify.zim might throw an error
-# HANDLE: create.zim
"make.zim" <- function(dir = ".", pattern = extensionPattern( "tif" ),
images = list.files(dir, pattern), show.log = TRUE, bell = FALSE) {
- # {{{ check that there are images to process
+ # check that there are images to process
if (length(images) < 1) {
stop("no images to process!" )
}
- # }}}
- # {{{ Name of images is something like SCS.xxxx-xx-xx.SS+Ann.tif
+ # Name of images is something like SCS.xxxx-xx-xx.SS+Ann.tif
# We make the same .zim file for all ...+Ann images, so, reduce the list
zims <- sort(unique(get.sampleinfo(images, type = "fraction", ext = pattern)))
zims <- file.path(dir, sprintf( "%.zim", zims ) )
- ok <- TRUE
+ ok <- TRUE
zmax <- length(zims)
cat("Making & checking .zim files...\n")
- # }}}
- # {{{ Start with a default template
+ # Start with a default template
template <- NULL
for (z in 1:zmax) {
Progress(z, zmax)
@@ -58,16 +54,18 @@
# Use the previous file as template
template = zims[z]
}
+
# Verify that the zim is correct
res <- verify.zim(zims[z])
- if (res != 0) ok <- FALSE
+ if (res != 0){
+ ok <- FALSE
+ }
}
- # }}}
- # {{{ cleans up
+ # cleans up
ClearProgress()
finish.loopfunction( ok, bell = bell, show.log = show.log )
- # }}}
+
}
# }}}
@@ -91,8 +89,7 @@
#'
#' Verify a "(_dat1).zim" file (all required fields + return the number of items in it)
#' 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)
+#' Otherwise, an error is generated by stop
"verify.zim" <- function(zimfile, check.ext = FALSE,
is.dat1 = hasExtension( zimfile, "_dat1.zim"), check.table = FALSE) {
@@ -178,13 +175,13 @@
# {{{ Check for required column headers
posHeaders <- grep("^\\[Data\\]$", Lines)[1] + 1
- LineHeader <- scan(zimfile, character(), sep = "%", skip = posHeaders,
+ LineHeader <- scan(zimfile, character(), sep = "%", skip = posHeaders,
nmax = 1, flush = TRUE, quiet = TRUE, comment.char = "=")
- Headers <- trim(strsplit(LineHeader, "\t")[[1]])
- misHeaders <- reqcols[!(reqcols %in% Headers)]
- if (length(misHeaders) > 0) {
- stop( paste("Missing columns in the table:", paste(misHeaders, collapse = ", ")) )
- }
+ Headers <- trim(strsplit(LineHeader, "\t")[[1]])
+ misHeaders <- reqcols[!(reqcols %in% Headers)]
+ if (length(misHeaders) > 0) {
+ stop( paste("Missing columns in the table:", paste(misHeaders, collapse = ", ")) )
+ }
# }}}
# {{{ Check that the table can be read
@@ -198,30 +195,24 @@
# from here, because stop might have a different meaning
# in the context of the verify.zim function
# allowing to use the zooImage calling handlers, see errorHandling.R
- # COMMENT: maybe the alternative stop should be revised so that
- # it throws the message using the driver that is the
- # deapest in the call stack, that way we are
- # sure that we get a context and we don't have grab
- # errors to rethrow them right away
- # not sure this will work with namespaces, ...
Mes <- try(read.table(zimfile, sep = "\t", header = TRUE,
skip = posMes + 1), silent = TRUE)
- if (inherits(Mes, "try-error")) {
- stop( paste( "Unable to read the table of measurements! : ", extractMessage( Mes) ) )
- } else { # Successful reading of the table of measurements
- return(nrow(Mes)) # Return the number of items measured
- }
+ if (inherits(Mes, "try-error")) {
+ stop( paste( "Unable to read the table of measurements! : ", extractMessage( Mes) ) )
+ } else { # Successful reading of the table of measurements
+ return(nrow(Mes)) # Return the number of items measured
+ }
}
# }}}
} else {
# {{{ Alternative method that does not read the table
- # We don't read the table, use a different method to get the number of entries in it
- # Read the last entry in Lines and convert it to a numeric value: should be the number of items measured
+ # We don't read the table, use a different method to get the number of entries in it
+ # Read the last entry in Lines and convert it to a numeric value: should be the number of items measured
nItems <- Lines[length(Lines)]
- if (sub("^[0-9]+$", "", nItems) != ""){
- stop("Impossible to determine the number of items measured!")
+ if (sub("^[0-9]+$", "", nItems) != ""){
+ stop("Impossible to determine the number of items measured!")
}
- return(as.integer(nItems))
+ return(as.integer(nItems))
# }}}
}
# }}}
@@ -238,16 +229,11 @@
# {{{ extract.zims
# Extract notes from .zip files and place them in .zim files
-# STOP: All zip files must be located in the same directory!
-# STOP: this is not a valid directory!
-# STOP: One or several files not found!
-# STOP: sprintf( "%s: is not a valid directory!", path)
-# STOP: Done, no file to process!
"extract.zims" <- function(zipdir = ".", zipfiles = list.zip(zipdir),
path = NULL, replace = FALSE, check.unzip = TRUE, show.log = TRUE, bell = FALSE) {
# {{{ This requires the 'unzip' program!, Make sure it is available
- checkUnzipAvailable( )
+ checkCapable( "unzip" )
# }}}
# {{{ Make sure all zipfiles are in the same directory
@@ -296,7 +282,7 @@
# Note: use only the fraction, that is, SCS.xxxx-xx-xx.SS+F from SCS.xxxx-xx-xx.SS+Fnn)
# If there are duplicates, only extract first one
zimfiles <- sprintf( "%s.zim",
- get.sampleinfo(zipfiles, "fraction", ext = "\\.[zZ][iI][pP]$") )
+ get.sampleinfo(zipfiles, "fraction", ext = extensionPattern(".zip") )
keep <- !duplicated(zimfiles)
zimfiles <- zimfiles[keep]
zipfiles <- zipfiles[keep]
@@ -323,10 +309,8 @@
# {{{ Extract .zim files, one at a time, and check them
zmax <- length(zimfiles)
- ok <- rep(TRUE, zmax)
- for (i in 1:zmax) {
-
- ok[i] <- tryCatch( {
+ ok <- sapply( 1:zmax, function(i){
+ tryCatch( {
# Extract the .zim file from zip comment
zipnote( zipfiles[i], zimfiles[i] )
@@ -340,8 +324,7 @@
logError( e )
FALSE
})
-
- }
+ } )
# }}}
# {{{ cleans up
More information about the Zooimage-commits
mailing list