diff --git a/R/IO.R b/R/IO.R index 295ce10c..722ee4e7 100644 --- a/R/IO.R +++ b/R/IO.R @@ -41,7 +41,7 @@ isFCSfile <- function(files) #' @param path Directory where to look for the files. #' @param keyword An optional character vector that specifies the FCS keyword #' to read. -#' @param emptyValue see \code{link[flowCore]{read.FCS}} +#' @param ... other arguments passed to \code{link[flowCore]{read.FCS}} #' #' @return A list of character vectors. Each element of the list correspond to #' one FCS file. @@ -60,7 +60,7 @@ isFCSfile <- function(files) #' samp #' #' @export -read.FCSheader <- function(files, path=".", keyword=NULL, emptyValue = TRUE) +read.FCSheader <- function(files, path=".", keyword=NULL, ...) { stopifnot(is.character(files), length(files)>=1, files!="") @@ -69,7 +69,7 @@ read.FCSheader <- function(files, path=".", keyword=NULL, emptyValue = TRUE) files = file.path(path, files) res <- lapply(files, function(file){ - thisRes <- try(header(file, emptyValue = emptyValue), silent = TRUE) + thisRes <- try(header(file, ...), silent = TRUE) if(class(thisRes) == "try-error"){ stop(thisRes, file) }else @@ -81,10 +81,10 @@ read.FCSheader <- function(files, path=".", keyword=NULL, emptyValue = TRUE) res } -header <- function(files,emptyValue=TRUE){ +header <- function(files, ...){ con <- file(files, open="rb") - offsets <- readFCSheader(con) - txt <- readFCStext(con, offsets,emptyValue=emptyValue) + offsets <- findOffsets(con, ...) + txt <- readFCStext(con, offsets, ...) close(con) txt } @@ -478,7 +478,7 @@ readFCSgetPar <- function(x, pnam, strict=TRUE) ## ========================================================================== ## Find all data sections in a file and record their offsets. ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -findOffsets <- function(con,emptyValue=TRUE, dataset, ...) +findOffsets <- function(con,emptyValue=TRUE, dataset = NULL, ...) { offsets <- readFCSheader(con) offsets <- matrix(offsets, nrow = 1, dimnames = list(NULL, names(offsets))) @@ -629,7 +629,7 @@ readFCSheader <- function(con, start=0) ## ========================================================================== ## parse FCS file text section ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -readFCStext <- function(con, offsets,emptyValue, cpp = TRUE, ...) +readFCStext <- function(con, offsets,emptyValue = TRUE, cpp = TRUE, ...) { seek(con, offsets["textstart"]) diff --git a/man/read.FCSheader.Rd b/man/read.FCSheader.Rd index 29d8e3ee..79e4c085 100644 --- a/man/read.FCSheader.Rd +++ b/man/read.FCSheader.Rd @@ -4,7 +4,7 @@ \alias{read.FCSheader} \title{Read the TEXT section of a FCS file} \usage{ -read.FCSheader(files, path = ".", keyword = NULL, emptyValue = TRUE) +read.FCSheader(files, path = ".", keyword = NULL, ...) } \arguments{ \item{files}{Character vector of filenames.} @@ -14,7 +14,7 @@ read.FCSheader(files, path = ".", keyword = NULL, emptyValue = TRUE) \item{keyword}{An optional character vector that specifies the FCS keyword to read.} -\item{emptyValue}{see \code{link[flowCore]{read.FCS}}} +\item{...}{other arguments passed to \code{link[flowCore]{read.FCS}}} } \value{ A list of character vectors. Each element of the list correspond to diff --git a/tests/testthat/test-IO.R b/tests/testthat/test-IO.R index 501d7b1e..b9462441 100644 --- a/tests/testthat/test-IO.R +++ b/tests/testthat/test-IO.R @@ -11,6 +11,23 @@ rownames(expectPD) <- paste0(rownames(expectPD), ".fcs") tmpdir <- tempfile() write.flowSet(fs, tmpdir) + + +test_that("read.FCSheader--multi data segment", { + dataPath <- "~/rglab/workspace/flowCore/misc/" + filename <- file.path(dataPath, "multi-datasegment.fcs") + skip_if_not(file.exists(filename)) + + expect_warning(txt <- read.FCSheader(filename)[[1]], "39 additional data") + expect_equal(txt[['$TOT']], "1244") + + txt <- read.FCSheader(filename, dataset = 1)[[1]] + expect_equal(txt[['$TOT']], "1244") + + txt <- read.FCSheader(filename, dataset = 10)[[1]] + expect_equal(txt[['$TOT']], "955") + +}) test_that("write.FCS--write correct $BEGINDATA",{ mat <- matrix(1:30,ncol = 3, dimnames = list(NULL, letters[1:3]))