From 6cc1fccb975235c297f529556c157fd0ebd7b2b1 Mon Sep 17 00:00:00 2001 From: mikejiang Date: Fri, 24 Aug 2018 14:51:27 -0700 Subject: [PATCH] use the actual range instead of 1024 for in write.FCS #122 --- NAMESPACE | 2 +- R/IO.R | 11 +++++++---- tests/testthat/helper-expectResults.R | 1 + tests/testthat/test-IO.R | 12 ++++++++++++ tests/testthat/test-fr-methods.R | 1 + 5 files changed, 22 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0bd6502..42f1683 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,7 @@ useDynLib("flowCore",.registration=TRUE) import(methods) import(Rcpp) -importFrom(matrixStats, colMins) +importFrom(matrixStats, colMins, colMaxs) importClassesFrom(Biobase, AnnotatedDataFrame) importFrom("grDevices", "devAskNewPage") importFrom("graphics", "abline") diff --git a/R/IO.R b/R/IO.R index bb09697..c526324 100644 --- a/R/IO.R +++ b/R/IO.R @@ -1391,10 +1391,13 @@ write.FCS <- function(x, filename, what="numeric", delimiter = "|", endian = "bi pne[sapply(pne, length)==0] <- "0,0" mk <- c(mk, pne) - ## The same for PnR, "1024" if missing + mat <- exprs(x) + ## The same for PnR, pnr <- orig.kw[paste0(pid, "R")] names(pnr) <- sprintf("$P%sR", newid) - pnr[sapply(pnr, length)==0] <- "1024" + empty_range_ind <- sapply(pnr, length)==0 + empty_range_chnl <- as.character(pd[pid[empty_range_ind],"name"]) + pnr[empty_range_ind] <- colMaxs(mat[, empty_range_chnl, drop = FALSE]) mk <- c(mk, pnr) ## Now update the PnN keyword @@ -1415,7 +1418,7 @@ write.FCS <- function(x, filename, what="numeric", delimiter = "|", endian = "bi description(x) <- mk ## Figure out the offsets based on the size of the initial text section - ld <- length(exprs(x)) * types[what, "bitwidth"] + ld <- length(mat) * types[what, "bitwidth"] ctxt <- collapseDesc(x, delimiter = delimiter) # these two are estimated value and just to get the reserved length of characters for storing the @@ -1437,7 +1440,7 @@ write.FCS <- function(x, filename, what="numeric", delimiter = "|", endian = "bi on.exit(close(con)) writeFCSheader(con, offsets) writeChar(ctxt, con, eos=NULL) - writeBin(as(t(exprs(x)), what), con, size=types[what, "bitwidth"], + writeBin(as(t(mat), what), con, size=types[what, "bitwidth"], endian=endian) writeChar("00000000", con, eos=NULL) filename diff --git a/tests/testthat/helper-expectResults.R b/tests/testthat/helper-expectResults.R index ac3a939..aea622b 100644 --- a/tests/testthat/helper-expectResults.R +++ b/tests/testthat/helper-expectResults.R @@ -1,3 +1,4 @@ library(digest) +library(Biobase) expectRes <- readRDS("expectResults.rds") data(GvHD) diff --git a/tests/testthat/test-IO.R b/tests/testthat/test-IO.R index c947546..8ac147d 100644 --- a/tests/testthat/test-IO.R +++ b/tests/testthat/test-IO.R @@ -265,6 +265,18 @@ test_that("write.FCS -- update channel and marker", { expect_equal(markernames(inputFcs), markernames(tmp1)) }) +test_that("write.FCS -- data from the flowFrame constructor without $PnR keys", { + set.seed(1) + mat <- matrix(rnorm(1000),ncol=4) + colnames(mat) <- LETTERS[1:4] + fr1 <- flowFrame(mat) + keyword(fr1) + tmp <- tempfile() + write.FCS(fr1, tmp) + fr2 <- read.FCS(tmp) + expect_equal(as.numeric(keyword(fr2)[["$P1R"]]), 2.4977, tolerance = 3e-4) +}) + test_that("write.FCS -- add new cols", { tmp <- GvHD[[1]] diff --git a/tests/testthat/test-fr-methods.R b/tests/testthat/test-fr-methods.R index 836c4ba..cb851bc 100644 --- a/tests/testthat/test-fr-methods.R +++ b/tests/testthat/test-fr-methods.R @@ -1,6 +1,7 @@ context("flowFrame methods...") data("GvHD") fr <- GvHD[[1]] + test_that("range", { rng1 <- data.frame("FSC-H" = c(0,1023) ,"SSC-H" = c(0,1023)