[Zooimage-commits] r187 - in pkg/zooimage: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Apr 13 18:14:16 CEST 2010
Author: phgrosjean
Date: 2010-04-13 18:14:14 +0200 (Tue, 13 Apr 2010)
New Revision: 187
Modified:
pkg/zooimage/R/RealTime.R
pkg/zooimage/R/ZIClass.R
pkg/zooimage/R/ZIRes.R
pkg/zooimage/R/ZITrain.R
pkg/zooimage/R/gui.R
pkg/zooimage/R/utilities.R
pkg/zooimage/man/RealTime.Rd
pkg/zooimage/man/ZIClass.Rd
pkg/zooimage/man/utilities.Rd
Log:
Some more cleaning up, mainly in the real time process
Modified: pkg/zooimage/R/RealTime.R
===================================================================
--- pkg/zooimage/R/RealTime.R 2010-04-12 07:36:16 UTC (rev 186)
+++ pkg/zooimage/R/RealTime.R 2010-04-13 16:14:14 UTC (rev 187)
@@ -15,803 +15,751 @@
# You should have received a copy of the GNU General Public License
# along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
+"realtimeSlope" <- function (ZIDat, breaks, log = TRUE)
+{
+ if (!"FIT_Diameter_ABD" %in% names(ZIDat))
+ stop("The 'FIT_Diameter_ABD' column is required in 'ZIDat' but not found")
+ Dat <- as.vector(table(cut(ZIDat$FIT_Diameter_ABD/1000, breaks = breaks)))
+ if (isTRUE(log)) Dat <- log10(Dat + 1)
+ midpoints <- (breaks[-1] + breaks[-length(breaks)]) / 2
+ Lm <- lm(Dat ~ midpoints)
+ res <- coef(Lm)[2]
+ attr(res, "lm") <- Lm
+ return(res)
+}
-# 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
- }
- return(tab)
+# Loop to run process and comparisons in real-time (delay interval is in ms)
+"realtimeLoop" <- function (delay = 15000)
+{
+ continue <- TRUE
+ # Function to execute at regular interval
+ realtimeProcess(List = getOption("Path"), ZIClass = getOption("Classifier"),
+ conv = getOption("conv"), Collage = getOption("Collage"),
+ FlowCell = getOption("FlowCell"), ImgPerSec = getOption("ImgPerSec"),
+ Size = getOption("Size"), Lag = getOption("Lag"))
+ #realtimePlotMobile(ZIDat = rec, group = getOption("Group"),
+ # identify = getOption("identify"), breaks = getOption("breaks"),
+ # log = getOption("log"), RealT = TRUE)
+ #realtimePlot(ZIDat = rec, type = getOption("type"), Abd = getOption("Abd"),
+ # Bio = getOption("Bio"), Group = getOption("Group"),
+ # Concentration = getOption("Concentration"),
+ # Spectra = getOption("Spectra"), breaks = getOption("breaks"),
+ # Compa = getOption("Compa"), log = getOption("log"))
+
+ # Is there a stop signal?
+ if (existsTemp(".realtimeStopItFlag")) {
+ rmTemp(".realtimeStopItFlag")
+ timer <- NULL
+ } else { # Continue...
+ # Run realtimeLoop after 'delay' ms
+ timer <- .Tcl(paste("after", as.integer(delay)[1], "realtimeLoop"))
+ }
+ return(invisible(timer))
}
-# Prediction of classes in real-time
-"predict.ZIClass.Real.Time" <-
- function(object, ZIDat, calc.vars = TRUE, class.only = FALSE, type = "class", na.rm = NULL, ...) {
- # Make sure we have correct objects
- if (!inherits(object, "ZIClass"))
- stop("'object' must be a ZIClass object!")
- if (!inherits(ZIDat, "ZIDat") && !inherits(ZIDat, "data.frame"))
- stop("'ZIDat' must be a ZIDat object, or a data.frame!")
- # Possibly load a specific package for prediction
- # Note: this is done in NAMESPACE
- #package <- attr(object, "package")
- #if (is.null(package)) {
- # # This is for old version, we make sure to load
- # # MASS, RandomForest, class, rpart, e1071, ipred
- # # Rem: nnet has a special treatment in nnet2
- # (require(MASS) || stop("package 'MASS' is required!"))
- # (require(RandomForest) || stop("package 'RandomForest' is required!"))
- # (require(class) || stop("package 'class' is required!"))
- # (require(rpart) || stop("package 'rpart' is required!"))
- # (require(e1071) || stop("package 'e1071' is required!"))
- # (require(ipred) || stop("package 'ipred' is required!"))
- #} else {
- # # Make sure that the specific required package is loaded
- # eval(parse(text = paste("require(", package, ")", sep = "")))
- #}
+"realtimeStop" <- function ()
+ assignTemp(".realtimeStopItFlag", TRUE)
- class(object) <- class(object)[-1]
- data <- as.data.frame(ZIDat)
- if (calc.vars) data <- attr(object, "calc.vars")(data)
- if (!is.null(na.rm)) na.omit(data)
- if(type != "prob"){
- Ident <- predict(object, newdata = data, type = type)
- } else {
- if(inherits(object, "randomForest")) {
- Ident <- predict(object, newdata = data, type = type)
- }
- if(inherits(object, "lda")) {
- Ident <- predict(object, newdata = data)$posterior
- }
- }
- # Special case for prediction from an LDA (list with $class item)
- if (inherits(Ident, "list") && "class" %in% names(Ident))
- Ident <- Ident$class
- if (!class.only) {
- res <- cbind(ZIDat, Ident)
- class(res) <- class(ZIDat)
- } else res <- Ident
- return(res)
+"realtimeReset" <- function () {
+ assignTemp("rtData", NULL)
+ assignTemp("rtRecords", NULL)
+ assignTemp("rtTime", NULL)
}
-# Calculation of biomass
-Biomass <- function(tab){
- res <- NULL
- grps <- levels(tab$Ident)
- for(i in 1:length(grps)){
- res[i] <- sum(tab$Biomass[tab$Ident %in% grps[i]])
+"realtimeOptions" <- function (
+lstdir = ".", # Path of the list file of the current FlowCAM experiment
+ZIClass, # Classifier to use
+type = "b", # "b" : barplot, "l" : line alpha code
+SizeThreshold = NULL, # NULL or Size threshold in µm alpha code
+breaks = seq(0.05, 3, by = 0.1), # in mm
+convdir = ".", # Path of the conversion table
+ImgPerSec = 7,
+FlowCell = 600,
+Concentration = "p/mL", # "Absolute", "Relative" or "p/mL"
+Collage = NULL, # NULL: no mobile window, TRUE: use collage, FALSE: use number of vignettes
+Size = 5, # The size of the mobile window
+Lag = 2, # The lag between two successive mobile windows
+Abd = NULL, # NULL, TRUE or FALSE
+Bio = NULL, # NULL, TRUE or FALSE
+Spectra = NULL, # NULL, TRUE or FALSE
+Compa = NULL, # NULL, FALSE or a path of a list of sample to compare with
+Group = NULL, # The group to recognize and/or plot
+identify = FALSE, # Identify points on plot (TRUE or FALSE)
+log = FALSE, # Transform data in log10(x + 1)
+Slope = FALSE)
+{
+ # Check and/or convert arguments
+ lstdir <- as.character(lstdir)[1]
+
+ if (!inherits(ZIClass, "ZIClass"))
+ stop("'ZIClass' must be a classifier of class 'ZIClass'")
+
+ type <- as.character(type)[1]
+ if (!type %in% c("b", "l"))
+ stop("type must be 'b' (barplot) or 'l' (lines)")
+
+ if (!is.null(SizeThreshold) && !is.numeric(SizeThreshold))
+ stop("'SizeThreshold' must be a numeric value in microns or NULL")
+
+ if (!is.numeric(breaks))
+ stop("breaks must be the size interval (a vector of numeric values)")
+
+ convdir <- as.character(convdir)[1]
+
+ ImgPerSec <- as.numeric(ImgPerSec)[1]
+ if (ImgPerSec < 0)
+ stop("'ImgPerSec' must be the number of images taken by the FlowCAM per Second")
+
+ FlowCell <- as.integer(FlowCell)[1]
+
+ Concentration <- as.character(Concentration)[1]
+ if (!Concentration %in% c("p/mL", "Relative", "Absolute"))
+ stop("'Concentration' must be \"p/mL\", \"Absolute\" or \"Relative\"")
+
+ if (!is.null(Collage)) Collage <- isTRUE(Collage)
+
+ Size <- as.numeric(Size)[1]
+ if (Size <= 0)
+ stop("'Size' must be the value of the interval size (a positivce number)")
+
+ Lag <- as.numeric(Lag)[1]
+ if (Lag < 0)
+ stop("'Lag' must be the value of the lag between two mobile windows (postive or zero)")
+
+ if (!is.null(Abd)) Abd <- isTRUE(Abd)
+
+ if (!is.null(Bio)) Bio <- isTRUE(Bio)
+
+ if (!is.null(Spectra)) Spectra <- isTRUE(Spectra)
+
+ if (!is.null(Compa)) {
+ Compa <- as.character(Compa)
+ if (length(Compa) == 1) {
+ if(length(grep(pattern = ".[Zz][Ii][Dd]", x = Compa)) >= 1) {
+ # This a zid file
+ Smp <- read.zid(Compa)
+ } else {
+ # This is a list file
+ Smp <- read.lst(Compa)
+ }
+ Smp <- predict(ZIClass, Smp, calc.vars = FALSE, class.only = FALSE)
+ Smp <- BiomassTab(ZIDat = Smp, conv = convdir, RealT = TRUE)
+ List <- list(Smp)
+ names(List) <- noext(basename(Compa))
+ } else {
+ List <- list()
+ if (length(grep(pattern = ".[Zz][Ii][Dd]", x = Compa)) >= 1) {
+ # This a zid file
+ for (i in 1 : length(Compa))
+ List[[i]] <- BiomassTab(ZIDat = predict(ZIClass,
+ read.zid(Compa[i]), calc.vars = FALSE,
+ class.only = FALSE), conv = convdir, RealT = TRUE)
+ } else {
+ # This is a list file
+ for (i in 1 : length(Compa))
+ List[[i]] <- BiomassTab(ZIDat = predict(ZIClass,
+ read.lst(Compa[i]), calc.vars = FALSE,
+ class.only = FALSE), conv = convdir, RealT = TRUE)
+ }
+ names(List) <- noext(basename(Compa))
}
- names(res) <- grps
- return(res)
-}
+ Compa <- List
+ } else Compa <- FALSE
+
+ if (!is.null(Group)) Group <- as.character(Group)[1]
+
+ identify <- isTRUE(identify)
+
+ log <- isTRUE(log)
+
+ Slope <- isTRUE(Slope)
-# Plot of histograms and line for exponential decrease for size spectra
-hist.spectrum <- function(spect, breaks = seq(0.05, 0.6, by = 0.05),
- width = 0.1, xlab = "classes (mm)", ylab = "log(abundance + 1)", main = "",
- ylim = c(0, 10)) {
- spect.lm <- lm(spect ~ breaks[-length(breaks)])
- print(summary(spect.lm))
- slope <- format(coef(spect.lm)[2], digits = 3)
- main <- paste(main, " (slope = ", slope, ")", sep = "")
- barplot(spect, width = 0.1, space = 0, xlab = xlab, ylab = ylab, main = main, ylim = ylim)
- #abline(a = coef(spect.lm)[1], b = coef(spect.lm)[2], col = 2, lwd = 2)
- return(invisible(spect.lm))
+ # Construct the options object and save it in options
+ opts <- list(lstdir, ZIClass, type, SizeThreshold, breaks, convdir,
+ ImgPerSec, FlowCell, Size, Lag, Concentration, Abd, Bio, Spectra, Group,
+ Compa, identify, log, Slope)
+ options("ZIrealtimeOpts" = opts)
+ return(invisible(opts))
}
-# Function which controls arguments
-loop.opts <- function(lst = ".", # path of the list file of the current FlowCAM experiment
- classif = ZIC, # Classifier
- type = NULL, # Null: barplot, "l" : line alpha code
- SizeThreshold = NULL, # NULL or Size threshold in microns alpha code
- Export_Collages = NULL, # NULL or Number of collages by artificial sample alpha code
- ZIprevSmp = NULL, # Comparison with one previous sample
- ZIlist = NULL, # Comparison several previous samples
- Abd.all = TRUE, # NULL or TRUE
- Abd.gp = NULL, # NULL or groups to plot
- Spec.all = NULL, # NULL or TRUE
- Spec.gp = NULL, # NULL or groups to plot
- Bio.all = NULL, # NULL or TRUE
- Bio.gp = NULL, # NULL or groups to plot
- breaks = seq(0.05, 3, by = 0.1), # in mm
- conv = ".", #c(1, 0, 1), # or conversion table
- ZICompAbd = NULL,
- ZICompSpectra = NULL,
- ZICompBiomass = NULL,
- ZICompSlope = NULL,
- ZICompAbd.gp = NULL,
- ZICompBio.gp = NULL
- ){
- # Print in global environment default values for tab, rec, and TabGroups
- tab <<- NULL
- rec <<- NULL
- # Check argument
- if(!is.character(lst)){
- stop("lst must be a character string with the path of the list file")
- } else {
- options(Path = lst) # Path used in the process function and lst an arguement of the loop.opts function
- }
- if(!inherits(classif, "ZIClass")){
- stop("classif must be a classifier of class ZIClass")
- } else {
- options(Classifier = classif)
- }
- # Lines graphical representation
- if(!is.null(type)){
- options(type = "l")
- TabGroups <<- NULL
- } else {
- options(type = FALSE)
- }
- # Size threshold
- if(!is.null(SizeThreshold)){
- options(SizeThreshold = SizeThreshold)
- TabGroupsSize <<- NULL
- } else {
- options(SizeThreshold = FALSE)
- }
- # Collage and results exportation
- if(!is.null(Export_Collages)){
- options(MaxCollages = Export_Collages)
- Collages <<- NULL
- } else {
- options(MaxCollages = FALSE)
- }
- # Abundances
- if(!is.null(Abd.all)){
- options(Abd.all = TRUE)
- } else {
- options(Abd.all = FALSE)
- }
- if(!is.null(Abd.gp)){
- options(Abd.gp = Abd.gp)
- } else {
- options(Abd.gp = FALSE)
- }
- # Size Spectrum
- # total size spectrum
- if (!is.null(Spec.all)){
- if (!is.null(Spec.gp)){
- stop("total spectrum only")
- } else {
- options(Spec.all = TRUE)
- #options(breaks = breaks)
- }
- } else {
- options(Spec.all = FALSE)
- }
- # Size spectrum by groups
- if (!is.null(Spec.gp)){
- if (!inherits(Spec.gp, "character")) stop("groups must be a vector with names of groups")
- gp.Spec <- as.list(Spec.gp)
- names(gp.Spec) <- Spec.gp # list with levels = names of groups
- options(gp.Spec = gp.Spec)
- #options(breaks = breaks)
- } else {
- options(gp.Spec = FALSE)
- }
- # Biomass
- # Biomass for all groups
- if(!is.null(Bio.all)){
- options(Bio.all = TRUE)
- #options(conv = conv)
- } else {
- options (Bio.all = FALSE)
- }
- # Biomass by group
- if(!is.null(Bio.gp)){
- if (!inherits(Bio.gp, "character")) stop("groups must be a vector with names of groups")
- gp.Bio <- as.list(Bio.gp)
- names(gp.Bio) <- Bio.gp
- options(gp.Bio = gp.Bio)
- #options(conv = conv)
- } else {
- options(gp.Bio = FALSE)
- }
- if(!is.numeric(breaks)){
- stop("breaks must be the size intervall")
- } else {
- options(breaks = breaks)
- }
- if(!is.character(conv)){
- stop("conv must be the path of a conversion table")
- } else {
- Conv <- read.table(conv, header = TRUE, sep = "\t")
- options(conv = Conv)
- }
- #### Parameters for the comparison in near real time ####
- # the sample to compare with
- if(!is.null(ZIprevSmp)){
- if(!is.character(ZIprevSmp)) {
- stop("'ZIprevSmp' must be the path of the list file to compare")
- } else {
- options(ZIprevSmp = ZIprevSmp)
- }
- } else {
- options(ZIprevSmp = FALSE)
- }
- # comparison of abundances
- if(!is.null(ZICompAbd)){
- options(ZICompAbd = TRUE)
- } else {
- options(ZICompAbd = FALSE)
- }
- # Compa of abundances of some groups
- if(!is.null(ZICompAbd.gp)){
- options(ZICompAbd.gp = ZICompAbd.gp)
- } else {
- options(ZICompAbd.gp = FALSE)
- }
- # comparison of size spectra
- if(!is.null(ZICompSpectra)){
- options(ZICompSpectra = TRUE)
- } else {
- options(ZICompSpectra = FALSE)
- }
- # Comparison of Biomass
- if(!is.null(ZICompBiomass)){
- options(ZICompBiomass = TRUE)
- } else {
- options(ZICompBiomass = FALSE)
- }
- # Comparison of biomass by groups
- if(!is.null(ZICompBio.gp)){
- options(ZICompBio.gp = ZICompBio.gp)
- } else {
- options(ZICompBio.gp = FALSE)
- }
- # Comparison of size spectra slope
- if(!is.null(ZICompSlope)){
- options(ZICompSlope = TRUE)
- } else {
- options(ZICompSlope = FALSE)
- }
- # Comparison with more than one sample
- #if(!is.null(ZICompMultiple)) options(CompMultiple = TRUE)
- if(!is.null(ZIlist)){
- if(!is.character(ZIlist)){
- stop("'ZIlist' must be a character string of the files to analyze")
- } else {
- options(ZIlist = ZIlist)
- }
- } else {
- options(ZIlist = FALSE)
- }
-}
+"realtimeProcess" <- function(List, ZIClass, conv = c(1, 0, 1), Collage = NULL,
+FlowCell = 600, ImgPerSec = 5, Size = 5, Lag = 2)
+{
+ if (!existsTemp("rtData")) {
+ # First iteration
+ # Calculation of elapsed time
+ TIME <- TimeElapsed(List)
+ # Read the list file
+ tab <- read.lst(List, skip = 2)
+ # If no measurements in the list file
+ if (dim(tab)[1] == 0) {
+ print("The list file is empty")
+ rmTemp("rtData")
+ } else {
+ rec <- getTemp("rtRecord")
+ if (is.null(rec)) {
+ rec <- predict(ZIClass, tab, calc.vars = FALSE,
+ class.only = FALSE) # Ident
+ rec <- BiomassTab(ZIDat = rec, conv = conv,
+ RealT = TRUE) # Biomass
+ # Proceed to the mobile window
+ if (!is.null(Collage))
+ rec <- mobileWindow(RealT = TRUE)
+ # Add Sec and Vol column to the general table
+ if (!"sec" %in% names(rec))
+ rec <- AddSecVol(ZIDat = rec, FlowCell = FlowCell,
+ ImagePerSec = ImgPerSec)
+ assignTemp("rtRecord", rec)
+ }
+ }
+ # Create Attributes
+ if (!is.null(rec)) {
+ Abd <- table(rec$Ident)
+ Bio <- tapply(rec$Biomass, rec$Ident, sum)
+ # Remove NA and 0 from tables Abd and Bio to avoid any log problem
+ Abd[is.na(Abd)] <- 1e-09
+ Abd[Abd == 0] <- 1e-09
+ Bio[is.na(Bio)] <- 1e-09
+ Bio[Bio == 0] <- 1e-09
+ # Add attributes to rec
+ attr(rec, "Abd") <- Abd
+ attr(rec, "Bio") <- Bio
+ attr(rec, "Skip") <- nrow(tab)
+ # used to know the number of row to skip to get new measurements
+ attr(rec, "RowToSkip") <- nrow(rec)
+ # used to create a trnasect after the cruise
+ attr(rec, "VolumeDigitized") <- VolumeDigi(rec = rec,
+ FlowCell = FlowCell, ImgPerSec = ImgPerSec)
+ # Attribute for time elapsed
+ attr(rec, "TimeElapsed") <- TIME
+ # this parameter is used by VolumeDigi(List)
+ assignTemp("rtRecord", rec)
+ }
+ } else {
+ # There is one lst (non empty tab) list in memory
+ rec1 <- rec # recognition table from the previous iteration
+ Abd1 <- attr(rec1, "Abd") # Abd from the previous iteration
+ Bio1 <- attr(rec1, "Bio") # Bio from the previous iteration
+ # read the complete table to know if new results have been added
+ # Calculation of elapsed time
+ TIME <- TimeElapsed(List)
+ New <- read.lst(List, skip = 2) # read the New tab after the elapsed time
+ # Check if new measurements added in New
+ attr(rec, "Skip") <- c(attr(rec, "Skip"), nrow(New))
+ # Comparision with the previous Skip
+ if (attr(rec, "Skip")[length(attr(rec, "Skip"))] !=
+ attr(rec, "Skip")[length(attr(rec, "Skip"))- 1]) {
+ # Extract only new measurements
+ tab <- New[(attr(rec, "Skip")[length(attr(rec, "Skip")) - 1] + 1):
+ attr(rec, "Skip")[length(attr(rec, "Skip"))], ]
+ # Return the object in R
+ tab <- getTemp("rtData")
+ # recognition of tab
+ rec <- predict(ZIClass, tab, calc.vars = FALSE,
+ class.only = FALSE) # Ident
+ rec <- BiomassTab(ZIDat = rec, conv = conv, RealT = TRUE) # Biomass
-# Function to plot information about current sample
-SampleCurrent <- function(){
- if(!is.character(getOption("type")) && !is.numeric(getOption("SizeThreshold"))){ # if we want to have the line representation
- # Check if rec in R
- if (!exists("rec", env = .GlobalEnv)) stop("There is no recognition table in memory")
- # Plot the different graphes
- if (getOption("Abd.all")){
- barplot(table(rec$Ident)/nrow(rec)*100, xlab = "Groups", ylab = "Abundance (%)", main = "Relative abundance")# to improve
- }
- if (is.character(getOption("Abd.gp"))){
- barplot((table(rec$Ident)[names(table(rec$Ident)) %in% getOption("Abd.gp")])/nrow(rec)*100, xlab = "Groups", ylab = "Abundance (%)", main = "relative abundance by groups")
- }
- if (getOption("Spec.all")){
- Spec <- Spectrum(ZIDat = rec, use.Dil = FALSE, breaks = getOption("breaks"), RealT = TRUE)
- #barplot(Spec$total/nrow(rec)*100, xlab = "size interval", ylab = "Abundance", main = "Total size spectrum") # in relative abundance
- barplot(Spec$total, xlab = "size interval", ylab = "Abundance", main = "Total size spectrum")
- }
- if (is.list(getOption("gp.Spec"))){
- Spec <- Spectrum(ZIDat = rec, use.Dil = FALSE, breaks = getOption("breaks"), groups = getOption("gp.Spec"), RealT = TRUE)
- par(mfrow = c(length(getOption("gp.Spec")),1))
- for(i in 1:length(getOption("gp.Spec"))) {
- #barplot(Spec[[i]]/nrow(rec)*100, xlab = "size interval", ylab = names(getOption("gp.Spec")[i]), main = "Size spectra by groups") # in relative abundance
- barplot(Spec[[i]], xlab = "size interval", ylab = "Abundance", main = paste("Size spectrum for", names(getOption("gp.Spec")[i]), sep = " "))
- }
- }
- if (getOption("Bio.all")){
- Bio <- Bio.sample(ZIDat = rec, conv = getOption("conv"), exportdir = NULL, RealT = TRUE)
- barplot(Bio/sum(Bio)*100, xlab = "Groups", ylab = "Biomass (%)", main = "Relative biomass")
- }
- if (is.list(getOption("gp.Bio"))){
- Bio <- Bio.sample(ZIDat = rec, conv = getOption("conv"), exportdir = NULL, RealT = TRUE)
- barplot(Bio[names(Bio) %in% getOption("gp.Bio")]/sum(Bio)*100, xlab = "Groups", ylab = "Biomass (%)", main = "Relative biomass by groups")
- }
- }
+ # Add Sec and Vol information
+ if (!"sec" %in% names(rec))
+ rec <- AddSecVol(ZIDat = rec, FlowCell = FlowCell,
+ ImagePerSec = ImgPerSec)
+ # Create new tables
+ Abd <- table(rec$Ident)
+ Bio <- tapply(rec$Biomass, rec$Ident, sum)
+ # Remove NA and 0
+ Abd[is.na(Abd)] <- 1e-09
+ Abd[Abd == 0] <- 1e-09
+ Bio[is.na(Bio)] <- 1e-09
+ Bio[Bio == 0] <- 1e-09
+ # Paste the two tables : the previous and the new ones
+ rec <- rbind(rec1, rec)
+ if (!is.null(Collage)) {
+ # calculation of the rest of the mobile window
+ attr(rec, "Intervals") <- attr(rec1, "Intervals")
+ # because it is used to determine the range in mobileWindow
+ rec <<- mobileWindow(RealT = TRUE)
+ NewInterval <- attr(rec, "Intervals")
+ # Extracted here because it will be lost after the rbind operation
+ NewMobile_Tab <- attr(rec, "Mobile_Tab")
+ NewTime <- attr(rec, "Time")
+ }
+ # When we rbind rec, we loose attributes --> Add new attributes
+ attr(rec, "Skip") <- c(attr(rec, "Skip"), nrow(New))
+ if (!is.null(Abd1)) attr(rec, "Abd") <<- cbind(Abd1, Abd)
+ if (!is.null(Bio1)) attr(rec, "Bio") <<- cbind(Bio1, Bio)
+ if (!is.null(Collage)) {
+ # Attribute of the mobile window
+ attr(rec, "Time") <- c(attr(rec1, "Time")[
+ -length(attr(rec1, "Time"))], NewTime)
+ # everything excepted last iteration
+ attr(rec, "Intervals") <- cbind(attr(rec1, "Intervals")[
+ , -ncol(attr(rec1, "Intervals"))], NewInterval)
+ # everything excepted last iteration
+ attr(rec, "Mobile_Tab") <- cbind(attr(rec1, "Mobile_Tab")[
+ , -ncol(attr(rec1, "Mobile_Tab"))], NewMobile_Tab[, -1])
+ # everything excepted last iteration
+ attr(rec, "Size") <- Size
+ attr(rec, "Lag") <- Lag
+ attr(rec, "Collage") <- Collage
+ assignTemp("rtRecord", rec)
+ }
+ } else {
+ # There are no new measurements in list file
+ cat("There are no new measurements in list file or experiment finished\n")
+ # Remove the last element of the Skip attribute
+ attr(rec, "Skip") <- attr(rec, "Skip")[
+ -length(attr(rec, "Skip"))]
+ # Add attributes
+ if (!is.null(Abd1))
+ attr(rec, "Abd") <- cbind(attr(rec, "Abd"),
+ rep(1e-09, nrow(attr(rec, "Abd"))))
+ if (!is.null(Bio1))
+ attr(rec, "Bio") <- cbind(attr(rec, "Bio"),
+ rep(1e-09, nrow(attr(rec, "Bio"))))
+ assignTemp("rtRecord", rec)
+ }
+ # Attributes with the number of rows to skip
+ attr(rec, "RowToSkip") <- c(attr(rec, "RowToSkip"), nrow(rec))
+ # 2010-01-06
+ # Attribute for time elapsed
+ attr(rec, "TimeElapsed") <- TIME
+ # this parameter is used by VolumeDigi()
+ # Calculation of digitized volume
+ # 2010-01-06
+
+ # 2009-11-26
+ attr(rec, "VolumeDigitized") <- c(attr(rec, "VolumeDigitized"),
+ VolumeDigi(rec = rec, FlowCell = FlowCell, ImgPerSec = ImgPerSec))
+ # 2009-11-26
+ assignTemp("rtRecord", rec)
+ }
+ # Write a table with Volume and nrow of rec
+ Time <- attr(rec, "TimeElapsed")
+ Vol <- attr(rec, "VolumeDigitized")
+ Row <- attr(rec, "RowToSkip")
+ write.table(data.frame(Time, Vol, Row), file = file.path(dirname(List),
+ paste(basename(List), "RowToSkip.txt", sep = "_")),
+ sep = "\t", dec = ".", row.names = FALSE)
+ # Save data as Rdata
+ save(rec, file = file.path(dirname(List),
+ paste(basename(List),"rec.Rdata", sep = "_")))
+ # Change class(rec)
+ if (!inherits(rec, "RealT"))
+ class(rec) <- c("RealT", class(rec))
+ assignTemp("rtRecord", rec)
}
-# Function of comparison between current sample and a previous FlowCAM digitization
-CompaSamplePrev <- function(){
- #if(!is.character(getOption("ZIlist"))){ # If we do not compare sample to a list
- if(unique(getOption("ZIprevSmp") != FALSE)){
- if(!is.null(getOption("ZIprevSmp"))){ # If we want to compare with a previous sample
- if(is.character(getOption("ZIlist"))) stop("You must select only one prevous sample and not a list of samples")
- if(!is.character(getOption("ZIprevSmp"))) stop ("You must provide a character string") # check if prevSmp is empty
- # Calculate general table for sample to compare
- PrevTable <- read.lst(getOption("ZIprevSmp"))
- PrevRec <- predict.ZIClass.Real.Time(getOption("Classifier"), PrevTable, calc.vars = TRUE, class.only = FALSE)
- PrevSmp <- Bio.sample(ZIDat = PrevRec, conv = getOption("conv"), exportdir = NULL, RealT = TRUE)
- PrevSmp <- Bio.tab
- rm(Bio.tab, envir = .GlobalEnv)
- # Calculate table for the sample currently analysed
- if (!exists("rec", env = .GlobalEnv)){
- stop("You must have a recognition file in memory")
- } else {
- CurrentSmp <- Bio.sample(ZIDat = rec, conv = getOption("conv"), exportdir = NULL, RealT = TRUE)
- CurrentSmp <- Bio.tab
- }
- # Comparision of the two samples
- if (getOption("ZICompAbd")){
- # Statistics
- print(paste("Difference in abundance between the previous and the current sample is", nrow(PrevSmp)- nrow(CurrentSmp), "particles", sep = " "))
- # Dominant Species
- PrevSpecies <- sort(table(PrevRec$Ident), decreasing = TRUE)
- #print(paste("Dominant species of the previous sample :", max(PrevSpecies), "particles of", names(PrevSpecies)[PrevSpecies == max(PrevSpecies)], sep = " "))
- print(paste("The 3 most abundant taxa of the previous sample :",
- PrevSpecies[1], " particles of ", names(PrevSpecies)[PrevSpecies == PrevSpecies[1]], ", ",
- PrevSpecies[2], " particles of ", names(PrevSpecies)[PrevSpecies == PrevSpecies[2]], ", ",
- PrevSpecies[3], " particles of ", names(PrevSpecies)[PrevSpecies == PrevSpecies[3]], ", ",
- sep = ""))
- CurrentSpecies <- sort(table(rec$Ident), decreasing = TRUE)
- print(paste("The 3 most abundant taxa of the current sample :",
- CurrentSpecies[1], " particles of ", names(CurrentSpecies)[CurrentSpecies == CurrentSpecies[1]], ", ",
- CurrentSpecies[2], " particles of ", names(CurrentSpecies)[CurrentSpecies == CurrentSpecies[2]], ", ",
- CurrentSpecies[3], " particles of ", names(CurrentSpecies)[CurrentSpecies == CurrentSpecies[3]], ", ",
- sep = ""))
- # Graphic representation
- par(mfrow = c(2,1))
- barplot(table(PrevSmp$Ident)/nrow(PrevSmp)*100, xlab = "Groups", ylab = "Abundance (%)", main = "Relative abundance in the previous sample") # to improve
- barplot(table(CurrentSmp$Ident)/nrow(CurrentSmp)*100, xlab = "Groups", ylab = "Abundance (%)", main = "Relative abundance in the current sample") # to improve
- }
- # Comparison of abundances for some groups
- if(is.character(getOption("ZICompAbd.gp"))){
- par(mfrow = c(2,1))
- barplot((table(PrevSmp$Ident)[names(table(PrevSmp$Ident)) %in% getOption("ZICompAbd.gp")])/nrow(PrevSmp)*100,
- xlab = "Groups", ylab = "Abundance (%)", main = "Relative abundance by groups in the previous sample")
- barplot((table(CurrentSmp$Ident)[names(table(CurrentSmp$Ident)) %in% getOption("ZICompAbd.gp")])/nrow(CurrentSmp)*100,
- xlab = "Groups", ylab = "Abundance (%)", main = "Relative abundance by groups in the current sample")
- }
- if(getOption("ZICompSpectra")){
- # Graphs
- PrevDat <- PrevSmp$FIT_Diameter_ABD/1000
- Prevspc <- table(cut(PrevDat, breaks = getOption("breaks")))/length(PrevDat)*100
- CurrentDat <- CurrentSmp$FIT_Diameter_ABD/1000
- Currentspc <- table(cut(CurrentDat, breaks = getOption("breaks")))/length(CurrentDat)*100
- # Compa of size spectra
- par(mfrow = c(2,1))
- barplot(Prevspc, xlab = "size interval", ylab = "Abundance", main = "Previous sample")
- barplot(Currentspc, xlab = "size interval", ylab = "Abundance", main = "Current sample")
- }
- if(getOption("ZICompBiomass")){
- # Graphs
- par(mfrow = c(2,1))
- BioPrev <- Biomass(PrevSmp)
- BioCurrent <- Biomass(CurrentSmp)
- barplot(BioPrev/sum(BioPrev)*100, xlab = "Groups", ylab = "Biomass (%)", main = "Relative biomass in the previous sample")
- barplot(BioCurrent/sum(BioCurrent)*100, xlab = "Groups", ylab = "Biomass (%)", main = "Relative biomass in the current sample")
- }
- if(is.character(getOption("ZICompBio.gp"))){
- BioPrev <- Biomass(PrevSmp)
- BioCurrent <- Biomass(CurrentSmp)
- par(mfrow = c(2,1))
- barplot(BioPrev[names(BioPrev) %in% getOption("ZICompBio.gp")]/sum(BioPrev)*100,
- xlab = "Groups", ylab = "Biomass (%)", main = "Relative biomass by groups in the previous sample")
- barplot(BioCurrent[names(BioCurrent) %in% getOption("ZICompBio.gp")]/sum(BioCurrent)*100,
- xlab = "Groups", ylab = "Biomass (%)", main = "Relative biomass by groups in the current sample")
- }
- if(getOption("ZICompSlope")){
- par(mfrow = c(2,1))
- hist.spectrum(spect = log(as.vector(table(cut(PrevSmp$FIT_Diameter_ABD/1000, breaks = getOption("breaks"))))+1), breaks = getOption("breaks"))
- hist.spectrum(spect = log(as.vector(table(cut(CurrentSmp$FIT_Diameter_ABD/1000, breaks = getOption("breaks"))))+1), breaks = getOption("breaks"))
- }
- }
- }
+# 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",
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 187
More information about the Zooimage-commits
mailing list