.findCcgParent <- function(dataHeader, dataTypeId, ...) { for (parent in dataHeader$parents) { if (identical(parent$dataTypeId, dataTypeId)) return(parent); } NULL; } # .findCcgParent() .getCelHeaderVersion <- function(header, ...) { version <- header$version; if (is.null(version)) { version <- header$fileHeader$version; } if (is.null(version)) { stop("Cannot identify header version. Argument 'header' has an unknown format: ", class(header)[1]); } version; } # .getCelHeaderVersion() # Get the DatHeader from the CCG CEL header .getCelDatHeader <- function(header, ...) { version <- .getCelHeaderVersion(header); if (version == 1) { # Command Console Generic (Calvin) format dataHeader <- header$dataHeader; parent <- .findCcgParent(dataHeader, dataTypeId="affymetrix-calvin-scan-acquisition"); datHeader <- parent$parameters[["affymetrix-dat-header"]]; } else if (version == 3) { datHeader <- .unwrapCelHeaderV3String(header)$datHeader; datHeader <- .wrapDatHeader(datHeader); } else if (version == 4) { datHeader <- .unwrapCelHeaderV4(header)$header$DatHeader; datHeader <- .wrapDatHeader(datHeader); } else { stop("Cannot extract DAT header from CEL header. Unknown CEL header version: ", version); } datHeader; } # .getCelDatHeader() # Extract a CEL header of v3 from the CCG CEL header .getCelHeaderV3 <- function(header, ...) { version <- .getCelHeaderVersion(header); if (version == 1) { # Command Console Generic (Calvin) format dataHeader <- header$dataHeader; params <- dataHeader$parameters; # Algorithm parameters pattern <- "^affymetrix-algorithm-param-"; idxs <- grep(pattern, names(params)); aParams <- params[idxs]; names(aParams) <- gsub(pattern, "", names(aParams)); hdr <- NULL; rows <- as.integer(params[["affymetrix-cel-rows"]][1]); cols <- as.integer(params[["affymetrix-cel-cols"]][1]); hdr <- c(hdr, sprintf("Cols=%d\nRows=%d\n", cols, rows)); hdr <- c(hdr, sprintf("TotalX=%d\nTotalY=%d\n", cols, rows)); hdr <- c(hdr, sprintf("OffsetX=0\nOffsetY=0\n", 0, 0)); for (ff in c("UL", "UR", "LR", "LL")) { xkey <- sprintf("Grid%sX", ff); ykey <- sprintf("Grid%sY", ff); x <- as.integer(aParams[[xkey]][1]) y <- as.integer(aParams[[ykey]][1]) hdr <- c(hdr, sprintf("GridCorner%s=%d %d\n", ff, x, y)); } hdr <- c(hdr, sprintf("Axis-invertX=%d\nAxisInvertY=%d\n", 0, 0)); hdr <- c(hdr, sprintf("swapXY=%d\n", 0)); parent <- .findCcgParent(dataHeader, dataTypeId="affymetrix-calvin-scan-acquisition"); # Infer DAT header datHeader <- parent$parameters[["affymetrix-dat-header"]]; if (is.null(datHeader)) { value <- parent$parameters[["affymetrix-partial-dat-header"]]; pos <- regexpr(":CLS=", value); if (pos != -1) { value <- substring(value, pos+1); datHeader <- sprintf("[%d..%d] %s:%s", 0, 65535, "dummy", value); } } if (is.null(datHeader)) { stop("Failed to locate a valid DAT header in the AGCC file header."); } hdr <- c(hdr, sprintf("DatHeader=%s\n", datHeader)); hdr <- c(hdr, sprintf("Algorithm=%s\n", params[["affymetrix-algorithm-name"]])); excl <- grep("^Grid", names(aParams)); aParams <- aParams[-excl]; aParams <- sapply(aParams, FUN=function(x) x[1]); aParams <- paste(names(aParams), aParams, sep=":"); aParams <- paste(aParams, collapse=";"); hdr <- c(hdr, sprintf("AlgorithmParameters=%s\n", aParams)); hdr <- paste(hdr, collapse=""); headerV3 <- hdr; } else if (version == 3) { # Nothing to do. headerV3 <- header; datHeader <- .wrapDatHeader(datHeader); } else if (version == 4) { # To do: Create a v3 header from scratch (for consistency). headerV3 <- header$header; } else { stop("Cannot extract CEL header of v3 from CEL header. Unknown CEL header version: ", version); } headerV3; } # .getCelHeaderV3() .getCelHeaderV4 <- function(header, ...) { version <- .getCelHeaderVersion(header); if (version == 1) { # Calvin CEL header? if (is.null(header$fileHeader)) { # Re-read the CEL CCG v1 header headerV4 <- header; header <- readCcgHeader(headerV4$filename); } else { # Re-read the CEL v4 header headerV4 <- readCelHeader(header$filename); } # Append CEL v3 header headerV4$header <- .getCelHeaderV3(header); headerV4 <- .unwrapCelHeaderV4(headerV4); headerV4 <- .wrapCelHeaderV4(headerV4); } else if (version == 3) { stop("Cannot get CEL header of v4 from CEL header of v3. Non-implemented feature."); } else if (version == 4) { headerV4 <- .wrapCelHeaderV4(.unwrapCelHeaderV4(header)); } else { stop("Cannot extract CEL header of v3 from CEL header. Unknown CEL header version: ", version); } headerV4; } # .getCelHeaderV4() ############################################################################ # HISTORY: # 2015-04-15 # o BUG FIX: .getCelHeaderV4() on a CCG/v1 header could give "Error in # sprintf("GridCorner%s=%d %d\n" ... invalid format '%d' ...)". # 2012-05-18 # o Now using stop() instead of throw(). # 2007-10-12 # o Now .getCelHeaderV3() tries to infer the DAT header from parent # parameters 'affymetrix-partial-dat-header' if 'affymetrix-dat-header' # is not available. If neither is found, an informative error is thrown. # 2007-08-16 # o Added .getCelHeaderV4(). Verified to work with CEL v1 & v4 headers. # o Added .getCelHeaderV3(). Verified to work with CEL v1, v3 & v4 headers. # o Added .getCelDatHeader(). Verified to work with CEL v1 & v4 headers. # o Created. ############################################################################