[Zooimage-commits] r222 - in pkg: phytoimage/inst/gui zooimage zooimage/R zooimage/inst/gui zooimage/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 10 19:59:48 CEST 2012
Author: phgrosjean
Date: 2012-07-10 19:59:48 +0200 (Tue, 10 Jul 2012)
New Revision: 222
Added:
pkg/zooimage/R/guiutils.R
pkg/zooimage/man/guiutils.Rd
Removed:
pkg/zooimage/R/RealTime.R
pkg/zooimage/R/log.R
pkg/zooimage/R/misc.R
pkg/zooimage/R/programs.R
pkg/zooimage/man/RealTime.Rd
pkg/zooimage/man/log.Rd
Modified:
pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
pkg/zooimage/NAMESPACE
pkg/zooimage/R/ZIRes.R
pkg/zooimage/R/ZITrain.R
pkg/zooimage/R/fileutils.R
pkg/zooimage/R/gui.R
pkg/zooimage/R/utilities.R
pkg/zooimage/R/zid.R
pkg/zooimage/R/zidb.R
pkg/zooimage/R/zie.R
pkg/zooimage/R/zim.R
pkg/zooimage/R/zip.R
pkg/zooimage/inst/gui/MenusZIDlgWin.txt
pkg/zooimage/man/fileutils.Rd
pkg/zooimage/man/utilities.Rd
pkg/zooimage/man/zie.Rd
pkg/zooimage/man/zip.Rd
Log:
Further clean up and elimination of unnecessary code in ZooImage
Modified: pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
===================================================================
--- pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-08 22:43:40 UTC (rev 221)
+++ pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-10 17:59:48 UTC (rev 222)
@@ -24,11 +24,6 @@
||$E&xit
|||From the &assistant Ctrl+X ~~ closeAssistant()
|||From &PhytoImage ~~ closePhytoImage()
-|$Real-time
-||&Start process... ~~ realtimeStart()
-||&Stop process... ~~ realtimeStop()
-||&Export results... ~~ realtimeSave()
-||&Remove data... ~~ realtimeReset()
|$Objects
||&Load ~~ loadObjects()
||&Save ~~ saveObjects()
Modified: pkg/zooimage/NAMESPACE
===================================================================
--- pkg/zooimage/NAMESPACE 2012-07-08 22:43:40 UTC (rev 221)
+++ pkg/zooimage/NAMESPACE 2012-07-10 17:59:48 UTC (rev 222)
@@ -25,36 +25,23 @@
export(BFcorrection)
export(calibrate)
export(checkBF)
-export(clearProgress)
export(compareExif)
export(getSpectrum)
export(histSpectrum)
export(isTestFile)
export(isZim)
-export(logClear)
-export(logError)
-export(logProcess)
-export(logView)
-export(logWarning)
export(lvq)
export(modalAssistant)
export(nnet2)
export(plotAbdBio)
export(processSample)
export(processSampleAll)
-export(Progress)
export(rawConvert)
export(readExifRaw)
-export(realtimeReset)
-export(realtimeSave)
-export(realtimeStart)
-export(realtimeStop)
export(sampleAbd)
export(sampleBio)
export(sampleSpectrum)
export(startPgm)
-export(unzipImg)
-export(unzipImgAll)
export(vignettesClass)
export(ZIClass)
export(ZIConf)
@@ -93,15 +80,18 @@
export(zimMake)
export(zimRefreshAll)
export(zimVerify)
-export(ZIpgm)
-export(ZIpgmHelp)
-export(zipImg)
-export(zipImgAll)
+
# Zic
export(zicCheck)
+# Zip
+export(zipImg)
+export(zipImgAll)
+export(unzipImg)
+export(unzipImgAll)
+
# Zis
export(zisCreate)
export(zisEdit)
@@ -124,6 +114,8 @@
export(sampleInfo)
export(trimString)
export(underscoreToSpace)
+export(zipNoteAdd)
+export(zipNoteGet)
# File-Utilities
export(extensionPattern)
@@ -173,12 +165,11 @@
export(ZIDlg)
# GUI-Utilities
-export(getList)
-export(getVar)
-export(formulaVarSel)
export(selectGroups)
export(selectFile)
-export(selectSamples)
+export(selectList)
+export(selectObject)
+export(imageViewer)
# S3 methods
S3method(predict, nnet2)
@@ -190,27 +181,3 @@
S3method(print, ZIE)
S3method(plot, ZITable)
S3method(merge, ZITable)
-
-# The following objects are NOT exported (and should be eliminated too!)
-# backspaces
-# finishLoop
-# imagemagick
-# imagemagick_convert
-# imagemagick_identify
-# imageViewer
-# misc
-# misc_dcraw
-# netpbm
-# netpbm_pgmhist
-# netpbm_ppmtopgm
-# netpbm_tifftopnm
-# program
-# unzip
-# xite
-# xite_biff2tiff
-# xite_divide
-# xite_pnm2biff
-# xite_statistics
-# zip
-# zipNoteAdd
-# zipNote
Deleted: pkg/zooimage/R/RealTime.R
===================================================================
--- pkg/zooimage/R/RealTime.R 2012-07-08 22:43:40 UTC (rev 221)
+++ pkg/zooimage/R/RealTime.R 2012-07-10 17:59:48 UTC (rev 222)
@@ -1,867 +0,0 @@
-## Copyright (c) 2008-2012, Ph. Grosjean <phgrosjean at sciviews.org>
-##
-## This file is part of ZooImage
-##
-## ZooImage is free software: you can redistribute it and/or modify
-## it under the terms of the GNU General Public License as published by
-## the Free Software Foundation, either version 2 of the License, or
-## (at your option) any later version.
-##
-## ZooImage is distributed in the hope that it will be useful,
-## but WITHOUT ANY WARRANTY; without even the implied warranty of
-## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-## GNU General Public License for more details.
-##
-## You should have received a copy of the GNU General Public License
-## along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
-
-## Functions and dialog box created for the real time recogntion
-realtimeStart <- function ()
-{
- ## Process real time recognition during a FlowCAM experiment
- ## First remove existing file from the global environment before
- ## we read a new sample
- realtimeReset()
- ## Ask for an algorithm and one or several samples to compare with
- defval <- "Only One Sample"
- opts <- c("Only One Sample",
- "Comparison with One Other Sample",
- "Comparison with Several Other Samples")
- ## Then, show the dialog box
- #res <- modalAssistant(paste(getTemp("ZIname"),
- # "Real-Time recognition for FlowCAM"),
- # c("This is a beta version of the real time recognition",
- # "of FlowCAM samples developed for the AMORE III project.",
- # "Warning! This method is only developed for FlowCAM data,",
- # "and with a classifier made with FlowCAM parameters only.",
- # "", "Select an option:", ""), init = defval,
- # options = opts, help.topic = "makeClass")
- #if (res == "ID_CANCEL") return(invisible())
- res <- dlgList(opts, preselect = defval, multiple = FALSE,
- title = "Select an option:")$res
- if (!length(res)) return(invisible())
- ## Only one sample
- if (res == "Only One Sample") {
- ## Use default values for the classifier creation
- cat("Classify one sample at a time in real-time mode\n")
- mode <- 0
- } else if (res == "Comparison with One Other Sample") {
- cat("Comparison of current sample with previous one activated\n")
- mode <- 1
- } else if (res == "Comparison with Several Other Samples") {
- cat("Comparison of current sample with a list of samples already digitized\n")
- mode <- 2
- } else stop("Unknown option!")
- flush.console()
-
- ## Look if we have a classifier object defined
- ZIC <- getTemp("ZI.ClassName")
- if (is.null(ZIC)) ZIC <- ""
- ZIC <- getVar("ZIClass", multi = FALSE, default = ZIC,
- title = "Choose a classifier (ZIClass object):", warn.only = FALSE)
- if (length(ZIC) == 0 || (length(ZIC) == 1 && ZIC == ""))
- return(invisible())
- ZICobj <- get(ZIC, envir = .GlobalEnv)
-
- ## Select the current sample
- Current <- dlgOpen(title = "Select a lst file",
- filters = matrix(c("FlowCAM list file", ".lst"),
- ncol = 2, byrow = TRUE))$res
-
- if (mode == 1) { # Select the Previous sample
- Prev <- dlgOpen(title = "Select the lst file for the previous sample",
- filters = matrix(c("FlowCAM list file", ".lst"),
- ncol = 2, byrow = TRUE))$res
- } else if (mode == 2) {
- ## Select the Previous samples
- List <- list.files(dlgDir(title = "Select general directory")$res,
- recursive = TRUE, pattern = ".lst$", full.names = TRUE)
- ListSamples <- selectSamples(Samples = List)
- } else Prev <- NULL
-
- ## Select a conversion table
- ConvFile <- getOption("ZI.ConversionFile", file.path(getTemp("ZIetc"),
- "Conversion.txt"))
- ## Ask for selecting a Conversion file
- ConvFile <- dlgOpen(title = "Select a conversion file",
- filters = matrix(c("Biomass Conversion table (*Conversion.txt)",
- "Conversion.txt"), ncol = 2, byrow = TRUE))$res
- if (length(ConvFile) == 0 || ConvFile == "")
- return(invisible()) # Cancelled dialog box
-
- ## Select the size spectra option
- brks <- dlgInput("Breaks for size spectrum classes in mm (empty for no spectrum):",
- default = "seq(0.25, 2, by = 0.1)")$res
- if (!length(brks)) return(invisible())
- brks <- eval(parse(text = brks))
- ## Choose options
- ## Default options
- ## Without sample comparison
- Abd.all <- TRUE
- Abd.gp <- NULL
- Spec.all <- NULL
- Spec.gp <- NULL
- Bio.all <- NULL
- Bio.gp <- NULL
- ## With one or more samples for comparison
- ZICompAbd <- TRUE
- ZICompSpectra <- NULL
- ZICompBiomass <- NULL
- ZICompSlope <- NULL
- ZICompAbd.gp <- NULL
- ZICompBio.gp <- NULL
- ## Options for all modes
- defval_Graphs <- "Total Abundance"
- if (mode == 0) {
- opts_Graphs <- c("Total Abundance", "Abundance of groups",
- "Total Size Spectra", "Size Spectra of groups",
- "Total Biomass", "Biomass of groups")
- } else {
- opts_Graphs <- c("Total Abundance", "Abundance of groups",
- "Total Size Spectra", "Total Biomass", "Biomass of groups",
- "Slope of size spectra")
- }
- #res <- modalAssistant(paste(getTemp("ZIname"),
- # "Real-Time classification with the FlowCAM"),
- # c("Select one type of plot you want to do",
- # "", "Select an option:", ""), init = defval_Graphs,
- # options = opts_Graphs, help.topic = "makeClass")
- res <- dlgList(opts_Graphs, preselect = defval_Graphs, multiple = FALSE,
- title = "Select one type of plot:")$res
- if (!length(res)) return(invisible())
- if (mode == 0) {
- if (res == "Total Abundance")
- Abd.all <- TRUE
- if (res == "Abundance of groups") {
- Abd.all <- NULL
- Abd.gp <- selectGroups(ZICobj)
- }
- if (res == "Total Size Spectra") {
- Abd.all <- NULL
- Spec.all <- TRUE
- }
- if (res == "Size Spectra of groups") {
- Abd.all <- NULL
- Spec.gp <- selectGroups(ZICobj)
- }
- if (res == "Total Biomass") {
- Abd.all <- NULL
- Bio.all <- TRUE
- }
- if (res == "Biomass of groups") {
- Abd.all <- NULL
- Bio.gp <- selectGroups(ZICobj)
- }
- } else { # mode 1 or 2
- if (res == "Total Abundance")
- ZICompAbd <- TRUE
- if (res == "Abundance of groups") {
- ZICompAbd <- NULL
- ZICompAbd.gp <- selectGroups(ZICobj)
- }
- if (res == "Total Size Spectra") {
- ZICompAbd <- NULL
- ZICompSpectra <- TRUE
- }
- if (res == "Total Biomass") {
- ZICompAbd <- NULL
- ZICompBiomass <- TRUE
- }
- if (res == "Biomass of groups") {
- ZICompAbd <- NULL
- ZICompBio.gp <- selectGroups(ZICobj)
- }
- if (res == "Slope of size spectra") {
- ZICompAbd <- NULL
- ZICompSlope <- TRUE
- }
- }
- ## Loop parameters
- #realtimeOptions(lstdir = Current, # path of the list file of the FlowCAM run
- # ZIClass = ZICobj, # Classifer
- # ZIprevSmp = NULL, # Comparison with one previous sample
- # ZIlist = NULL, # Comparison several previous samples
- # ################## One Sample
- # Abd.all = Abd.all, # NULL or TRUE
- # Abd.gp = Abd.gp, # NULL or groups to plot
- # Spec.all = Spec.all, # NULL or TRUE
- # Spec.gp = Spec.gp, # NULL or groups
- # Bio.all = Bio.all, # NULL or TRUE
- # Bio.gp = Bio.gp, # NULL or groups
- # breaks = brks, # in mm
- # conv = ConvFile, # or conversion table
- # ################## More than one sample
- # ZICompAbd = ZICompAbd,
- # ZICompSpectra = ZICompSpectra,
- # ZICompBiomass = ZICompBiomass,
- # ZICompSlope = ZICompSlope,
- # ZICompAbd.gp = ZICompAbd.gp,
- # ZICompBio.gp = ZICompBio.gp
- #)
- ## Run automatic recognition and plot
-## TODO: we need a depends on tcltk2 here!
-# tclFun(realtimeLoop)
- realtimeLoop()
-}
-
-realtimeSave <- function ()
-{
- lst <- getOption("Path")
- classif <- getOption("Classifier")
- breaks <- getOption("breaks")
- conv <- getOption("conv")
- save.dir <- dirname(getOption("Path"))
-
- rec <- getTemp("rtRecord")
- if (is.null(rec))
- rec <- predict(classif, lstRead(lst),
- calc.vars = TRUE, class.only = FALSE)
- if (!is.null(save.dir)) {
- if (!is.character(save.dir))
- stop("The exportation path must be a character string")
- } else save.dir <- dlgDir()$res
-
- Bio.tab <- sampleBio(ZIDat = rec, conv = conv, exportdir = NULL,
- realtime = TRUE)
- write.table(Bio.tab, file = paste(save.dir, paste(basename(dirname(lst)),
- "AbdBio.txt", sep = "_"), sep = "\\"), sep = "\t", dec = ".",
- col.names = TRUE, na = "NA", row.names = FALSE)
- ## Delete objects from R environment
- rmTemp("rtData")
- rmTemp("rtRecord")
- rmTemp("rtTime")
-}
-
-realtimeStop <- function ()
- assignTemp(".realtimeStopItFlag", TRUE)
-
-realtimeReset <- function () {
- assignTemp("rtData", NULL)
- assignTemp("rtRecords", NULL)
- assignTemp("rtTime", NULL)
-}
-
-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)
-}
-
-## 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"),
- flow.cell = getOption("flow.cell"), images.per.sec = getOption("images.per.sec"),
- size = getOption("size"), lag = getOption("Lag"))
- #realtimePlotMobile(ZIDat = rec, group = getOption("group"),
- # identify = getOption("identify"), breaks = getOption("breaks"),
- # log = getOption("log"), realtime = 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"),
- # compare.smp = getOption("compare.smp"), 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))
-}
-
-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
-size.threshold = NULL, # NULL or Size threshold in µm alpha code
-breaks = seq(0.05, 3, by = 0.1), # in mm
-conv.dir = ".", # Path of the conversion table
-images.per.sec = 7,
-flow.cell = 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
-compare.smp = 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(size.threshold) && !is.numeric(size.threshold))
- stop("'size.threshold' 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)")
-
- conv.dir <- as.character(conv.dir)[1]
-
- images.per.sec <- as.numeric(images.per.sec)[1]
- if (images.per.sec < 0)
- stop("'images.per.sec' must be the number of images taken by the FlowCAM per second")
-
- flow.cell <- as.integer(flow.cell)[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(compare.smp)) {
- compare.smp <- as.character(compare.smp)
- if (length(compare.smp) == 1) {
- if(length(grep(pattern = ".[Zz][Ii][Dd]", x = compare.smp)) >= 1) {
- ## This a zid file
- Smp <- zidDatRead(compare.smp)
- } else {
- ## This is a list file
- Smp <- lstRead(compare.smp)
- }
- Smp <- predict(ZIClass, Smp, calc.vars = FALSE, class.only = FALSE)
- Smp <- calcBiomass(ZIDat = Smp, conv = conv.dir, realtime = TRUE)
- List <- list(Smp)
- names(List) <- noExtension(compare.smp)
- } else {
- List <- list()
- if (length(grep(pattern = ".[Zz][Ii][Dd]", x = compare.smp)) >= 1) {
- ## This a zid file
- for (i in 1 : length(compare.smp))
- List[[i]] <- calcBiomass(ZIDat = predict(ZIClass,
- zidDatRead(compare.smp[i]), calc.vars = FALSE,
- class.only = FALSE), conv = conv.dir, realtime = TRUE)
- } else {
- ## This is a list file
- for (i in 1 : length(compare.smp))
- List[[i]] <- calcBiomass(ZIDat = predict(ZIClass,
- lstRead(compare.smp[i]), calc.vars = FALSE,
- class.only = FALSE), conv = conv.dir, realtime = TRUE)
- }
- names(List) <- noExtension(compare.smp)
- }
- compare.smp <- List
- } else compare.smp <- FALSE
-
- if (!is.null(group)) group <- as.character(group)[1]
-
- identify <- isTRUE(identify)
-
- log <- isTRUE(log)
-
- slope <- isTRUE(slope)
-
- ## Construct the options object and save it in options
- opts <- list(lstdir, ZIClass, type, size.threshold, breaks, conv.dir,
- images.per.sec, flow.cell, size, lag, concentration, abd, bio, spectra,
- group, compare.smp, identify, log, slope)
- options("ZIrealtimeOpts" = opts)
- return(invisible(opts))
-}
-
-realtimeProcess <- function (List, ZIClass, conv = c(1, 0, 1), collage = NULL,
-flow.cell = 600, images.per.sec = 5, size = 5, lag = 2)
-{
- if (!existsTemp("rtData")) {
- ## First iteration
- ## Calculation of elapsed time
- Time <- elapsedTime(List)
- ## Read the list file
- tab <- lstRead(List, skip = 2)
- ## If no measurements in the list file
- if (dim(tab)[1] == 0) {
- cat("The list file is empty\n")
- flush.console()
- rmTemp("rtData")
- } else {
- rec <- getTemp("rtRecord")
- if (is.null(rec)) {
- rec <- predict(ZIClass, tab, calc.vars = FALSE,
- class.only = FALSE) # Ident
- rec <- calcBiomass(ZIDat = rec, conv = conv,
- realtime = TRUE) # Biomass
- ## Proceed to the mobile window
- if (!is.null(collage))
- rec <- mobileWindow(realtime = TRUE)
- ## Add Sec and Vol column to the general table
- if (!"sec" %in% names(rec))
- rec <- addSecVol(ZIDat = rec, flow.cell = flow.cell,
- images.per.sec = images.per.sec)
- 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") <- volumeDigitized(rec = rec,
- flow.cell = flow.cell, images.per.sec = images.per.sec)
- ## Attribute for time elapsed
- attr(rec, "elapsedTime") <- Time
- ## This parameter is used by volumeDigitized(List)
- assignTemp("rtRecord", rec)
- }
- } else {
- ## There is one lst (non empty tab) list in memory
- rec1 <- rec # classification 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 <- elapsedTime(List)
- New <- lstRead(List, skip = 2) # Read new tab after the elapsed time
- ## Check if new measurements added in New
- skp <- attr(rec, "skip")
- attr(rec, "skip") <- c(skp, nrow(New))
- skp <- attr(rec, "skip")
- ## Comparision with the previous skip
- if (skp[length(skp)] != skp[length(skp)- 1]) {
- ## Extract only new measurements
- tab <- New[(skp[length(skp) - 1] + 1):skp[length(skp)], ]
- ## Return the object in R
- tab <- getTemp("rtData")
- ## recognition of tab
- rec <- predict(ZIClass, tab, calc.vars = FALSE,
- class.only = FALSE) # Ident
- ## Biomass
- rec <- calcBiomass(ZIDat = rec, conv = conv, realtime = TRUE)
-
- ## Add Sec and Vol information
- if (!"sec" %in% names(rec))
- rec <- addSecVol(ZIDat = rec, flow.cell = flow.cell,
- images.per.sec = images.per.sec)
- ## 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
- Interv <- attr(rec1, "intervals")
- attr(rec, "intervals") <- Interv
- ## Because it is used to determine the range in mobileWindow
- rec <<- mobileWindow(realtime = TRUE)
- NewInterval <- Interv
- ## Extracted here (will be lost after the rbind operation)
- NewMobileTab <- attr(rec, "mobileTab")
- 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
- recTime <- attr(rec1, "time")
- attr(rec, "time") <- c(recTime[-length(recTime)], NewTime)
- ## Everything except last iteration
- Interv <- attr(rec1, "intervals")
- attr(rec, "intervals") <- cbind(Interv[ , -ncol(Interv)],
- NewInterval)
- ## idem
- MobileTab <- attr(rec1, "mobileTab")
- attr(rec, "mobileTab") <- cbind(MobileTab[ , -ncol(MobileTab)],
- NewMobileTab[, -1])
- ## idem
- 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 run done\n")
- flush.console()
- ## Remove the last element of the skip attribute
- skip <- attr(rec, "skip")
- attr(rec, "skip") <- skip[-length(skip)]
- ## Add attributes
- if (!is.null(abd1)) {
- abd <- attr(rec, "abd")
- attr(rec, "abd") <- cbind(abd, rep(1e-09, nrow(abd)))
- }
- if (!is.null(bio1)) {
- bio <- attr(rec, "bio")
- attr(rec, "bio") <- cbind(bio, rep(1e-09, nrow(bio)))
- }
- assignTemp("rtRecord", rec)
- }
- ## Attributes with the number of rows to skip
- attr(rec, "rowToSkip") <- c(attr(rec, "rowToSkip"), nrow(rec))
- ## Attribute for time elapsed
- attr(rec, "elapsedTime") <- Time
- ## This parameter is used by volumeDigitized()
- ## Calculation of digitized volume
- attr(rec, "volumeDigitized") <- c(attr(rec, "volumeDigitized"),
- volumeDigitized(rec = rec, flow.cell = flow.cell,
- images.per.sec = images.per.sec))
- assignTemp("rtRecord", rec)
- }
- ## Write a table with Volume and nrow of rec
- Time <- attr(rec, "elapsedTime")
- 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, "realtime"))
- class(rec) <- c("realtime", class(rec))
- assignTemp("rtRecord", rec)
-}
-
-#### Utility functions for real-time process ###################################
-## Calculation of elapsed time and create the attr(rec, "elapsedTime")
-elapsedTime <- function (List)
-{
- ## Info <- file.info(getOption("Path"))
- Info <- file.info(List)
- Time <- getTemp("rtTime")
- if (is.null(Time)) {
- ## First iteration
- Elapsed <- difftime(time1 = Info$ctime, time2 = Sys.time(),
- units = "sec")
- Time2 <- abs(as.numeric(Elapsed))
- assignTemp("rtTime", Time2)
- } else {
- Elapsed <- difftime(time1 = Info$ctime, time2 = Sys.time(),
- units = "sec")
- Time2 <- abs(as.numeric(Elapsed)) - sum(Time)
- assignTemp("rtTime", c(Time, Time2))
- }
- return(Time)
-}
-
-## Calculation of the digitized volume using the Time elapsed attirbute
-volumeDigitized <- function (rec, flow.cell = 600, images.per.sec = 5)
-{
- CalConst <- unique(rec$FIT_Cal_Const)
- Height <- 767 * CalConst
- Width <- 1023 * CalConst
- Area <- Height * Width
- Volume <- (Area / 10^8) * (flow.cell/10000) # mL
- ElapsedTime <- attr(rec, "elapsedTime")
- lElapsedTime <- length(ElapsedTime)
- RowToSkip <- attr(rec, "rowToSkip")
- lRowToSkip <- length(RowToSkip)
- if (all(is.na(rec$FIT_Source_Image))) {
- ## We have to calculate volume using the elapsed time
- res <- Volume * images.per.sec * ElapsedTime
- } else {
- ## We have the information from the new FlowCAM about the raw images
- if (lRowToSkip == 1) {
- ## First iteration completed
- Raw <- rec$FIT_Source_Image[RowToSkip]
- } else {
- ## More than one iteration
- if (RowToSkip[lRowToSkip - 1] == RowToSkip[lRowToSkip]) {
- ## No new data added at the list file --> Use the elapsed time
- ## to approximate number of raw images
- Raw <- images.per.sec * ElapsedTime[lElapsedTime]
- } else {
- ## New measurements are added at hte end of the list file
- NewRaw <- rec$FIT_Source_Image[RowToSkip[lRowToSkip]]
- PrevRaw <- rec$FIT_Source_Image[RowToSkip[lRowToSkip - 1] + 1]
- Raw <- NewRaw - PrevRaw + 1
- }
- }
- res <- Volume * Raw
- }
- return(res)
-}
-
-## Function to add a column for biomass calculation
-calcBiomass <- function (ZIDat, conv = c(1, 0, 1), realtime = FALSE)
-{
- if (!isTRUE(realtime)) {
- if (!inherits(ZIDat, "ZIDat"))
- stop("ZIDat must be a 'ZIDat' object")
- }
- ## Convert ECD (biomass calculation, etc.)
- ## Check arguments
- Smp <- ZIDat
- if (nrow(Smp) == 0)
- stop("no data for this sample/taxa in ZIDat")
- ## Add P1/P2/P3 conversion params to the table
- if (inherits(conv, "data.frame")) {
- if (!all(names(conv)[1:4] == c("Group", "P1", "P2", "P3") ||
- c("Group", "a", "b", "c")))
- stop("conv must have 'Group', 'P1', 'P2', 'P3' or 'a', 'b', 'c' columns!")
- IdSmp <- as.character(Smp$Ident)
- IdSmpU <- unique(IdSmp)
- IdConv <- as.character(conv$Group)
- ## Eliminate [other] from the table and the list
- ## and keep its values for further use
- IsOther <- (IdConv == "[other]")
- Other <- conv[IsOther, ]
- if (sum(IsOther) > 0) {
- IdConv <- IdConv[!IsOther]
- conv <- conv[!IsOther, ]
- conv$Group <- as.factor(as.character(conv$Group))
- }
- if (!all(IdSmpU %in% IdConv)) {
- if (nrow(Other) > 0) {
- ## Fill all the other groups with the formula for other
- ## and issue a warning
- NotThere <- IdSmpU[!(IdSmpU %in% IdConv)]
- warning("Applying default [other] biomass conversion for ",
- paste(NotThere, collapse = ", "))
- N <- length(NotThere)
- conv2 <- data.frame(Group = NotThere, P1 = rep(Other[1, 2], N),
- P2 = rep(Other[1, 3], N), P3 = rep(Other[1, 4], N))
- conv <- rbind(conv, conv2)
- conv$Group <- as.factor(as.character(conv$Group))
- } else {
- ## All groups must be there: stop!
- stop("Not all 'Ident' in sample match 'Group' in the conv table")
- }
- }
- ## Line number of the corresponding parameter
- ## is calculated as the level of a factor whose levels
- ## are the same as in the conversion table
- Pos <- as.numeric(factor(IdSmp, levels = as.character(conv$Group)))
- Smp$P1 <- conv[Pos, "P1"]
- Smp$P2 <- conv[Pos, "P2"]
- Smp$P3 <- conv[Pos, "P3"]
- } else { # Use the same three parameters for all
- if (length(conv) != 3)
- stop("You must provide a vector with three numbers")
- Smp$P1 <- conv[1]
- Smp$P2 <- conv[2]
- Smp$P3 <- conv[3]
- }
- ## Individual contributions to biomass by m^3
- if (!isTRUE(realtime)) {
- Smp$Biomass <- (Smp$P1 * Smp$ECD + Smp$P2)^Smp$P3 * Smp$Dil
- } else {
- Smp$Biomass <- (Smp$P1 * Smp$FIT_Diameter_ABD + Smp$P2)^Smp$P3
- }
- ## AZTI special treatment
- ## introducimos la formula de montagnes y la correccion para ESD(2.61951)
- #Smp$Biomass <- (0.109 * (pi*4/3*((2.61951*Smp$ECD)/2)^3)^0.991) * Smp$Dil
-
- ## Add metadata attribute
- attr(Smp, "metadata") <- attr(ZIDat, "metadata")
- return(Smp)
-}
-
-## Add Sec and Volume column
-addSecVol <- function (ZIDat, flow.cell, images.per.sec)
-{
- calcVol <- function (lst, flow.cell) {
- CalConst <- unique(lst$FIT_Cal_Const)
- Height <- 767 * CalConst
- Width <- 1023 * CalConst
- Area <- Height * Width
- Volume <- (Area / 10^8) * (flow.cell / 10000) # mL
- return(Volume)
- }
-
- if (!inherits(ZIDat, "data.frame"))
- stop("ZIDat must be an object of class 'data.frame'")
- if (!is.numeric(flow.cell))
- stop("flow.cell must be a numrical value with the depth of the flow cell used")
- if (!is.numeric(images.per.sec))
- stop("images.per.sec must be the number of image per second saved by the FlowCAM")
- ZIDat$Sec <- ZIDat$FIT_Source_Image / images.per.sec
- Vol <- calcVol(ZIDat, flow.cell)
- ZIDat$Vol <- ZIDat$FIT_Source_Image * Vol
- return(ZIDat)
-}
-
-## Mobile window
-mobileWindow <- function (ZIDat, size = 1, lag = 1, collage = FALSE, flow.cell,
-images.per.sec, realtime = FALSE)
-{
- if (!isTRUE(realtime)) {
- rec <- getTemp("rtRecord")
- Time <- numeric()
- if (!inherits(ZIDat, "data.frame"))
- stop("ZIDat must be an object of class 'data.frame'")
- if (!"Ident" %in% colnames(ZIDat))
- stop("ZIDat must contain a column Ident")
- if (lag < 1)
- stop("lag must be higher than 1")
- if (size < lag)
- stop("size must be larger or equal to lag")
- if (!"sec" %in% names(ZIDat))
- ZIDat <- addSecVol(ZIDat = ZIDat, flow.cell = flow.cell,
- images.per.sec = images.per.sec)
- if (isTRUE(collage)) {
- for (i in 1:(length(levels(ZIDat$FIT_Filename)) - (2 * size))) {
- if (i <= 1) {
- df <- data.frame(Int = (0 + i):(i + (2* size)))
- Tab <- data.frame(table(ZIDat[ZIDat$FIT_Filename %in%
- levels(ZIDat$FIT_Filename)[df[, i]], ]$Ident))
- } else {
- df[, i] <- data.frame(Int = df[, (i - 1)] + lag)
- Tab[, i+1] <- table(ZIDat[ZIDat$FIT_Filename %in%
- levels(ZIDat$FIT_Filename)[df[, i]], ]$Ident)
- }
- Time[i] <- mean(ZIDat[ZIDat$FIT_Filename %in%
- levels(ZIDat$FIT_Filename)[df[size + 1, i]], ]$Sec)
- if (!all(df[, i] < length(levels(ZIDat$FIT_Filename)))) {
- warning("The loop is stopped because the end of the table is reached")
- break
- }
- }
- } else {
- for (i in 1:(dim(ZIDat)[1] - (2 * size))) {
- if (i <= 1) {
- df <- data.frame(Int = (0 + i) : (i + (2* size)))
- Tab <- data.frame(table(ZIDat[df[, i],]$Ident))
- } else {
- df[, i] <- data.frame(Int = df[, (i - 1)] + lag)
- Tab[, i+1] <- table(ZIDat[df[, i], ]$Ident)
- }
- Time[i] <- ZIDat[df[size, i], ]$Sec
- if (!all(df[, i] < nrow(ZIDat))) {
- warning("The loop is stopped because the end of the table is reached")
- break
- }
- }
- }
- attr(ZIDat, "time") <- Time
- attr(ZIDat, "size") <- size
- attr(ZIDat, "lag") <- lag
- attr(ZIDat, "intervals") <- df
- attr(ZIDat, "mobileTab") <- Tab
- attr(ZIDat, "collage") <- collage
- return(ZIDat)
- } else {
- Temp <- numeric()
- if (!"sec" %in% names(rec))
- assignTemp("rtRecord", addSecVol(ZIDat = rec,
- flow.cell = getOption("flow.cell"),
- images.per.sec = getOption("images.per.sec")))
- if (getOption("collage")) {
- ## Determine the starting point for the loop
- if (is.null(attr(rec, "intervals"))) {
- Range <- 1:(length(levels(rec$FIT_Filename)) -
- (2 * getOption("size")))
- } else {
- Range <- attr(rec, "intervals")[1, ncol(attr(rec, "intervals"))]:
- (length(levels(rec$FIT_Filename)) - (2 * getOption("size")))
- }
- for (i in Range) {
- if (grep(i, Range)[1] <= 1) {
- df <- data.frame(Int = (0 + i):
- (i + (2* getOption("size"))))
- Tab <- data.frame(table(rec[rec$FIT_Filename %in%
- levels(rec$FIT_Filename)[df[, (i + 1) -
- Range[1]]], ]$Ident))
- } else {
- df[, (i + 1) - Range[1]] <- data.frame(Int = df[, ((i + 1) -
- Range[1] - 1)] + getOption("lag"))
- Tab[, ((i + 1) - Range[1]) + 1] <-
- table(rec[rec$FIT_Filename %in%
- levels(rec$FIT_Filename)[df[, (i + 1) -
- Range[1]]], ]$Ident)
- }
- Temp[(i + 1) - Range[1]] <- mean(rec[rec$FIT_Filename %in%
- levels(rec$FIT_Filename)[df[getOption("size") + 1, (i + 1) -
- Range[1]]], ]$Sec)
- if (!all(df[, (i + 1) - Range[1]] <
- length(levels(rec$FIT_Filename)))) {
- warning("The loop is stopped because the end of the table is reached")
- break
- }
- }
- } else {
- ## Determine the starting point for the loop
- if (is.null(attr(rec, "intervals"))) {
- Range <- 1:(dim(rec)[1] - (2 * getOption("size")))
- } else {
- Range <- attr(rec, "intervals")[1, ncol(attr(rec, "intervals"))]:
- (dim(rec)[1] - (2 * getOption("size")))
- }
- for (i in Range) {
- if (grep(i, Range)[1] <= 1) {
- df <- data.frame(Int = (0 + i):
- (i + (2 * getOption("size"))))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 222
More information about the Zooimage-commits
mailing list