Nothing
setConstructorS3("SampleAnnotationFile", function(...) {
this <- extend(GenericDataFile(...), c("SampleAnnotationFile",
uses("FileCacheKeyInterface")),
"cached:.db" = NULL
)
# Parse attributes (all subclasses must call this in the constructor).
setAttributesByTags(this)
this
})
setMethodS3("getExtensionPattern", "SampleAnnotationFile", function(static, ...) {
"[.](saf|SAF)$"
}, static=TRUE, protected=TRUE)
setMethodS3("fromPath", "SampleAnnotationFile", function(static, path, pattern=getExtensionPattern(static), ...) {
# pathnames <- findSAFs(static, path=path, pattern=pattern, ...)
pathnames <- list.files(path=path, pattern=pattern, full.names=TRUE, ...)
if (length(pathnames) == 0)
return(NULL)
pathname <- pathnames[1]
newInstance(static, pathname)
}, static=TRUE, protected=TRUE)
setMethodS3("readDataFrame", "SampleAnnotationFile", function(this, rows=NULL, force=FALSE, ...) {
db <- this$.db
if (force || is.null(db)) {
pathname <- getPathname(this)
# Read all non-commented lines
bfr <- readLines(pathname)
excl <- grep("^[ ]*#", bfr)
if (length(excl) > 0)
bfr <- bfr[-excl]
# Parse these as a DCF
con <- textConnection(bfr)
on.exit(close(con))
db <- read.dcf(con)
db <- gsub("[\n\r]", "", db)
# Not needed anymore
bfr <- NULL
this$.db <- db
}
colnames(db) <- toCamelCase(colnames(db))
if (!is.null(rows))
db <- db[rows,,drop=FALSE]
db
}, protected=TRUE)
setMethodS3("getPatterns", "SampleAnnotationFile", function(this, ...) {
db <- readDataFrame(this, ...)
# Get sample name pattern
patterns <- sprintf("^%s.*$", db[,"name"])
patterns <- gsub("\\^\\^", "^", patterns)
patterns <- gsub("\\$\\.\\*\\$", "$", patterns)
patterns
}, protected=TRUE)
setMethodS3("matchPatterns", "SampleAnnotationFile", function(this, names, trim=FALSE, ...) {
# Scan vector of names for matching patterns
patterns <- getPatterns(this, ...)
res <- lapply(patterns, FUN=function(pattern) {
idxs <- grep(pattern, names)
names(idxs) <- names[idxs]
idxs
})
names(res) <- patterns # In case length(res) == 1 /HB 2007-03-06
if (trim) {
keep <- (sapply(res, FUN=length) > 0)
res <- res[keep]
}
res
}, protected=TRUE)
setMethodS3("applyTo", "SampleAnnotationFile", function(this, names, FUN, ..., verbose=FALSE) {
verbose <- Arguments$getVerbose(verbose)
if (verbose) {
pushState(verbose)
on.exit(popState(verbose))
}
allPatterns <- getPatterns(this, ..., verbose=verbose)
res <- matchPatterns(this, names, trim=TRUE)
# Nothing do to?
if (length(res) == 0)
return(invisible())
verbose && print(verbose, res)
patterns <- names(res)
verbose && print(verbose, patterns)
verbose && print(verbose, allPatterns)
rows <- match(patterns, allPatterns)
# Nothing do to?
if (length(rows) == 0)
return(invisible())
verbose && print(verbose, rows)
db <- readDataFrame(this, rows=rows)
cc <- setdiff(colnames(db), "name")
db <- db[,cc,drop=FALSE]
# Nothing do to?
if (nrow(db) == 0 || ncol(db) == 0)
return(invisible())
for (kk in seq_along(res)) {
record <- db[kk,,drop=TRUE]
# Nothing to do?
if (all(is.na(record)))
next
args <- list(
appliesTo = res[[kk]]
)
args <- c(args, as.list(record))
args <- c(args, list(...))
do.call(FUN, args=args)
}
}, protected=TRUE)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.