[Zooimage-commits] r221 - in pkg: phytoimage/R phytoimage/inst/gui phytoimage/man zooimage zooimage/R zooimage/inst/gui zooimage/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jul 9 00:43:40 CEST 2012
Author: phgrosjean
Date: 2012-07-09 00:43:40 +0200 (Mon, 09 Jul 2012)
New Revision: 221
Added:
pkg/zooimage/man/zic.Rd
Removed:
pkg/zooimage/R/capabilities.R
pkg/zooimage/R/catcher.R
pkg/zooimage/R/errorHandling.R
Modified:
pkg/phytoimage/R/zzz.r
pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
pkg/phytoimage/inst/gui/ToolbarsZIDlgWin.txt
pkg/phytoimage/man/phytoimage.package.Rd
pkg/zooimage/DESCRIPTION
pkg/zooimage/NAMESPACE
pkg/zooimage/R/RealTime.R
pkg/zooimage/R/ZIMan.R
pkg/zooimage/R/ZIRes.R
pkg/zooimage/R/ZITrain.R
pkg/zooimage/R/fileutils.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/inst/gui/ToolbarsZIDlgWin.txt
pkg/zooimage/man/ZIClass.Rd
pkg/zooimage/man/ZITrain.Rd
pkg/zooimage/man/gui.Rd
pkg/zooimage/man/utilities.Rd
pkg/zooimage/man/zid.Rd
pkg/zooimage/man/zie.Rd
pkg/zooimage/man/zim.Rd
pkg/zooimage/man/zip.Rd
pkg/zooimage/man/zis.Rd
Log:
Many changes towards refactoring and simplification of the code in ZooImage
Modified: pkg/phytoimage/R/zzz.r
===================================================================
--- pkg/phytoimage/R/zzz.r 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/phytoimage/R/zzz.r 2012-07-08 22:43:40 UTC (rev 221)
@@ -38,7 +38,7 @@
assignTemp("ZIguiPackage", ZIguiPackage)
## Make sure that ZooImage will not overwrite these entries
- options(ZIredefine = TRUE)
+ options(ZI.redefine = TRUE)
## Load the initial zooimage package now
## No, this is now done in NAMESPACE import!
Modified: pkg/phytoimage/inst/gui/MenusZIDlgWin.txt
===================================================================
--- pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/phytoimage/inst/gui/MenusZIDlgWin.txt 2012-07-08 22:43:40 UTC (rev 221)
@@ -10,8 +10,8 @@
||Make .&zid files... Ctrl+Z ~~ makeZid()
||-
||&Make training set... Ctrl+M ~~ makeTrain()
-||Add vignettes to training set ~~ increaseTrain()
-||&Read training set.. Ctrl+T ~~ readTrain()
+||Add vignettes to training set ~~ addToTrain()
+||&Read training set.. Ctrl+T ~~ collectTrain()
||Make &classifier... Ctrl+C ~~ makeClass()
||A&nalyze classifier... Ctrl+N ~~ analyzeClass()
||Automatic classification of vignettes ~~ vignettesClass()
@@ -77,18 +77,13 @@
|||zisCreate() ~~ guiDlgFunction("zisCreate")
|||zisEdit() ~~ guiDlgFunction("zisEdit")
|||-
-|||zisRead() ~~ guiDlgFunction("zisRead")
+|||zisRead() ~~ guiDlgFunction("zisRead")
||--
||$PhytoImage &Training set
-|||prepare.ZITrain() ~~ guiDlgFunction("prepare.ZITrain")
-|||get.ZITrain() ~~ guiDlgFunction("get.ZITrain")
+|||prepareTrain() ~~ guiDlgFunction("prepareTrain")
+|||getTrain() ~~ guiDlgFunction("getTrain")
+|||increaseTrain() ~~ guiDlgFunction("increaseTrain")
|||-
-|||read.ZITrain() ~~ guiDlgFunction("read.ZITrain")
-|||write.ZITrain() ~~ guiDlgFunction("write.ZITrain")
-|||--
-|||zip.ZITrain() ~~ guiDlgFunction("zip.ZITrain")
-|||unzip.ZITrain() ~~ guiDlgFunction("unzip.ZITrain")
-|||---
|||re&code.ZITrain() ~~ guiDlgFunction("recode.ZITrain")
|||ZIRecodeLevels() ~~ guiDlgFunction("ZIRecodeLevels")
||$PhytoImage &Classifier
Modified: pkg/phytoimage/inst/gui/ToolbarsZIDlgWin.txt
===================================================================
--- pkg/phytoimage/inst/gui/ToolbarsZIDlgWin.txt 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/phytoimage/inst/gui/ToolbarsZIDlgWin.txt 2012-07-08 22:43:40 UTC (rev 221)
@@ -10,7 +10,7 @@
||[butBluecase]Make .zid files... ~~ makeZid()
||-
||[butHand1]Make training set... ~~ makeTrain()
-||[butHand2]Read training set.. ~~ readTrain()
+||[butHand2]Read training set.. ~~ collectTrain()
||[butDirectory]Make classifier... ~~ makeClass()
||[butGraph]Analyze classifier... ~~ analyzeClass()
||-
Modified: pkg/phytoimage/man/phytoimage.package.Rd
===================================================================
--- pkg/phytoimage/man/phytoimage.package.Rd 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/phytoimage/man/phytoimage.package.Rd 2012-07-08 22:43:40 UTC (rev 221)
@@ -25,7 +25,7 @@
}
Everytime you publish results that use PhytoImage, you must place a reference
to the Zoo/PhytoImage web site (http://www.sciviews.org/zooimage) in your publication.
-For papers, send also a reprint to Philippe.Grosjean at umh.ac.be, preferrably
+For papers, send also a reprint to Philippe.Grosjean at umons.ac.be, preferrably
as a PDF file.
}
\author{
Modified: pkg/zooimage/DESCRIPTION
===================================================================
--- pkg/zooimage/DESCRIPTION 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/zooimage/DESCRIPTION 2012-07-08 22:43:40 UTC (rev 221)
@@ -5,7 +5,7 @@
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-67), svDialogs (>= 0.9-53), grDevices, filehash, jpeg, png, MASS, randomForest, ipred, rpart, e1071, nnet, class, tree, RColorBrewer, gplots, RWeka, RWekajars
+Depends: R (>= 2.14.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-07 17:29:06 UTC (rev 220)
+++ pkg/zooimage/NAMESPACE 2012-07-08 22:43:40 UTC (rev 221)
@@ -21,91 +21,43 @@
import(RWeka)
import(RWekajars)
-export(aboutZI)
-export(acquireImg)
-export(analyzeClass)
+
export(BFcorrection)
-export(calcVars)
-export(calib)
export(calibrate)
export(checkBF)
export(clearProgress)
-export(closeAssistant)
-export(closeZooImage)
export(compareExif)
-export(ecd)
-export(editDescription)
-export(exitZI)
-export(expand.ZITrain)
-export(exportResults)
-export(focusGraph)
-export(focusR)
-export(formulaVarSel)
-export(getDec)
-export(getKey)
-export(getList)
export(getSpectrum)
-export(getVar)
-export(get.ZITrain)
export(histSpectrum)
-export(importImg)
-export(increaseTrain)
export(isTestFile)
export(isZim)
-export(listObjects)
-export(listSamples)
-export(loadObjects)
export(logClear)
export(logError)
export(logProcess)
export(logView)
export(logWarning)
export(lvq)
-export(makeClass)
-export(makeId)
-export(makeTrain)
-export(makeZid)
export(modalAssistant)
export(nnet2)
-export(optInOutDecimalSep)
-export(parseIni)
export(plotAbdBio)
-export(prepare.ZITrain)
-export(processImg)
export(processSample)
export(processSampleAll)
-export(processSamples)
export(Progress)
export(rawConvert)
export(readExifRaw)
-export(readTrain)
-export(read.ZITrain)
export(realtimeReset)
export(realtimeSave)
export(realtimeStart)
export(realtimeStop)
-export(recode.ZITrain)
-export(removeObjects)
export(sampleAbd)
export(sampleBio)
-export(sampleInfo)
export(sampleSpectrum)
-export(saveObjects)
-export(selectFile)
-export(setKey)
export(startPgm)
-export(trimString)
-export(underscoreToSpace)
export(unzipImg)
export(unzipImgAll)
-export(unzip.ZITrain)
-export(viewManual)
-export(viewResults)
export(vignettesClass)
-export(write.ZITrain)
export(ZIClass)
export(ZIConf)
-export(zicCheck)
export(zidClean)
export(zidCompress)
export(zidCompressAll)
@@ -126,7 +78,6 @@
export(zidbDatRead)
export(zidbPlot)
export(zidbDrawVignette)
-export(ZIDlg)
export(ZIE)
export(ZIEimportJpg)
export(ZIEimportTable)
@@ -146,18 +97,35 @@
export(ZIpgmHelp)
export(zipImg)
export(zipImgAll)
-export(zip.ZITrain)
-export(ZIRecodeLevels)
+
+# Zic
+export(zicCheck)
+
# Zis
export(zisCreate)
export(zisEdit)
export(zisRead)
+# ZITrain
+export(prepareTrain)
+export(increaseTrain)
+export(getTrain)
+export(recode.ZITrain)
+export(ZIRecodeLevels)
+
# Utilities
+export(calcVars)
+export(ecd)
+export(getDec)
+export(listSamples)
+export(makeId)
+export(parseIni)
+export(sampleInfo)
+export(trimString)
+export(underscoreToSpace)
-
-# File-utilities
+# File-Utilities
export(extensionPattern)
export(hasExtension)
export(noExtension)
@@ -175,12 +143,44 @@
export(checkFirstLine)
export(forceDirCreate)
+# GUI
+export(aboutZI)
+export(acquireImg)
+export(addToTrain)
+export(analyzeClass)
+export(calib)
+export(closeAssistant)
+export(closeZooImage)
+export(collectTrain)
+export(editDescription)
+export(exitZI)
+export(exportResults)
+export(focusGraph)
+export(focusR)
+export(importImg)
+export(listObjects)
+export(loadObjects)
+export(makeClass)
+export(makeZid)
+export(makeTrain)
+export(optInOutDecimalSep)
+export(processImg)
+export(processSamples)
+export(removeObjects)
+export(saveObjects)
+export(viewManual)
+export(viewResults)
+export(ZIDlg)
-# TODO...
+# GUI-Utilities
+export(getList)
+export(getVar)
+export(formulaVarSel)
+export(selectGroups)
+export(selectFile)
+export(selectSamples)
-
-
-
+# S3 methods
S3method(predict, nnet2)
S3method(predict, lvq)
S3method(print, ZIClass)
@@ -191,34 +191,9 @@
S3method(plot, ZITable)
S3method(merge, ZITable)
-# The following objects are NOT exported
-# ZOOIMAGEENV (environment holding ZooImage data)
+# The following objects are NOT exported (and should be eliminated too!)
# backspaces
-# callstack
-# catch
-# catch.env
-# checkJavaAvailable
-# checkBiff2tiffAvailable # Eliminate Xite programs
-# checkDivideAvailable # Eliminate Xite programs
-# checkPnm2biffAvailable # Eliminate Xite programs
-# checkStatisticsAvailable # Eliminate Xite programs
-# checkCapabilityAvailable
-# checkCapable
-# checkCapabilityAvailable
-# checkConvertAvailable # Eliminate?
-# checkDcRawAvailable # Eliminate?
-# checkIdentifyAvailable # Eliminate?
-# checkPpmtopgmAvailable # Eliminate?
-# checkUnzipAvailable
-# checkZipAvailable
-# checkZipnoteAvailable
-# dummyCatcher
# finishLoop
-# getCatcher
-# getZooImageCapability
-# getZooImageConditionFunction
-# getZooImageErrorFunction
-# getZooImageWarningFunction
# imagemagick
# imagemagick_convert
# imagemagick_identify
@@ -230,12 +205,7 @@
# netpbm_ppmtopgm
# netpbm_tifftopnm
# program
-# recallWithCatcher
-# resetCatcher
-# setCatcher
-# stop
# unzip
-# warning
# xite
# xite_biff2tiff
# xite_divide
@@ -244,12 +214,3 @@
# zip
# zipNoteAdd
# zipNote
-# zooImageCapabilities
-# zooImageError
-# [[.zooImageError
-# zooImageErrorContext
-# zooImageErrorDrivers
-# zooImageWarning
-# [[.zooImageWarning
-# zooImageWarningContext
-# zooImageWarningDrivers
Modified: pkg/zooimage/R/RealTime.R
===================================================================
--- pkg/zooimage/R/RealTime.R 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/zooimage/R/RealTime.R 2012-07-08 22:43:40 UTC (rev 221)
@@ -80,7 +80,7 @@
} else Prev <- NULL
## Select a conversion table
- ConvFile <- getKey("ConversionFile", file.path(getTemp("ZIetc"),
+ ConvFile <- getOption("ZI.ConversionFile", file.path(getTemp("ZIetc"),
"Conversion.txt"))
## Ask for selecting a Conversion file
ConvFile <- dlgOpen(title = "Select a conversion file",
Modified: pkg/zooimage/R/ZIMan.R
===================================================================
--- pkg/zooimage/R/ZIMan.R 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/zooimage/R/ZIMan.R 2012-07-08 22:43:40 UTC (rev 221)
@@ -190,8 +190,8 @@
ZIManRead <- function (dir, creator = NULL, desc = NULL, keep_ = FALSE,
na.rm = FALSE)
{
- ## Use get.ZITrain function to read vignette
- ManValidation <- get.ZITrain(dir = dir, creator = creator, desc = desc,
+ ## Use getTrain() function to read vignette
+ ManValidation <- getTrain(traindir = dir, creator = creator, desc = desc,
keep_ = keep_, na.rm = na.rm)
## Add attributes with names of samples already manually validated
Modified: pkg/zooimage/R/ZIRes.R
===================================================================
--- pkg/zooimage/R/ZIRes.R 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/zooimage/R/ZIRes.R 2012-07-08 22:43:40 UTC (rev 221)
@@ -156,24 +156,19 @@
results <- lapply(1:imax, function (i) {
Progress(i, imax)
-
## Modif. by Kevin Denis for manual validation --> Add ZIMan argument
- tryCatch({
- res <- processSample(ZidFiles[i], ZIClass = ZIClass, ZIMan = ZIMan,
- ZIDesc = ZIDesc, abd.taxa = abd.taxa, abd.groups = abd.groups,
- abd.type = abd.type, bio.taxa = bio.taxa,
- bio.groups = bio.groups, bio.conv = bio.conv,
- headers = headers, spec.taxa = spec.taxa,
- spec.groups = spec.groups, spec.breaks = spec.breaks,
- spec.use.Dil = spec.use.Dil, exportdir = exportdir,
- show.log = FALSE)
-
- logProcess("OK", ZidFiles[i])
- return(res)
- }, zooImageError = function (e) {
- logError(e)
- return(NULL)
- })
+ res <- try(processSample(ZidFiles[i], ZIClass = ZIClass, ZIMan = ZIMan,
+ ZIDesc = ZIDesc, abd.taxa = abd.taxa, abd.groups = abd.groups,
+ abd.type = abd.type, bio.taxa = bio.taxa,
+ bio.groups = bio.groups, bio.conv = bio.conv,
+ headers = headers, spec.taxa = spec.taxa,
+ spec.groups = spec.groups, spec.breaks = spec.breaks,
+ spec.use.Dil = spec.use.Dil, exportdir = exportdir,
+ show.log = FALSE), silent = TRUE)
+ if (inherits(res, "try-error")) {
+ warning(as.character(res)) # Turn the error into a warning
+ return(FALSE)
+ } else return(TRUE)
})
clearProgress()
@@ -207,10 +202,12 @@
## Determine the number of images in this sample
imgs <- as.character(unique(ZIDat$Label))
lists <- lapply( imgs, function(im) {
- tryCatch({
- getSpectrum(Smp, im, taxa = taxa, groups = groups, breaks = breaks,
- use.Dil = use.Dil)
- }, zooImageError = function (e) return(NULL))
+ res <- try(getSpectrum(Smp, im, taxa = taxa, groups = groups,
+ breaks = breaks, use.Dil = use.Dil), silent = TRUE)
+ if (inherits(res, "try-error")) {
+ warning(as.character(res))
+ return(NULL)
+ } else return(res)
})
## Add items across two lists (names must be the same)
Modified: pkg/zooimage/R/ZITrain.R
===================================================================
--- pkg/zooimage/R/ZITrain.R 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/zooimage/R/ZITrain.R 2012-07-08 22:43:40 UTC (rev 221)
@@ -18,25 +18,21 @@
## Prepare 'dir\subdir' for a manual classification by expanding all vignettes
## from a given number of zidfiles to the '_' subdir, and making
## a template for subdirs
-prepare.ZITrain <- function (dir, subdir = "_train", zidfiles, zidbfiles = NULL,
+prepareTrain <- function (rootdir, subdir = "_train", zidfiles, zidbfiles = NULL,
groups.template = c("[Basic]", "[Detailed]", "[Very detailed]"),
-ident = NULL, show.log = TRUE, bell = FALSE, start.viewer = FALSE)
+ident = NULL, start.viewer = FALSE)
{
- ## Make sure unzip is available
-# bug: Erreur dans stop(msg) : unzip - program from Info-Zip not found!
- #checkCapable("unzip")
+ ## First, check that rootdir is valid
+ if (!checkDirExists(rootdir)) return(invisible(FALSE))
- ## First, check that dir is valid
- checkDirExists(dir)
+ ## New dir is rootdir + subdir
+ dir <- file.path(rootdir, as.character(subdir)[1])
+ if (!checkEmptyDir(dir,
+ message = 'dir "%s" must be empty. Clean it first!'))
+ return(invisible(FALSE))
- ## New dir is dir + subdir
- dir <- file.path(dir, subdir)
-
- if (!checkEmptyDir(dir, message = 'dir "%s" must be empty. Clean it first!'))
- return(NULL)
-
- ## Then, check that all zidfiles exist
- if (is.null(zidbfiles)){
+ ## Then, check that all zidfiles or zidbfiles exist
+ if (is.null(zidbfiles)) {
if (!checkFileExists(zidfiles, "zid")) return(invisible(FALSE))
zmax <- length(zidfiles)
} else {
@@ -45,21 +41,23 @@
}
## Finally, look for the groups.template
- groups.template <- groups.template[1]
+ groups.template <- as.character(groups.template)[1]
rx <- "^[[](.+)[]]$"
if (grepl(rx, groups.template)) {
## This should be a template file in the default directory
groups.template <- paste(sub(rx, "\\1", groups.template), ".zic",
sep = "")
groups.template <- file.path(getTemp("ZIetc"), groups.template)
+ if (!file.exists(groups.template)) {
+ warning("The file '", groups.template, "' is not found")
+ return(invisible(FALSE))
+ }
}
+ ## Check that this is a .zic file
+ if (!zicCheck(groups.template)) return(invisible(FALSE))
- ## Check that this is a zic file
- zicCheck(groups.template)
-
## Do the job...
- cat("Extracting data and vignettes ...\n")
- logProcess("\nExtracting data and vignettes ...")
+ message("Extracting data and vignettes ...")
## Create '_' subdir and unzip all vignettes there
dir_ <- file.path(dir, "_")
@@ -67,7 +65,7 @@
for (i in 1:zmax) {
Progress(i, zmax)
- if(is.null(zidbfiles)){
+ if (is.null(zidbfiles)) {
logProcess("data", zidfiles[i])
## Using a temporary directory to unzip all files and then copy
## the RData files to the train directory
@@ -80,19 +78,20 @@
pattern = extensionPattern(".jpg"), recursive = TRUE))
if (length(vignettes)) file.copy(vignettes, dir_)
unlink(td, recursive = TRUE)
- } else {
- # Link zidb database to R objects in memory
+ } else { # Use .zidb files
+ ## Link .zidb database to R objects in memory
Zidb <- zidbLink(zidbfiles[i])
- AllFiles <- ls(Zidb)
- Vigns <- AllFiles[-c(grep(".zis", AllFiles), grep("_dat1", AllFiles))]
- # copy all vignettes in the "_" directory
- for(j in 1 : length(Vigns)){
+ AllItems <- ls(Zidb)
+ Vigns <- AllItems[-grep("_dat1", AllItems)]
+ ## Copy all vignettes in the "_" directory
+ ext <- Zidb[[".ImageType"]]
+ for (j in 1:length(Vigns)){
From <- Vigns[j]
- To <- file.path(dir_, paste(From, ".jpg", sep = ""))
+ To <- file.path(dir_, paste(From, ext, sep = "."))
writeBin(Zidb[[From]], To)
}
- # save vignettes
- ZI.sample <- Zidb$.DATA
+ ## Save vignettes
+ ZI.sample <- Zidb$.Data
save(ZI.sample, file = file.path(dir, paste(sub(".zidb", "", basename(zidbfiles[i])), "_dat1.RData", sep = "")))
}
}
@@ -101,51 +100,119 @@
## Create the other directories
Lines <- scan(groups.template, character(), sep = "\n", skip = 2,
quiet = TRUE)
- if (length(Lines) < 1)
- stop(sprintf("'%s' is empty or corrupted!", groups.template))
+ if (!length(Lines)) {
+ warning(sprintf("'%s' is empty or corrupted!", groups.template))
+ return(invisible(FALSE))
+ }
Lines <- file.path(dir, Lines)
- cat("Making directories...\n")
- logProcess("\nMaking directories...")
+ message("Making directories...")
for (i in 1:length(Lines)) {
- logProcess(Lines[i])
+ message(Lines[i])
dir.create(Lines[i], recursive = TRUE)
}
### TODO: relocate vignettes in subdirectories, if ident is not NULL
- finishLoop(ok = TRUE, bell = bell, show.log = show.log,
- ok.console.msg = " -- Done! --\n", ok.log.msg = "\n-- Done! --")
+ ## Finish and possibly start the image viewer
+ message(" -- Done! --")
+ if (isTRUE(as.logical(start.viewer))) imageViewer(dir_)
+ return(invisible(TRUE))
+}
- if (start.viewer) imageViewer(dir_)
+## Function to add new vignettes in a training set
+increaseTrain <- function (traindir, zidbfiles)
+{
+ ## Check if selected zid(b) files are already classified in the training set
+ Rdata <- list.files(traindir, pattern = "[.]RData$")
+ RdataNew <- paste0(sub("[.]zidb?$", "", basename(zidbfiles)), "_dat1.RData")
+ NewZidb <- !RdataNew %in% Rdata
+
+ if (!any(NewZidb)) { # All zidbs are already in the training set
+ warning("All selected zid(b) files already in the training set")
+ return(invisible(FALSE))
+ } else { # Keep only new zid(b) files
+ zidbfiles <- zidbfiles[NewZidb]
+ warning("You have selected ", length(zidbfiles), " new zid(b) files.\n",
+ "The others files are already included in the training set")
+ }
+
+ ## Extract vignettes to a new subdir in '_' and .RData to parent directory
+ NewDir <- "_/_NewVignettes1"
+ ## Check if the new directory name already exists
+ if (file.exists(file.path(traindir, NewDir))) {
+ DirLst <- dir(file.path(traindir, "_"), pattern = "_NewVignettes")
+ NewDir <- paste("_/_NewVignettes", (length(DirLst) + 1), sep = "")
+ }
+
+ ## Check if NewDir exist
+ ToPath <- file.path(traindir, NewDir)
+ if (!file.exists(ToPath))
+ if (!forceDirCreate(ToPath)) return(invisible(FALSE))
+
+ ## Extract RData in the root directory
+ zmax <- length(zidbfiles)
+ message("Adding data and vignettes to the training set...")
+ for (i in 1:zmax) {
+ Progress(i, zmax)
+ ## treatment depends if it is a .zid or .zidb file
+ zidbfile <- zidbfiles[i]
+ if (grepl("[.]zidb$", zidbfile)) { # .zidb file
+
+ } else { # .zid file
+ ## Using a temporary directory to unzip all files and then copy
+ ## the RData files to the train directory
+ td <- tempfile()
+ unzip(zipfile = zidbfiles[i], path = td, delete.source = FALSE)
+ datafiles <- file.path(td, list.files(td,
+ pattern = extensionPattern(".RData"), recursive = TRUE))
+ if (length(datafiles))
+ file.copy(datafiles, file.path(traindir, basename(datafiles)))
+ vignettes <- file.path(td, list.files(td,
+ pattern = extensionPattern(".jpg"), recursive = TRUE))
+ if (!length(vignettes))
+ vignettes <- file.path(td, list.files(td,
+ pattern = extensionPattern(".png"), recursive = TRUE))
+ if (length(vignettes))
+ file.copy(vignettes, file.path(ToPath, basename(vignettes)))
+ unlink(td, recursive = TRUE)
+ }
+ }
+ clearProgress()
+ message("-- Done --\n")
return(invisible(TRUE))
}
-## Retrieve information from a manual training set
-## and store it in a 'ZITrain' object
-get.ZITrain <- function (dir, creator = NULL, desc = NULL, keep_ = FALSE,
-na.rm = FALSE)
+## Retrieve information from a manual training set in a 'ZITrain' object
+getTrain <- function (traindir, creator = NULL, desc = NULL, keep_ = FALSE,
+na.rm = FALSE, numvars = NULL)
{
- ## 'dir' must be the base directory of the manual classification
- checkDirExists(dir)
+ ## 'traindir' must be the base directory of the manual classification
+ if (!checkDirExists(traindir)) return(invisible(FALSE))
- ## Make sure we have .RData files in this dir (otherwise it is perhaps not a
- ## training set root dir!
- Dats <- list.files(dir, pattern = "_dat1[.]RData$", full.names = TRUE)
- if (length(Dats) == 0)
- stop("does not appear to be a ", getTemp("ZIname"),
+ ## Make sure we have .RData files in this traindir (otherwise it is
+ ## perhaps not a training set root dir!
+ Dats <- list.files(traindir, pattern = "_dat1[.]RData$", full.names = TRUE)
+ if (!length(Dats)) {
+ warning("'traindir' does not appear to be a ", getTemp("ZIname"),
" training set root dir!")
+ return(invisible(FALSE))
+ }
- ## list the jpg files (recursively) in the dir
- res <- jpgList(dir, recursive = TRUE)
+ ## List the .jpg or .png files (recursively) in the dir
+ res <- jpgList(traindir, recursive = TRUE)
+ if (!length(res)) res <- pngList(traindir, recursive = TRUE)
## Check the result...
- if (length(res) < 1)
- stop("Error while getting data")
+ if (!length(res)) {
+ warning("no .png or .jpg vignettes found in this tree")
+ return(invisible(FALSE))
+ }
## Replace "\\" by "/"
res <- gsub("[\\]", "/", res)
## Do we eliminate the '_' directory?
- if (!keep_) res <- grep("^[^_]", res, value = TRUE)
+ if (!isTRUE(as.logical(keep_)))
+ res <- grep("^[^_]", res, value = TRUE)
## 'Id' is the name of the vignettes, minus the extension
Id <- noExtension(res)
@@ -153,10 +220,10 @@
## 'Path' is the directory path
Path <- dirname(res)
- ## 'Class' is the last directory where the files are located
+ ## 'Class' is the last directory where the vignettes are located
Class <- basename(Path)
- ## Create a directory (a data frame with: Id, Class)
+ ## Create a data frame with Id and Class
df <- data.frame(Id = Id, Class = Class)
df$Id <- as.character(df$Id)
nitems <- nrow(df)
@@ -194,37 +261,37 @@
# df <- merge(Dat, df, by = "Id")
## Rename Dat in df
df <- Dat
- ## Issue an error if there is no remaing row in the data frame
- if (nrow(df) == 0)
- stop("No valid item found (both with a vignette and with valid measurement data!")
+ ## Problem if there is no remaining row in the data frame
+ if (nrow(df) == 0) {
+ warning("No valid item found (no vignettes with valid measurement data)")
+ return(invisible(FALSE))
+ }
## Check that all items have associated measurements
- if (nrow(df) < nitems) {
- nmiss <- nrow(df) - nitems
- warning(nmiss, " vignettes do not have associated measurement data. They are eliminated (",
+ if (nrow(df) < nitems)
+ warning(nitems - nrow(df),
+ " vignettes without measurement data are eliminated (",
nrow(df), " items remain in the object)")
- }
## Delete lines which contain NA values v1.2-2
- if (any(is.na(df))) {
- cat("NAs found in the table of measurements")
- if (na.rm) {
- cat("... deleted\n")
+ if (any(is.na(df)))
+ if (isTRUE(as.logical(na.rm))) {
+ message("NAs found in the table of measurements and deleted")
df <- na.omit(df)
- } else cat("... left there\n")
- }
+ } else message("NAs found in the table of measurements and left there")
+
+ ## Add attributes
attr(df, "basedir") <- dir
attr(df, "path") <- sort(unique(Path))
- if (!is.null(creator)) attr(df, "creator") <- creator
- if (!is.null(desc)) attr(df, "desc") <- desc
- Classes <- c("ZI1Train", "ZITrain", Classes)
+ if (length(creator)) attr(df, "creator") <- creator
+ if (length(desc)) attr(df, "desc") <- desc
+ Classes <- c("ZI3Train", "ZITrain", Classes)
class(df) <- Classes
- ## 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",
+
+ ## Be sure that variables are numeric (sometimes, wrong importation)
+ as.numeric.Vars <- function (ZIDat, numvars) {
+ if (is.null(numvars)) # Default values
+ numvars <- 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",
@@ -239,26 +306,21 @@
"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"
- )
- }
+ "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]])
+ ## Make sure numvars are numeric
+ Names <- names(ZIDat)
+ for (numvar in numvars) {
+ if (numvar %in% Names && !is.numeric(ZIDat[, numvar]))
+ ZIDat[, numvar] <- as.numeric(ZIDat[, numvar])
}
- return(ZIDat)
+ ZIDat
}
- return(as.numeric.Vars(df))
+ as.numeric.Vars(df, numvars = numvars)
}
recode.ZITrain <- function (ZITrain, ZIRecode, warn.only = FALSE)
{
- ## Check classes
if (!inherits(ZITrain, "ZITrain"))
stop("'ZITrain' must be a 'ZITrain' object")
if (!inherits(ZIRecode, "ZIRecode"))
@@ -282,12 +344,12 @@
path <- attr(ZIRecode, "path")
### TODO: check its validity here
if (!is.null(path)) attr(ZITrain, "path") <- path
- return(ZITrain)
+ ZITrain
}
+## Merge with previous one!
ZIRecodeLevels <- function (ZITrain, level = 1)
{
- ## Check class
if (!inherits(ZITrain, "ZITrain"))
stop("'ZITrain' must be a 'ZITrain' object")
@@ -306,87 +368,5 @@
class(res) <- c("ZIRecode", "data.frame")
attr(res, "call") <- match.call()
## We do not need to change the path here: it is still the same one
- return(res)
+ res
}
-
-expand.ZITrain <- function (ZITrain, ZIDdir, destination)
-{
- ### TODO: make directories and extract vignettes for a classification
- stop("Not implemented yet!")
-}
-
-read.ZITrain <- function (file)
-{
- ### TODO: read data from a text file
- stop("Not implemented yet!")
-}
-
-write.ZITrain <- function (ZITrain, file)
-{
- ### TODO: write data to a text file
- stop("Not implemented yet!")
-}
-
-zip.ZITrain <- function (dir, zipfile, overwrite = FALSE)
-{
- ### TODO: compress a classification tree
- stop("Not implemented yet!")
-}
-
-unzip.ZITrain <- function (zipfile, dir, overwrite = FALSE)
-{
- ### TODO: uncompress a classification tree
- stop("Not implemented yet!")
-}
-
-## Function to add new vignettes in a training set
-increase.ZITrain <- function (zidfiles, train)
-{
- ## Check if selected zid files are already classified in the training set
- Rdata <- list.files(train, pattern = ".RData")
- Rdata_New <- paste(sub("[.]zid$", "", basename(zidfiles)), "_dat1.RData",
- sep = "")
- NewZid <- !Rdata_New %in% Rdata
-
- if (!any(NewZid)) { # All zids are already in the training set
- stop("All selected zid files are already included in the training set")
- } else { # Keep only new zid files
- zidfiles <- zidfiles[NewZid]
- warning("You have selected ", length(zidfiles), " new zid files. ",
- "The others files are already included in the training set")
- }
-
- ## Extract vignettes to a new subdir in '_' and RData to parent directory
- NewDir <- "_/_NewVignettes1"
- ## Check if the new directory name already exists
- if (file.exists(file.path(train, NewDir))) {
- DirLst <- dir(file.path(train, "_"), pattern = "_NewVignettes")
- NewDir <- paste("_/_NewVignettes", (length(DirLst) + 1), sep = "")
- }
-
- ## Check if NewDir exist
- ToPath <- file.path(dir, NewDir)
- if (!file.exists(ToPath))
- if (!forceDirCreate(ToPath)) return(invisible(FALSE))
-
- zmax <- length(zidfiles)
- ## Extract RData in the root directory
- for (i in 1:zmax) {
- logProcess("data", zidfiles[i])
- Progress(i, zmax)
- ## Using a temporary directory to unzip all files and then copy
- ## the RData files to the train directory
- td <- tempfile()
- unzip(zipfile = zidfiles[i], path = td, delete.source = FALSE)
- datafiles <- file.path(td, list.files(td,
- pattern = extensionPattern(".RData"), recursive = TRUE))
- if (length(datafiles)) file.copy(datafiles, dir)
- vignettes <- file.path(td, list.files(td,
- pattern = extensionPattern(".jpg"), recursive = TRUE))
- if (length(vignettes))
- file.copy(vignettes, file.path(ToPath, basename(vignettes)))
- unlink(td, recursive = TRUE)
- }
- clearProgress()
- cat("-- Done --\n")
-}
Deleted: pkg/zooimage/R/capabilities.R
===================================================================
--- pkg/zooimage/R/capabilities.R 2012-07-07 17:29:06 UTC (rev 220)
+++ pkg/zooimage/R/capabilities.R 2012-07-08 22:43:40 UTC (rev 221)
@@ -1,189 +0,0 @@
-## Copyright (c) 2009-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/>.
-
-ZOOIMAGEENV <- new.env()
-
-checkCapable <- function (cap)
- if (cap %in% names(ZIcapabilities)) ZIcapabilities[[cap]]()
-
-## Various check*Capability functions
-## Utility that checks if the zip program is available
-checkZipAvailable <- function ()
-{
- checkCapabilityAvailable("zip",
- sprintf('"%s" -h %s', ZIpgm("zip", "misc"),
- if (!isWin()) " > /dev/null" else ""),
- "zip - program from Info-Zip not found!")
-}
-
-checkUnzipAvailable <- function ()
-{
- checkCapabilityAvailable("unzip",
- sprintf('"%s" -h %s', ZIpgm("unzip", "misc"),
- if (!isWin()) " > /dev/null" else ""),
- "unzip - program from Info-Zip not found!")
-}
-
-checkZipnoteAvailable <- function ()
-{
- checkCapabilityAvailable("zipnote",
- sprintf('"%s" -h %s', ZIpgm("zipnote", "misc"),
- if(!isWin()) " > /dev/null" else ""),
- "zipnote - program from Info-Zip not found!")
-}
-
-checkIdentifyAvailable <- function ()
-{
- checkCapabilityAvailable("identify",
- sprintf('"%s" -version ', ZIpgm("identify", "imagemagick")),
- "program not found! Install ImageMagick 16 bit!")
-}
-
-checkConvertAvailable <- function ()
-{
- checkCapabilityAvailable("convert",
- sprintf('"%s" -version ', ZIpgm("convert", "imagemagick")),
- "program not found! Install ImageMagick 16 bit!")
-}
-
-checkPpmtopgmAvailable <- function ()
-{
- checkCapabilityAvailable("ppmtopgm",
- sprintf('"%s" -help ', ZIpgm("ppmtopgm", "netpbm")),
- "ppmtopgm: program not found! Please, install it!")
-}
-
-checkDcRawAvailable <- function ()
-{
- checkCapabilityAvailable("dc_raw",
- sprintf('"%s" -help ', ZIpgm("dc_raw", "misc")),
- "dc_raw: program not found! Please, install it!")
-}
-
-checkPnm2biffAvailable <- function ()
-{
- checkCapabilityAvailable("pnm2biff",
- sprintf('"%s" -version ', ZIpgm("pnm2biff", "xite")),
- "pnm2biff: program not found! Please, install xite!")
-}
-
-checkDivideAvailable <- function ()
-{
- checkCapabilityAvailable("divide",
- sprintf('"%s" -version ', ZIpgm("divide", "xite")),
- "divide: program not found! Please, install xite!")
-}
-
-checkStatisticsAvailable <- function ()
-{
- checkCapabilityAvailable("statistics",
- sprintf('"%s" -version ', ZIpgm("statistics", "xite")),
- "statistics: program not found! Please, install xite!")
-}
-
-checkBiff2tiffAvailable <- function ()
-{
- checkCapabilityAvailable("biff2tiff",
- sprintf('"%s" -version ', ZIpgm("biff2tiff", "xite")),
- "biff2tiff: program not found! Please, install xite!")
-}
-
-checkJavaAvailable <- function ()
-{
- checkCapabilityAvailable("java",
- 'java -version ',
- "java: program not found! Please, install it!")
-}
-
-checkCapabilityAvailable <- function (cap, cmd, msg)
-{
- program <- cap
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/zooimage -r 221
More information about the Zooimage-commits
mailing list