[Zooimage-commits] r82 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 15 20:04:36 CEST 2009
Author: romain
Date: 2009-04-15 20:04:36 +0200 (Wed, 15 Apr 2009)
New Revision: 82
Modified:
pkg/zooimage/R/zid.r
pkg/zooimage/R/zis.r
Log:
s/C&P/function/
Modified: pkg/zooimage/R/zid.r
===================================================================
--- pkg/zooimage/R/zid.r 2009-04-15 15:47:07 UTC (rev 81)
+++ pkg/zooimage/R/zid.r 2009-04-15 18:04:36 UTC (rev 82)
@@ -315,12 +315,10 @@
# {{{ Make sure everything is fine for this directory
ok <- TRUE
if (check) {
- withRestarts( withCallingHandlers( {
+ tryCatch( {
verify.zid(zidir, type = type, check.vignettes = check.vignettes, show.log = FALSE)
} , zooImageError = function( e ){
logError( e )
- invokeRestart( "zooImageError" )
- } ), zooImageError = function( e ){
ok <<- FALSE
} )
}
@@ -503,10 +501,7 @@
"uncompress.zid" <- function(zidfile, path = dirname(zidfile), delete.source = FALSE, show.log = TRUE) {
# {{{ Check if the file provided is a .zid file, and if it exists
- if (!file.exists(zidfile))
- stop(zidfile, " not found!")
- if(length(grep("[.]zid$", zidfile)) == 0)
- stop(file, " is not a .zid file!")
+ checkFileExists( zidfile, extension = "zid" )
# }}}
# {{{ Uncompress it
@@ -574,19 +569,9 @@
cat("Decompression...\n")
logProcess("\nDecompression...")
for (s in 1:smax) {
- # TODO: revises this so that this function watches when uncompress.zid
- # starts and finishes and log the appropriate message using conditions
Progress(s, smax)
uncompress.zid(zidfiles[s], path = path.extract,
delete.source = delete.source, show.log = FALSE)
-
- #< if (!uncompress.zid(zidfiles[s], path = path.extract,
- #< delete.source = delete.source, show.log = FALSE)) {
- #< ok <- FALSE
- #< } else {
- #< logProcess("OK", zidfiles[s])
- #< }
-
}
# }}}
Modified: pkg/zooimage/R/zis.r
===================================================================
--- pkg/zooimage/R/zis.r 2009-04-15 15:47:07 UTC (rev 81)
+++ pkg/zooimage/R/zis.r 2009-04-15 18:04:36 UTC (rev 82)
@@ -16,90 +16,65 @@
# along with ZooImage. If not, see <http://www.gnu.org/licenses/>.
# }}}
-"read.description" <-
- function(zisfile = "Description.zis") {
+# {{{ read.description
+"read.description" <- function(zisfile = "Description.zis",
+ expected.sections = c( "Description","Series","Cruises","Stations","Samples")
+ ) {
### TODO: a print function for ZIDesc object.
-
- # Read a *.zis file, and construct a 'ZIDesc' object
- deleteExtraRows <- function(df) {
- Names <- names(df)
- Del <- grep("^X[.][0-9]+$", Names)
- if (length(Del) > 0) Names <- Names[-Del]
- if ("X" %in% Names && all(is.na(df$X))) Names <- Names[Names != "X"]
- return(df[ , Names])
- }
-
- if (!file.exists(zisfile) || file.info(zisfile)$isdir)
- stop(zisfile, " not found, or not a file!")
- if (length(grep("[.]zis$", tolower(zisfile))) == 0)
- stop(zisfile, " is not a ZooImage sample description file (*.zis)!")
- # check first line for ZI1
- Line1 <- scan(zisfile, character(), nmax = 1, quiet = TRUE)
- if (Line1 != "ZI1")
- stop(zisfile, " does not appear to be ZooImage version 1 file, or it is corrupted!")
- Lines <- scan(zisfile, character(), sep = "\t", skip = 1,
- blank.lines.skip = FALSE, flush = TRUE, quiet = TRUE, comment.char = "#")
- if (length(Lines) < 1)
+ checkFileExists( zisfile, extension = "zis", force.file = TRUE )
+ checkFirstLine( zisfile )
+ rl <- readLines( zisfile )
+ if (!length(rl) > 1){
stop("The file is empty or corrupted!")
- # Determine the position of the various tables (Series, Cruises, Stations & Samples)
- posSeries <- grep("[[]Series[]]", Lines) + 1
- if (length(posSeries) == 0) stop("[Series] section not found!")
- posCruises <- grep("[[]Cruises[]]", Lines) + 1
- if (length(posCruises) == 0) stop("[Cruises] section not found!")
- posStations <- grep("[[]Stations[]]", Lines) + 1
- if (length(posStations) == 0) stop("[Stations] section not found!")
- posSamples <- grep("[[]Samples[]]", Lines) + 1
- if (length(posSamples) == 0) stop("[Samples] section not found!")
- # Parse all the text before those tables
- data <- Lines[1:(posSeries - 2)]
- Desc <- parse.ini(data, "")
- # Parse these tables
- Series <- data.frame(); Cruises <- data.frame(); Stations <- data.frame()
- Nrows <- posCruises - posSeries - 3
- if (Nrows > 0) {
- Series <- read.table(zisfile, sep = "\t", header = TRUE, skip = posSeries,
- dec = getDec(), blank.lines.skip = FALSE, nrows = Nrows)
- Series <- deleteExtraRows(Series)
- Names <- names(Series)
- if (Names[1] == "X.Code") { Names[1] <- "Code"; names(Series) <- Names }
}
- Nrows <- posStations - posCruises - 3
- if (Nrows > 0) {
- Cruises <- read.table(zisfile, sep = "\t", header = TRUE, skip = posCruises,
- dec = getDec(), blank.lines.skip = FALSE, nrows = Nrows)
- Cruises <- deleteExtraRows(Cruises)
- Names <- names(Cruises)
- if (Names[1] == "X.Code") { Names[1] <- "Code"; names(Cruises) <- Names }
- # Convert 'Start' and 'End' in dates
- Stations$Start <- as.Date(Stations$Start)
- Stations$End <- as.Date(Stations$End)
- }
- Nrows <- posSamples - posStations - 3
- if (Nrows > 0) {
- Stations <- read.table(zisfile, sep = "\t", header = TRUE, skip = posStations,
- dec = getDec(), blank.lines.skip = FALSE, nrows = Nrows)
- Stations <- deleteExtraRows(Stations)
- Names <- names(Stations)
- if (Names[1] == "X.Code") { Names[1] <- "Code"; names(Stations) <- Names }
- # Convert 'Start' and 'End' in dates
- Stations$Start <- as.Date(Stations$Start)
- Stations$End <- as.Date(Stations$End)
- }
- Samples <- read.table(zisfile, sep = "\t", dec = getDec(),header = TRUE,
- skip = posSamples)
- Samples <- deleteExtraRows(Samples)
- Names <- names(Samples)
- if (Names[1] == "X.Label") { Names[1] <- "Label"; names(Samples) <- Names }
- # Convert 'Date' into a Date
- Samples$Date <- as.Date(Samples$Date)
+ positions <- grep( "^[[].*[]]", rl )
+ names <- sub( "^[[](.*)[]]", "\\1", rl[positions] )
+ if( !all( expected.sections %in% names ) ){
+ stop( "Incorrect zis file, does not have all expected sections" )
+ }
+ start <- positions + 1
+ end <- c( tail( positions, -1 ) - 2, length(rl) )
+ data <- lapply( 1:length( start ), function( i ){
+ if( names[i] == "Description" ){
+ rx <- "^(.*?)=(.*)$"
+ txt <- rl[ start[i] : end[i] ]
+ variables <- sub( rx, "\\1", txt )
+ values <- sub( rx, "\\2", txt )
+ out <- data.frame( matrix( values, nr = 1 ) )
+ names( out ) <- variables
+ } else{
+ con <- textConnection( rl[ start[i] : end[i] ] )
+ out <- read.table( con ,
+ sep = "\t", header = TRUE,
+ dec = getDec(), blank.lines.skip = FALSE )
+ close( con )
+
+ names(out)[1] <- sub( "^X\\.", "", names(out)[1] )
+ out <- out[ , !grepl( "^X\\.[0-9]+", names(out) ) ]
+ out
+ }
+ out
+ } )
+ names( data ) <- names
+ Samples <- data[["Samples"]]
+ Samples$Date <- as.Date(Samples$Date)
+ Series <- data[["Series"]]
+ Cruises <- data[["Cruises"]]
+ Cruises$Start <- as.Date(Cruises$Start)
+ Cruises$End <- as.Date(Cruises$End)
+ Stations <- data[["Stations"]]
+ Stations$Start <- as.Date(Stations$Start)
+ Stations$End <- as.Date(Stations$End)
+ Description <- data[["Description"]]
+
# Combine all this in a data frame + metadata
- Meta <- list(Desc = Desc$Description, Series = Series, Cruises = Cruises, Stations = Stations)
- attr(Samples, "metadata") <- Meta
- # This is a "ZIDesc" object
- class(Samples) <- c("ZIDesc", "data.frame")
- return(Samples)
+ structure(Samples,
+ metadata = list(Desc = Description, Series = Series,
+ Cruises = Cruises, Stations = Stations),
+ class = c("ZIDesc", "data.frame") )
}
+# }}}
# {{{ createZis
#' Create a .zis file from a template and edit it
More information about the Zooimage-commits
mailing list