#########################################################################/**
# @RdocFunction updateCel
#
# @title "Updates a CEL file"
#
# @synopsis
#
# \description{
# @get "title".
# }
#
# \arguments{
# \item{filename}{The filename of the CEL file.}
# \item{indices}{A @numeric @vector of cell (probe) indices specifying
# which cells to updated. If @NULL, all indices are considered.}
# \item{intensities}{A @numeric @vector of intensity values to be stored.
# Alternatively, it can also be a named @data.frame or @matrix (or @list)
# where the named columns (elements) are the fields to be updated.}
# \item{stdvs}{A optional @numeric @vector.}
# \item{pixels}{A optional @numeric @vector.}
# \item{writeMap}{An optional write map.}
# \item{...}{Not used.}
# \item{verbose}{An @integer specifying how much verbose details are
# outputted.}
# }
#
# \value{
# Returns (invisibly) the pathname of the file updated.
# }
#
# \details{
# Currently only binary (v4) CEL files are supported.
# The current version of the method does not make use of the Fusion SDK,
# but its own code to navigate and update the CEL file.
# }
#
# @examples "../incl/updateCel.Rex"
#
# @author "HB"
#
# @keyword "file"
# @keyword "IO"
#*/#########################################################################
updateCel <- function(filename, indices=NULL, intensities=NULL, stdvs=NULL, pixels=NULL, writeMap=NULL, ..., verbose=0) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'filename':
if (!file.exists(filename)) {
stop("Cannot update CEL file. File not found: ", filename);
}
header <- readCelHeader(filename);
version <- header$version;
if (!version %in% 4) {
stop("Updating CEL v", version, " files is not supported: ", filename);
}
nbrOfCells <- header$total;
# Argument 'indices':
if (is.null(indices)) {
nbrOfIndices <- nbrOfCells;
} else {
# A CEL file has one-based indices
r <- range(indices);
if (r[1] < 1 || r[2] > nbrOfCells) {
stop("Argument 'indices' is out of range [1,", nbrOfCells, "]: ",
"[", r[1], ",", r[2], "]");
}
nbrOfIndices <- length(indices);
}
# Argument 'intensities':
if (is.matrix(intensities)) {
intensities <- as.data.frame(intensities);
}
if (is.list(intensities) || is.data.frame(intensities)) {
if (is.list(intensities)) {
fields <- names(intensities);
} else {
fields <- colnames(intensities);
}
if (is.null(stdvs) && ("stdvs" %in% fields)) {
stdvs <- intensities[["stdvs"]];
}
if (is.null(pixels) && ("pixels" %in% fields)) {
pixels <- intensities[["pixels"]];
}
if ("intensities" %in% fields) {
intensities <- intensities[["intensities"]];
}
}
# Argument 'intensities':
if (!is.null(intensities)) {
if (!is.double(intensities))
intensities <- as.double(intensities);
if (length(intensities) != nbrOfIndices) {
stop("Number of 'intensities' values does not match the number of cell indices: ", length(intensities), " != ", nbrOfIndices);
}
}
# Argument 'stdvs':
if (!is.null(stdvs)) {
if (!is.double(stdvs))
stdvs <- as.double(stdvs);
if (length(stdvs) != nbrOfIndices) {
stop("Number of 'stdvs' values does not match the number of cell indices: ", length(stdvs), " != ", nbrOfIndices);
}
}
# Argument 'pixels':
if (!is.null(pixels)) {
if (!is.integer(pixels))
pixels <- as.integer(pixels);
if (length(pixels) != nbrOfIndices) {
stop("Number of 'pixels' values does not match the number of cell indices: ", length(pixels), " != ", nbrOfIndices);
}
}
# Argument 'writeMap':
if (!is.null(writeMap)) {
writeMap <- .assertMap(writeMap, nbrOfCells);
}
# Argument 'verbose':
if (length(verbose) != 1)
stop("Argument 'verbose' must be a single integer.");
verbose <- as.integer(verbose);
if (!is.finite(verbose))
stop("Argument 'verbose' must be an integer: ", verbose);
# Nothing to do?
if (nbrOfIndices == 0) {
return(invisible(filename));
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Reorder data such that it is written in optimal order
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
reorder <- TRUE;
if (is.null(indices)) {
# Has write map?
if (is.null(writeMap)) {
indices <- 1:nbrOfIndices;
reorder <- FALSE;
} else {
indices <- writeMap;
}
}
if (reorder) {
if (verbose >= 2)
cat("Re-ordering data for optimal write order...");
o <- order(indices);
indices <- indices[o];
if (!is.null(intensities))
intensities <- intensities[o];
if (!is.null(stdvs))
stdvs <- stdvs[o];
if (!is.null(pixels))
pixels <- pixels[o];
o <- NULL; # Not needed anymore
if (verbose >= 2)
cat("done.\n");
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Write data to file
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
version <- header$version;
if (version == 4) {
# Open CEL file
con <- file(filename, open="r+b");
on.exit(close(con));
# Skip CEL header
if (verbose >= 2)
cat("Skipping to beginging of data section...");
h <- .readCelHeaderV4(con);
# "Cell entries - this consists of an intensity value, standard
# deviation value and pixel count for each cell in the array.
# The values are stored by row then column starting with the X=0,
# Y=0 cell. As an example, the first five entries are for cells
# defined by XY coordinates: (0,0), (1,0), (2,0), (3,0), (4,0).
# Type: (float, float, short) = 4 + 4 + 2 = 10 bytes / cell
# cellData <- c(readFloat(con), readFloat(con), readShort(con));
sizeOfCell <- 10;
# Current file position
dataOffset <- seek(con, origin="start", rw="read");
if (verbose >= 2)
cat("done.\n");
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Update in chunks
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
CHUNK.SIZE <- 2^19; # = 524288 indices == 5.2Mb
CHUNK.SIZE <- 2^20; # = 1048576 indices == 10.5Mb
# Work with zero-based indices
indices <- indices - 1;
count <- 1;
offset <- dataOffset;
nbrOfChunks <- ceiling(length(indices) / CHUNK.SIZE);
while (length(indices) > 0) {
if (verbose >= 1) {
cat(sprintf("Number of indices left: %d\n", length(indices)));
cat(sprintf("Updating chunk #%d of %d...\n", count, nbrOfChunks));
}
# Recall: All indices are ordered!
# Shift offset to the first index.
firstIndex <- indices[1];
offset <- offset + sizeOfCell*firstIndex;
# Shift indices such that first index is zero.
indices <- indices - firstIndex;
# Get largest index
maxIndex <- indices[length(indices)];
# verbose && cat(verbose, "Largest index: ", maxIndex, "\n");
# Identify the indices to update such no more than CHUNK.SIZE cells
# are read/updated.
n <- which.max(indices >= CHUNK.SIZE);
if (n == 1)
n <- length(indices);
subset <- 1:n;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Read the data section of the CEL file
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (verbose >= 1)
cat("Reading chunk data section...");
seek(con, origin="start", where=offset, rw="read");
rawAll <- readBin(con=con, what="raw", n=sizeOfCell*(indices[n]+1));
if (verbose >= 1)
cat("done.\n");
# Common to all fields
raw <- NULL;
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Update 'intensities'
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (!is.null(intensities)) {
if (verbose >= 1)
cat("Updating 'intensities'...");
# Write floats (size=4) to raw vector
raw <- raw(length=4*n);
raw <- writeBin(con=raw, intensities[subset], size=4, endian="little");
intensities <- intensities[-subset]; # Not needed anymore
# Updated 'rawAll' accordingly
idx <- rep(sizeOfCell*indices[subset], each=4) + 1:4;
rawAll[idx] <- raw;
idx <- NULL; # Not needed anymore
if (verbose >= 1)
cat("done.\n");
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Update 'stdvs'
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (!is.null(stdvs)) {
if (verbose >= 1)
cat("Updating 'stdvs'...");
# Write floats (size=4) to raw vector
if (length(raw) != 4*n)
raw <- raw(length=4*n);
raw <- writeBin(con=raw, stdvs[subset], size=4, endian="little");
stdvs <- stdvs[-subset]; # Not needed anymore
# Updated 'rawAll' accordingly
idx <- rep(sizeOfCell*indices[subset], each=4) + 5:8;
rawAll[idx] <- raw;
idx <- NULL; # Not needed anymore
if (verbose >= 1)
cat("done.\n");
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Update 'pixels'
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (!is.null(pixels)) {
raw <- NULL; # Not needed anymore
if (verbose >= 1)
cat("Updating 'pixels'...");
# Write short integers (size=2) to raw vector
raw <- raw(length=2*n);
raw <- writeBin(con=raw, pixels[subset], size=2, endian="little");
pixels <- pixels[-subset]; # Not needed anymore
# Updated 'rawAll' accordingly
idx <- rep(sizeOfCell*indices[subset], each=2) + 9:10;
rawAll[idx] <- raw;
idx <- NULL; # Not needed anymore
if (verbose >= 1)
cat("done.\n");
}
raw <- NULL; # Not needed anymore
# Remove updated indices
indices <- indices[-subset];
subset <- NULL; # Not needed anymore
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Write raw data back to file
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (verbose >= 1)
cat("Writing chunk to data section...");
seek(con, origin="start", where=offset, rw="write");
writeBin(con=con, rawAll);
if (verbose >= 1)
cat("done.\n");
rawAll <- NULL; # Not needed anymore
if (verbose >= 1)
cat(sprintf("Updating chunk #%d of %d...done\n", count, nbrOfChunks));
count <- count + 1;
} # while (...)
} # if (version ...)
invisible(filename);
}
############################################################################
# HISTORY:
# 2007-01-04
# o Added argument 'writeMap'.
# 2006-08-19
# o BUG FIX: Wow wow wow. This one was tricky to find. If not specifying
# the 'rw' argument in seek() it defaults to "", which is not "read" as
# I naively though (because I did not read the inner details of ?seek),
# but the latest call to seek. In other words, since I at the end of
# every "chunk" loop call seek(..., rw="write") the seek(..., [rw=""])
# was equal to a seek(..., rw="write"), but I wanted seek(..., rw="read")!
# That made updateCel() do funny things and write to the wrongs parts
# of the file etc.
# 2006-08-18
# o BUG FIX: The new implementation where data was written to raw vectors
# was incorrect. A lot of extra zeros was written. The "eastern egg" in
# the updated example contains an image from http://tpo.berkeley.edu/.
# 2006-08-14
# o BUG FIX: updateCel() would in some cases give "Error: subscript out of
# bounds" when writing the last chunk.
# 2006-07-22
# o Update updateCel() to update data in chunks, because updating the
# complete data section is expensive. For example, a 500K chip has
# 6553600 cells each of size 10 bytes, i.e. >65Mb or raw memory. With
# copying etc it costs >100-200Mb of memory to update a CEL file if only
# the first *and* the last cell is updated. Now it should only be of
# the order of 10-20Mb per chunk.
# o Added verbose output to updateCel().
# o Now updateCel() deallocates objects as soon as possible in order to
# free up as much memory as possible. Had memory problems with the 500K's.
# 2006-07-21
# o updateCel() was really slow when updating a large number of cells.
# Now the idea is to write to raw vectors stored in memory. By reading
# the chunk of the CEL data section that is going to be updated as a raw
# data vector and then updating this in memory first, and the re-write
# that chuck of raw data to file, things are much faster.
# o BUG FIX: updateCel(..., indices=NULL) would generate an error, because
# we tried to reorder by order(indices).
# 2006-06-19
# o Replace 'data' argument with arguments 'intensities', 'stdvs', and
# 'pixels'. /HB
# 2006-06-18
# o First version can update CEL v4 (binary) cell entries. Note that this
# code does not make use of the Fusion SDK library. This may updated in
# the future, but for now we just want something that works.
# o Created. /HB
############################################################################
