[Zooimage-commits] r224 - 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
Thu Jul 12 21:36:03 CEST 2012
Author: phgrosjean
Date: 2012-07-12 21:36:03 +0200 (Thu, 12 Jul 2012)
New Revision: 224
Modified:
pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
pkg/zooimage/NAMESPACE
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/gui.Rd
pkg/zooimage/man/utilities.Rd
pkg/zooimage/man/zie.Rd
pkg/zooimage/man/zim.Rd
pkg/zooimage/man/zip.Rd
pkg/zooimage/man/zis.Rd
Log:
.zim and .zie management
Modified: pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
===================================================================
--- pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-12 19:36:03 UTC (rev 224)
@@ -48,7 +48,7 @@
|||zimVerify() ~~ guiDlgFunction("zimVerify")
|||--
|||zimE&xtractAll() ~~ guiDlgFunction("zimExtractAll")
-|||zimRefreshAll() ~~ guiDlgFunction("zimRefreshAll")
+|||zimUpdateAll() ~~ guiDlgFunction("zimUpdateAll")
||$PhytoImage &Picture (zip)
|||zipImg() ~~ guiDlgFunction("zipImg")
|||zipImg&All() ~~ guiDlgFunction("zipImgAll")
Modified: pkg/zooimage/NAMESPACE
===================================================================
--- pkg/zooimage/NAMESPACE 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/zooimage/NAMESPACE 2012-07-12 19:36:03 UTC (rev 224)
@@ -22,21 +22,13 @@
import(RWekajars)
-export(BFcorrection)
-export(calibrate)
-export(checkBF)
-export(compareExif)
export(getSpectrum)
export(histSpectrum)
-export(isTestFile)
-export(isZim)
export(lvq)
export(nnet2)
export(plotAbdBio)
export(processSample)
export(processSampleAll)
-export(rawConvert)
-export(readExifRaw)
export(sampleAbd)
export(sampleBio)
export(sampleSpectrum)
@@ -62,27 +54,27 @@
export(zidbDatRead)
export(zidbPlot)
export(zidbDrawVignette)
+
+# Zic
+export(zicCheck)
+
+# Zie
export(ZIE)
-export(ZIEimportJpg)
-export(ZIEimportTable)
-export(ZIEimportTif)
-export(ZIEimportZie)
export(zieCompile)
+export(zieCompileFlowCAM)
export(zieMake)
+
+# Zim
+export(isZim)
export(zimCreate)
-export(zimDatList)
export(zimEdit)
export(zimExtractAll)
-export(zimList)
export(zimMake)
-export(zimRefreshAll)
+export(zimUpdateAll)
export(zimVerify)
+export(zimDatMakeFlowCAM)
+export(zimDatMakeFlowCAMAll)
-
-
-# Zic
-export(zicCheck)
-
# Zip
export(zipImg)
export(zipImgAll)
@@ -103,6 +95,7 @@
# Utilities
export(calcVars)
+export(calibrate)
export(ecd)
export(getDec)
export(listSamples)
@@ -163,7 +156,6 @@
export(ZIDlg)
# Not in menus yet!
export(subpartZIDat)
-export(batchFilePlugin)
# GUI-Utilities
export(selectGroups)
Modified: pkg/zooimage/R/fileutils.R
===================================================================
--- pkg/zooimage/R/fileutils.R 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/zooimage/R/fileutils.R 2012-07-12 19:36:03 UTC (rev 224)
@@ -72,7 +72,7 @@
pngList <- function (dir, ...)
listFilesExt(dir, extension = "png", ...)
-## Check if a file exists (batchable!)
+## Check if a file exists
checkFileExists <- function (file, extension, message = "file not found: %s",
force.file = FALSE)
{
@@ -111,7 +111,7 @@
return(TRUE)
}
-#### OK #### batcheable! (used in prepareTrain())
+## Check if a directory is empty (used in prepareTrain())
checkEmptyDir <- function (dir, message = 'dir "%s" is not empty')
{
## Works only on a single dir (not vectorized code)
@@ -141,7 +141,6 @@
} else TRUE
}
-#### OK #### batcheable! (used in various places)
## Checks the first line of a file against some expected content
checkFirstLine <- function (file, expected = c("ZI1", "ZI2", "ZI3"),
message = 'file "%s" is not a valid ZooImage version <= 3 file')
Modified: pkg/zooimage/R/gui.R
===================================================================
--- pkg/zooimage/R/gui.R 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/zooimage/R/gui.R 2012-07-12 19:36:03 UTC (rev 224)
@@ -314,60 +314,51 @@
title = "Select data to import...")
## Look if there is at least one image selected
- if (!length(Images)) return(invisible())
+ if (!length(Images)) return(invisible(FALSE))
dir <- dirname(Images[1])
Images <- basename(Images)
- has <- function (extension, pattern = extensionPattern(extension))
+ has <- function (file, pattern)
grepl(pattern, Images[1])
## Determine which kind of data it is
- if (has(pattern = "^Import_.*[.]zie$")) {
- return(zieMake(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 (has(Images[1], pattern = "^Import_.*[.]zie$")) {
+ if (length(Images) > 1)
+ warning("you cannot select more than one .zie file; using the first one")
- if (all(TargetName %in% names(FlowCAM.txt))) {
- res <- zimMakeFlowCAM(import = FlowCAMPath, check.names = FALSE)
- return(invisible(res))
- }
- pattern <- extensionPattern(".txt")
- message("Creating .zie file...")
- ziefile <- zieCompile(path = dir, Tablefile = Images[1])
- message(" ...OK!")
- res <- zieMake(path = dirname(ziefile), Filemap = basename(ziefile),
- check = TRUE, show.log = TRUE)
- if (res) { # Everything is fine...
- ## Move the table and copy the template to the '_raw' subdirectory too
- path <- dirname(ziefile)
- tplfile <- file.path(path, Images[1])
- file.rename(tplfile, file.path(path, "_raw", basename(tplfile)))
- ## Move also possibly the .xls equivalent
- xlsfile <- sub( pattern, ".xls", tplfile)
- if (xlsfile != tplfile && file.exists(xlsfile))
- file.rename(xlsfile, file.path(path, "_raw", basename(xlsfile)))
- file.rename(file.path(path, "ImportTemplate.zie"), file.path(path,
- "_raw", "ImportTemplate.zie"))
- }
- return(res)
+ return(invisible(zieMake(path = dir, Filemap = Images[1], check = TRUE)))
+
+ } else if (has(Images[1], "[.]txt$")) {
+ ## Special Case for FlowCAM images
+ if (length(Images) > 1)
+ warning("you cannot select more than one .txt file; using the first one")
+
+ ## I also need the "ImportTemplate.zie" file in the same path
+ txtFile <- Images
+ zieTemplate <- file.path(dirname(txtFile), "ImportTemplate.zie")
+ if (!checkFileExists(zieTemplate, "zie", force.file = TRUE))
+ return(invisible(FALSE))
+
+ ## Create .zim files + FitVisParameters.csv file for the FlowCAM
+ message("Creating .zim files and FitVisParameters.csv...")
+ res <- zieCompileFlowCAM(path = dirname(txtFile), Tablefile = txtFile,
+ Template = zieTemplate, check.names = FALSE)
+ return(invisible(res))
+
} else if (has(".tif")) {
pattern <- extensionPattern(".tif")
+
} else if (has("jpg")) {
pattern <- extensionPattern("jpg")
- } else stop("Unrecognized data type!")
+
+ } else {
+ warning("unrecognized data type!")
+ return(invisible(FALSE))
+ }
## If there is no special treatment, just make all required .zim files
## for currently selected images
- zimMake(dir = dir, pattern = pattern, images = Images)
+ invisible(zimMake(dir = dir, pattern = pattern, images = Images))
}
## TODO: the text appears only on one line on the Mac???
@@ -1307,28 +1298,3 @@
res <- subpartThreshold(ZIDat = zid, Filter = threshold)
return(res)
}
-
-
-## Create a batch file for FlowCAM image analysis
-batchFilePlugin <- function ()
-{
- ## Select a FlowCAM context file
- ctxFile <- dlgOpen(multiple = FALSE, title = "Select a context file...",
- filters = matrix(c("FlowCAM Context file", ".ctx"), ncol = 2,
- byrow = TRUE))$res
- if (!length(ctxFile)) return(invisible(NULL))
- ctxSampleDir <- dirname(dirname(ctxFile))
-
- ## Create the table of importation
- ContextList <- ctxReadAll(ctxfile = ctxFile, fil = FALSE, largest = FALSE,
- vignettes = TRUE, scalebar = TRUE, enhance = FALSE, outline = FALSE,
- masks = FALSE, verbose = TRUE)
-
- ## Write the table of importation in the sample directory
- write.table(ContextList, sep = "\t", dec = ".", row.names = FALSE,
- file = file.path(ctxSampleDir, "batchExampleParameters.txt"),
- quote = TRUE, col.names = TRUE)
-
- message("Your import table has been created in your sample directory ",
- ctxSampleDir)
-}
Modified: pkg/zooimage/R/utilities.R
===================================================================
--- pkg/zooimage/R/utilities.R 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/zooimage/R/utilities.R 2012-07-12 19:36:03 UTC (rev 224)
@@ -221,6 +221,168 @@
DatSec
}
+## Garyscale calibration in O.D. scale
+## TODO: rework all this using ImageJ
+calibrate <- function (ODfile)
+{
+ ### TODO: include also a spatial calibration procedure
+ ## (with a black circle around the center of the image)
+ ## and check also other characteristics, especially the sharpness
+
+ cal <- c(NA, NA)
+ names(cal) <- c("WhitePoint", "BlackPoint")
+ msg <- character(0)
+
+ if (!file.exists(ODfile)) {
+ msg <- paste("O.D. file '", ODfile, "' not found!", sep = "")
+ attr(cal, "msg") <- msg
+ return(cal)
+ }
+
+ ## Is it a test file?
+ if (.isTestFile(ODfile)) {
+ ## We behave like if the file was correct and return fake calibration data!
+ cal <- c(1000, 50000)
+ names(cal) <- c("WhitePoint", "BlackPoint")
+ attr(cal, "msg") <- character(0)
+ return(cal)
+ }
+
+ filedir <- dirname(ODfile)
+ if (filedir != ".") {
+ ## Temporary change directory to the one where the file is located
+ inidir <- setwd(filedir)
+ on.exit(setwd(inidir))
+ ODfile <- basename(ODfile)
+ }
+
+ ## The command to use depends on the format of the image (determined on the
+ ## extension)
+ ext <- tolower(rev(strsplit(ODfile, "\\.")[[1]])[1])
+ pgmfile <- ODfile
+ if (ext == "tif") {
+ ## First, convert into a .pgm file
+ pgmfile <- paste(ODfile, "pgm", sep = ".")
+#### netpbm_tifftopnm( ODfile, pgmfile )
+ delfile <- TRUE
+ ext <- "pgm"
+ } else delfile <- FALSE
+ if (ext != "pgm")
+ return(paste("Unrecognized image format for '", ODfile, "'", sep = ""))
+#### OD <- netpbm_pgmhist(pgmfile, delete = delfile)
+
+ ## Make sure we work with 16bit images
+ if (max(OD$Gray) < 256) {
+ msg <- c(msg, "O.D. seems to be a 8bit image (16bit required)")
+ } else {
+ ## Eliminate values with low number of points
+ OD <- OD[OD$Count > 100, ]
+
+ ## Look at range: should be widespread enough, but without saturation
+ rngOD <- range(OD$Gray)
+ if (rngOD[2] > 65500) msg <-
+ c(msg, "Images are overexposed, or whitepoint is already calibrated")
+ if (rngOD[2] < 55000)
+ msg <- c(msg, "Images are underexposed")
+
+ ## Saturation on the left-side of the histogram is not much a problem!
+ if (rngOD[2] - rngOD[1] < 40000)
+ msg <- c(msg, "Images lack contrast")
+ ## We should end up with four segments
+ graylev <- OD$Gray
+ gap <- (diff(graylev) > 500)
+
+ ## There are not *exactly* four gaps => problem with the image!
+ if (sum(gap) != 4) {
+ msg <- c(msg, "Impossible to calibrate O.D.: wrong image")
+ } else {
+ ## Get the five peaks, analyze them and get modes for blank, NDx2,
+ ## NDx4 and NDx8
+ peaks <- as.factor(cumsum(c(0, gap)) + 1)
+ peaksgray <- split(graylev, peaks)
+ names(peaksgray) <- c("Black", "NDx8", "NDx4", "NDx2", "White")
+
+ ## These are supposed to be all narrow peaks... check this
+ peakspan <- sapply(peaksgray, range)
+ peaksrange <- peakspan[2, ] - peakspan[1, ]
+
+ ## 1.2-2: width of black peak is much larger for Epson 4990
+ ## => be more tolerant for that peak
+ if (any(peaksrange > c(20000, rep(5000, 4)))) {
+ wrongpeaks <- paste(names(peaksrange)[peaksrange > 5000],
+ collapse = ", ")
+ msg <- c(msg, paste("Wrong O.D. image: lack of homogeneity for",
+ wrongpeaks))
+ }
+
+ ## Look for the gray levels at the top of the peaks
+ peaksheight <- split(OD$Count, peaks)
+ names(peaksheight) <- c("Black", "NDx8", "NDx4", "NDx2", "White")
+ findmax <- function(x) which.max(lowess(x, f = 0.05, iter = 1)$y)
+ peaksval <- sapply(peaksheight, findmax)
+
+ ## Get the number of pixels in the white peak
+ nbrwhite <- peaksheight$White[peaksval["White"]]
+
+ ## Replace the location by the actual gray level
+ for (i in 1:5)
+ peaksval[i] <- peaksgray[[i]][peaksval[i]]
+ ## If the number of pixels for pure white is larger than the white
+ ## peak found, replace it by pure white (65535)
+ nbrpurewhite <- OD[nrow(OD), 2]
+ if (nbrpurewhite > nbrwhite)
+ peaksval["White"] <- 65535
+
+ ## Now, we need to calibrate the black and white points
+ WhitePoint <- 65535 - peaksval["White"]
+
+ ## Perform a correction for the white point
+ peaksval <- peaksval + WhitePoint
+
+ ## Transform those gray levels into O.D.
+ peaksOD <- log(peaksval) * 65535 / log(65535)
+
+ ## Create a data frame with gray levels and corresponding OD for
+ ## White, NDx2, NDx4 and NDx8
+ calib <- data.frame(Gray = peaksOD[5:2], OD = c(0, 0.3, 0.6, 0.9))
+
+ ## Fit a line on these data
+ calib.lm <- lm(OD ~ Gray, data = calib)
+
+ ## Check that calibration line is fine (i.e., the ANOVA should
+ ## reject H0 at alpha = 5%)
+ if (anova(calib.lm)[["Pr(>F)"]][1] > 0.01)
+ msg <- c(msg, "Wrong OD calibration: not a straight line relation at alpha level = 0.01")
+
+ ## Check also that R squared is at least 0.98
+ rsq <- summary(calib.lm)$r.squared
+ if (rsq < 0.98)
+ msg <- c(msg, paste("Bad OD calibration (R squared = ",
+ formatC(rsq, digits = 3), ")", sep = ""))
+
+ ## Check linearity of the relationship by fitting a second order
+ ## polynome and by looking at the t-test for the x square parameter
+ calib2.lm <- lm(OD ~ I(Gray^2) + Gray, data = calib)
+ if (summary(calib2.lm)$coefficients["I(Gray^2)", "Pr(>|t|)"] < 0.01)
+ msg <- c(msg, "Nonlinear OD calibration at alpha level = 0.01")
+
+ ## Calculate the value of the black point to get 0.004 OD per gray
+ ## level after conversion (see the manual)
+ ccoef <- coef(calib.lm)
+ BlackPoint <- (1.024 - ccoef[1]) / ccoef[2]
+
+ ## Get the calibration data
+ cal[1] <- round(WhitePoint)
+ cal[2] <- round(BlackPoint)
+ }
+ }
+ attr(cal, "msg") <- msg
+ return(cal)
+}
+## example:
+## setwd("g:/zooplankton/madagascar2macro")
+## calibrate("test.tif")
+
## Decimal separator to use in import/export ZooImage files
getDec <- function ()
{
@@ -280,18 +442,18 @@
zipfile <- as.character(zipfile)
if (length(zipfile) != 1) {
warning("exactly one 'zipfile' must be provided")
- return(FALSE)
+ return(NULL)
}
if (!file.exists(zipfile)) {
warning("'zipfile' not found: '", basename(zipfile), "'")
- return(FALSE)
+ return(NULL)
}
if (length(zimfile)) {
zimfile <- as.character(zimfile)
if (length(zimfile) != 1) {
warning("exactly one 'zimfile' must be provided")
- return(FALSE)
+ return(NULL)
}
}
## Make sure old data do not remain in zimfile
@@ -304,7 +466,7 @@
if (unzippgm == zippgm || inherits(try(system("unzip", intern = TRUE),
silent = TRUE), "try-error")) {
warning("'unzip' program is required, but not found")
- return(character(0))
+ return(NULL)
}
cmd <- sprintf('"%s" -zq "%s"', unzippgm, zipfile)
res <- try(system(cmd, invisible = TRUE, intern = TRUE), silent = TRUE)
@@ -314,7 +476,7 @@
}
if (inherits(res, "try-error")) {
warning(as.character(res))
- return(character(0))
+ return(NULL)
}
if (length(res) < 2) {
Modified: pkg/zooimage/R/zid.R
===================================================================
--- pkg/zooimage/R/zid.R 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/zooimage/R/zid.R 2012-07-12 19:36:03 UTC (rev 224)
@@ -39,9 +39,9 @@
dat1files <- sort(dat1files)
## Default to -1 for corrupted dat1 files
nitems <- sapply(dat1files, function(x) {
- zimVerify(file.path(zidir, x), is.dat1 = TRUE )
+ zimVerify(file.path(zidir, x))
})
- ok <- all(nitems != -1)
+ ok <- all(nitems >= 0)
## Check the vignettes
if (isTRUE(as.logical(check.vignettes))) {
@@ -154,7 +154,7 @@
}
## Make sure everything is fine for this directory
- if (check)
+ if (isTRUE(as.logical(check)))
zidVerify(zidir, type = type, check.vignettes = check.vignettes)
## Make sure the .RData file is created (or refreshed)
@@ -234,13 +234,12 @@
zidClean <- function (path = ".", samples = NULL)
{
## Do we have samples to process
- if (length(samples) == 0) return(invisible(FALSE))
+ if (!length(samples)) return(invisible(FALSE))
## First, switch to that directory
- inidir <- getwd()
- checkDirExists(path)
- on.exit(setwd(inidir))
- setwd(path)
+ if (!checkDirExists(path)) return(invisible(FALSE))
+ initdir <- setwd(path)
+ on.exit(setwd(initdir))
## Identify paths
message("Cleaning directory...")
@@ -251,7 +250,7 @@
zimfiles <- zimfiles[zimsamples %in% samples]
## Process
- if (length(zimfiles) > 0) {
+ if (length(zimfiles)) {
rawdir <- file.path(".", "_raw")
## If the _raw subdirectory does not exists, create it
@@ -359,13 +358,12 @@
dat1files <- zimDatList(zidir)
## Create _dat1.zim file if it is missing (for FlowCAM data)
- if (length(dat1files) == 0) {
- ## Try to create them
- SmpDir <- dirname(zidir)
- ZimFile <- file.path(SmpDir, paste(basename(zidir), ".zim", sep = ""))
- zimDatMake(ZimFile)
+ if (!length(dat1files)) {
+ SmpDir <- dirname(zidir)
+ zimDatMakeFlowCAM(file.path(SmpDir,
+ paste(basename(zidir), "zim", sep = ".")))
dat1files <- zimDatList(zidir)
- if (length(dat1files) == 0) {
+ if (!length(dat1files)) {
warning("no '_dat1.zim' file!")
return(invisible(FALSE))
}
@@ -495,7 +493,7 @@
allmes <- data.frame(allmes[, 1:2], ECD = ECD, allmes[, 3:ncol(allmes)])
}
attr(allmes, "metadata") <- allmeta
- class(allmes) <- c("ZI1Dat", "ZIDat", "data.frame")
+ class(allmes) <- c("ZI3Dat", "ZIDat", "data.frame")
ZI.sample <- allmes
save(ZI.sample, file = RDataFile, ascii = FALSE, version = 2,
compress = TRUE)
@@ -550,6 +548,6 @@
## Set the class
if (!inherits(ZI.sample, "ZIDat") && inherits(ZI.sample, "data.frame"))
- class(ZI.sample) <- c("ZI1Dat", "ZIDat", "data.frame")
+ class(ZI.sample) <- c("ZI3Dat", "ZIDat", "data.frame")
return(ZI.sample)
}
Modified: pkg/zooimage/R/zidb.R
===================================================================
--- pkg/zooimage/R/zidb.R 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/zooimage/R/zidb.R 2012-07-12 19:36:03 UTC (rev 224)
@@ -242,7 +242,7 @@
con = file.path(ZidbDir, paste0(ZimName, ".zim")))
## Vignettes
- VignNames <- AllFiles[!isZimFile]
+ VignNames <- AllFiles[-isZimFile]
message("Extracting vignettes...")
for(i in 1 : length(VignNames)){
writeBin(Zidb[[VignNames[i]]],
Modified: pkg/zooimage/R/zie.R
===================================================================
--- pkg/zooimage/R/zie.R 2012-07-10 22:50:25 UTC (rev 223)
+++ pkg/zooimage/R/zie.R 2012-07-12 19:36:03 UTC (rev 224)
@@ -15,138 +15,9 @@
## You should have received a copy of the GNU General Public License
## along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
-## Specific functions for manipulating .zie files (ZooImage Import/Export)
-## These .zie files contain specifications for importing a series of images
-## and creating their corresponding .zim files (ZooImage Metadata) automatically.
-## Typically, they are created by 'importing' image/data from other software
-## or from digitization hardware/software.
-## Another version specifies rules to automated exportation of ZooImage results.
-## They are all 'ZIE' objects, with respective subclasses 'ZIEimport' and
-## 'ZIEexport'.
-
-### TODO: check image filename during importation!!!
-### TODO: a routine that lists all ZIEimport objects + summary of them.
-
-## Standard import/export classes provided by default with ZooImage
-
-## The function that eases creation of a ZIE object
-### TODO: add a 'message' entry = message to display after of the importation
-ZIE <- function (title, filter, description, pattern, command, author,
-version, date, license, url, depends = "R (>= 2.4.0), zooimage (>= 1.0-0)",
-type = c("import", "export"))
-{
- if (!is.character(title) || !is.character(filter) ||
- !is.character(description) || !is.character(pattern) ||
- !is.character(command) || !is.character(author) ||
- !is.character(version) || !is.character(date) ||
- !is.character(license) || !is.character(url) ||
- !is.character(depends))
- stop("All arguments must be character strings!")
- obj <- list(title = title[1], filter = filter[1],
- description = paste(description, collapse = "\n"), pattern = pattern[1],
- command = paste(command, collapse = "\n"), author = author[1],
- version = version[1], license = license[1], depends = depends[1])
- type <- match.arg(type, several.ok = FALSE)
- class(obj) <- switch(type,
- import = c("ZIEimport", "ZIE"),
- export = c("ZIEexport", "ZIE"))
- return(obj)
-}
-
-print.ZIE <- function (x, ...)
-{
- SubClass <- class(x)[1]
- cat("A", getTemp("ZIname"),
- "Import/Export definition object of subclass:", SubClass, "\n")
- cat("\n", x$description, "\n\n")
- cat("Title: ", x$title, "\n")
- cat("Filter: ", x$filter, "\n")
- cat("Pattern:", x$pattern, "\n")
- cat("Command:", x$command, "\n")
- cat("Author: ", x$author, "\n")
- cat("Version:", x$version, "\n")
- cat("Date: ", x$date, "\n")
- cat("License:", x$license, "\n")
- cat("Depends:", x$depends, "\n")
- cat("URL: ", x$url, "\n")
- return(invisible(x))
-}
-
-## Import plain .tif files, with manual creation of associated .zim files
-ZIEimportTif <- ZIE(
- title = "Tiff image files (*.tif)",
- filter = "*.tif",
- description = c("Manual creation of ZooImage Metadata files (.zim)",
- "given a list of directly usable .tif images",
- "that is, no conversion required and image names",
- "already follow the ZooImage convention"),
- pattern = "\\.[tT][iI][fF]$",
- command = "zimMake(dir = Dir, pattern = Pattern, images = Files, show.log = TRUE)",
- author = "Philippe Grosjean (phgrosjean at sciviews.org)",
- version = "1.1-0",
- date = "2007-02-20",
- license = "GPL 2 or above",
- url = "",
- depends = "R (>= 2.4.0), zooimage (>= 1.1-0)",
- type = "import")
-
-## Import plain .jpg files, with manual creation of associated .zim files
-ZIEimportJpg <- ZIE(
- title = "Jpeg image files (*.jpg)",
- filter = "*.jpg",
- description = c("Manual creation of ZooImage Metadata files (.zim)",
- "given a list of directly usable .jpg images",
- "that is, no conversion required and image names",
- "already follow the ZooImage convention"),
- pattern = "\\.[jJ][pP][gG]$",
- command = "zimMake(dir = Dir, pattern = Pattern, images = Files, show.log = TRUE)",
- author = "Philippe Grosjean (phgrosjean at sciviews.org)",
- version = "1.1-0",
- date = "2007-02-20",
- license = "GPL 2 or above",
- url = "",
- depends = "R (>= 2.4.0), zooimage (>= 1.1-0)",
- type = "import")
-
-## Complex import of images (conversion, renaming, etc.) with automatic creation
-## of associated .zim files using a .zie file
-ZIEimportZie <- ZIE(
- title = "ZooImage Import Extension (Import_*.zie)",
- filter = "Import_*.zie",
- description = c("Run a .zie import specification file to convert",
- "and/or rename images and automatically create",
- "associated .zim files (ZooImage Metadata)"),
- pattern = "\\.[zZ][iI][eE]$",
- command = "zieMake(path = Dir, Filemap = Files[1], check = TRUE, show.log = TRUE))",
- author = "Philippe Grosjean (phgrosjean at sciviews.org)",
- version = "1.1-0",
- date = "2007-02-20",
- license = "GPL 2 or above",
- url = "",
- depends = "R (>= 2.4.0), zooimage (>= 1.1-0)",
- type = "import")
-
-## Compile a .zie file from TemplateImport.zie and a table.txt and then compute it
-ZIEimportTable <- ZIE(
- title = "Table and ImportTemplate.zie (*.txt)",
- filter = "*.txt",
- description = c("Create a .zie file by interpretting a table,",
- "using a template file in the same directory",
- "and named 'ImportTemplate.zie'. The resulting",
- ".zie file is then run to make images + metadata"),
- pattern = "\\.[tT][xX][tT]$",
- command = "zieCompile(path = Dir, TableFile = Files[1], make.it = TRUE, show.log = TRUE))",
- author = "Philippe Grosjean (phgrosjean at sciviews.org)",
- version = "1.1-0",
- date = "2007-02-20",
- license = "GPL 2 or above",
- url = "",
- depends = "R (>= 2.4.0), zooimage (>= 1.1-0)",
- type = "import")
-
+## Make .zim files and import images, using a .zie import file for specifs
zieMake <- function (path = ".", Filemap = "Import_Table.zie", check = TRUE,
-replace = FALSE, move.to.raw = TRUE, zip.images = "[.][tT][iI][fF]$",
-show.log = TRUE, bell = FALSE)
+replace = FALSE, move.to.raw = TRUE, zip.images = "[.]tif$")
{
## Example of use:
## Import Digicam RAW files (currently, only Canon .CR2 files)
@@ -154,9 +25,10 @@
## move processed .cr2 files into _raw; create associated .zim files
## This requires the 'dc_raw' and 'ppmtopgm' programs plus a couple of others!
+ ## TODO: change this to eliminate external programs dependencies!
## We need 'identify' and 'convert' from ImageMagick 16 bits!
## Make sure they are available
- if (isTRUE(check)) {
+ if (isTRUE(as.logical(check))) {
#checkCapable("identify")
#checkCapable("convert")
#checkCapable("dc_raw")
@@ -165,10 +37,9 @@
}
## First, switch to the root directory
- inidir <- getwd()
- checkDirExists(path)
- setwd(path)
- on.exit(setwd(inidir))
+ if (!checkDirExists(path)) return(invisible(FALSE))
+ initdir <- setwd(path)
+ on.exit(setwd(initdir))
path <- getwd() # Indicate we are now in the right path
### TODO If last subdir of path is "_raw", then, work with parent dir
## and do not move files in _raw subdir
@@ -176,47 +47,56 @@
## Read the Filemap
cat("Reading Filemap...\n")
if (!checkFileExists(Filemap, extension = "zie", force.file = TRUE))
- return(NULL)
+ return(invisible(FALSE))
## Check first line for ZI1-3
- if (!checkFirstLine(Filemap))
- return(NULL)
+ if (!checkFirstLine(Filemap)) return(invisible(FALSE))
## Read the file and check it is not empty
## Note: we don't use comment.char = '#' because we want to read and rewrite
## those comments!
Lines <- scan(Filemap, character(), sep = "\t", skip = 1,
blank.lines.skip = FALSE, flush = TRUE, quiet = TRUE, comment.char = "")
- if (length(Lines) < 1) stop('Empty or corrupted!')
+ if (!length(Lines)) {
+ warning('filemap empty or corrupted!')
+ return(invisible(FALSE))
+ }
## Get the position of a section
getSectionPos <- function (section = "Map",
- message = "section '[%s]' found") {
+ message = "section '[%s]' found") {
rx <- sprintf("[[]%s[]]", section)
out <- grep(rx, Lines)
- if (length(out) != 1) stop(sprintf(message, section))
- return(out)
+ if (length(out) != 1) {
+ warning(sprintf(message, section))
+ NULL
+ } else out
}
getSection <- function (section = "Map", to = c("next","end"),
- message = "The [Map] section is empty!") {
+ message = "The [Map] section is empty!") {
to <- match.arg(to)
start <- getSectionPos(section)[1]
+ if (!length(start)) return(NULL)
end <- switch(to,
"next" = {
ends <- getSectionPos(".*")
+ if (!length(ends)) return(NULL)
ends[ends > start][1] - 1
},
"end" = length(Lines)
)
out <- Lines[seq.int(from = start + 1, to = end)]
- if (length(out) == 0) stop(message)
- return(out)
+ if (!length(out)) {
+ warning(message)
+ NULL
+ } else out
}
## Get everything before '[Map]' as template data for the .zim file
posMap <- getSectionPos("Map",
"The file is corrupted: no or duplicated [Map] section found!")
+ if (!length(posMap)) return(invisible(FALSE))
## Setup the zim data
zimData <- Lines[1:(posMap - 1)]
@@ -247,12 +127,14 @@
## Get the [Map] section
Lines <- getSection("Map", to = "end", "The [Map] section is empty!")
+ if (!length(Lines)) return(invisible(FALSE))
+
message("Reading Filemap... OK!")
## Make sure _raw, and _work subdirectories exists and have write access
- if (!forceDirCreate("_raw")) return(NULL)
+ if (!forceDirCreate("_raw")) return(invisible(FALSE))
if (Convert != "" || MoveToWork)
- if (!forceDirCreate("_work")) return(NULL)
+ if (!forceDirCreate("_work")) return(invisible(FALSE))
## This function constructs image filename using possibly a FilenamePattern
MakeImageName <- function(x, pattern = FilePat) {
@@ -272,7 +154,7 @@
## of the same image
### TODO: indicate progression with exact line number in the zie file!
### TODO: allow restarting from a given point!
- message("Checking all lines in the .zie file for raw images...\n")
+ message("Checking all lines in the .zie file for raw images...")
allImages <- character(0)
nLines <- length(Lines)
for (i in 1:nLines) {
@@ -283,8 +165,11 @@
if (!grepl("^[-][>]", Lines[i])) { # This is not a state change command
File <- MakeImageName(trimString(sub("[=].*$", "", Lines[i])))
checkFileExists(File)
- if (File %in% allImages)
- stop(sprintf("Duplicated use of the same file : '%s' !", File))
+ if (File %in% allImages) {
+ warning(sprintf("Duplicated use of the same file : '%s' !",
+ File))
+ return(invisible(FALSE))
+ }
allImages <- c(allImages, File)
}
}
@@ -341,11 +226,11 @@
posFrac <- grep(Frac, zimD)
if (length(posFrac) < 1) {
warning("[Fraction] section not found (", Frac, ")!")
- return(invisible(FALSE))
+ return(FALSE)
}
if (length(posFrac) > 1) {
warning("multiple", Frac, "sections for sample '", Smp, "'")
- return(invisible(FALSE))
+ return(FALSE)
}
zimD[posFrac] <- "[Fraction]"
## Strip out all other [Fraction_XXX] sections
@@ -357,18 +242,22 @@
if (SubPat != "") {
## This is the header to consider
- if (length(grep(SubPat, Smp)) == 0)
- stop( paste("Sample '", Smp,
- "' is incompatible\nwith SubsamplePattern '", SubPat, "'",
- sep = ""))
+ if (!length(grep(SubPat, Smp))) {
+ warning("Sample '", Smp,
+ "' is incompatible\nwith SubsamplePattern '", SubPat, "'")
+ return(FALSE)
+ }
Sub <- paste("[[]Subsample_", sub(SubPat, "\\1", Smp), "\\]",
sep = "")
posSub <- grep(Sub, zimD)
- if (length(posSub) < 1)
- stop(paste("[Subsample] section not found (", Sub, ")!",
- sep = ""))
- if (length(posSub) > 1)
- stop(paste("multiple", Sub, "sections found for this sample!"))
+ if (!length(posSub)) {
+ warning("[Subsample] section not found (", Sub, ")!")
+ return(FALSE)
+ }
+ if (length(posSub) > 1) {
+ warning("multiple", Sub, "sections found for this sample!")
+ return(FALSE)
+ }
zimD[posSub] <- "[Subsample]"
## Strip out all other [Subsample_XXX] sections
otherSub <- grep("[[]Subsample_", zimD)
@@ -396,7 +285,7 @@
UpdateZim <- function (dat, zimData) {
### TODO: Strip out comments (not done here, because we want to process
### strings with '#' correctly!
- if (length(grep("^[-][>]", dat)) == 0) return(FALSE)
+ if (length(grep("^[-][>]", dat)) == 0) return(NULL)
## This line starts with "->" => we update zimData
Key <- sub("^[-][>]([^ =]+).*$", "\\1", dat)
## Special treatment if Key == "Sample"
@@ -446,6 +335,10 @@
for (i in 1:nLines) {
progress(i, nLines)
res <- UpdateZim(Lines[i], zimData)
+ if (!length(res)) {
+ warning("problem while updating .zim files")
+ return(invisible(FALSE))
+ }
## This is not a state change command
if (length(res) == 1 && res == FALSE) {
@@ -506,10 +399,10 @@
## (or check correspondance)
if (Exif) {
ExifData <- attr(zimData, "Exif")
- ExifData2 <- readExifRaw(File, check = FALSE)
+ ExifData2 <- .readExifRaw(File, check = FALSE)
if (!is.null(ExifData) && length(ExifData) > 0 &&
ExifData != "") { # Do a comparison of Exif data
- compa <- compareExif(ExifData, ExifData2)
+ compa <- .compareExif(ExifData, ExifData2)
if (length(compa) > 0)
warning("Exif seems to be different from the rest in '",
File, "'")
@@ -562,7 +455,7 @@
## If this is a blank-field, then test it
if (length(grep("^_CalibBF", NewFile)) > 0) {
- msg <- checkBF(FileConv)
+ msg <- .checkBF(FileConv)
if (!is.null(msg) && length(msg) > 0 && msg != "") {
warning(paste(c(
"Warning! Problem(s) detected with blank-field image:",
@@ -579,7 +472,7 @@
} else { # make blank-field correction
if (!is.null(BlankField)) {
tryCatch({
- BFcorrection(FileConv, BlankField, deleteBF = FALSE)
+ .BFcorrection(FileConv, BlankField, deleteBF = FALSE)
}, error = function (e) {
warning(as.character(e))
})
@@ -700,8 +593,7 @@
## delete it for the moment
unlink("fileconv.tif")
}
-
-## finishLoop(ok, bell = bell, show.log = show.log)
+ invisible(TRUE)
}
## example:
## setwd("g:/zooplankton/Madagascar2Macro") # My example directory
@@ -709,27 +601,31 @@
zieCompile <- function (path = ".", Tablefile = "Table.txt",
Template = "ImportTemplate.zie", Filemap = paste("Import_", noExtension(Tablefile),
-".zie", sep = ""), Nrange = c(1, 1000), replace = TRUE, make.it = FALSE,
-show.log = make.it)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 224
More information about the Zooimage-commits
mailing list