[Zooimage-commits] r177 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 21 11:29:12 CEST 2009
Author: kevin
Date: 2009-08-21 11:29:08 +0200 (Fri, 21 Aug 2009)
New Revision: 177
Modified:
pkg/zooimage/R/ZIRes.r
pkg/zooimage/R/gui.r
Log:
Modifications for the semi automatic classification
gui.r: option to select a manual error correction directory
ZIres.r: implementation to use the manual error correction in the "normal" ZooImage treatment flow.
I am not sure about the modification about process.samples function (ZIRes.r) because the loop has been replaced by a lapply function which contains different other functions. This part maybe contains a bug (sorry in advance). Anyway, the modifications of the old code works on my laptop (windows XP).
Modified: pkg/zooimage/R/ZIRes.r
===================================================================
--- pkg/zooimage/R/ZIRes.r 2009-07-03 07:53:57 UTC (rev 176)
+++ pkg/zooimage/R/ZIRes.r 2009-08-21 09:29:08 UTC (rev 177)
@@ -21,7 +21,7 @@
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, show.log = TRUE) {
+ exportdir = NULL, show.log = TRUE, SemiTab = NULL, Semi = FALSE) {
# Check if the ZidFile exists
checkFileExists( ZidFile )
@@ -41,6 +41,21 @@
# Predict classes (add a new column Ident to the table)
ZIDat <- predict(ZIClass, ZIDat)
+
+ # Modif Kevin Denis for Semi Automatic classification
+ if(Semi){
+ if(is.null(SemiTab)){
+ stop("You must provide a table with semi automatic classification")
+ }
+ if(!inherits(SemiTab, "ZITrain")) stop("SemiTab must be a ZItrain object with manual classification")
+ # Extract ZidFile subtable from SemiTab (Semi automatic classification general table)
+ SemiClass <- SemiTab[sub("[+].*", "", as.character(SemiTab$Label)) %in% noext(ZidFile),]
+ # Repalce automatic recogntion by semi automatic one
+ for(j in 1: nrow(SemiClass)){
+ ZIDat[ZIDat$Item == j, ]$Ident <- SemiClass[SemiClass$Item == j,]$Class
+ }
+ }
+
Grp <- levels(ZIDat$Ident)
if (is.null(abd.groups)) {
# Calculate groups (list with levels to consider)
@@ -90,7 +105,7 @@
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, show.log = TRUE, bell = FALSE) {
+ exportdir = NULL, show.log = TRUE, bell = FALSE, SemiTab = NULL, Semi = FALSE) {
# Determine which samples do we have to process...
if (is.null(ZidFiles)) {
@@ -115,20 +130,60 @@
results <- lapply( 1:imax, function(i){
Progress(i, imax)
- tryCatch({
- res <- process.sample(ZidFiles[i], ZIClass = ZIClass, 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])
- res
- }, zooImageError = function(e){
- logError( e )
- NULL
- } )
- } )
+
+ # Modif Kevin Denis for semi automatic recognition
+ if(Semi){
+ if(is.null(SemiTab)){
+ stop("You must provide a table with manual classification")
+ }
+ if(!inherits(SemiTab, "ZITrain")) stop("SemiTab must be a ZItrain object with manual classification")
+
+ if(noext(ZidFiles[i]) %in% sub("[+].*", "", as.character(SemiTab$Label))){
+ tryCatch({
+ res <- process.sample(ZidFiles[i], ZIClass = ZIClass, 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, SemiTab = Semi.Auto, Semi = TRUE)
+
+ logProcess("OK", ZidFiles[i])
+ res
+ }, zooImageError = function(e){
+ logError( e )
+ NULL
+ } )
+ } else {
+ tryCatch({
+ res <- process.sample(ZidFiles[i], ZIClass = ZIClass, 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])
+ res
+ }, zooImageError = function(e){
+ logError( e )
+ NULL
+ } )
+ }
+ } else {
+ tryCatch({
+ res <- process.sample(ZidFiles[i], ZIClass = ZIClass, 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])
+ res
+ }, zooImageError = function(e){
+ logError( e )
+ NULL
+ } )
+ }
+ # end modif Kevin Denis
+ })
ClearProgress()
Modified: pkg/zooimage/R/gui.r
===================================================================
--- pkg/zooimage/R/gui.r 2009-07-03 07:53:57 UTC (rev 176)
+++ pkg/zooimage/R/gui.r 2009-08-21 09:29:08 UTC (rev 177)
@@ -824,6 +824,8 @@
title = "Select a ZIS file")), collapse = " ")
}
if (length(zisfile) == 0 || zisfile == "") return(invisible())
+
+ # Add Kevin Denis option for Semi automatic classification
# Option dialog box
res <- modalAssistant(paste(getTemp("ZIname"), "samples processing"),
c("Each sample registered in the description.zis file",
@@ -834,13 +836,49 @@
"particle individually, check the option below.",
"",
"Click 'OK' to proceed...", ""),
- init = "0", check = "Save individual calculations", help.topic = "processSamples")
+ init = "0", options = "Semi Automatic Classification",
+ check = "Save individual calculations", help.topic = "processSamples")
# Analyze result
if (res == "ID_CANCEL") return(invisible())
# Do we save individual calculations?
if (res == "1") exportdir <- dirname(zisfile) else exportdir <- NULL
+ if (res == "1") exportdir <- dirname(zisfile) else exportdir <- NULL
+
+ # Add Kevin Denis for semi automatic classification
+ # Do we use Semi automatic classification?
+ if (res == "Semi Automatic Classification"){
+ res <- modalAssistant(paste(getTemp("ZIname"), "samples processing"),
+ c("Each sample registered in the description.zis file",
+ "will be processed in turn to extract ecological",
+ "parameters (abundances, biomasses, size spectra).",
+ "",
+ "If you want to save calculation done on each",
+ "particle individually, check the option below.",
+ "",
+ "Click 'OK' to proceed...", ""),
+ init = "0", check = "Save individual calculations", help.topic = "processSamples")
+ # Analyze result
+ if (res == "ID_CANCEL") return(invisible())
+ # Do we save individual calculations?
+ if (res == "1") exportdir <- dirname(zisfile) else exportdir <- NULL
- # Get a list of samples from the description file
+ # Read the manual error correction directory called Semi.Auto
+ dir <- getTemp("ZI.TrainDir")
+ if (is.null(dir) || !file.exists(dir) || !file.info(dir)$isdir) dir <- getwd()
+ # Ask for a base directory of a training set...
+ dir <- tkchooseDirectory(initialdir = dir, mustexist = "1", title = paste("Select a", getTemp("ZIname"), "Manual classification base dir"))
+ dir <- tclvalue(dir)
+ if (is.null(dir) || dir == "" || !file.exists(dir) || !file.info(dir)$isdir)
+ return(invisible())
+ res <- get.ZITrain(dir, creator = NULL, desc = NULL, keep_ = FALSE)
+ assign("Semi.Auto", res, envir = .GlobalEnv)
+ # Create an object for condition
+ Semi.Classif <- TRUE
+ } else {
+ Semi.Classif <- FALSE
+ }
+
+ # Get a list of samples from the description file
smpdesc <- read.description(zisfile)
smplist <- list.samples(smpdesc)
# Are there samples in it?
@@ -886,12 +924,23 @@
if (is.null(name) || length(name) == 0 || name == "") return(invisible())
name <- make.names(name) # Make sure it is a valid name!
# Process sample by sample and collect results together in a ZIRes object
+
+ # Add Kevin Denis for semi automatic classification
+ if(Semi.Classif){
res <- process.samples(path = dirname(zisfile), ZidFiles = NULL, ZICobj, ZIDesc = read.description(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,
+ exportdir = exportdir, show.log = TRUE, bell = FALSE, SemiTab = Semi.Auto, Semi = TRUE)
+ } else {
+ res <- process.samples(path = dirname(zisfile), ZidFiles = NULL, ZICobj, ZIDesc = read.description(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,
exportdir = exportdir, show.log = TRUE, bell = FALSE)
- # Assign this result to the variable
+ }
+
+ # Assign this result to the variable
assign(name, res, envir = .GlobalEnv)
# Remember the name of the variable
assignTemp("ZI.LastRES", name)
More information about the Zooimage-commits
mailing list