[Zooimage-commits] r68 - pkg/zooimage/R

[noreply at r-forge.r-project.org]

Author: romain
Date: 2009-04-15 12:36:04 +0200 (Wed, 15 Apr 2009)
New Revision: 68

Modified:
   pkg/zooimage/R/ZITrain.r
   pkg/zooimage/R/errorHandling.R
Log:
adding error driver for get.ZITrain

Modified: pkg/zooimage/R/ZITrain.r
===================================================================
--- pkg/zooimage/R/ZITrain.r	2009-04-15 10:27:25 UTC (rev 67)
+++ pkg/zooimage/R/ZITrain.r	2009-04-15 10:36:04 UTC (rev 68)
@@ -119,83 +119,85 @@
 #' 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 = TRUE) {
 	# 'dir' must be the base directory of the manual classification
-	if (!file.exists(dir) || !file.info(dir)$isdir)
-		stop("'dir' is not a valid directory!")
+	checkDirExists( dir )
+	
 	# 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("'", dir, "' does not appear to be a ", getTemp("ZIname"), " training set root dir!") 
-    
-	# Get a list of subdirs vith vignettes
-	# if (isWin()) {
-	# 	# Make sure the directory is written with "\\", not "/"
-	# 	Dir <- gsub("[/]", "\\\\", dir)
-	# 	if (length(grep("[\\]$", Dir)) == 0) Dir <- paste(Dir, "\\", sep = "")
-	# 	cmd <- paste(Sys.getenv("COMSPEC"), " /c dir \"", Dir, "*.jpg\" /B /S", sep = "")
-	# 	res <- system(cmd, intern = TRUE, invisible = TRUE)
-	# } else {
-	# 	### TODO: adapt this to other platforms
-	# 	stop("This function is not implemented yet on this platform!")
-	# }
+	if (length(Dats) == 0){
+		stop( "does not appear to be a ", getTemp("ZIname"), " training set root dir!")
+	}
 	
-	res <- list.files.ext( dir, extension = "jpg", recursive = TRUE, full = TRUE )
+	# list the jpg files (recursively) in the dir
+    res <- list.files.ext( dir, extension = "jpg", recursive = TRUE )
 	
 	# Check the result...
-	if (length(res) < 1 || length(grep(Dir, res[1], fixed = TRUE)) == 0)
-		stop("Error while getting data from ", dir)
-	# Eliminate the root directory
-	res <- substring(res, nchar(Dir) + 1)
+	if (length(res) < 1 ){
+		stop("Error while getting data")
+	}
+	
 	# Replace "\\" by "/"
 	res <- gsub("[\\]", "/", res)
+	
 	# Do we eliminate the '_' directory?
 	if (!keep_) {
-	del <- -grep("^_", res)
-	if (length(del) > 0) res <- res[del]
+		res <- grep( "^[^_]", res, value = TRUE )
 	}
+	
 	# 'Id' is the name of the vignettes, minus the extension
-	Id <- sub("[.]jpg$", "", basename(res))
+	Id <- noext( basename(res ) )
+	
 	# 'Path' is the directory path
 	Path <- dirname(res)
+	
 	# 'Class' is the last directory where the files are located
 	Class <- basename(Path)
+	
 	# Create a directory (a data frame with: Id, Class)
 	df <- data.frame(Id = Id, Class = Class)
 	df$Id <- as.character(df$Id)
     nitems <- nrow(df)
+	
 	# Read in all the .RData files from the root directory and merge them
     ### TODO: also collect metadata and merge them => make a merge function for ZIDat!!!
 	# Get measurement infos
     load(Dats[1])
 	Dat <- ZI.sample
 	Classes <- class(Dat)
-	if (length(Dats) > 1)
+	if (length(Dats) > 1){
 		for (i in 2:length(Dats)) {
 			load(Dats[i])
 			Dat <- rbind(Dat, ZI.sample)
 		}
+	}
 	rownames(Dat) <- 1:nrow(Dat)
+	
 	# Create the Id column
 	Dat <- cbind(Id = make.Id(Dat), Dat)
+	
 	# Merge Dat & df by "Id"
 	df <- merge(Dat, df, by = "Id")
+	
 	# Issue an error if there is no remaing row in the data frame
-	if (nrow(df) == 0)
+	if (nrow(df) == 0){
 		stop("No valid item found (both with a vignette and with valid measurement data!")
+	}
+	
 	# 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 (", nrow(df), " items remain in the object)")
 	}
+	
 	# delete lines which contain NA values v1.2-2
 	if (any(is.na(df))){
-  warning ("NA in table of measurements")
-  if (na.rm){
-    warning("NA are deleted from table of measurements") 
-    df <- na.omit(df)
-    }
-  }
-  attr(df, "basedir") <- dir
+		warning ("NA in table of measurements")
+		if (na.rm){
+  	  		warning("NA are deleted from table of measurements") 
+  	  		df <- na.omit(df)
+		}
+  	}
+	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

Modified: pkg/zooimage/R/errorHandling.R
===================================================================
--- pkg/zooimage/R/errorHandling.R	2009-04-15 10:27:25 UTC (rev 67)
+++ pkg/zooimage/R/errorHandling.R	2009-04-15 10:36:04 UTC (rev 68)
@@ -132,7 +132,8 @@
 	"BuildZim" = "Smp", 
 	"checkFileExists" = "file", 
 	"checkFirstLine"  = "file", 
-	"checkDirExists"  = "dir" 
+	"checkDirExists"  = "dir", 
+	"get.ZITrain"     = "dir"
 	
 )
 # }}}