R/traverseCcg.R
76ffb454
 .findCcgParent <- function(dataHeader, dataTypeId, ...) {
ede2c2f5
   for (parent in dataHeader$parents) {
76ffb454
    if (identical(parent$dataTypeId, dataTypeId))
ede2c2f5
      return(parent);
   }
 
   NULL;
 } # .findCcgParent()
 
 
 .getCelHeaderVersion <- function(header, ...) {
   version <- header$version;
   if (is.null(version)) {
     version <- header$fileHeader$version;
   }
   if (is.null(version)) {
b5de40e6
     stop("Cannot identify header version.  Argument 'header' has an unknown format: ", class(header)[1]);
ede2c2f5
   }
 
   version;
 } # .getCelHeaderVersion()
 
 
 # Get the DatHeader from the CCG CEL header
 .getCelDatHeader <- function(header, ...) {
   version <- .getCelHeaderVersion(header);
76ffb454
   if (version == 1) {
ede2c2f5
     # Command Console Generic (Calvin) format
     dataHeader <- header$dataHeader;
76ffb454
     parent <- .findCcgParent(dataHeader,
ede2c2f5
                          dataTypeId="affymetrix-calvin-scan-acquisition");
     datHeader <- parent$parameters[["affymetrix-dat-header"]];
   } else if (version == 3) {
76ffb454
     datHeader <- .unwrapCelHeaderV3String(header)$datHeader;
     datHeader <- .wrapDatHeader(datHeader);
   } else if (version == 4) {
     datHeader <- .unwrapCelHeaderV4(header)$header$DatHeader;
     datHeader <- .wrapDatHeader(datHeader);
ede2c2f5
   } else {
b5de40e6
     stop("Cannot extract DAT header from CEL header.  Unknown CEL header version: ", version);
ede2c2f5
   }
76ffb454
 
ede2c2f5
   datHeader;
 } # .getCelDatHeader()
 
 
 
 # Extract a CEL header of v3 from the CCG CEL header
 .getCelHeaderV3 <- function(header, ...) {
   version <- .getCelHeaderVersion(header);
76ffb454
   if (version == 1) {
ede2c2f5
     # 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;
7d16a177
     rows <- as.integer(params[["affymetrix-cel-rows"]][1]);
     cols <- as.integer(params[["affymetrix-cel-cols"]][1]);
ede2c2f5
     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);
7d16a177
       x <- as.integer(aParams[[xkey]][1])
       y <- as.integer(aParams[[ykey]][1])
       hdr <- c(hdr, sprintf("GridCorner%s=%d %d\n", ff, x, y));
ede2c2f5
     }
     hdr <- c(hdr, sprintf("Axis-invertX=%d\nAxisInvertY=%d\n", 0, 0));
     hdr <- c(hdr, sprintf("swapXY=%d\n", 0));
76ffb454
     parent <- .findCcgParent(dataHeader,
ede2c2f5
                          dataTypeId="affymetrix-calvin-scan-acquisition");
66176856
 
     # Infer DAT header
ede2c2f5
     datHeader <- parent$parameters[["affymetrix-dat-header"]];
66176856
     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)) {
b5de40e6
       stop("Failed to locate a valid DAT header in the AGCC file header.");
66176856
     }
ede2c2f5
     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="");
76ffb454
 
ede2c2f5
     headerV3 <- hdr;
   } else if (version == 3) {
     # Nothing to do.
     headerV3 <- header;
76ffb454
     datHeader <- .wrapDatHeader(datHeader);
ede2c2f5
   } else if (version == 4) {
     # To do: Create a v3 header from scratch (for consistency).
     headerV3 <- header$header;
   } else {
b5de40e6
     stop("Cannot extract CEL header of v3 from CEL header.  Unknown CEL header version: ", version);
ede2c2f5
   }
76ffb454
 
ede2c2f5
   headerV3;
 } # .getCelHeaderV3()
 
 
 .getCelHeaderV4 <- function(header, ...) {
   version <- .getCelHeaderVersion(header);
   if (version == 1) {
     # Calvin CEL header?
     if (is.null(header$fileHeader)) {
76ffb454
       # Re-read the CEL CCG v1 header
ede2c2f5
       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) {
b5de40e6
     stop("Cannot get CEL header of v4 from CEL header of v3.  Non-implemented feature.");
ede2c2f5
   } else if (version == 4) {
     headerV4 <- .wrapCelHeaderV4(.unwrapCelHeaderV4(header));
   } else {
b5de40e6
     stop("Cannot extract CEL header of v3 from CEL header.  Unknown CEL header version: ", version);
ede2c2f5
   }
 
76ffb454
   headerV4;
ede2c2f5
 } # .getCelHeaderV4()
 
 
 ############################################################################
 # HISTORY:
7d16a177
 # 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' ...)".
b5de40e6
 # 2012-05-18
 # o Now using stop() instead of throw().
66176856
 # 2007-10-12
76ffb454
 # o Now .getCelHeaderV3() tries to infer the DAT header from parent
 #   parameters 'affymetrix-partial-dat-header' if 'affymetrix-dat-header'
66176856
 #   is not available.  If neither is found, an informative error is thrown.
ede2c2f5
 # 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.
76ffb454
 ############################################################################