[Zooimage-commits] r220 - 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
Sat Jul 7 19:29:06 CEST 2012
Author: phgrosjean
Date: 2012-07-07 19:29:06 +0200 (Sat, 07 Jul 2012)
New Revision: 220
Added:
pkg/zooimage/R/fileutils.R
pkg/zooimage/man/fileutils.Rd
Modified:
pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
pkg/zooimage/DESCRIPTION
pkg/zooimage/NAMESPACE
pkg/zooimage/R/RealTime.R
pkg/zooimage/R/ZIClass.R
pkg/zooimage/R/ZIMan.R
pkg/zooimage/R/ZIRes.R
pkg/zooimage/R/ZITrain.R
pkg/zooimage/R/catcher.R
pkg/zooimage/R/errorHandling.R
pkg/zooimage/R/gui.R
pkg/zooimage/R/misc.R
pkg/zooimage/R/programs.R
pkg/zooimage/R/utilities.R
pkg/zooimage/R/zic.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/R/zis.R
pkg/zooimage/R/zzz.R
pkg/zooimage/inst/gui/MenusZIDlgWin.txt
pkg/zooimage/man/ZIClass.Rd
pkg/zooimage/man/utilities.Rd
pkg/zooimage/man/zid.Rd
pkg/zooimage/man/zie.Rd
pkg/zooimage/man/zim.Rd
pkg/zooimage/man/zis.Rd
pkg/zooimage/man/zooimage.package.Rd
Log:
Many changes, refactoring all code towards version 3.0-0 of ZooImage
Modified: pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
===================================================================
--- pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-07 17:29:06 UTC (rev 220)
@@ -41,7 +41,7 @@
||-
||Image &viewer (XnView) ~~ startPgm("ImageViewer")
||Image &analyzer (ImageJ) ~~ startPgm("ImageEditor", switchdir = TRUE, iconize = TRUE)
-||&Metadata editor (Sc1) ~~ startPgm("ZIEditor", cmdline = selectFile("ZimZis"))
+||&Metadata editor ~~ fileEdit(selectFile("ZimZis"))
||--
||Simple acquisition (&VueScan) ~~ startPgm("VueScan", switchdir = TRUE)
|$Functions
@@ -77,7 +77,7 @@
|||zisCreate() ~~ guiDlgFunction("zisCreate")
|||zisEdit() ~~ guiDlgFunction("zisEdit")
|||-
-|||readDescription() ~~ guiDlgFunction("readDescription")
+|||zisRead() ~~ guiDlgFunction("zisRead")
||--
||$PhytoImage &Training set
|||prepare.ZITrain() ~~ guiDlgFunction("prepare.ZITrain")
@@ -106,7 +106,7 @@
|||sampleSpectrum() ~~ guiDlgFunction("sampleSpectrum")
|$Utilities
||Calibrate grayscale (16bit) ~~ calib()
-||Biomass conversion specification ~~ startPgm("ZIEditor", cmdline = file.path(getTemp("ZIetc"), "Conversion.txt"))
+||Biomass conversion specification ~~ fileEdit(file.path(getTemp("ZIetc"), "Conversion.txt"))
||-
||$R Graphs
|||&New ~~ dev.new()
Modified: pkg/zooimage/DESCRIPTION
===================================================================
--- pkg/zooimage/DESCRIPTION 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/DESCRIPTION 2012-07-07 17:29:06 UTC (rev 220)
@@ -2,10 +2,10 @@
Type: Package
Title: Analysis of numerical zooplankton images
Version: 3.0-0
-Date: 2012-05-05
+Date: 2012-07-05
Author: Ph. Grosjean, K. Denis & R. Francois
Maintainer: Ph. Grosjean <Philippe.Grosjean at umons.ac.be>
-Depends: R (>= 2.15.0), utils, svMisc (>= 0.9-66), svDialogs (>= 0.9-53), grDevices, filehash, jpeg, png, MASS, randomForest, ipred, rpart, e1071, nnet, class, tree, RColorBrewer, gplots, RWeka, RWekajars
+Depends: R (>= 2.15.0), utils, svMisc (>= 0.9-67), svDialogs (>= 0.9-53), grDevices, filehash, jpeg, png, MASS, randomForest, ipred, rpart, e1071, nnet, class, tree, RColorBrewer, gplots, RWeka, RWekajars
Suggests: rJava
Description: ZooImage is a free (open source) solution for analyzing digital
images of zooplankton. In combination with ImageJ, a free image analysis
Modified: pkg/zooimage/NAMESPACE
===================================================================
--- pkg/zooimage/NAMESPACE 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/NAMESPACE 2012-07-07 17:29:06 UTC (rev 220)
@@ -44,7 +44,6 @@
export(getDec)
export(getKey)
export(getList)
-export(gettextZI)
export(getSpectrum)
export(getVar)
export(get.ZITrain)
@@ -52,10 +51,7 @@
export(importImg)
export(increaseTrain)
export(isTestFile)
-export(is.zim)
-export(listAdd)
-export(listMerge)
-export(listReduce)
+export(isZim)
export(listObjects)
export(listSamples)
export(loadObjects)
@@ -71,7 +67,6 @@
export(makeZid)
export(modalAssistant)
export(nnet2)
-export(noExt)
export(optInOutDecimalSep)
export(parseIni)
export(plotAbdBio)
@@ -82,7 +77,6 @@
export(processSamples)
export(Progress)
export(rawConvert)
-export(readDescription)
export(readExifRaw)
export(readTrain)
export(read.ZITrain)
@@ -154,9 +148,39 @@
export(zipImgAll)
export(zip.ZITrain)
export(ZIRecodeLevels)
+
+# Zis
export(zisCreate)
export(zisEdit)
+export(zisRead)
+# Utilities
+
+
+# File-utilities
+export(extensionPattern)
+export(hasExtension)
+export(noExtension)
+export(listFilesExt)
+export(jpgList)
+export(pngList)
+export(zidList)
+export(zidbList)
+export(zipList)
+export(zimList)
+export(zimDatList)
+export(checkDirExists)
+export(checkEmptyDir)
+export(checkFileExists)
+export(checkFirstLine)
+export(forceDirCreate)
+
+
+# TODO...
+
+
+
+
S3method(predict, nnet2)
S3method(predict, lvq)
S3method(print, ZIClass)
@@ -173,7 +197,6 @@
# callstack
# catch
# catch.env
-# checkFileExistAll
# checkJavaAvailable
# checkBiff2tiffAvailable # Eliminate Xite programs
# checkDivideAvailable # Eliminate Xite programs
@@ -184,36 +207,22 @@
# checkCapabilityAvailable
# checkConvertAvailable # Eliminate?
# checkDcRawAvailable # Eliminate?
-# checkDirExists
-# checkEmptyDir
-# checkFileExists
-# checkFirstLine
# checkIdentifyAvailable # Eliminate?
# checkPpmtopgmAvailable # Eliminate?
# checkUnzipAvailable
# checkZipAvailable
# checkZipnoteAvailable
# dummyCatcher
-# editor
-# extensionPattern
-# extractMessage
# finishLoop
-# forceDirCreate
# getCatcher
-# getSample
# getZooImageCapability
# getZooImageConditionFunction
# getZooImageErrorFunction
# getZooImageWarningFunction
-# hasExtension
# imagemagick
# imagemagick_convert
# imagemagick_identify
# imageViewer
-# jpgList
-# pngList
-# listFilesExt
-# listDirs
# misc
# misc_dcraw
# netpbm
@@ -225,7 +234,6 @@
# resetCatcher
# setCatcher
# stop
-# template
# unzip
# warning
# xite
@@ -233,9 +241,6 @@
# xite_divide
# xite_pnm2biff
# xite_statistics
-# zidList
-# zidbList
-# zipList
# zip
# zipNoteAdd
# zipNote
Modified: pkg/zooimage/R/RealTime.R
===================================================================
--- pkg/zooimage/R/RealTime.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/RealTime.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -362,7 +362,7 @@
Smp <- predict(ZIClass, Smp, calc.vars = FALSE, class.only = FALSE)
Smp <- calcBiomass(ZIDat = Smp, conv = conv.dir, realtime = TRUE)
List <- list(Smp)
- names(List) <- noExt(basename(compare.smp))
+ names(List) <- noExtension(compare.smp)
} else {
List <- list()
if (length(grep(pattern = ".[Zz][Ii][Dd]", x = compare.smp)) >= 1) {
@@ -378,7 +378,7 @@
lstRead(compare.smp[i]), calc.vars = FALSE,
class.only = FALSE), conv = conv.dir, realtime = TRUE)
}
- names(List) <- noExt(basename(compare.smp))
+ names(List) <- noExtension(compare.smp)
}
compare.smp <- List
} else compare.smp <- FALSE
Modified: pkg/zooimage/R/ZIClass.R
===================================================================
--- pkg/zooimage/R/ZIClass.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/ZIClass.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -20,7 +20,7 @@
package = c("MASS", "randomForest"), Formula = Class ~ logArea + Mean + StdDev +
Mode + Min + Max + logPerim. + logMajor + logMinor + Circ. + logFeret + IntDen +
Elongation + CentBoxD + GrayCentBoxD + CentroidsD + Range + MeanPos + SDNorm + CV,
-calc.vars = "calcVars", k.xval = 10, ...)
+calc.vars = getOption("ZI.calcVars", "calcVars"), k.xval = 10, ...)
{
## Check package availability
## Note: this is supposed to be managed in the NAMESPACE
@@ -28,7 +28,7 @@
## if (!is.null(package)) require( package, character.only = TRUE)
## Check calc.vars
- calc.vars <- calc.vars[1]
+ calc.vars <- as.character(calc.vars)[1]
if (!is.null(calc.vars)) {
CV <- match.fun(calc.vars)
df <- CV(df)
Modified: pkg/zooimage/R/ZIMan.R
===================================================================
--- pkg/zooimage/R/ZIMan.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/ZIMan.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -21,7 +21,7 @@
Filter = NULL)
{
DirName <- dirname(zidfile)
- ZidName <- noExt(zidfile)
+ ZidName <- noExtension(zidfile)
ZidDir <- file.path(DirName, ZidName)
## Check if Directory with the same names as ZIdfile
Modified: pkg/zooimage/R/ZIRes.R
===================================================================
--- pkg/zooimage/R/ZIRes.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/ZIRes.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -22,7 +22,8 @@
exportdir = NULL, show.log = TRUE, SemiTab = NULL, Semi = FALSE)
{
## Check if the ZidFile exists
- checkFileExists(ZidFile)
+ if (!checkFileExists(ZidFile, message = "'ZidFile' not found"))
+ return(invisible(FALSE))
## Check if ZIClass is of the right class
if (!inherits(ZIClass, "ZIClass"))
@@ -44,7 +45,7 @@
AllSamples <- attr(ZIMan, "Samples")
## Check if manual validation exists for this zid file
- if (noExt(ZidFile) %in% AllSamples) {
+ if (noExtension(ZidFile) %in% AllSamples) {
## The ZidFile was manually validated
## --> use Class column for identification
## Subtable of ZidFile vignettes
@@ -125,7 +126,7 @@
}
processSampleAll <- function (path = ".", ZidFiles = NULL, ZIClass, ZIMan = NULL,
-ZIDesc = readDescription("Description.zis"), abd.taxa = NULL, abd.groups = NULL,
+ZIDesc = zisRead("Description.zis"), abd.taxa = NULL, abd.groups = NULL,
abd.type = "absolute", bio.taxa = NULL, bio.groups = NULL, bio.conv = c(1, 0, 1),
headers = c("Abd", "Bio"), spec.taxa = NULL, spec.groups = NULL,
spec.breaks = seq(0.25, 2, by = 0.1), spec.use.Dil = TRUE, exportdir = NULL,
@@ -199,8 +200,8 @@
stop("'sample' must be a single character string")
## Extract only data for a given sample
- ## Sample is everything before a '+' sign
- Smps <- getSample(ZIDat$Label, unique = TRUE, must.have = sample)
+ Smps <- unique(sampleInfo(ZIDat$Label, type = "sample", ext = ""))
+ if (!sample %in% Smps) stop("Sample not found in ZIDat object")
Smp <- ZIDat[Smps == sample, ]
## Determine the number of images in this sample
@@ -211,6 +212,18 @@
use.Dil = use.Dil)
}, zooImageError = function (e) return(NULL))
})
+
+ ## Add items across two lists (names must be the same)
+ listAdd <- function (..., .list = list(...)) {
+ .list <- Filter(Negate(is.null), .list)
+ if (length(.list) == 1) return(.list[[1]])
+ n <- length(.list[[1]])
+ out <- lapply(1:n, function (i) {
+ Reduce("+", lapply(.list , "[[", i))
+ })
+ attributes(out) <- attributes(.list[[1]])
+ return(out)
+ }
listAdd(lists)
}
@@ -340,7 +353,8 @@
stop("'sample' must be a single character string")
## Extract only data for a given sample
- Smps <- getSample(ZIDat$Label, unique = TRUE, must.have = sample)
+ Smps <- unique(sampleInfo(ZIDat$Label, type = "sample", ext = ""))
+ if (!sample %in% Smps) stop("Sample not found in ZIDat object")
Smp <- ZIDat[Smps == sample, ]
## Subsample, depending on taxa we keep
@@ -552,7 +566,8 @@
}
## Extract only data for a given sample
- Smps <- getSample(ZIDat$Label, unique = TRUE, must.have = sample)
+ Smps <- unique(sampleInfo(ZIDat$Label, type = "sample", ext = ""))
+ if (!sample %in% Smps) stop("Sample not found in ZIDat object")
Smp <- ZIDat[Smps == sample, ]
## Subsample, depending on taxa we keep
Modified: pkg/zooimage/R/ZITrain.R
===================================================================
--- pkg/zooimage/R/ZITrain.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/ZITrain.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -32,14 +32,15 @@
## New dir is dir + subdir
dir <- file.path(dir, subdir)
- checkEmptyDir(dir, message = "must be empty. Clean it first!")
+ if (!checkEmptyDir(dir, message = 'dir "%s" must be empty. Clean it first!'))
+ return(NULL)
## Then, check that all zidfiles exist
- if(is.null(zidbfiles)){
- checkFileExistAll(zidfiles, "zid")
+ if (is.null(zidbfiles)){
+ if (!checkFileExists(zidfiles, "zid")) return(invisible(FALSE))
zmax <- length(zidfiles)
} else {
- checkFileExistAll(zidbfiles, "zidb")
+ if (!checkFileExists(zidbfiles, "zidb")) return(invisible(FALSE))
zmax <- length(zidbfiles)
}
@@ -62,7 +63,7 @@
## Create '_' subdir and unzip all vignettes there
dir_ <- file.path(dir, "_")
- forceDirCreate(dir_)
+ if (!forceDirCreate(dir_)) return(invisible(FALSE))
for (i in 1:zmax) {
Progress(i, zmax)
@@ -147,7 +148,7 @@
if (!keep_) res <- grep("^[^_]", res, value = TRUE)
## 'Id' is the name of the vignettes, minus the extension
- Id <- noExt(basename(res))
+ Id <- noExtension(res)
## 'Path' is the directory path
Path <- dirname(res)
@@ -218,9 +219,41 @@
if (!is.null(desc)) attr(df, "desc") <- desc
Classes <- c("ZI1Train", "ZITrain", Classes)
class(df) <- Classes
- ## Be sure that variables are in numeric
- df <- as.numeric.Vars(df)
- return(df)
+ ## Be sure that variables are numeric (sometimes not, because of wrong importation)
+
+ as.numeric.Vars <- function (ZIDat, Vars = NULL) {
+ ## Default values
+ if (is.null(Vars)) {
+ Vars <- c("ECD",
+ "FIT_Area_ABD", "FIT_Diameter_ABD", "FIT_Volume_ABD",
+ "FIT_Diameter_ESD", "FIT_Volume_ESD", "FIT_Length", "FIT_Width",
+ "FIT_Aspect_Ratio", "FIT_Transparency", "FIT_Intensity",
+ "FIT_Sigma_Intensity", "FIT_Sum_Intensity", "FIT_Compactness",
+ "FIT_Elongation", "FIT_Perimeter", "FIT_Convex_Perimeter",
+ "FIT_Roughness", "FIT_Feret_Max_Angle", "FIT_PPC", "FIT_Ch1_Peak",
+ "FIT_Ch1_TOF", "FIT_Ch2_Peak", "FIT_Ch2_TOF", "FIT_Ch3_Peak",
+ "FIT_Ch3_TOF", "FIT_Avg_Red", "FIT_Avg_Green", "FIT_Avg_Blue",
+ "FIT_Red_Green_Ratio", "FIT_Blue_Green", "FIT_Red_Blue_Ratio",
+ "FIT_CaptureX", "FIT_CaptureY", "FIT_SaveX", "FIT_SaveY",
+ "FIT_PixelW", "FIT_PixelH", "FIT_Cal_Const",
+ "Area", "Mean", "StdDev", "Mode", "Min", "Max", "X", "Y", "XM",
+ "YM", "Perim.", "BX", "BY", "Width", "Height", "Major", "Minor",
+ "Angle", "Circ.", "Feret", "IntDen", "Median", "Skew", "Kurt",
+ "XStart", "YStart", "Dil"
+ )
+ }
+
+ ## Names of ZIDat
+ Names <- names(ZIDat)
+
+ ## Transform variables in numeric values
+ for (i in 1:length(Vars)) {
+ if (isTRUE(Vars[i] %in% Names) && !is.numeric(ZIDat[, Vars[i]]))
+ ZIDat[, Vars[i]] <- as.numeric(ZIDat[, Vars[i]])
+ }
+ return(ZIDat)
+ }
+ return(as.numeric.Vars(df))
}
recode.ZITrain <- function (ZITrain, ZIRecode, warn.only = FALSE)
@@ -333,7 +366,8 @@
## Check if NewDir exist
ToPath <- file.path(dir, NewDir)
- if (!file.exists(ToPath)) forceDirCreate(ToPath)
+ if (!file.exists(ToPath))
+ if (!forceDirCreate(ToPath)) return(invisible(FALSE))
zmax <- length(zidfiles)
## Extract RData in the root directory
Modified: pkg/zooimage/R/catcher.R
===================================================================
--- pkg/zooimage/R/catcher.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/catcher.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -38,6 +38,18 @@
## An environment where the current catcher is stored
catch.env <- new.env()
+## Get the current call stack
+callStack <- function ()
+{
+ calls <- sys.calls()
+ out <- lapply(calls, function(.) {
+ out <- try( as.character(.[[1]] ), silent = TRUE)
+ if (inherits(out, "try-error")) NULL else out
+ })
+ out <- unlist(out[!sapply(out, is.null)])
+ return(out)
+}
+
## Evaluates the call calling the catcher associated with the function calling
##
## call: the call to surround with the catcher
Modified: pkg/zooimage/R/errorHandling.R
===================================================================
--- pkg/zooimage/R/errorHandling.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/errorHandling.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -15,6 +15,18 @@
## You should have received a copy of the GNU General Public License
## along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
+## Get the current call stack
+callStack <- function ()
+{
+ calls <- sys.calls()
+ out <- lapply(calls, function(.) {
+ out <- try( as.character(.[[1]] ), silent = TRUE)
+ if (inherits(out, "try-error")) NULL else out
+ })
+ out <- unlist(out[!sapply(out, is.null)])
+ return(out)
+}
+
## Masking stop in the NAMESPACE of ZooImage
##
## The base function "stop" is masked in the namespace
@@ -232,8 +244,10 @@
##
## err: error (generated by stop)
## Returns the message without the "Error in ... :" part
-extractMessage <- function (err)
-{
- err[1] <- sub("^.*?:", "", err[1])
- return(err)
-}
+
+## PhG: not used any more!
+#extractMessage <- function (err)
+#{
+# err[1] <- sub("^.*?:", "", err[1])
+# return(err)
+#}
Added: pkg/zooimage/R/fileutils.R
===================================================================
--- pkg/zooimage/R/fileutils.R (rev 0)
+++ pkg/zooimage/R/fileutils.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -0,0 +1,156 @@
+## Copyright (c) 2004-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/>.
+
+## Transforms a file extension to a pattern for ignore.case matching of the
+## extension: extension (with or without the dot at the beginning)
+## returns a regular expression pattern that can be used
+## to match files with this extension
+extensionPattern <- function (extension = "r",
+add.dot = !grepl("[.]", extension))
+{
+ extensionLetters <- substring(extension, 1:nchar(extension),
+ 1:nchar(extension))
+ parts <- ifelse(extensionLetters %in% c(letters, LETTERS),
+ paste("[", extensionLetters, casefold(extensionLetters, upper = TRUE),
+ "]", sep = ""), extensionLetters)
+ pattern <- paste(parts, collapse = "")
+ if (add.dot) pattern <- paste(".", pattern, sep = "")
+ pattern <- gsub( "[.]", "[.]", pattern)
+ return(paste(pattern, "$", sep = ""))
+}
+
+## Checks if the file has the given extension (used at different places...)
+hasExtension <- function (file, extension = "r",
+pattern = extensionPattern(extension))
+ grepl(pattern, file)
+
+## Get the name of a file, without its extension
+noExtension <- function (file)
+ return(sub("\\.[^.]+$", "", basename(file)))
+
+## List files with given extension
+listFilesExt <- function (dir, extension = "r",
+pattern = extensionPattern(extension), ... )
+{
+ checkDirExists(dir)
+ list.files(dir, pattern = pattern , ...)
+}
+
+zimList <- function (dir, ...)
+ listFilesExt(dir, extension = "zim", ...)
+
+zimDatList <- function (dir, ...)
+ listFilesExt(dir, extension = "_dat1.zim", ...)
+
+zipList <- function (dir, ...)
+ listFilesExt(dir, extension = "zip", ...)
+
+zidList <- function (dir, ...)
+ listFilesExt(dir, extension = "zid", ...)
+
+zidbList <- function (dir, ...)
+ listFilesExt(dir, extension = "zidb", ...)
+
+jpgList <- function (dir, ...)
+ listFilesExt(dir, extension = "jpg", ...)
+
+pngList <- function (dir, ...)
+ listFilesExt(dir, extension = "png", ...)
+
+## Check if a file exists (batchable!)
+checkFileExists <- function (file, extension, message = "file not found: %s",
+force.file = FALSE)
+{
+ ## Does this file exists?
+ if (!all(file.exists(file))) {
+ warning(sprintf(message, file))
+ return(FALSE)
+ }
+
+ ## Make sure it is not a directory
+ if (force.file && any(file.info(file)$isdir)) {
+ warning("one or more files are directories")
+ return(FALSE)
+ }
+
+ ## Check its extension
+ if (!missing(extension) && !all(hasExtension(file, extension))) {
+ warning(sprintf("one or more files are not '%s' file", extension))
+ return(FALSE)
+ }
+
+ ## Everything is fine!
+ return(TRUE)
+}
+
+## Checks if a directory exists
+checkDirExists <- function (dir,
+message = 'Path "%s" does not exist or is not a directory')
+{
+ if (!all(file.exists(dir)) || !all(file.info(dir)$isdir)) {
+ warning(sprintf(message, dir))
+ return(FALSE)
+ }
+
+ ## Everything is fine...
+ return(TRUE)
+}
+
+#### OK #### batcheable! (used in prepare.ZITrain())
+checkEmptyDir <- function (dir, message = 'dir "%s" is not empty')
+{
+ ## Works only on a single dir (not vectorized code)
+ dir <- as.character(dir)[1]
+ if (file.exists(dir)) {
+ Files <- list.files(dir, all.files = TRUE)
+ Files <- Files[!Files %in% c(".", "..")]
+ if (length(Files > 0)) {
+ warning(sprintf(message, dir))
+ return(FALSE)
+ } else return(TRUE)
+ } else forceDirCreate(dir)
+}
+
+## Force creation of a directory
+forceDirCreate <- function (dir)
+{
+ ## If it exists, make sure it is a directory
+ if (file.exists(dir) && !file.info(dir)$isdir) {
+ warning(sprintf('"%s" is not a directory', dir))
+ return(FALSE)
+ }
+
+ ## Try (re)create it
+ if (!dir.create(dir)) {
+ warning(sprintf('could not create directory "%s"', dir))
+ return(FALSE)
+ }
+
+ ## Everything is fine, return TRUE
+ return(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')
+{
+ Line1 <- scan(as.character(file)[1], character(), nmax = 1, quiet = TRUE)
+ res <- Line1 %in% expected
+ if (!res) warning(sprintf(message, file))
+ return(res)
+}
Modified: pkg/zooimage/R/gui.R
===================================================================
--- pkg/zooimage/R/gui.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/gui.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -67,13 +67,13 @@
menuAdd("Utilities")
menuAddItem("Utilities", "Calibrate grayscale (16bit)", "calib()")
menuAddItem("Utilities", "Biomass conversion specification",
- "startPgm('ZIEditor', cmdline = file.path(getTemp('ZIetc'), 'Conversion.txt'))")
+ "fileEdit(file.path(getTemp('ZIetc'), 'Conversion.txt'))")
menuAddItem("Utilities", "-", "")
menuAddItem("Utilities", "Image viewer( XnView)", 'startPgm("ImageViewer")')
menuAddItem("Utilities", "Image analyzer (ImageJ)",
'startPgm("ImageEditor", switchdir = TRUE, iconize = TRUE)')
- menuAddItem("Utilities", "Metadata editor (Sc1)",
- 'startPgm("ZIEditor", cmdline = selectFile("ZimZis"))')
+ menuAddItem("Utilities", "Metadata editor",
+ 'fileEdit(selectFile("ZimZis"))')
menuAddItem("Utilities", "Simple acquisition (Vuescan)",
'startPgm("VueScan", switchdir = TRUE)')
menuAddItem("Utilities", "--", "")
@@ -142,8 +142,8 @@
#
# # For each of the six external programs, look if they are accessible,
# # otherwise, inactivate
-# if (is.null(getOption("ZIEditor")))
-# MenuStateItem("$Tk.ZIDlgWin/Apps", "&Metadata editor (Sc1)", FALSE)
+# if (is.null(getOption("fileEditor")))
+# MenuStateItem("$Tk.ZIDlgWin/Apps", "&Metadata editor", FALSE)
# if (is.null(getOption("ImageEditor")))
# MenuStateItem("$Tk.ZIDlgWin/Apps", "Image &analyzer (ImageJ)", FALSE)
# if (is.null(getOption("ImageViewer")))
@@ -467,7 +467,7 @@
## If there is no special treatment, just make all required .zim files
## for currently selected images
- zimMake(dir = dir, pattern = pattern, images = Images, show.log = TRUE)
+ zimMake(dir = dir, pattern = pattern, images = Images)
}
## TODO: the text appears only on one line on the Mac???
@@ -997,7 +997,7 @@
}
## Get a list of samples from the description file
- smpdesc <- readDescription(zisfile)
+ smpdesc <- zisRead(zisfile)
smplist <- listSamples(smpdesc)
## Are there samples in it?
@@ -1056,7 +1056,7 @@
## Add Kevin for manual validation
if (!isTRUE(ManValid)) ZIManTable <- NULL
res <- processSampleAll(path = dirname(zisfile), ZidFiles = NULL, ZICobj,
- ZIDesc = readDescription(zisfile), abd.taxa = NULL, abd.groups = NULL,
+ ZIDesc = zisRead(zisfile), abd.taxa = NULL, abd.groups = NULL,
abd.type = "absolute", bio.taxa = NULL, bio.groups = NULL,
bio.conv = conv, headers = c("Abd", "Bio"), spec.taxa = NULL,
spec.groups = NULL, spec.breaks = brks, spec.use.Dil = TRUE,
@@ -1315,7 +1315,7 @@
if (length(zid) > 1) {
classVignettesAll(zidfiles = zid, Dir = "_manuValidation", ZIClass = zicObj)
} else {
- classVignettes(zidfile = zid, Dir = noExt(zid), ZIClass = zicObj)
+ classVignettes(zidfile = zid, Dir = noExtension(zid), ZIClass = zicObj)
}
}
@@ -1384,19 +1384,17 @@
}
## Select one or several files of a given type
-selectFile <- function (type = c("ZipZid", "ZimZis", "LstZid", "Zip", "Zid",
+selectFile <- function (type = c("ZipZid", "ZimZis", "LstZid", "ZidZidb", "Zip", "Zid", "Zidb",
"Zim", "Zis", "Zie", "Zic", "Img", "TifPgm", "RData"),
multi = FALSE, quote = TRUE, title = NULL)
{
- type <- tryCatch(match.arg(type), error = function (e) {
- stop("unrecognized type")
- })
-
+ type <- match.arg(type)
Type <- switch(type,
ZipZis = "Zip/Zis",
ZimZis = "Zim/Zis",
LstZis = "Lst/Zis",
TifPgm = "Tiff/Pgm",
+ ZidZidb = "Zid/Zidb",
type)
## Adapt title according to 'multi'
@@ -1411,8 +1409,11 @@
"ZooImage metadata files" , ".zis"),
LstZid = c("FlowCAM list files" , ".lst",
"ZooImage files" , ".zid"),
+ ZidZidb = c("ZooImage files" , ".zid",
+ "ZooImage databases" , ".zidb"),
Zip = c("ZooImage picture files" , ".zip"),
Zid = c("ZooImage data files" , ".zid"),
+ Zidb = c("ZooImage databases" , ".zidb"),
Zim = c("ZooImage metadata files" , ".zim"),
Zis = c("ZooImage sample files" , ".zis"),
Zie = c("ZooImage extension files", ".zie"),
@@ -1504,14 +1505,16 @@
}
## Formula calculation by variables selection for the classifier creation v1.2-2
-formulaVarSel <- function (ZITrain)
+formulaVarSel <- function (ZITrain,
+calc.vars = getOption("ZI.calcVars", "calcVars"))
{
## ZITrain must be a ZItrain object
if (!inherits(ZITrain, "ZITrain"))
stop("'ZITrain' must be a 'ZITrain' object")
+ calcfun <- match.fun(as.character(calc.vars)[1])
## Parameters measured on particles and new variables calculated
- mes <- as.vector(colnames(calcVars(ZITrain)))
+ mes <- as.vector(colnames(calcfun(ZITrain)))
presel <- c("Id", "FIT_Cal_Const", "Item", "FIT_Raw_Area",
"FIT_Raw_Feret_Max", "FIT_Raw_Feret_Min", "FIT_Raw_Feret_Mean",
"FIT_Raw_Perim", "FIT_Raw_Convex_Perim", "FIT_Feret_Max_Angle",
Modified: pkg/zooimage/R/misc.R
===================================================================
--- pkg/zooimage/R/misc.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/misc.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -15,181 +15,14 @@
## You should have received a copy of the GNU General Public License
## along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
-getSample <- function (x, unique = FALSE, must.have, msg)
-{
- res <- sub("[+].*", "", as.character(x))
- if (isTRUE(unique)) res <- unique(res)
- if (!missing(must.have)) {
- if (!all(must.have %in% res)) {
- if (missing(msg))
- msg <- sprintf("sample '%s' not in ZIDat",
- paste(must.have, sep = ","))
- stop(msg)
- }
- }
- return(res)
-}
-
-backspaces <- function (n = getOption("width"))
- paste(rep("\b", n), collapse = "")
-
-## Get the current call stack
-callStack <- function ()
-{
- calls <- sys.calls()
- out <- lapply(calls, function(.) {
- out <- try( as.character(.[[1]] ), silent = TRUE)
- if (inherits(out, "try-error")) NULL else out
- })
- out <- unlist(out[!sapply(out, is.null)])
- return(out)
-}
-
-## Checks if the file has the extension
-hasExtension <- function (file, extension = "zip",
-pattern = extensionPattern(extension))
- grepl(pattern, file)
-
-## List files with given extension
-## dir: directory to list files
-## extension: file extension to accept. This will be
-## modified by extensionPattern so that the test is case independent
-listFilesExt <- function (dir, extension = "zip",
-pattern = extensionPattern(extension), ... )
-{
- checkDirExists(dir)
- list.files(dir, pattern = pattern , ...)
-}
-
-zimList <- function (zidir, ...)
- listFilesExt(zidir, extension = "zim", ...)
-
-zimDatList <- function (zidir, ...)
- listFilesExt(zidir, extension = "_dat1.zim", ...)
-
-zipList <- function (zidir, ...)
- listFilesExt(zidir, extension = "zip", ...)
-
-zidList <- function (zidir, ...)
- listFilesExt(zidir, extension = "zid", ...)
-
-zidbList <- function (zidir, ...)
- listFilesExt(zidir, extension = "zidb", ...)
-
-jpgList <- function (dir, ...)
- listFilesExt(dir, extension = "jpg", ...)
-
-pngList <- function (dir, ...)
- listFilesExt(dir, extension = "png", ...)
-
+#### OK #### (used in many places...)
## Transforms a file extension to a pattern for ignore.case matching of the
## extension: extension (with or without the dot at the beginning)
## returns a regular expression pattern that can be used
## to match files with this extension
## example: extensionPattern("tif")
-extensionPattern <- function (extension = "tif",
-add.dot = !grepl("[.]", extension))
-{
- extensionLetters <- substring(extension, 1:nchar(extension),
- 1:nchar(extension))
- parts <- ifelse(extensionLetters %in% c(letters, LETTERS),
- paste("[", extensionLetters, casefold(extensionLetters, upper = TRUE),
- "]", sep = ""), extensionLetters)
- pattern <- paste(parts, collapse = "")
- if (add.dot) pattern <- paste(".", pattern, sep = "")
- pattern <- gsub( "[.]", "[.]", pattern)
- return(paste(pattern, "$", sep = ""))
-}
-## Check if a file exists
-## file: file to check
-## extension: if given the file should have this extension
-## message: message to give when the file is not found
-checkFileExists <- function (file, extension, message = "file not found: %s",
-force.file = FALSE)
-{
- message <- sprintf(message, file)
- if (!file.exists(file)) stop(message)
- if (force.file && file.info(file)$isdir)
- stop(sprintf('file "%s" is a directory', file))
- if (!missing(extension) && !grepl(extensionPattern(extension), file)) {
- message <- sprintf("'%s' is not a '%s' file", file, extension)
- stop(message)
- }
- return(invisible(NULL))
-}
-
-checkFileExistAll <- function (files, extension)
-{
- if (!all( file.exists(files)))
- stop("one or more file does not exist")
- if (!missing(extension) && ! all(hasExtension(files, extension)))
- stop("one or more files have wrong extension")
-}
-
-## Checks if a directory exists
-## dir: the directory to check
-## message: the message to throw into stop if the directory does
-## not exists or is not a directory
-checkDirExists <- function (dir,
-message = 'Path "%s" does not exist or is not a directory')
-{
- message <- sprintf(message, dir)
- if (!file.exists(dir) || !file.info(dir)$isdir)
- stop(message)
-}
-
-checkEmptyDir <- function (dir, message = "not empty")
-{
- if (file.exists(dir)) {
- if (length(list.files(dir, all.files = TRUE) > 0))
- stop(message)
- } else {
- forceDirCreate(dir)
- }
-}
-
-## Force creation of a directory
-## First, if the path exists but is not a directory, this stops.
-## Then, if it did not exist, it calls dir.create to attempt to create it
-## If the creation was not sucessful, it stops
-## path: the path of the directory to create
-forceDirCreate <- function (path, ...)
-{
- if (file.exists(path) && !file.info(path)$isdir)
- stop ("not a directory")
- out <- dir.create(path, ...)
- if (!out) stop("could not create directory")
- return(out)
-}
-
-## 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', stop = FALSE)
-{
- Line1 <- scan(file, character(), nmax = 1, quiet = TRUE)
- res <- Line1 %in% expected
- if (!res && stop) {
- message <- sprintf(message, file)
- stop(message)
- }
- return(invisible(res))
-}
-
-listDirs <- function (dir, ...)
-{
- out <- list.files(dir)
- out[file.info(file.path(dir, basename(out)))$isdir]
-}
-
-## Get a template file from the "ZITemplate" option
-template <- function (file = "default.zim", dir = getOption("ZITemplates"))
-{
- f <- file.path(dir, file)
- checkFileExists(f, message = "template file '%s' does not exist")
- return(f)
-}
-
+## TODO: eliminate this function!
## Called at the looping function (*.all)
## ok: logical; TRUE if there was a problem
## ok.console.msg: the message to write to the console if ok is TRUE
@@ -223,6 +56,7 @@
return(invisible(ok))
}
+## TODO: use the original zip() function in R + eliminate all the rest!
## Zip the content of the directory into the zipfile
## and delete the directory if needed
# Modif Kev zip is now available in R
Modified: pkg/zooimage/R/programs.R
===================================================================
--- pkg/zooimage/R/programs.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/programs.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -143,13 +143,6 @@
return(res)
}
-editor <- function (file, editor = getOption("ZIEditor"))
-{
- if (!file.exists(editor)) editor <- getOption("editor")
- edit(file = file, editor = editor)
- return(invisible(file))
-}
-
imageViewer <- function (dir = getwd())
{
if (isWin()) {
Modified: pkg/zooimage/R/utilities.R
===================================================================
--- pkg/zooimage/R/utilities.R 2012-07-02 13:48:52 UTC (rev 219)
+++ pkg/zooimage/R/utilities.R 2012-07-07 17:29:06 UTC (rev 220)
@@ -13,68 +13,13 @@
## 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/>.
+## along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
-## Masking system so that the warnings related to using windows arguments
-## system <- function (command, intern = FALSE, ignore.stderr = FALSE, wait = TRUE,
-## input = NULL, show.output.on.console = TRUE, minimized = FALSE,
-## invisible = TRUE){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 220
More information about the Zooimage-commits
mailing list