[Zooimage-commits] r195 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 7 12:15:24 CEST 2010
Author: kevin
Date: 2010-09-07 12:15:24 +0200 (Tue, 07 Sep 2010)
New Revision: 195
Modified:
pkg/zooimage/R/RealTime.R
pkg/zooimage/R/ZITrain.R
pkg/zooimage/R/gui.R
pkg/zooimage/R/utilities.R
pkg/zooimage/R/zid.R
pkg/zooimage/R/zim.R
Log:
Importation of FlowCAM images
- gui.R: ImportImg accepts FlowCAM imgs and BatchFilePlugin creates a batch file used by FlowCAM plugin
- RealTime.R: delete read.lst
- utilities.R: selectFile proposes an option for flowCAM images, create.BatchFile creates a batch file used by FlowCAM image analysis plugin, newRData can recalculate the RData file from a zid file
- zid.R: modification of make.RData function to create the dat1.zim file not generated by plugin of FlowCAM image analysis
- zim.R: addition of function to import FlowCAM images and generates zim and dat1.zim files
- ZITrain.R: make sure that numeric variables from a ZITrain object are numeric values!
Modified: pkg/zooimage/R/RealTime.R
===================================================================
--- pkg/zooimage/R/RealTime.R 2010-09-03 13:37:02 UTC (rev 194)
+++ pkg/zooimage/R/RealTime.R 2010-09-07 10:15:24 UTC (rev 195)
@@ -747,111 +747,6 @@
assignTemp("rtRecord", rec)
}
-# read.lst for both FlowCAM II and III by Kevin Denis
-"read.lst" <- function (x, skip = 2)
-{
- # Determine the version of the FlowCAM
- ncol <- length(read.table(x, header = FALSE, sep = ":", dec = ".", skip = 2, nrow = 1))
- if (ncol <= 44) {
- # FlowCAM II with 44 columns
- # read the table
- tab <- read.table(x, header = FALSE, sep = ":", dec = '.',
- col.names = c("Id", "FIT_Cal_Const", "FIT_Raw_Area", "FIT_Raw_Feret_Max",
- "FIT_Raw_Feret_Min", "FIT_Raw_Feret_Mean",
- "FIT_Raw_Perim", "FIT_Raw_Convex_Perim", "FIT_Area_ABD", "FIT_Diameter_ABD",
- "FIT_Length", "FIT_Width", "FIT_Diameter_ESD", "FIT_Perimeter", "FIT_Convex_Perimeter",
- "FIT_Intensity", "FIT_Sigma_Intensity", "FIT_Compactness", "FIT_Elongation",
- "FIT_Sum_Intensity", "FIT_Roughness", "FIT_Feret_Max_Angle", "FIT_Avg_Red",
- "FIT_Avg_Green", "FIT_Avg_Blue", "FIT_PPC", "FIT_Ch1_Peak",
- "FIT_Ch1_TOF", "FIT_Ch2_Peak", "FIT_Ch2_TOF", "FIT_Ch3_Peak", "FIT_Ch3_TOF",
- "FIT_Ch4_Peak", "FIT_Ch4_TOF", "FIT_Filename", "FIT_SaveX",
- "FIT_SaveY", "FIT_PixelW", "FIT_PixelH", "FIT_CaptureX",
- "FIT_CaptureY", "FIT_High_U32", "FIT_Low_U32", "FIT_Total"), skip = skip)
- # Add columns present in list files from FlowCAM III
- tab$FIT_Feret_Min_Angle <- NA
- tab$FIT_Edge_Gradient <- NA
- tab$FIT_Timestamp1 <- NA
- tab$FIT_Timestamp2 <- NA
- tab$FIT_Source_Image <- NA
- tab$FIT_Calibration_Image <- NA
- tab$FIT_Ch2_Ch1_Ratio <- tab$FIT_Ch2_Peak / tab$FIT_Ch1_Peak
- # new variables calculation (present in dataexport.csv from the FlowCAM)
- tab$FIT_Volume_ABD <- (4/3) * pi * (tab$FIT_Diameter_ABD/2)^3
- tab$FIT_Volume_ESD <- (4/3) * pi * (tab$FIT_Diameter_ESD/2)^3
- tab$FIT_Aspect_Ratio <- tab$FIT_Width / tab$FIT_Length
- tab$FIT_Transparency <- 1 - (tab$FIT_Diameter_ABD/tab$FIT_Diameter_ESD)
- tab$FIT_Red_Green_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Green
- tab$FIT_Blue_Green_Ratio <- tab$FIT_Avg_Blue / tab$FIT_Avg_Green
- tab$FIT_Red_Blue_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Blue
- } else {
- # FlowCAM III with 47 columns
- # read the table
- tab <- read.table(x, header = FALSE, sep = ":", dec = '.',
- col.names = c("Id", "FIT_Cal_Const", "FIT_Raw_Area", "FIT_Raw_Feret_Max", "FIT_Raw_Feret_Min",
- "FIT_Raw_Feret_Mean", "FIT_Raw_Perim", "FIT_Raw_Convex_Perim", "FIT_Area_ABD",
- "FIT_Diameter_ABD", "FIT_Length", "FIT_Width", "FIT_Diameter_ESD", "FIT_Perimeter",
- "FIT_Convex_Perimeter", "FIT_Intensity", "FIT_Sigma_Intensity", "FIT_Compactness",
- "FIT_Elongation", "FIT_Sum_Intensity", "FIT_Roughness", "FIT_Feret_Max_Angle",
- "FIT_Feret_Min_Angle", "FIT_Avg_Red", "FIT_Avg_Green", "FIT_Avg_Blue", "FIT_PPC",
- "FIT_Ch1_Peak", "FIT_Ch1_TOF", "FIT_Ch2_Peak", "FIT_Ch2_TOF", "FIT_Ch3_Peak",
- "FIT_Ch3_TOF", "FIT_Ch4_Peak", "FIT_Ch4_TOF", "FIT_Filename", "FIT_SaveX",
- "FIT_SaveY", "FIT_PixelW", "FIT_PixelH", "FIT_CaptureX", "FIT_CaptureY", "FIT_Edge_Gradient",
- "FIT_Timestamp1", "FIT_Timestamp2", "FIT_Source_Image", "FIT_Calibration_Image"), skip = skip)
- # Add columns present in list files from FlowCAM II
- tab$FIT_High_U32 <- NA
- tab$FIT_Low_U32 <- NA
- tab$FIT_Total <- NA
- # new variables calculation (present in dataexport.csv from the FlowCAM)
- tab$FIT_Volume_ABD <- (4/3) * pi * (tab$FIT_Diameter_ABD/2)^3
- tab$FIT_Volume_ESD <- (4/3) * pi * (tab$FIT_Diameter_ESD/2)^3
- tab$FIT_Aspect_Ratio <- tab$FIT_Width / tab$FIT_Length
- tab$FIT_Transparency <- 1 - (tab$FIT_Diameter_ABD/tab$FIT_Diameter_ESD)
- tab$FIT_Red_Green_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Green
- tab$FIT_Blue_Green_Ratio <- tab$FIT_Avg_Blue / tab$FIT_Avg_Green
- tab$FIT_Red_Blue_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Blue
- tab$FIT_Ch2_Ch1_Ratio <- tab$FIT_Ch2_Peak / tab$FIT_Ch1_Peak
- }
- # Try to extract metadata from ctx files
- ctxfile <- sub("lst$", "ctx", x)
- if (file.exists(ctxfile)) {
- # There is an associated ctx file
- Ctx <- scan(ctxfile, character(), sep = "\t", skip = 0,
- blank.lines.skip = FALSE, flush = TRUE, quiet = TRUE,
- comment.char = "")
- KeyValue <- function (x, key, as.numeric = TRUE) {
- pos <- grep(paste("^", key, sep = ""), x)
- if (length(pos) < 1) return(NULL)
- str <- x[pos[1]]
- res <- strsplit(str, "=")[[1]][2]
- res <- trimstring(res)
- if (isTRUE(as.numeric)) res <- as.numeric(res)
- return(res)
- }
- Version <- KeyValue(Ctx, "SoftwareVersion", as.numeric = FALSE)
- if (Version == "2.2.1") {
- AcceptableLeft <- KeyValue(Ctx, "AcceptableLeft")
- AcceptableRight <- KeyValue(Ctx, "AcceptableRight")
- AcceptableTop <- KeyValue(Ctx, "AcceptableTop")
- AcceptableBottom <- KeyValue(Ctx, "AcceptableBottom")
- MinESD <- KeyValue(Ctx, "MinESD")
- MaxESD <- KeyValue(Ctx, "MaxESD")
- RawImageTotal <- KeyValue(Ctx, "RawImageTotal")
- FlowCellDepth <- KeyValue(Ctx, "FlowCellDepth")
- FlowCellWidth <- KeyValue(Ctx, "FlowCellWidth")
- ImagePerSec <- KeyValue(Ctx, "AutoImageRate")
- CalibConstant <- KeyValue(Ctx, "CalibrationConstant")
- TotalVolume <- KeyValue(Ctx, "TotalVolumeML")
- } else warning("Ctx version not recognized (", Version, ")\n", sep = "")
-
- # Must be metadata and must conform to the specification of a ZIDat/zim file
- attr(tab, "metadata") <- list(Version, AcceptableLeft, AcceptableRight,
- AcceptableTop, AcceptableBottom, MinESD, MaxESD, RawImageTotal,
- FlowCellDepth, FlowCellWidth, ImagePerSec, CalibConstant, TotalVolume)
- } else attr(tab, "metadata") <- NULL
- class(tab) <- c("ZI1Dat", "ZIDat", "data.frame")
- return(tab)
-}
-
# Calculation of elapsed time and create the attr(rec, "TimeElapsed")
"TimeElapsed" <- function (List)
{
Modified: pkg/zooimage/R/ZITrain.R
===================================================================
--- pkg/zooimage/R/ZITrain.R 2010-09-03 13:37:02 UTC (rev 194)
+++ pkg/zooimage/R/ZITrain.R 2010-09-07 10:15:24 UTC (rev 195)
@@ -187,6 +187,8 @@
if (!is.null(desc)) attr(df, "desc") <- desc
Classes <- c("ZI1Train", "ZITrain", Classes)
class(df) <- Classes
+ # Be sure that variables are in numeric
+ df <- as.numeric.Vars(df)
return(df)
}
Modified: pkg/zooimage/R/gui.R
===================================================================
--- pkg/zooimage/R/gui.R 2010-09-03 13:37:02 UTC (rev 194)
+++ pkg/zooimage/R/gui.R 2010-09-07 10:15:24 UTC (rev 195)
@@ -328,7 +328,7 @@
# Look if there is at least one image selected
if (length(Images) == 0) return(invisible())
- dir <- dirname(Images[1])
+ dir <- dirname(Images[1])
Images <- basename(Images)
has <- function (extension, pattern = extensionPattern(extension))
@@ -340,6 +340,19 @@
return(make.zie(path = dir, Filemap = Images[1], check = TRUE,
show.log = TRUE))
} else if (has("txt")) {
+ # Special Case for flowCAM images
+ FlowCAMPath <- file.path(dir, Images)
+ FlowCAM.txt <- read.table(FlowCAMPath, header = TRUE, sep = "\t", dec = ".")
+ TargetName <- c("Station", "Date", "FlowCell", "Mode", "Magnification", "Exp_Name",
+ "Sample", "Dilution", "Sieve", "Volume", "Pump_Speed", "Duration", "Temperature",
+ "Salinity", "Gain_Fluo_Ch1", "Threshold_Fluo_Ch1", "Gain_Fluo_Ch2", "Threshold_Fluo_Ch2",
+ "Threshold_Scatter", "Min", "Max", "Size", "Dark_Threshold", "Light_Threshold",
+ "Dist_To_Nearest", "Lugol")
+
+ if(isTRUE(all(TargetName %in% names(FlowCAM.txt)))){
+ res <- make.Zim.FlowCAM(import = FlowCAMPath, check.names = FALSE)
+ return(invisible(res))
+ }
pattern <- extensionPattern(".txt")
setKey("ImageIndex", "4")
logProcess("Creating .zie file...")
@@ -1307,3 +1320,25 @@
# Classify vignettes
classifVign(zidfile = zid, ZIDat = ZIDat, ZIClass = ZICobj, Dir = FinalDir, Filter = Threshold)
}
+
+# Create a batch file for FlowCAM image analysis
+"BatchFilePlugin" <- function()
+{
+ # Select a context file
+ if (isWin()) {
+ CtxFile <- choose.files(
+ caption = "Select a context file...",
+ multi = FALSE, filters = c("FlowCAM Context file",
+ "*.ctx"))
+ } else {
+ CtxFile <- tk_choose.files(
+ caption = "Select a context file...",
+ multi = FALSE, filters = matrix(c("FlowCAM Context file",
+ ".ctx"), ncol = 2, byrow = TRUE))
+ }
+
+ # create the table
+ create.BatchFile(ctx = CtxFile, fil = FALSE, largest = FALSE, vignettes = TRUE,
+ scalebar = TRUE, enhance = FALSE, outline = FALSE, masks = FALSE, verbose = TRUE,
+ txt = FALSE, csv = TRUE, ImportName = "batchExampleParameters")
+}
Modified: pkg/zooimage/R/utilities.R
===================================================================
--- pkg/zooimage/R/utilities.R 2010-09-03 13:37:02 UTC (rev 194)
+++ pkg/zooimage/R/utilities.R 2010-09-07 10:15:24 UTC (rev 195)
@@ -95,7 +95,7 @@
# Adapt title according to 'multi'
if (isTRUE(multi) && !is.null(title)) {
- title <- paste("Select one or several", Type, "files...")
+ title <- paste("Select one or several", Type, "files...")
} else {
title <- paste("Select one", Type, "file...")
}
@@ -117,12 +117,28 @@
Img = c("Tiff image files" , ".tif",
"Jpeg image files" , ".jpg",
"Zooimage import extensions",".zie",
- "Table and ImportTemplate.zie",".txt" ),
+ "Table and ImportTemplate.zie",".txt",
+# Modif Kev add option for FlowCAM images
+ "FlowCAM Table and ImportTemplate.zie",".txt"),
TifPgm = c("Tiff image files" , ".tif" ),
"Pgm image files" , ".pgm",
RData = c("R data" , ".RData" ))
filters <- matrix(filters, ncol = 2, byrow = TRUE)
res <- tk_choose.files(caption = title, multi = multi, filters = filters)
+
+ #} else { # Old treatment using Windows-only function
+ # filters <- switch(type,
+ # ZipZid = c("ZooImage files (*.zip;*.zid)" , "*.zip;*.zid"),
+ # ZimZis = c("ZooImage metadata files (*.zim;*.zis)" , "*.zim;*.zis"),
+ # Zip = c("ZooImage picture files (*.zip)" , "*.zip" ),
+ # Zid = c("ZooImage data files (*.zid)" , "*.zid" ),
+ # Zim = c("ZooImage metadata files (*.zim)" , "*.zim" ),
+ # Zis = c("ZooImage sample files (*.zis)" , "*.zis" ),
+ # Zie = c("ZooImage extension files (*.zie)" , "*.zie" ))
+ # filters <- matrix(filters, ncol = 2, byrow = TRUE)
+ # res <- choose.files(caption = title, multi = multi, filters = filters)
+ #}
+
if (length(res) && res != "" && quote)
res <- paste('"', res, '"', sep = "")
return(res)
@@ -522,3 +538,81 @@
if (!Dec %in% DecList) Dec <- "."
return(Dec)
}
+
+# function to be sure that numeric values are numeric!
+as.numeric.Vars <- function(ZIDat, Vars = NULL){
+ # Default values
+ if(is.null(Vars)){
+ Vars <- c("ECD",
+ "FIT_Area_ABD", "FIT_Diameter_ABD", "FIT_Volume_ABD", "FIT_Diameter_ESD",
+ "FIT_Volume_ESD", "FIT_Length", "FIT_Width", "FIT_Aspect_Ratio", "FIT_Transparency",
+ "FIT_Intensity", "FIT_Sigma_Intensity", "FIT_Sum_Intensity", "FIT_Compactness",
+ "FIT_Elongation", "FIT_Perimeter", "FIT_Convex_Perimeter", "FIT_Roughness",
+ "FIT_Feret_Max_Angle", "FIT_PPC", "FIT_Ch1_Peak", "FIT_Ch1_TOF", "FIT_Ch2_Peak",
+ "FIT_Ch2_TOF", "FIT_Ch3_Peak", "FIT_Ch3_TOF", "FIT_Avg_Red", "FIT_Avg_Green",
+ "FIT_Avg_Blue", "FIT_Red_Green_Ratio", "FIT_Blue_Green", "FIT_Red_Blue_Ratio",
+ "FIT_CaptureX", "FIT_CaptureY", "FIT_SaveX", "FIT_SaveY", "FIT_PixelW", "FIT_PixelH",
+ "FIT_Cal_Const",
+ "Area", "Mean", "StdDev", "Mode", "Min", "Max", "X", "Y", "XM",
+ "YM", "Perim.", "BX", "BY", "Width", "Height", "Major", "Minor", "Angle", "Circ.",
+ "Feret", "IntDen", "Median", "Skew", "Kurt", "XStart", "YStart", "Dil"
+ )
+ }
+
+ # Names of ZIDat
+ Names <- names(ZIDat)
+
+ # Transform variables in numeric values
+ for (i in 1 : length(Vars)){
+ if(isTRUE(Vars[i] %in% Names)){
+ Num <- is.numeric(ZIDat[, Vars[i]])
+ if(!isTRUE(Num)){
+ ZIDat[, Vars[i]] <- as.numeric(ZIDat[, Vars[i]])
+ }
+ }
+ }
+ return(ZIDat)
+}
+
+# Function to reprocess a R.Data file in a zid file
+"NewRdata" <- function(path = "D", replace = TRUE)
+{
+ # list of zid files to reporcess
+ zid <- list.files(path = path, pattern = "^.*[.][zZ][iI][dD]")
+ if(is.null(zid)) stop("no zid files in the directory") # of no zid files
+ # path of zid files
+ path.zid <- paste(path, zid, sep = "/")
+ # loop to analyze zid files one by one
+ for (i in 1 : length(zid)){
+ # extract zid in 'path' directory
+ uncompress.zid(path.zid[i])
+ # calculate new Rdata
+ path.sample <- sub("[.][zZ][iI][dD]","",path.zid[i])
+ make.RData(path.sample, replace = replace)
+ # compress new zid file
+ compress.zid(path.sample, replace = replace)
+ }
+}
+
+# Function to create a batch file for FlowCAM image analysis
+"create.BatchFile" <- function(ctx, fil = FALSE, largest = FALSE, vignettes = TRUE,
+ scalebar = TRUE, enhance = FALSE, outline = FALSE, masks = FALSE, verbose = TRUE,
+ txt = TRUE, csv = FALSE, ImportName = "batchExampleParameters")
+{
+ # Check arguments
+ if(!is.character(ctx)) stop("You must select a context file")
+ # Create the table of importation
+ ContextList <- read.ctx.all(ctx = ctx, fil = fil, largest = largest, vignettes = vignettes,
+ scalebar = scalebar, enhance = enhance, outline = outline, masks = masks, verbose = verbose)
+ # Write the table of importation in the sample directory
+ if(txt){
+ # Export table as txt format
+ write.table(ContextList, file = paste(dirname(dirname(ctx)), paste(ImportName, ".txt", sep = ""), sep = "/"),
+ quote = TRUE, sep = "\t", dec = ".", row.names = FALSE, col.names = TRUE)
+ } else {
+ # export table as csv format
+ write.csv(ContextList, file = paste(dirname(dirname(ctx)), paste(ImportName, ".csv", sep = ""), sep = "/"), row.names = FALSE)
+ }
+ cat(paste("Your import table has been created in", dirname(dirname(ctx)), " : your samples directory", "\n", sep = " "))
+}
+
Modified: pkg/zooimage/R/zid.R
===================================================================
--- pkg/zooimage/R/zid.R 2010-09-03 13:37:02 UTC (rev 194)
+++ pkg/zooimage/R/zid.R 2010-09-07 10:15:24 UTC (rev 195)
@@ -132,133 +132,165 @@
# 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)
+"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 (type != "ZI1")
+ stop("only 'ZI1' is currently supported for 'type'!")
+ RDataFile <- file.path(zidir, paste(basename(zidir), "_dat1.RData",
+ sep = ""))
+
+ # File already exists
+ if (file.exists(RDataFile) && !replace)
+ return(invisible(TRUE))
+ ok <- TRUE
+ dat1files <- list.dat1.zim(zidir)
- # File already exists
- if (file.exists(RDataFile) && !replace) return(invisible(TRUE))
+ # modif to create zidat1zim files
+ # Create dat1zim if ity is missing (Special treatment for FlowCAM data)
+ if (length(dat1files) == 0){
+ # Try to create them
+ SmpDir <- dirname(zidir)
+ ZimFile <- file.path(SmpDir, paste(basename(zidir), ".zim", sep = ""))
+ Make.dat1.zim(ZimFile)
+ dat1files <- list.dat1.zim(zidir)
+ if (length(dat1files) == 0){
+ stop("no '_dat1.zim' file!")
+ }
+ }
+
+ dat1files <- sort(dat1files)
+ fractions <- get.sampleinfo(dat1files, "fraction")
- ok <- TRUE
- dat1files <- list.dat1.zim(zidir)
- if (length(dat1files) == 0) stop("no '_dat1.zim' file!")
- dat1files <- sort(dat1files)
- fractions <- get.sampleinfo(dat1files, "fraction")
+ # Avoid collecting duplicate informations about fractions
+ fracdup <- duplicated(fractions)
+ results <- lapply(seq.int(1, length(dat1files)), function(i) {
+ dat1path <- file.path(zidir, dat1files[i])
+ iszim <- tryCatch(is.zim(dat1path), zooImageError = function(e) {
+ logError(e)
+ return(FALSE)
+ })
+ if (!iszim)
+ return(NULL)
+
+ # Read the header
+ 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])
+ return(NULL)
+ }
+
+ # Trim leading and trailing spaces in Lines
+ Lines <- trimstring(Lines)
+
+ # Convert underscore to space
+ Lines <- underscore2space(Lines)
+
+ # Determine start of the measurements table (it is '[Data]' header)
+ endhead <- tail(which(Lines == "[Data]"), 1)
+ if (!is.null(endhead))
+ 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
+# Bug meta is not calculated if fracdup[i] = TRUE and thus there is no meta calculated
+# meta <- if (!fracdup[i] && !is.null(Lines))
+# parse.ini(Lines, sub("_dat1[.]zim$", "", fractions[i]))
+ if (!is.null(Lines)){
+ meta <- parse.ini(Lines, sub("_dat1[.]zim$", "", fractions[i]))
+ }
+# Bug
- # Avoid collecting duplicate informations about fractions
- fracdup <- duplicated(fractions)
- results <- lapply(seq.int(1, length(dat1files)), function (i) {
- dat1path <- file.path(zidir, dat1files[i])
- iszim <- tryCatch(is.zim(dat1path), zooImageError = function (e) {
- logError(e)
- return(FALSE)
- })
- if (!iszim) return(NULL)
+ if (!is.null(endhead)) {
+ mes <- read.table(dat1path, header = TRUE, sep = "\t",
+ dec = ".", as.is = FALSE, skip = endhead + 1,
+ comment.char = "#", na.strings = "null")
+ # 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.
+ # [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 its 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"
+ # 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)
+ Sub <- meta$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"))
+
+ combine <- function(.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)
+ }
- # Read the header
- 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])
- return(NULL)
- }
+# Bug combine(list.allmeta) doesn't work!
+# allmeta <- combine(list.allmeta)
+ list.allmeta <- list.allmeta[!fracdup] # only the levels of not duplicated metadata
+ Lmeta <- length(list.allmeta[])
+ if(Lmeta == 1){
+# Lmeta <- list.allmeta
+ allmeta <- combine(list.allmeta)
+ } else {
+ allmeta <- NULL
+ for(i in 1 : (Lmeta-1)){
+ allmeta <- list.merge(list.allmeta[[i]], list.allmeta[[i + 1]])
+ }
+ }
+# Bug combine(list.allmeta) doesn't work!
- # Trim leading and trailing spaces in Lines
- Lines <- trimstring(Lines)
-
- # Convert underscore to space
- Lines <- underscore2space(Lines)
-
- # Determine start of the measurements table (it is '[Data]' header)
- endhead <- tail(which(Lines == "[Data]"), 1)
- if (!is.null(endhead))
- 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
- meta <- if (!fracdup[i] && !is.null(Lines))
- parse.ini(Lines, sub("_dat1[.]zim$", "", fractions[i]))
-
- # 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 = "#", na.strings = "null")
-
- # 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.
-
- # [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 its 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"
- # 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)
-
- Sub <- meta$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"))
-
- combine <- function (.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)
- }
- 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 <- data.frame(allmes[, 1:2], "ECD" = ECD,
- allmes[, 3:ncol(allmes)])
- }
-
- # Construct a c('ZI1Dat', 'ZIDat', 'data.frame') object with 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()
- return(invisible(ok))
+ allmes <- combine(list.allmes)
+ rownames(allmes) <- 1:nrow(allmes)
+ Names <- names(allmes)
+ # Calculate an ECD from Area if there is not one yet
+ if (!"ECD" %in% Names && "Area" %in% Names) {
+ ECD <- ecd(allmes$Area)
+ allmes <- data.frame(allmes[, 1:2], ECD = ECD, allmes[,
+ 3:ncol(allmes)])
+ }
+ attr(allmes, "metadata") <- allmeta
+ class(allmes) <- c("ZI1Dat", "ZIDat", "data.frame")
+ ZI.sample <- allmes
+ save(ZI.sample, file = RDataFile, ascii = FALSE, version = 2,
+ compress = TRUE)
+ if (ok)
+ ok <- file.exists(RDataFile)
+ if (show.log)
+ logView()
+ return(invisible(ok))
}
# Compress one sample as a single .zid zipped file
Modified: pkg/zooimage/R/zim.R
===================================================================
--- pkg/zooimage/R/zim.R 2010-09-03 13:37:02 UTC (rev 194)
+++ pkg/zooimage/R/zim.R 2010-09-07 10:15:24 UTC (rev 195)
@@ -433,3 +433,504 @@
} else is.zim(name)
editor(name, editor = editor)
}
+
+## FlowCAM special treatment because the plugin doesn't export dat1.zim!
+# read list file
+"read.lst" <- function (x, skip = 2)
+{
+ # Determine the version of the FlowCAM
+ ncol <- length(read.table(x, header = FALSE, sep = ":", dec = ".", skip = 2, nrow = 1))
+ if(ncol <= 44){
+ # FlowCAM II with 44 columns
+ # read the table
+ tab <- read.table(x, header = FALSE, sep = ":", dec = '.',
+ col.names = c("Id", "FIT_Cal_Const", "FIT_Raw_Area", "FIT_Raw_Feret_Max",
+ "FIT_Raw_Feret_Min", "FIT_Raw_Feret_Mean",
+ "FIT_Raw_Perim", "FIT_Raw_Convex_Perim", "FIT_Area_ABD", "FIT_Diameter_ABD",
+ "FIT_Length", "FIT_Width", "FIT_Diameter_ESD", "FIT_Perimeter", "FIT_Convex_Perimeter",
+ "FIT_Intensity", "FIT_Sigma_Intensity", "FIT_Compactness", "FIT_Elongation",
+ "FIT_Sum_Intensity", "FIT_Roughness", "FIT_Feret_Max_Angle", "FIT_Avg_Red",
+ "FIT_Avg_Green", "FIT_Avg_Blue", "FIT_PPC", "FIT_Ch1_Peak",
+ "FIT_Ch1_TOF", "FIT_Ch2_Peak", "FIT_Ch2_TOF", "FIT_Ch3_Peak", "FIT_Ch3_TOF",
+ "FIT_Ch4_Peak", "FIT_Ch4_TOF", "FIT_Filename", "FIT_SaveX",
+ "FIT_SaveY", "FIT_PixelW", "FIT_PixelH", "FIT_CaptureX",
+ "FIT_CaptureY", "FIT_High_U32", "FIT_Low_U32", "FIT_Total"), skip = skip)
+ # Add columns present in list files from FlowCAM III
+ tab$FIT_Feret_Min_Angle <- NA
+ tab$FIT_Edge_Gradient <- NA
+ tab$FIT_Timestamp1 <- NA
+ tab$FIT_Timestamp2 <- NA
+ tab$FIT_Source_Image <- NA
+ tab$FIT_Calibration_Image <- NA
+ tab$FIT_Ch2_Ch1_Ratio <- tab$FIT_Ch2_Peak / tab$FIT_Ch1_Peak
+ # new variables calculation (present in dataexport.csv from the FlowCAM)
+ tab$FIT_Volume_ABD <- (4/3) * pi * (tab$FIT_Diameter_ABD/2)^3
+ tab$FIT_Volume_ESD <- (4/3) * pi * (tab$FIT_Diameter_ESD/2)^3
+ tab$FIT_Aspect_Ratio <- tab$FIT_Width / tab$FIT_Length
+ tab$FIT_Transparency <- 1 - (tab$FIT_Diameter_ABD/tab$FIT_Diameter_ESD)
+ tab$FIT_Red_Green_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Green
+ tab$FIT_Blue_Green_Ratio <- tab$FIT_Avg_Blue / tab$FIT_Avg_Green
+ tab$FIT_Red_Blue_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Blue
+ } else {
+ # FlowCAM III with 47 columns
+ # read the table
+ tab <- read.table(x, header = FALSE, sep = ":", dec = '.',
+ col.names = c("Id", "FIT_Cal_Const", "FIT_Raw_Area", "FIT_Raw_Feret_Max", "FIT_Raw_Feret_Min",
+ "FIT_Raw_Feret_Mean", "FIT_Raw_Perim", "FIT_Raw_Convex_Perim", "FIT_Area_ABD",
+ "FIT_Diameter_ABD", "FIT_Length", "FIT_Width", "FIT_Diameter_ESD", "FIT_Perimeter",
+ "FIT_Convex_Perimeter", "FIT_Intensity", "FIT_Sigma_Intensity", "FIT_Compactness",
+ "FIT_Elongation", "FIT_Sum_Intensity", "FIT_Roughness", "FIT_Feret_Max_Angle",
+ "FIT_Feret_Min_Angle", "FIT_Avg_Red", "FIT_Avg_Green", "FIT_Avg_Blue", "FIT_PPC",
+ "FIT_Ch1_Peak", "FIT_Ch1_TOF", "FIT_Ch2_Peak", "FIT_Ch2_TOF", "FIT_Ch3_Peak",
+ "FIT_Ch3_TOF", "FIT_Ch4_Peak", "FIT_Ch4_TOF", "FIT_Filename", "FIT_SaveX",
+ "FIT_SaveY", "FIT_PixelW", "FIT_PixelH", "FIT_CaptureX", "FIT_CaptureY", "FIT_Edge_Gradient",
+ "FIT_Timestamp1", "FIT_Timestamp2", "FIT_Source_Image", "FIT_Calibration_Image"), skip = skip)
+ # Add columns present in list files from FlowCAM II
+ tab$FIT_High_U32 <- NA
+ tab$FIT_Low_U32 <- NA
+ tab$FIT_Total <- NA
+ # new variables calculation (present in dataexport.csv from the FlowCAM)
+ tab$FIT_Volume_ABD <- (4/3) * pi * (tab$FIT_Diameter_ABD/2)^3
+ tab$FIT_Volume_ESD <- (4/3) * pi * (tab$FIT_Diameter_ESD/2)^3
+ tab$FIT_Aspect_Ratio <- tab$FIT_Width / tab$FIT_Length
+ tab$FIT_Transparency <- 1 - (tab$FIT_Diameter_ABD/tab$FIT_Diameter_ESD)
+ tab$FIT_Red_Green_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Green
+ tab$FIT_Blue_Green_Ratio <- tab$FIT_Avg_Blue / tab$FIT_Avg_Green
+ tab$FIT_Red_Blue_Ratio <- tab$FIT_Avg_Red / tab$FIT_Avg_Blue
+ tab$FIT_Ch2_Ch1_Ratio <- tab$FIT_Ch2_Peak / tab$FIT_Ch1_Peak
+ }
+ return(tab)
+}
+
+# read context file
+"read.ctx" <- function(ctx, fil = FALSE, largest = FALSE, vignettes = TRUE,
+ scalebar = TRUE, enhance = FALSE, outline = FALSE, masks = FALSE, verbose = TRUE)
+{
+ # Check arguments
+ if(!is.character(ctx)) stop("You must select a context file")
+ # Extract information from context file
+ # Scan the ctx file
+ Ctxfile <- scan(ctx, character(), sep = "\t", skip = 0,
+ blank.lines.skip = FALSE, flush = TRUE, quiet = TRUE, comment.char = "")
+ # Read version of Visual SpreadSheet
+ ImageLine <- grep("^SoftwareVersion", Ctxfile)
+ SoftwareVersion <- as.character(sub("[ ]*$", "", sub("^SoftwareVersion[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Read right parameters
+# if(SoftwareVersion == "1.5.14" | SoftwareVersion == "1.5.16"){
+ if(sub("...$", "", SoftwareVersion) == "1.5" | sub("..$", "", SoftwareVersion) == "1.5"){
+ # Read recalibration duration
+ ImageLine <- grep("^SaveIntervalMinutes", Ctxfile)
+ interval <- as.numeric(sub("[ ]*$", "", sub("^SaveIntervalMinutes[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Read pixel size
+ ImageLine <- grep("^CalibrationConstant", Ctxfile)
+ pixelsize <- as.numeric(sub("[ ]*$", "", sub("^CalibrationConstant[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Read minimal size
+ ImageLine <- grep("^MinESD", Ctxfile)
+ minsize <- as.numeric(sub("[ ]*$", "", sub("^MinESD[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Read maximal size
+ ImageLine <- grep("^MaxESD", Ctxfile)
+ maxsize <- as.numeric(sub("[ ]*$", "", sub("^MaxESD[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Read the kind of segmentation used
+ ImageLine <- grep("^CaptureDarkOrLightPixels", Ctxfile)
+ DarkOrLight <- as.numeric(sub("[ ]*$", "", sub("^CaptureDarkOrLightPixels[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ if(DarkOrLight == 0){
+ use <- "dark"
+ # Read segmentation threshold
+ ImageLine <- grep("^Threshold", Ctxfile)
+ thresholddark <- as.numeric(sub("[ ]*$", "", sub("^Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ thresholdlight <- as.numeric(sub("[ ]*$", "", sub("^Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ }
+ if(DarkOrLight == 1){
+ use <- "light"
+ # Read segmentation threshold
+ ImageLine <- grep("^Threshold", Ctxfile)
+ thresholddark <- as.numeric(sub("[ ]*$", "", sub("^Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ thresholdlight <- as.numeric(sub("[ ]*$", "", sub("^Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ }
+ if(DarkOrLight == 2){
+ use <- "both"
+ # Read segmentation threshold
+ ImageLine <- grep("^Threshold", Ctxfile)
+ thresholddark <- as.numeric(sub("[ ]*$", "", sub("^Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ thresholdlight <- as.numeric(sub("[ ]*$", "", sub("^Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ }
+ # Path of the export of data
+ select <- paste(basename(dirname(ctx)), "data_export.csv", sep = "/")
+ # Sample name
+ Sample_Name <- basename(dirname(ctx))
+ # Read Fluo information
+ ImageLine <- grep("^Ch1Gain", Ctxfile)
+ Gain_Fluo_Ch1 <- as.numeric(sub("[ ]*$", "", sub("^Ch1Gain[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ ImageLine <- grep("^Ch1Threshold", Ctxfile)
+ Threshold_Fluo_Ch1 <- as.numeric(sub("[ ]*$", "", sub("^Ch1Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ ImageLine <- grep("^Ch2Gain", Ctxfile)
+ Gain_Fluo_Ch2 <- as.numeric(sub("[ ]*$", "", sub("^Ch2Gain[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ ImageLine <- grep("^Ch2Threshold", Ctxfile)
+ Threshold_Fluo_Ch2 <- as.numeric(sub("[ ]*$", "", sub("^Ch2Threshold[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Read information about FlowCell
+ ImageLine <- grep("^FlowCellDepth", Ctxfile)
+ FlowCell <- as.numeric(sub("[ ]*$", "", sub("^FlowCellDepth[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Distance to nearest
+ ImageLine <- grep("^DistanceToNeighbor", Ctxfile)
+ Dist_To_Nearest <- as.numeric(sub("[ ]*$", "", sub("^DistanceToNeighbor[ ]*[=][ ]*", "", Ctxfile[ImageLine[1]])))
+ # Calculation of volume analyzed
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 195
More information about the Zooimage-commits
mailing list