[Zooimage-commits] r115 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 27 13:01:01 CEST 2009
Author: romain
Date: 2009-04-27 13:01:01 +0200 (Mon, 27 Apr 2009)
New Revision: 115
Modified:
pkg/zooimage/R/utilities.r
pkg/zooimage/R/zid.r
Log:
refactored make.RData using lapply instead of for loop
Modified: pkg/zooimage/R/utilities.r
===================================================================
--- pkg/zooimage/R/utilities.r 2009-04-27 09:38:23 UTC (rev 114)
+++ pkg/zooimage/R/utilities.r 2009-04-27 11:01:01 UTC (rev 115)
@@ -401,6 +401,20 @@
}
# }}}
+# {{{
+combine <- function( ..., .list = list(...) ){
+ force(.list)
+ mergefun <- function(x,y){
+ if(all( sort(names(x)) == sort(names(y)) ){
+ rbind( x,y )
+ } else{
+ merge( x, y, all = TRUE )
+ }
+ }
+ Reduce( mergefun, .list )
+}
+# }}}
+
# {{{ Add items across two lists (names must be the same)
list.add <- function( ..., .list = list(...), FUN = "+"){
list.reduce( .list= .list, FUN = FUN)
Modified: pkg/zooimage/R/zid.r
===================================================================
--- pkg/zooimage/R/zid.r 2009-04-27 09:38:23 UTC (rev 114)
+++ pkg/zooimage/R/zid.r 2009-04-27 11:01:01 UTC (rev 115)
@@ -178,17 +178,15 @@
# For each of these files, read content in a variable
allmes <- NULL
allmeta <- NULL
- for (i in 1:length(dat1files)) {
+
+ results <- lapply( seq.int( 1, length(dat1files) ), function(i){
+
dat1path <- file.path(zidir, dat1files[i])
- env <- environment()
-
iszim <- tryCatch( is.zim( dat1path ), zooImageError = function(e){
logError( e )
FALSE
} )
- if( !iszim ){
- next
- }
+ if( !iszim) return(NULL)
# Read the header
Lines <- scan(dat1path, character(), sep = "\t",
@@ -196,8 +194,7 @@
flush = TRUE, quiet = TRUE, comment.char = "#")
if (length(Lines) < 1) {
logProcess("is empty, or is corrupted", dat1files[i]);
- ok <- FALSE;
- next
+ return( NULL )
}
# Trim leading and trailing spaces in Lines
@@ -207,76 +204,91 @@
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)]
+ endhead <- tail( which( Lines == "[Data]" ), 1)
if (!is.null(endhead)) {
- if (endhead > 1) {
- Lines <- Lines[1:(endhead - 1)]
- } else Lines <- NULL
+ Lines <- if (endhead > 1) {
+ Lines[ seq.int( 1, endhead - 1) ]
+ }
}
# Decrypt all lines, that is, split on first occurrence of "=" into 'tag', 'value'
# and separate into sections
- if (!fracdup[i] && !is.null(Lines)) {
- meta <- parse.ini(Lines, sub("_dat1[.]zim$", "", fractions[i]))
- ## Collate all metadata together
- if (i == 1) allmeta <- meta else {
- # Merge metadata
- allmeta <- list.merge(allmeta, meta)
- }
+ meta <- if (!fracdup[i] && !is.null(Lines)) {
+ parse.ini(Lines, sub("_dat1[.]zim$", "", fractions[i]))
}
- # Calculate a data frame containing 'dilutions'
- Sub <- allmeta$Subsample
- Sub$Dil <- 1 / (Sub$SubPart * Sub$CellPart * Sub$Replicates * Sub$VolIni)
# Read the table of measurements
if (!is.null(endhead)) {
- mes <- read.table(dat1path, header = TRUE, sep = "\t", dec = ".",
- as.is = FALSE, skip = endhead + 1, comment.char = "#")
+ mes <- read.table(dat1path, header = TRUE, sep = "\t",
+ dec = ".", as.is = FALSE, skip = endhead + 1,
+ comment.char = "#")
+
# We have several problems here:
# 1) There is sometimes a column full of NAs at the end.
# This is because ImageJ adds an extra tab at the end of the line.
- if (all(is.na(mes[ , ncol(mes)]))) mes <- mes[ , -ncol(mes)]
+
+ # [RF] FIXME: this should not be the case anymore because we have more control
+ # of what ImageJ is doing
+ if (all(is.na(mes[ , ncol(mes)]))){
+ mes <- mes[ , -ncol(mes)]
+ }
+
# 2) The first column is the 'Item', but i ts name '!Item' is transformed into 'X.Item'
# 3) The '%Area' is transformed into 'X.Area'
Names <- names(mes)
- if (Names[1] == "X.Item") Names[1] <- "Item"
- if ("X.Area" %in% Names) Names[Names == "X.Area"] <- "PArea"
+ if (Names[1] == "X.Item") {
+ Names[1] <- "Item"
+ }
+ if ("X.Area" %in% Names){
+ Names[Names == "X.Area"] <- "PArea"
+ }
# Invert 'Item' and 'Label'
mes <- mes[ , c(2, 1, 3:ncol(mes))]
Names <- Names[c(2, 1, 3:length(Names))]
names(mes) <- make.names(Names, unique = TRUE)
- # Add a Dil column at the end with the corresponding dilution
- Dil <- Sub$Dil[Sub$Label == fractions[i]]
- Dil <- rep(Dil, nrow(mes))
- mes <- cbind(mes, Dil)
- # Collate data all together
- if (i == 1) allmes <- mes else {
- if (all(names(allmes) == names(mes))) {
- allmes <- rbind(allmes, mes) # Faster
- } else {
- allmes <- merge(allmes, mes, all = TRUE)
- }
- }
+
+ Sub <- allmeta$Subsample
+ Sub$Dil <- 1 / (Sub$SubPart * Sub$CellPart * Sub$Replicates * Sub$VolIni)
+ mes$Dil <- rep( Sub$Dil[ Sub$Label == fractions[i] ] , nrow(mes) )
+
+ } else{
+ mes <- NULL
}
- }
+
+ list( meta = meta, mes = mes )
+ } )
+
+ notnull.filter <- Negate(is.null)
+ results <- Filter( notnull.filter , results )
+ list.allmeta <- Filter( notnull.filter, lapply( results, "[[", "meta" ) )
+ list.allmes <- Filter( notnull.filter, lapply( results, "[[", "mes" ) )
+ allmeta <- combine( list.allmeta )
+ allmes <- combine( list.allmes )
rownames(allmes) <- 1:nrow(allmes)
+
# Calculate an ECD from Area if there is not one yet
Names <- names(allmes)
if (!"ECD" %in% Names && "Area" %in% Names) {
ECD <- ecd(allmes$Area)
# Place ECD in third position (should be just after 'Label' and 'Item')
- allmes <- cbind(allmes[, 1:2], ECD, allmes[, 3:ncol(allmes)])
+ allmes <- data.frame(allmes[, 1:2], "ECD" = ECD,
+ allmes[, 3:ncol(allmes)] )
}
+
# Construct a c('ZI1Dat', 'ZIDat', 'data.frame') object containing the data frame
# and the metadata as attribute
attr(allmes, "metadata") <- allmeta
class(allmes) <- c("ZI1Dat", "ZIDat", "data.frame")
+
# Save these data in a file
ZI.sample <- allmes
save(ZI.sample, file = RDataFile, ascii = FALSE, version = 2, compress = TRUE)
- if (ok) ok <- file.exists(RDataFile)
- if (show.log) logView()
+ if (ok){
+ ok <- file.exists(RDataFile)
+ }
+ if (show.log){
+ logView()
+ }
return(invisible(ok))
}
# }}}
More information about the Zooimage-commits
mailing list