[Zooimage-commits] r133 - in pkg: phytoimage zooimage zooimage/R zooimage/inst zooimage/inst/examples zooimage/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue May 19 16:39:00 CEST 2009
Author: phgrosjean
Date: 2009-05-19 16:39:00 +0200 (Tue, 19 May 2009)
New Revision: 133
Added:
pkg/phytoimage/TODO
pkg/zooimage/inst/examples/
pkg/zooimage/inst/examples/ScanCol24-example.zip
Modified:
pkg/zooimage/DESCRIPTION
pkg/zooimage/NAMESPACE
pkg/zooimage/R/ZIClass.r
pkg/zooimage/R/errorHandling.R
pkg/zooimage/R/gui.r
pkg/zooimage/R/log.r
pkg/zooimage/R/zim.r
pkg/zooimage/R/zip.r
pkg/zooimage/R/zzz.r
pkg/zooimage/man/utilities.Rd
pkg/zooimage/man/zie.Rd
pkg/zooimage/man/zim.Rd
Log:
R code for interface with ImageJ plus a series of little corrections related to R CMD check failures and addition of the ScanCol24 example in /inst/examples
Added: pkg/phytoimage/TODO
===================================================================
--- pkg/phytoimage/TODO (rev 0)
+++ pkg/phytoimage/TODO 2009-05-19 14:39:00 UTC (rev 133)
@@ -0,0 +1,7 @@
+PhytoImage - ToDo:
+------------------
+- A better PhytoImage.ico icon.
+- Redefine .\etc\Basic.zic / Detailed.zic / Very_detailed.zic with plausible
+ phytoplankton taxa
+- Idem for conversion.txt
+- Create http://www.sciviews.org/phytoimage and change URL accordingly
\ No newline at end of file
Property changes on: pkg/phytoimage/TODO
___________________________________________________________________
Name: svn:executable
+ *
Modified: pkg/zooimage/DESCRIPTION
===================================================================
--- pkg/zooimage/DESCRIPTION 2009-05-07 10:09:55 UTC (rev 132)
+++ pkg/zooimage/DESCRIPTION 2009-05-19 14:39:00 UTC (rev 133)
@@ -1,19 +1,16 @@
Package: zooimage
Type: Package
Title: Analysis of numerical zooplankton images
-Version: 1.2-1
-Date: 2007-05-28
-Author: Ph. Grosjean & K. Denis
+Version: 2.0-0
+Date: 2009-05-11
+Author: Ph. Grosjean, K. Denis & R. Francois
Maintainer: Ph. Grosjean <Philippe.Grosjean at umh.ac.be>
Depends: R (>= 2.4.0), utils, tcltk, tcltk2, svMisc, svWidgets, svDialogs
-Suggests: tree, rpart, e1071, nnet, class, MASS, randomForest, ipred, RColorBrewer, gregmisc
+Suggests: tree, rpart, e1071, nnet, class, MASS, randomForest, ipred, RColorBrewer, gplots, rJava, RWeka
Description: ZooImage is a free (open source) solution for analyzing digital
images of zooplankton. In combination with ImageJ, a free image analysis
system, it processes digital images, measures individuals, trains for
automatic identification of taxa, and finally, measures zooplankton samples
(abundances, total and partial size spectra or biomasses, etc.)
-License: GPL2 or above at your convenience. Send metadata and reprints to maintainer
- for every series you analyze and every paper you publish using ZooImage (see the
- web site for further informations).
+License: GPL >= 2
URL: http://www.sciviews.org/zooimage
-
Modified: pkg/zooimage/NAMESPACE
===================================================================
--- pkg/zooimage/NAMESPACE 2009-05-07 10:09:55 UTC (rev 132)
+++ pkg/zooimage/NAMESPACE 2009-05-19 14:39:00 UTC (rev 133)
@@ -1,9 +1,9 @@
-import( utils )
-import( tcltk )
-import( tcltk2 )
-import( svMisc )
-import( svWidgets )
-import( svDialogs )
+import(utils)
+import(tcltk)
+import(tcltk2)
+import(svMisc)
+import(svWidgets)
+import(svDialogs)
export(Abd.sample)
export(AboutZI)
@@ -134,22 +134,22 @@
export(zip.img.all)
export(zip.ZITrain)
-# catch
-# catch.env
-# checkCapabilityAvailable
-# checkUnzipAvailable
-# checkZipAvailable
-# checkZipnoteAvailable
-# dummyCatcher
-# extensionPattern
-# extractMessage
-# finish.loopfunction
-# getCatcher
-# getZooImageCapability
-# getZooImageConditionFunction
-# getZooImageErrorFunction
-# getZooImageWarningFunction
-# grepl
+# catch
+# catch.env
+# checkCapabilityAvailable
+# checkUnzipAvailable
+# checkZipAvailable
+# checkZipnoteAvailable
+# dummyCatcher
+# extensionPattern
+# extractMessage
+# finish.loopfunction
+# getCatcher
+# getZooImageCapability
+# getZooImageConditionFunction
+# getZooImageErrorFunction
+# getZooImageWarningFunction
+# grepl
# unzip
#warning
# zip
@@ -168,4 +168,3 @@
# resetCatcher
# setCatcher
# stop
-
Modified: pkg/zooimage/R/ZIClass.r
===================================================================
--- pkg/zooimage/R/ZIClass.r 2009-05-07 10:09:55 UTC (rev 132)
+++ pkg/zooimage/R/ZIClass.r 2009-05-19 14:39:00 UTC (rev 133)
@@ -1,17 +1,17 @@
# {{{ Copyright (c) 2004, 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/>.
# }}}
@@ -19,16 +19,16 @@
# Version 1.2.0: check for package loading, and add a 'package' attribute to ZIClass
### TODO: allow for defining parameters and use a plugin mechanism
-# {{{ ziclass
-# {{{ ZIClass
+# {{{ ziclass
+# {{{ ZIClass
#' Modifications in calculation of probabilities to accept variables selection v1.2-2
-"ZIClass" <- function(df,
+"ZIClass" <- function(df,
algorithm = c("lda", "randomForest"), 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,
+ GrayCentBoxD + CentroidsD + Range + MeanPos + SDNorm + CV,
calc.vars = "calc.vars", k.xval = 10, ...) {
-
+
# check package availability
### TODO: add error checking in all evals!
require(ipred)
@@ -36,25 +36,25 @@
if (!is.null(package)){
require( package, character.only = TRUE )
}
-
+
# check calc.vars
calc.vars <- calc.vars[1]
if (!is.null(calc.vars)) {
CV <- match.fun( calc.vars )
df <- CV(df)
}
-
+
# algorithm
algorithm <- algorithm[1]
algo.fun <- match.fun( algorithm )
ZI.class <- algo.fun(Formula, data = df, ...)
- ZI.class <- structure( ZI.class,
- class = c("ZIClass", class(ZI.class)),
+ ZI.class <- structure( ZI.class,
+ class = c("ZIClass", class(ZI.class)),
algorithm = algorithm,
- package = package,
- calc.vars = CV,
+ package = package,
+ calc.vars = CV,
classes = df[[ as.character(Formula)[2] ]] )
-
+
# Calculate predictions with full training set
attr(ZI.class, "predict") <- predict(ZI.class, df, calc.vars = FALSE, class.only = TRUE)
@@ -64,7 +64,7 @@
rf <- randomForest(formula = Formula, data = df)
attr(ZI.class, "proba") <- predict(object = rf, newdata = df, type = "prob")
}
-
+
# Possibly make a k-fold cross-validation and check results
if (!is.null(k.xval)) {
mypredict <- if (algorithm == "lda") {
@@ -75,7 +75,7 @@
res <- cv( attr(ZI.class, "classes" ), Formula, data = df, model = get(algorithm),
predict = mypredict, k = k.xval, predictions = TRUE, ...)$predictions
attr(ZI.class, "kfold.predict") <- res
- attr(ZI.class, "k") <- k.xval
+ attr(ZI.class, "k") <- k.xval
}
return(ZI.class)
}
@@ -92,47 +92,47 @@
cat("A ZIClass object predicting for", length(lclasses), "classes:\n")
print(lclasses)
Confu <- confu(classes, predict)
- mism <- 100 * (1 - ( sum(diag(Confu)) / sum(Confu) ) )
-
+ mism <- 100 * (1 - ( sum(diag(Confu)) / sum(Confu) ) )
+
# Change the number of digits to display
oldDigits <- options(digits = 4); on.exit(options(oldDigits))
cat("\nAlgorithm used:", algorithm, "\n")
- cat("Mismatch in classification: ", mism, "%\n", sep = "")
+ cat("Mismatch in classification: ", mism, "%\n", sep = "")
if (!is.null(k)) {
cat("k-fold cross validation error estimation (k = ", k, "):\n", sep = "")
kfold.predict <- attr(x, "kfold.predict")
prior <- table(classes)
- ok <- diag(table(classes, kfold.predict))
+ ok <- diag(table(classes, kfold.predict))
err <- 100 * (1 - (sum(ok) / sum(prior)) )
cat(err, "%\n", sep = "")
cat("\nError per class:\n")
`Error (%)` <- sort(1 - (ok / prior)) * 100
- print(as.data.frame(`Error (%)`))
+ print(as.data.frame(`Error (%)`))
}
- return(invisible(x))
+ return(invisible(x))
}
# }}}
# {{{ predict.ZIClass
"predict.ZIClass" <- function(object, ZIDat, calc.vars = TRUE, class.only = FALSE, ...) {
-
+
# Make sure we have correct objects
mustbe( object, "ZIClass" )
mustbe( ZIDat , c("ZIDat", "data.frame") )
-
+
# Possibly load a specific package for prediction
package <- attr(object, "package")
if (is.null(package)) {
# This is for old version, we make sure to load
- # MASS, RandomForest, class, rpart, e1071, ipred
+ # MASS, randomForest, class, rpart, e1071, ipred
# Rem: nnet has a special treatment in nnet2
- require(MASS)
- require(RandomForest)
+ require(MASS)
+ require(randomForest)
require(class)
require(rpart)
require(e1071)
require(ipred)
- } else {
+ } else {
# Make sure that the specific required package is loaded
require( package, character.only = TRUE )
}
@@ -158,49 +158,49 @@
# }}}
# }}}
-# {{{ confusion
+# {{{ confusion
# {{{ confu
"confu" <- function(classes1, classes2, classes.predicted = FALSE) {
-
+
if (is.factor(classes1) || is.factor(classes2)) {
if (NROW(classes1) != NROW(classes2)){
stop("Not same number of items in classes1 and classes2")
}
-
+
# Check that levels match
- mustmatch( levels(classes1), levels(classes2),
+ mustmatch( levels(classes1), levels(classes2),
msg = "'Class' levels in the two objects do not match" )
clCompa <- data.frame(Class.x = classes1, Class.y = classes2)
} else { # Merge two data frame according to common objects in "Id" column
-
+
# Check levels match
- mustmatch( levels(classes1$Class), levels(classes22$Class),
+ mustmatch( levels(classes1$Class), levels(classes22$Class),
msg = "Levels for 'Class' in the two objects do not match")
-
+
# Are there common objects left?
clCompa <- merge(classes1, classes2, by = "Id")
if (nrow(clCompa) == 0){
stop("No common objects between the two 'classes' objects")
}
}
-
+
# How many common objects by level?
NbPerClass <- table(clCompa$Class.x)
-
+
# Confusion matrix
if (classes.predicted) {
Conf <- table(classes = clCompa$Class.x, predicted = clCompa$Class.y)
} else {
Conf <- table(Class1 = clCompa$Class.x, Class2 = clCompa$Class.y)
}
-
+
# Pourcent of common objects
Acc <- sum(diag(Conf)) / sum(Conf)*100
-
+
# Change labels to get a more compact presentation
colnames(Conf) <- formatC(1:ncol(Conf), digits = 1, flag = "0")
rownames(Conf) <- paste(colnames(Conf), rownames(Conf))
-
+
# Results
res <- Conf
attr(res, "accuracy") <- Acc
@@ -211,13 +211,13 @@
# {{{ confu.map
"confu.map" <- function(set1, set2, level = 1){
-
+
opar <- par(no.readonly = TRUE) ; on.exit(par = opar)
par(mar = c(5, 12, 4, 2) + 0.1)
-
- n <- length(levels(set1))
- image(1:n, 1:n, 1/ (t(confu(set1, set2)[n:1, 1:n])),
- col = heat.colors(10),
+
+ n <- length(levels(set1))
+ image(1:n, 1:n, 1/ (t(confu(set1, set2)[n:1, 1:n])),
+ col = heat.colors(10),
xlab = "", ylab = "", xaxt = "n", yaxt = "n")
axis(1, at = 1:n, las = 2)
axis(2, at = n:1, labels = paste(levels(set1), 1:n), las = 1)
@@ -226,20 +226,20 @@
}
# }}}
-# {{{ confusion.tree
-# New function v1.2-2 using library gregmisc
+# {{{ confusion.tree
+# New function v1.2-2 using library gplots
confusion.tree <- function (confmat, maxval, margin=NULL, Rowv = TRUE, Colv = TRUE) {
nX <- nrow(confmat)
nY <- ncol(confmat)
nZ <- nX*nY
confmat <- pmin( confmat, maxval )
-
+
require(RColorBrewer)
mypalette <- brewer.pal(maxval-1, "Spectral")
library(gplots)
- heatmap.2(confmat, col= c(0,mypalette), symm=TRUE, margin=margin,
- trace="both", Rowv=Rowv, Colv=Colv, cexRow=0.2 + 1/log10(nX),
- cexCol=0.2 + 1/log10(nY),tracecol="Black", linecol=FALSE)
+ heatmap.2(confmat, col= c(0,mypalette), symm=TRUE, margin=margin,
+ trace="both", Rowv=Rowv, Colv=Colv, cexRow=0.2 + 1/log10(nX),
+ cexCol=0.2 + 1/log10(nY),tracecol="Black", linecol=FALSE)
}
# }}}
@@ -248,33 +248,33 @@
confusion.bar <- function(confmat, mar=NULL) {
mustbe(confmat, "matrix" )
Nn <- nrow(confmat)
-
+
## percent of correctly predicted objects in the test set
pred.tok <- diag(confmat) / colSums(confmat)*100
-
+
# If there are no items good recognize 0/0 = NaN so replace NaN by 0 for calculation
if (NaN %in% pred.tok){
pred.tok[pred.tok == "NaN"] <- 0
}
-
+
# percent of items in the test set predicted in its category
pred.tfrac <- diag(confmat) / rowSums(confmat)*100
pred.tfrac[ is.nan( pred.tfrac) ] <- 0
prediction <- cbind(pred.tok, pred.tfrac)
prediction.df <- data.frame(prediction)
- CR <- prediction[1:Nn,2] #
+ CR <- prediction[1:Nn,2] #
FN <- 100 - CR # faux négatif = objects which exist in the test set but not in the training set;
-
+
# they are wrongly predicted as not to belong to a particular group
prediction.df$FN <- FN
-
+
#put to scale
CR2 <- prediction[1:Nn,1]
FP <- 100-CR2 # Faux positifs
prediction.df$FP <- FP
prediction.df <- round(prediction.df,0) # arrondi les valeurs à des dombres entiers
Failure <- prediction.df[c("FN", "FP")]
-
+
# put all to scale
allN <- CR+FN # all negative
allP <- CR2+FP # all positive
@@ -282,7 +282,7 @@
cr2 <- (CR2/allP)*100 #% good identify by pc
fn <- (FN/allN)*100 # percentage of FN
fp <- (FP/allP)*100 # percentage of FP
- all <- matrix( c( fn, cr, cr2, fp), ncol = 4); colnames(all) <- c( "fn", "cr", "cr2", "fp")
+ all <- matrix( c( fn, cr, cr2, fp), ncol = 4); colnames(all) <- c( "fn", "cr", "cr2", "fp")
Order <- order( all[, 2] + all[, 3] , decreasing = TRUE) # trie du mieux reconnu au moin bon
all2 <- t(all[Order, ]) # transposer la matrice triée
Failure <- Failure[Order,] # grp du moin au plus d'erreur
@@ -293,17 +293,17 @@
valx <- matrix( c(rep(2 , Nmat), rep(198, Nmat)),ncol=2) #matrix for location
valx2 <- matrix( c(rep(98, Nmat), rep(102, Nmat)),ncol=2) #matrix for location
omar <- par("mar") ; on.exit( par(omar) ) # mar = margin size c(bottom, left, top, right)
- par(mar=mar);
- barplot(all2[,!is.na(all2[2,])], horiz=TRUE,
+ par(mar=mar);
+ barplot(all2[,!is.na(all2[2,])], horiz=TRUE,
col=c("PeachPuff2", "green3", "green3", "lemonChiffon2"),
xaxt="n", las=1, space = 0)
text(valx[i,] , row(valx) - 0.45 , Failure.mat , cex=0.7)
text(valx2[i,] , row(valx2)- 0.45 , 100 - Failure.mat , cex=0.7)
-
+
#### Ajout des légendes
- legend(100, Nmat+(Nmat/15),
- legend = c("false negative (FN)", "correct ident (CI)", "false positive (FP)"),
- xjust = 0.5, fill = c("PeachPuff2", "green3", "lemonChiffon2"),
+ legend(100, Nmat+(Nmat/15),
+ legend = c("false negative (FN)", "correct ident (CI)", "false positive (FP)"),
+ xjust = 0.5, fill = c("PeachPuff2", "green3", "lemonChiffon2"),
bty="n", horiz = TRUE)
legend(100, Nmat/55, "Percentage", xjust = 0.5, bty = "n")
segx0 <- rep(c(25, 50, 75, 125, 150, 175),2)
@@ -315,21 +315,21 @@
# }}}
# }}}
-# {{{ nnet2
+# {{{ nnet2
# {{{ nnet2
"nnet2" <- function(formula, data, size = 7, rang = 0.1, decay = 5e-4, maxit = 1000, ...) {
require(nnet)
-
- structure(
- nnet(formula = formula, data = data, size = size, rang = rang, decay = decay, maxit = maxit, ...),
+
+ structure(
+ nnet(formula = formula, data = data, size = size, rang = rang, decay = decay, maxit = maxit, ...),
class = c("nnet2", "nnet.formula", "nnet") )
}
# }}}
# {{{ predict.nnet2
"predict.nnet2" <- function (object, newdata, type = c("raw", "class"), ...) {
-
+
mustbe( object, "nnet2" )
require(nnet)
class(object) <- class(object)[-1]
@@ -375,13 +375,13 @@
# {{{ FormVarsSelect
#' Formula calculation by variables selection for the classifier creation v1.2-2
FormVarsSelect <- function(x){
-
+
# x must be a ZItrain object
mustbe( x, "ZI1Train" )
-
+
# Parameters measured on particles and new variables calculated
mes <- as.vector(colnames(calc.vars(x)))
-
+
# Selection of features for the creation of the classifier
keep <- select.list(list = mes,
preselect = c("ECD", "FIT_Area_ABD", "FIT_Diameter_ABD", "FIT_Volume_ABD", "FIT_Diameter_ESD",
Modified: pkg/zooimage/R/errorHandling.R
===================================================================
--- pkg/zooimage/R/errorHandling.R 2009-05-07 10:09:55 UTC (rev 132)
+++ pkg/zooimage/R/errorHandling.R 2009-05-19 14:39:00 UTC (rev 133)
@@ -1,46 +1,46 @@
# Copyright (c) 2009, 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/>.
#{{{ stop
-#' Masking stop in the NAMESPACE of ZooImage
-#'
+#' Masking stop in the NAMESPACE of ZooImage
+#'
#' The base function "stop" is masked in the namespace
#' of zooimage so that instead of throwing an error, the stop
-#' function throws a condition of class ZooImageError that wraps
+#' function throws a condition of class ZooImageError that wraps
#' information about the environment in which the error is created
-#'
-#' @details When a function in zooimage calls stop, this function
+#'
+#' @details When a function in zooimage calls stop, this function
#' is used to dispatch the error either to the standard stop function
#' or to the generation of a zooImageError condition when a batch function
#' is in the call stack
-#'
+#'
#' @param dots see ?Stop
#' @param call. see ?stop
#' @param domain see ?stop
stop <- function( ..., call.= TRUE, domain = NULL ){
calls <- callStack()
- calls <- head( calls, -2)
+ calls <- head( calls, -2)
if( ! tail(calls,1) %in% names( zooImageErrorDrivers) ){
- # the calling function does not have a driver, we use
+ # the calling function does not have a driver, we use
# the regular stop
# TODO: maybe this should be a default ZooImageError instead
base:::stop( ..., call.=call., domain = domain )
} else{
- # the calling function has a driver, we throw the condition
+ # the calling function has a driver, we throw the condition
# using the appropriate driver
message <- do.call( paste, list(...) )
condfun <- getZooImageErrorFunction( calls )
@@ -50,19 +50,19 @@
}
# }}}
-#{{{ warning
-#' Masking warning in the NAMESPACE of ZooImage
-#'
+#{{{ warning
+#' Masking warning in the NAMESPACE of ZooImage
+#'
#' The base function "warning" is masked in the namespace
#' of zooimage so that instead of throwing a warning, the warning
-#' function throws a condition of class ZooImageWarning that wraps
+#' function throws a condition of class ZooImageWarning that wraps
#' information about the environment in which the warning is created
-#'
-#' @details When a function in zooimage calls warning, this function
+#'
+#' @details When a function in zooimage calls warning, this function
#' is used to dispatch the error either to the standard warning function
#' or to the generation of a zooImageWarning condition when a batch function
#' is in the call stack
-#'
+#'
#' @param dots see ?Stop
#' @param call. see ?stop
#' @param immediate. See ?stop
@@ -80,12 +80,12 @@
#{{{ zooImageError
#' Error condition used in ZooImage batch treatments
-#'
-#' This function creates a condition of class "zooImageError".
+#'
+#' This function creates a condition of class "zooImageError".
#' These conditions are used in conjunction with the calling handler
#' mechanism in zooImage batch calls to grab additional information
#' about the context in which the stop function was called
-#'
+#'
#' @details this function is called when a function that is
#' directly or indirectly called by a batch treatment function
#' calls the stop function
@@ -94,7 +94,7 @@
#' @param env the environment in which the problem occured
zooImageError <- function( msg = "error", env = parent.frame(), errorClass = NULL, context = NULL, verbose = getOption("verbose") ){
err <- simpleError( message = msg )
- err$env <- env
+ err$env <- env
if( !is.null( context ) ){
if( context %in% ls( env ) ){
err$context <- env[[ context ]]
@@ -107,41 +107,41 @@
# }}}
#{{{ zooImageErrorDrivers
-#' if a zoo image function has a driver in this list
+#' if a ZooImage function has a driver in this list
#' the stop function will signal a condition built with the driver
#' instead of doing the normal thing
#' TODO: check that all function requiring a driver has one
-zooImageErrorDrivers <- list(
+zooImageErrorDrivers <- list(
# --------------------------------------- zid.R
- "verify.zid" = "zidir",
- "verify.zid.all" = "path",
- "clean.after.zid" = "path",
- "uncompress.zid.all" = "zidfiles",
- "read.zid" = "zidfile",
-
+ "verify.zid" = "zidir",
+ "verify.zid.all" = "path",
+ "clean.after.zid" = "path",
+ "uncompress.zid.all" = "zidfiles",
+ "read.zid" = "zidfile",
+
# --------------------------------------- utilities.R
- "get.sampleinfo" = "filename",
-
+ "get.sampleinfo" = "filename",
+
# --------------------------------------- zim.R
- "make.zim" = "images",
+ "make.zim" = "images",
"verify.zim" = "zimfile",
- "extract.zims" = "zipfiles",
-
+ "extract.zims" = "zipfiles",
+
# -------------- zic.R
- "check.zic" = "file",
-
+ "check.zic" = "file",
+
# --------------------------------------- zie.R
- "make.zie" = "Filemap",
- "BuildZim" = "Smp",
- "checkFileExists" = "file",
- "checkFirstLine" = "file",
- "checkDirExists" = "dir",
+ "make.zie" = "Filemap",
+ "BuildZim" = "Smp",
+ "checkFileExists" = "file",
+ "checkFirstLine" = "file",
+ "checkDirExists" = "dir",
"get.ZITrain" = "dir",
"force.dir.create" = "path",
- "checkEmptyDir" = "dir",
- "make.RData" = "zidir",
- "process.sample" = "Sample",
- "process.samples" = "Samples"
+ "checkEmptyDir" = "dir",
+ "make.RData" = "zidir",
+ "process.sample" = "Sample",
+ "process.samples" = "Samples"
)
# }}}
@@ -180,11 +180,11 @@
driver <- context.fun( fun, driver )
} else if( is.null( fun ) ){
driver <- default
- }
+ }
# TODO: maybe further checking on the arguments of the driver
if( !inherits( driver, "function" ) ){
stop( "wrong driver" )
- }
+ }
driver
}
#}}}
@@ -202,30 +202,30 @@
getZooImageConditionFunction( calls, zooImageWarningDrivers, zooImageWarning, zooImageWarningContext )
}
# }}}
-
+
#{{{ [[.zooImageError
#' Extracts a object from the environment in which the error was generated
-#'
-#' When a ZooImageError is created, it contains the environment in which the
+#'
+#' When a ZooImageError is created, it contains the environment in which the
#' error was created (the frame above the environment of the stop function)
#' This utility function can be used to extract an object from
#' this environment
-#'
+#'
#' @param x the zooImageError
#' @param dots what to extract from the environment
`[[.zooImageError` <- function( x, ...){
- x$env[[ ... ]]
+ x$env[[ ... ]]
}
# }}}
#{{{ zooImageWarning
#' Warning condition used in ZooImage batch treatments
-#'
-#' This function creates a condition of class "zooImageWarning".
+#'
+#' This function creates a condition of class "zooImageWarning".
#' These conditions are used in conjunction with the calling handler
#' mechanism in zooImage batch calls to grab additional information
#' about the context in which the warning function was called
-#'
+#'
#' @details this function is called when a function that is
#' directly or indirectly called by a batch treatment function
#' calls the warning function
@@ -233,36 +233,36 @@
#' @param msg the error message
#' @param env the environment in which the problem occured
zooImageWarning <- function( msg = "warning", env = parent.frame() ){
- w <- simpleWarning( message = msg )
- w$env <- env
- class( w ) <- c("zooImageWarning", "warning", "condition" )
- w
+ w <- simpleWarning( message = msg )
+ w$env <- env
+ class( w ) <- c("zooImageWarning", "warning", "condition" )
+ w
}
# }}}
#{{{ [[.zooImageWarning
#' Extracts a object from the environment in which the warning was generated
-#'
-#' When a ZooImageWarning is created, it contains the environment in which the
+#'
+#' When a ZooImageWarning is created, it contains the environment in which the
#' warning was created (the frame above the environment of the warning function)
#' This utility function can be used to extract an object from
#' this environment
-#'
+#'
#' @param x the zooImageWarning
#' @param dots what to extract from the environment
`[[.zooImageWarning` <- function( x, ...){
- x$env[[ ... ]]
+ x$env[[ ... ]]
}
# }}}
#{{{ extractMessage
#' extracts only the message of the error
-#'
+#'
#' @param err error (generated by stop)
#' @return the message without the "Error in ... :" part
extractMessage <- function( err ){
- err[1] <- sub( "^.*?:", "", err[1] )
- err
+ err[1] <- sub( "^.*?:", "", err[1] )
+ err
}
# }}}
Modified: pkg/zooimage/R/gui.r
===================================================================
--- pkg/zooimage/R/gui.r 2009-05-07 10:09:55 UTC (rev 132)
+++ pkg/zooimage/R/gui.r 2009-05-19 14:39:00 UTC (rev 133)
@@ -1,21 +1,21 @@
# {{{ Copyright (c) 2004, 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/>.
# }}}
-
+
# {{{ ZIDlg
ZIDlg <- function() {
# {{{ If the window is already created, just activate it...
@@ -34,18 +34,18 @@
# }}}
# {{{ Construct the window
- tkWinAdd("ZIDlgWin", title = paste(getTemp("ZIname"), "assistant"), pos = "-10+10")
+ tkWinAdd("ZIDlgWin", title = paste(getTemp("ZIname"), "assistant"), pos = "-100+10")
ZIDlgWin <- WinGet("ZIDlgWin")
-
+
# Do not show it until it is completelly constructed!
- tkwm.withdraw(ZIDlgWin)
+ tkwm.withdraw(ZIDlgWin)
on.exit(tkwm.deiconify(ZIDlgWin))
-
+
# Change the icon of that window (if under Windows)
if (isWin()) {
tk2ico.set(ZIDlgWin, getTemp("ZIico"))
}
-
+
# Add a menu (load it from a spec file)
Pkg <- getTemp("ZIguiPackage", default = "zooimage" )
MenuReadPackage(Pkg, file = "MenusZIDlgWin.txt")
@@ -64,7 +64,7 @@
tkpack(statusText, side = "left", fill= "x")
tkpack(status, side = "bottom", fill = "x")
tkpack(tk2separator(ZIDlgWin), side = "bottom", fill = "x")
-
+
# Keep track of statusText / statusProg
assignTemp("statusText", statusText)
assignTemp("statusProg", statusProg)
@@ -81,7 +81,7 @@
MenuStateItem("$Tk.ZIDlgWin/Apps", "Active R &Graph", FALSE)
}
# }}}
-
+
# {{{ 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)
@@ -145,9 +145,9 @@
manual <- file.path(getTemp("ZIetc"), "ZooImageManual.pdf")
pdfviewer <- getOption( "pdfviewer" )
if( !is.null( pdfviewer ) ){
- if (.Platform$OS.type == "windows")
+ if (.Platform$OS.type == "windows")
shell.exec(manual)
- else system(paste(shQuote(getOption("pdfviewer")), shQuote(manual)),
+ else system(paste(shQuote(getOption("pdfviewer")), shQuote(manual)),
wait = FALSE)
} else{
browseURL(manual)
@@ -296,7 +296,7 @@
#' Show an assitant dialog box allowing to choose between VueScan and a different
#' acquisition program... remember that setting in the registry under Windows
"acquireImg" <- function() {
-
+
# First read the registry to determine which software in recorded there...
Asoft <- getKey("AcquisitionSoftware", "VueScan")
if (Asoft == "VueScan") {
@@ -352,34 +352,34 @@
# and/or import images/data, including custom processes defined in
# separate 'ZIEimport' objects (see FlowCAM import routine for an example)
# Get a list of 'ZIEimport' objects currently loaded in memory
-
+
### TODO... Rework everything. What follows is old code!
ImgFilters <- as.matrix(data.frame(
title = c(
- "Tiff image files (*.tif)",
- "Jpeg image files (*.jpg)",
- "Zooimage import extensions (Import_*.zie)",
+ "Tiff image files (*.tif)",
+ "Jpeg image files (*.jpg)",
+ "Zooimage import extensions (Import_*.zie)",
"Table and ImportTemplate.zie (*.txt)"), #, "FlowCAM zipped files (*.zfc)"),
pattern = c("*.tif", "*.jpg", "Import_*.zie", "*.txt"))) #, "*.zfc")))
-
+
# Get last image type that was selected
Index <- as.numeric(getKey("ImageIndex", "1"))
-
+
# Get a list of images
Images <- choose.files(caption = "Select data to import...",
multi = TRUE, filters = ImgFilters, index = Index)
-
+
# Look if there is at least one image selected
if (length(Images) == 0) {
return(invisible())
}
dir <- dirname(Images[1])
Images <- basename(Images)
-
+
has <- function( extension, pattern = extensionPattern(extension) ){
grepl( pattern, Images[1])
}
-
+
# Determine which kind of data it is
if ( has( ".zfc" ) ){
setKey("ImageIndex", "5")
@@ -415,12 +415,12 @@
pattern <- extensionPatter( "jpg" )
setKey("ImageIndex", "2")
} else stop("Unrecognized data type!")
-
+
# If there is no special treatment, just make all required .zim files for currently selected images
make.zim(dir = dir, pattern = pattern, images = Images, show.log = TRUE)
}
-# TODO: call the batch version of imagej zooimage plugins
+# TODO: the text appears only on one line on the Mac???
"processImg" <- function() {
# Display a dialog box telling how to process images using ImageJ
# When the user clicks on 'OK', ImageJ is started... + the checkbox 'close R'
@@ -449,38 +449,74 @@
# {{{ makeZid
"makeZid" <- function() {
-
- # Finalize .zid files (and possibly also .zip files by updating their comment)
- res <- modalAssistant(paste(getTemp("ZIname"), "data processing"),
- c("You should have processed all your images now.",
- "The next step is to finalize the .zid files (ZooImage",
- "Data files). There will be one data file per sample and",
- "it is all you need for the next part of your work...",
- "",
- "Once this step succeed, you can free disk space by",
- "transferring all files from the _raw subdirectory to",
- "archives, for instance, DVDs (Apps -> CD-DVD burner).",
- "",
- "Warning: the whole _work subdirectory with intermediary",
- "images will be deleted, and all .zim files will be",
- "moved to the _raw subdirectory.",
- "At the end, you should have only .zid files remaining",
- "in your working directory.", "",
- "Click 'OK' to proceed (select working directory)...", ""),
- init = "1", check = "Check vignettes", help.topic = "makeZid")
+ # Create ZID files, possibly processing imqges first
+ # TODO: get the list of all available processes and select it automatically from the ZIM file
+ defval <- "Scanner_Gray16"
+ opts <- c("Scanner_Gray16",
+ "Scanner_Color",
+ "Macrophoto_Gray16",
+ "Microscope_Color",
+ "-- None --")
+ # Then, show the dialog box
+ plugin <- modalAssistant(paste(getTemp("ZIname"), "process images"),
+ c("Process images with associated metadata (ZIM files)",
+ "in batch mode from one directory and make ZID files.",
+ "", "Select an image processor:", ""), init = defval,
+ options = opts, help.topic = "processIJ")
# Analyze result
- if (res == "ID_CANCEL") return(invisible())
- # Confirm the directory to process...
+ if (plugin == "ID_CANCEL") return(invisible())
+ # Select zim file or directory
dir <- paste(tkchooseDirectory(), collapse = " ")
if (length(dir) == 0) return(invisible())
- # Do we check the vignettes?
- check.vignettes <- (res == "1")
+ # Do we need to process the images with ImageJ?
+ if (plugin != "-- None --") {
+ # Apparently, we have to be in the imagej directory for the command line
+ # tools to work
+ odir <- getwd()
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 133
More information about the Zooimage-commits
mailing list