R/ReadIgorBinary.R

Defines functions tsp.igorwave WaveToTimeSeries .ReadIgorBinary.V5 .ReadIgorBinary.V2 .ReadUserStr .ReadUserVar .ReadVarHeader .ReadPlatformInfo .ReadPackedFile .read_nt_string .ReadWaveRecord .ReadDataFolderEndRecord .ReadDataFolderStartRecord .ReadPackedHeader .convertIgorDate .readIgorDate .readCharsWithEnc .readNullTermString .ConvertIntToUInt .DetermineIgorWaveType read.pxp read.ibw

Documented in read.ibw .ReadPackedHeader read.pxp tsp.igorwave WaveToTimeSeries

# ReadIgorBinary.R
# 
# Copyright (C) 2007 Gregory Jefferis <gsxej2@cam.ac.uk>
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#################

# 2005-11-14
# File to read the igor binary file format into R
# There are various issues to deal with
# 1) Formats are either v2 or v5
# 2) Can be either Mac or PC

# Tested with the following from Igor Tech Note # 3 package
# zeroPointWave.ibw
# version5.ibw
# version2.ibw
# double.ibw
# along with my own testuint and testuword

# 2006-06-15
# Now reads the Igor packed experiment format into a list
# So far just works on the open/close data folders and reads 
# v2 and v5 multidimensional data.  Still need to check if matrices and
# higher dimensional arrays are laid out in the same order.
# Can supply a regex to read in only a selection and can also request that 
# only headers rather than data are loaded. 
# Have also tested it with one of Rachel's .pxp files and that worked fine 
# as well

# 2006-11-23
# Now reads text waves 
# tested with SamplesMac/textWave.ibw and SampleWin/textWave.ibw
# and some neuromatic pxp sweeps

# 2006-11-25
# Fixed problems reading waves with notes / extended units etc
# Now able to load a large Neuromatic pxp file (about 6 or 7Mb, 25s)
# Improved error checking for offsets of text waves
# Made return of v2 or v5 read more consistent

# 2009-07-09
# Fixed handling of dates in ReadNclampLogTable

#' Read binary files in the Igor Binary Wave format (IBW)
#' 
#' @param wavefile either a character vector containing the path to a file or an
#'   R \link{connection}.
#' @param Verbose if \code{TRUE}, print status information while reading the
#'   file.
#' @param ReturnTimeSeries if \code{TRUE}, return as an R time series (package
#'   \code{\link{ts}}).
#' @param MakeWave if \code{TRUE}, assign wave to a list in the global user
#'   environment.
#' @param HeaderOnly if \code{TRUE}, only return the header of the Igor Wave.
#' @return A vector containing the wave data or, if \code{MakeWave == TRUE},
#'   returns the name of a new R vector containing the data which has been made
#'   in the user environment
#' @author jefferis
#' @export
#' @examples
#' # return a list containing the wave
#' wavedata=read.ibw(system.file("igor","version5.ibw",package="IgorR")) 
#' sum(wavedata)
#' 
#' # make a list containing the wave's data in the users's environment
#' wavename=read.ibw(system.file("igor","version5.ibw",package="IgorR"),MakeWave=TRUE) 
#' sum(get(wavename))
#' @family igor-io
read.ibw<-function(wavefile,Verbose=FALSE,ReturnTimeSeries=FALSE,
    MakeWave=FALSE,HeaderOnly=FALSE){
  if (is.character(wavefile)) {
    # NB setting the encoding to "macintosh" resolves some problems with utf-8 incompatible chars
    # in the mac or windows-1252 encodings
    wavefile <- file(wavefile, "rb",encoding="macintosh")
    on.exit(close(wavefile))
  }
  
  # read one byte
  bytes=readBin(wavefile,"integer",2,size=1)
  if(bytes[1]==0){
    endian="big"; version=bytes[2]
  } else {
    endian="little"; version=bytes[1]
  }
  if(Verbose) cat("version = ",version,"endian = ",endian,"\n")
  
  if(version==5) {
    rval=.ReadIgorBinary.V5(wavefile,Verbose=Verbose,endian=endian,HeaderOnly=HeaderOnly)
  } else if(version==2){
    rval=.ReadIgorBinary.V2(wavefile,Verbose=Verbose,endian=endian,HeaderOnly=HeaderOnly)
  }
  else stop(paste("Unable to read from Igor Binary File:",summary(wavefile)$description,"with version:",version))
  # Store Igor wave version number
  attr(rval,'BinHeader')$version=version
  
  if(ReturnTimeSeries){
    rval=WaveToTimeSeries(rval)
  }
  
  # makes a wave with a specified name in the user environment
  if(MakeWave){
    OriginalWaveName=attr(rval,"WaveHeader")$WaveName
    WaveName=make.names(OriginalWaveName)
    if(WaveName!=OriginalWaveName)
      warning("Had to change wave name from ",OriginalWaveName," to ",WaveName,"to keep R happy")
    assign(WaveName,rval,envir = .GlobalEnv)
    invisible(WaveName)
  } else invisible(rval)
}

#' Reads an Igor Pro Packed Experiment (.pxp) file
#' 
#' Note that PXP files are only partially documented so some contents cannot be 
#' parsed (e.g. image data). This function currently reads data records (Igor 
#' waves and variables), history, procedures, recreation macros and plain text 
#' notebooks. Formatted notebooks cannot be read.
#' 
#' \code{IgorPlatform} will determine in which encoding text is read 
#' (WINDOWS-1252 for windows and macintosh for macintosh). Unique abbreviations 
#' are acceptable. Defaults to \code{"windows"} on Windows, \code{"macintosh"}
#' otherwise. Note that Igor Pro 5.5 added a PlatformRecord to the PXP file
#' format which is used to determine the file's platform of origin when
#' available. Since this is information straight from the horse's mouth it will
#' override the \code{IgorPlatform} argument.
#' @param pxpfile character vector naming a PXP file or an R \link{connection}.
#' @param regex if \code{TRUE}, only read records (e.g. waves) in the PXP file
#'   whose names match a \link{regex}.
#' @param ReturnTimeSeries if \code{TRUE}, Igor waves are returned as a
#'   \code{link{ts}} object with sensible x scaling (\code{FALSE} by default).
#' @param Verbose whether to print information to console during loading 
#'   (numeric values are also allowed 0=none, 1=basic, 2=all).
#' @param StructureOnly (TODO) if \code{TRUE}, only the structure of the PXP
#'   file for inspection.
#' @param ExtractText whether to extract procedures, recreation macros, history 
#'   and plain text notebooks (\code{FALSE} by default).
#' @param IgorPlatform OS on which Igor file was saved (windows or macintosh).
#' @param ... optional parameters passed to \link{read.ibw}.
#' @return A list containing all the individual waves or variables in the PXP 
#'   file.
#' @author jefferis
#' @export
#' @import bitops
#' @family igor-io
#' @examples 
#' r=read.pxp(system.file("igor","testexpt.pxp",package="IgorR"))
read.pxp<-function(pxpfile,regex,ReturnTimeSeries=FALSE,Verbose=FALSE,
    StructureOnly=FALSE,ExtractText=FALSE,IgorPlatform=NULL,...){
  if (is.character(pxpfile)) {
    # NB setting the encoding to "MAC" resolves some problems with utf-8 incompatible chars
    # in the mac or windows-1252 encodings
    pxpfile <- file(pxpfile, "rb",encoding="LATIN1")
    on.exit(close(pxpfile))
  }
  filename=summary(pxpfile)$description
  
  if(is.logical(Verbose))
    Verbose=ifelse(Verbose,1,0)

  # Check if this file needs to be byte swapped
  firstShort=readBin(pxpfile,"integer",1,size=2)
  firstShort=bitAnd(firstShort,0x7FFF)
  if (bitAnd(firstShort,0xFF00) != 0) endian="swap"
  else endian = .Platform$endian

  # default to windows on windows, mac otherwise
  if(is.null(IgorPlatform))
    IgorPlatform=ifelse(.Platform$OS.type=="windows",'windows','macintosh')
  else
    IgorPlatform=match.arg(IgorPlatform,choices=c('windows','macintosh'))

  encoding = ifelse(IgorPlatform=='windows','WINDOWS-1252','macintosh')

  root=list() # we will store data here
  currentNames="root"
  recordStartPos=0
  fileSize=file.info(filename)$size
  while(recordStartPos<fileSize){
    seek(pxpfile,recordStartPos)
    ph=.ReadPackedHeader(pxpfile,endian)
    if(Verbose>1) cat("recordStartPos =",recordStartPos,",Record type =",ph$recordType,
          "of length =",ph$numDataBytes,"\n")
    
    recordStartPos=seek(pxpfile)+ph$numDataBytes
    #if(!is.na(recTypeFuns[ph$recordType])) x=match.fun(recTypeFuns[ph$recordType])(pxpfile,endian)
    if (ph$recordType==1){
      # variables
      vh=.ReadVarHeader(pxpfile,endian)
      
      vars=list()
      if(vh$numSysVars>0) vars$sysVars=readBin(pxpfile,n=vh$numSysVars,size=4,what=numeric(),signed=TRUE,endian=endian)
      if(vh$numUserVars>0) vars=c(vars,.ReadUserVar(pxpfile,endian,n=vh$numUserVars))
      if(vh$numUserStrs>0) vars=c(vars,
            .ReadUserStr(pxpfile,endian,n=vh$numUserStrs,IgorPlatform=IgorPlatform),
            attr(vh,"version"))
      if(Verbose>1) print(vh)
      if(Verbose>1) print(vars)
      el=paste(paste(currentNames,collapse="$"),sep="$","vars")
      eval(.myparse(text=paste(el,"<-vars")))
    } else if (ph$recordType==3){
      # wave record; verbose made for wave reading if we are passed
      # Verbose = 2
      x=.ReadWaveRecord(pxpfile,endian,Verbose=ifelse(Verbose==2,TRUE,FALSE),
          HeaderOnly=StructureOnly,ReturnTimeSeries=ReturnTimeSeries,...)
      if(!is.null(x)){
        wavename=attr(x,"WaveHeader")$WaveName
        if(is.null(wavename)) {
          # assume this is a wave name
          wavename=x
        }
        el=paste(paste(currentNames,collapse="$"),sep="$",wavename)
        # store the record if required
        if(missing(regex) || any( grep(regex,el) )){
          eval(.myparse(text=paste(el,"<-x")))
        }
        if (Verbose>0) cat("el:",el,"\n")
      }
    } else if (ph$recordType == 2 && ExtractText){
        # Experiment History
        history = .readCharsWithEnc(pxpfile, ph$numDataBytes, encoding)
        el = paste(paste(currentNames, collapse="$"), sep="$", "history")
        eval(.myparse(text=paste(el,"<-history")))
        if(Verbose > 1)
          cat("history: ", substr(history,0,20), " ...\n")
    } else if (ph$recordType == 4 && ExtractText){
        # Recreation Macro
        recmacro = .readCharsWithEnc(pxpfile, ph$numDataBytes, encoding)
        el = paste(paste(currentNames, collapse="$"), sep="$", "recmacro")
        eval(.myparse(text=paste(el,"<-recmacro")))
        if(Verbose > 1)
          cat("recreation macro: ", substr(recmacro,0,20), " ...\n")
    } else if (ph$recordType == 5 && ExtractText){
        # Procedure Text
        mainproc = .readCharsWithEnc(pxpfile, ph$numDataBytes, encoding)
        el = paste(paste(currentNames, collapse="$"), sep="$", "mainproc")
        eval(.myparse(text=paste(el,"<-mainproc")))
        if(Verbose > 1)
          cat("main procedure: ", substr(mainproc,0,20), " ...\n")
    } else if (ph$recordType == 8 && ExtractText){
        # packed procedures and notebooks
        file = .ReadPackedFile(pxpfile, ph$numDataBytes, encoding,  Verbose)
        if(length(file) > 0){
          el = paste(paste(currentNames, collapse="$"), sep="$", file$name)
          eval(.myparse(text=paste(el,"<-file$data")))
          if(Verbose > 1)
            cat("packed file ", file$name, ": ", substr(file$data,1,20), " ...\n")
        }
    } else if (ph$recordType==9){
      # Open Data Folder
      foldername=.ReadDataFolderStartRecord(pxpfile,endian)
      # backquote protects funny folder names with no effect on valid names
      currentNames=c(currentNames, sprintf("`%s`", foldername))
    } else if (ph$recordType==10){
      # Close Data Folder
      currentNames=currentNames[-length(currentNames)]
    } else if (ph$recordType==20){
      # Platform info
      ipi=.ReadPlatformInfo(pxpfile,endian,ph$numDataBytes)
      if(ipi$platform==1) IgorPlatform='macintosh'
      else if(ipi$platform==2) IgorPlatform='windows'
    }
  }
  invisible(root)
}

.DetermineIgorWaveType<-function(WaveHeader,endian=NULL){
  if(endian=="big") WaveHeader$type=rev(WaveHeader$type)
  WaveHeader$typeBits=as.integer(rawToBits(WaveHeader$type[1]))
  
  # // From IgorMath.h
  #define NT_CMPLX 1      // Complex numbers.
  #define NT_FP32 2     // 32 bit fp numbers.
  #define NT_FP64 4     // 64 bit fp numbers.
  #define NT_I8 8       // 8 bit signed integer. Requires Igor Pro 2.0 or later.
  #define NT_I16  0x10    // 16 bit integer numbers. Requires Igor Pro 2.0 or later.
  #define NT_I32  0x20    // 32 bit integer numbers. Requires Igor Pro 2.0 or later.
  #define NT_UNSIGNED 0x40  // Makes above signed integers unsigned. Requires Igor Pro 3.0 or later.
  
  # default is character ie text wave, which I assume to be ascii
  what="character";size=1
  if(WaveHeader$typeBits[6]) { what="integer"; size=4 }
  if(WaveHeader$typeBits[5]) { what="integer"; size=2 }
  if(WaveHeader$typeBits[4]) { what="integer"; size=1 }
  if(WaveHeader$typeBits[3]) { what="double"; size=8 }
  if(WaveHeader$typeBits[2]) { what="double"; size=4 }
  if(WaveHeader$typeBits[1]) what="complex"
  WaveHeader$signAdjustment=0 # note that readBin handles unsigned data poorly,
  # so have to do it myself
  if(WaveHeader$typeBits[7]) { what="integer"; WaveHeader$signAdjustment=2^(size*8)}
  
  WaveHeader$what=what;
  WaveHeader$size=size;
  return(WaveHeader)
}

.ConvertIntToUInt<-function(x,adjustment=2^32){
  x=as.numeric(x)
  signs=sign(x)
  x[signs<0]=x[signs<0]+adjustment
  x
}
.readNullTermString<-function(con,totalLength,encoding,...){
  if(totalLength==0) return ("")
  # first read in exactly the number of raw bytes we've been told
  # note totalLength is the length including the null terminator (if present)
  rawc=readBin(con, what='raw', n=totalLength)
  # then read a string from that - readBin will drop any null terminator
  s=readBin(rawc, what="character")
  if(missing(encoding)) return(s)
  else return(iconv(s,from=encoding,to=""))
}

.readCharsWithEnc<-function(con,nchars,encoding,targetenc='UTF-8'){
  s=readChar(con,nchars,useBytes=TRUE)
  if(missing(encoding)) return(s)
  else return(iconv(s,from=encoding,to=targetenc))
}

.readIgorDate<-function(con,endian){
  # Igor uses date as seconds since midnight 1 Jan 1904
  # Unfortunately does not seem to record time zone, so have to use current
  # readBin can only read signed shorts or bytes,
  # so must add 2^32 to read as unsigned long 
  i=as.numeric(readBin(con,endian=endian,what=integer(),size=4))+2^32
  i=.convertIgorDate(i)
  i
}

# internal function to convert Igor dates
# these are expressed in seconds since 1904-01-01 in the local timezone
# note that we provide a tz argument to ensure that tests give the same
# results regardless of the local timezone of the test machine
.convertIgorDate<-function(dateval, tz=""){
  igor_origin=ISOdatetime(1904,1,1,hour=0,min = 0, sec=0, tz=tz)
  # this takes care of tz offset differences between the actual date and the origin
  # e.g. because date is during daylight savings (but origin was not)
  res=timechange::time_add(igor_origin, second = dateval)
  res
}

# enum PackedFileRecordType {
#   kUnusedRecord = 0,
#   kVariablesRecord,   //  1: Contains system numeric variables (e.g., K0) and user numeric and string variables.
#   kHistoryRecord,     //  2: Contains the experiment's history as plain text.
#   kWaveRecord,      //  3: Contains the data for a wave
#   kRecreationRecord,    //  4: Contains the experiment's recreation procedures as plain text.
#   kProcedureRecord,   //  5: Contains the experiment's main procedure window text as plain text.
#   kUnused2Record, //6
#   kGetHistoryRecord,    //  7x6: Not a real record but rather, a message to go back and read the history text.
#   kPackedFileRecord,    //  8x7: Contains the data for a procedure file or notebook in a packed form.
#   kDataFolderStartRecord, //  9x8: Marks the start of a new data folder.
#   kDataFolderEndRecord  // 10: Marks the end of a data folder.
#   kPlatformRecord=20    // 20: Info about Igor that wrote experiment. Added for Igor Pro 5.5D.
#   
#   /*  Igor writes other kinds of records in a packed experiment file, for storing
#     things like pictures, page setup records, and miscellaneous settings. The
#     format for these records is quite complex and is not described in PTN003.
#     If you are writing a program to read packed files, you must skip any record
#     with a record type that is not listed above.
#   */
# };

#' Private functions in IgorR Package
#' @name IgorR-private
NULL

#' @description \code{.ReadPackedHeader} reads the short record header from the
#'   current location in a PXP file
#' @details Note that the \code{recordType} will be one of the constants from
#'   Igor's enum \code{PackedFileRecordType}
#' @param con an R connection to the file we are reading
#' @param endian either little or big
#' @return a list containing information about the current record
#' @rdname IgorR-private
#' @author jefferis
.ReadPackedHeader<-function(con,endian){
  recordType=readBin(con,size=2,what=integer(),signed=FALSE,endian=endian)
  version=readBin(con,size=2,what=integer(),endian=endian)
  numDataBytes=readBin(con,size=4,what=integer(),endian=endian) # is 4 correct?
  return(list(recordType=recordType,version=version,numDataBytes=numDataBytes))
}

.ReadDataFolderStartRecord<-function(con,endian){
  folderName=.readNullTermString(con,32)
  #cat("Start of Data Folder",folderName,"\n")
  folderName
}
.ReadDataFolderEndRecord<-function(con,endian){
  #cat("End of Data Folder")
}
.ReadWaveRecord<-function(con,endian,Verbose=FALSE,...){  
  x=read.ibw(con,Verbose=Verbose,...)
  #cat("Wave Record", attr(x,"WaveHeader")$WaveName,"\n")
  x
}

# private function to read a null terminated string
.read_nt_string <- function(con, strlen) {
  rawchars=readBin(con, what=raw(), n = strlen)
  readBin(rawchars, what = 'character', n = 1)
}

.ReadPackedFile<-function(con, recordSize, encoding, Verbose){

  # discard first header part
  numBytes   = 32
  res=readBin(con, what=raw(), n = numBytes)
  recordSize = recordSize - numBytes

  # read the filename
  file       = list()
  file$name  = .read_nt_string(con, numBytes)
  recordSize = recordSize - numBytes

  # discard last header part
  numBytes   = 90
  readBin(con, what = raw(), n = numBytes)
  recordSize = recordSize - numBytes

  file$data  = suppressWarnings(.readCharsWithEnc(con, recordSize, encoding))

  if(nchar(file$data) <= 1) { # assume it is a formatted notebook with custom binary header

    if(Verbose > 1)
      cat("Ignoring formatted notebook ", file$name, "\n")

    return(list())
  }

  return(file)
}

#struct PlatformInfo {      // Data written for a record of type kPlatformRecord.
# short platform;       // 0=unspecified, 1=Macintosh, 2=Windows.
# short architecture;     // 0=invalid, 1=PowerPC, 2=Intel.
# double igorVersion;     // e.g., 5.00 for Igor Pro 5.00.
# char reserved[256 - 12];  // Reserved. Write as zero.
#};

.ReadPlatformInfo<-function(con,endian,size){
  # I didn't find this documented anywhere, but this record can be preceded
  # by some additional information besides the PlatformInfo struct
  readBin(con,n=size-256,size=1,what=raw())
  l=list()
  l$platform=readBin(con,size=2,what=integer(),signed=TRUE,endian=endian)
  l$architecture=readBin(con,size=2,what=integer(),signed=TRUE,endian=endian)
  l$igorVersion=readBin(con,size=8,what=numeric(),endian=endian)
#  print(l)
  # skip remaining bytes
  readBin(con,n=256-12,size=1,what=raw())
  l
}

.ReadVarHeader<-function(con,endian){
  l=list()
  vhversion=readBin(con,size=2,what=integer(),signed=TRUE,endian=endian) # Version number is 2 for this header.
  l$numSysVars=readBin(con,size=2,what=integer(),signed=TRUE,endian=endian)  # Number of system variables (K0, K1 . . .).
  l$numUserVars=readBin(con,size=2,what=integer(),signed=TRUE,endian=endian) # Number of user numeric variables -- may be zero.
  l$numUserStrs=readBin(con,size=2,what=integer(),signed=TRUE,endian=endian) # Number of user string variables -- may be zero.
  if(vhversion==2){
    l$numDependentVars==readBin(con,size=2,what=integer(),signed=TRUE,endian=endian) # Number of dependent numeric variables -- may be zero.
    l$numDependentStrs==readBin(con,size=2,what=integer(),signed=TRUE,endian=endian) # Number of dependent string variables -- may be zero.
  }
  attr(l,"version")=vhversion
  l
}
.ReadUserVar<-function(con,endian,n=1){
  # typedef struct UserNumVarRec {
  #   char name[31+1];          // Name of the variable as a C string including null terminator.
  #   short type;             // Must be 1, signifying numeric.
  #   VarNumRec num;            // Type and value of the variable if it is numeric.
  # } UserNumVarRec;
  l=list()
  if(n<0) {return(NULL)}
  for(i in 1:n){
    varname=.readNullTermString(con,32)
    vtype=readBin(con,size=2,what=integer(),signed=TRUE,endian=endian)
    if(vtype!=1) warning(paste("inappropriate vartype",vtype," for varname",varname))
    # struct VarNumRec {
    #   short numType;            // Type from IgorMath.h.
    #   double realPart;          // The real part of the number.
    #   double imagPart;          // The imag part if the number is complex.
    #   long reserved;            // Reserved - set to zero.
    # };
    # make a fake Igor Binary Wave Header and then use that to figure out numeric type
    fakewh=list(type=readBin(con,n=2,size=1,what="raw"))
    fakewh=.DetermineIgorWaveType(fakewh,endian)
    x=readBin(con,n=2,size=8,what=numeric(),endian=endian)
    if(fakewh$what=='complex'){
      x=complex(real=x[1],imaginary=x[2])
    } else{
      x=x[1]
    }
    readBin(con,n=1,size=4,what=integer(),endian=endian)
    l[[varname]]=x
  }
  l
}

.ReadUserStr<-function(con,endian,n=1,version=1,IgorPlatform){
  # typedef struct UserStrVarRec1 {
  #   char name[31+1];          // Name of the string variable.
  #   short strLen;           // The real size of the following array.
  #   char data[1];
  # } UserStrVarRec1;
  
  # typedef struct UserStrVarRec2 {
  #   char name[31+1];          // Name of the string variable.
  #   long strLen;            // Number of bytes in the string.
  #   char data[1];           // Start of string data. This is not a C string - no null terminator.
  # } UserStrVarRec2;         
  l=list()
  if(n<0) {return(NULL)}
  for(i in 1:n){
    #cat("seek=",seek(con),"\n")
    varname=.readNullTermString(con,32)
    #cat("seek=",seek(con),"\n")
    #print(varname)
    #print(version)
    strLen=readBin(con,n=1,size=version*2,what=integer(),endian=endian)
    #cat("strLen=",strLen,"\n")
    x=.readCharsWithEnc(con,strLen,encoding=ifelse(IgorPlatform=='windows','WINDOWS-1252','macintosh'))
    if(varname!=""){
      l[[varname]]=x
    }
  }
  l
}

# keep.source FALSE is a recent addition
if(R.version$major>2) {
  .myparse<-function(text) parse(text=text, keep.source=FALSE) 
} else {
  .myparse<-function(text) parse(text=text)
}

.ReadIgorBinary.V2<-function(con,Verbose=FALSE,ReturnTimeSeries=NULL,endian=NULL,HeaderOnly=FALSE){
  myread=function(what="integer",size=4,...) readBin(con,endian=endian,what=what,size=size,...)
  # File pointer should be positioned at the start of the header
  # this should be 2 bytes into the wave data 
  # (ie after endian and version bytes).  Store that position:
  startPos=seek(con)

  # Read binary header 
  BinHeader2=list()
  BinHeader2$wfmSize=myread()
  BinHeader2$noteSize=myread(); myread()
  BinHeader2$checksum=myread(size=2)

  if(Verbose) print("Hello!")
  if(Verbose) print(BinHeader2)
  if(Verbose) print(BinHeader2)
  # Read WaveHeader
  seek(con,where=startPos+16-2) # is this necessary?
  WaveHeader2=list()
  WaveHeader2$type=myread(what="raw",size=1,n=2)
  myread()
  # The platform default is utf-8, but some mac or windows-1252 chars are invalid in this
  # encoding (e.g. mu) so read as mac and convert later to windows=1252
  defaultEncoding="macintosh"
  WaveHeader2$WaveName=.readNullTermString(con,18+2,encoding=defaultEncoding)
  myread(n=2) # Skip 8 bytes
  WaveHeader2$dataUnits=.readNullTermString(con,3+1,encoding=defaultEncoding)
  WaveHeader2$xUnits=.readNullTermString(con,3+1,encoding=defaultEncoding)
  WaveHeader2$npts=myread()
  myread(size=2) # skip aModified
  WaveHeader2$hsA=myread(what="double",size=8)
  WaveHeader2$hsB=myread(what="double",size=8)
  myread()
  WaveHeader2$fsValid=myread(size=2)!=0
  WaveHeader2$topFullScale=myread(what="double",size=8)
  WaveHeader2$botFullScale=myread(what="double",size=8)
  myread(size=1,n=10)
  WaveHeader2$CreationDate=.readIgorDate(con,endian)
  WaveHeader2$platform=myread(size=1,signed=FALSE)  
  myread(size=1)
  WaveHeader2$modDate=.readIgorDate(con,endian)
  myread()
  
  # reencode character fields
  # if(WaveHeader2$platform==1 || (WaveHeader2$platform==0 && endian=="big")){
  if(WaveHeader2$platform==1 || (WaveHeader2$platform==0)){
    encoding="macintosh"
  } else {
    encoding="WINDOWS-1252"
  }
  if(Verbose) print(paste("encoding is:", encoding,"\n"))
  charfields=sapply(WaveHeader2,is.character)
  WaveHeader2[charfields]=lapply(WaveHeader2[charfields],iconv,from=encoding,to="")
  
  WaveTypeInfo=.DetermineIgorWaveType(WaveHeader2,endian=endian)
  if(Verbose) cat("signed=",(WaveTypeInfo$signAdjustment==0),"\n")
  
  if(HeaderOnly) {
    x=NA; attr(x,"WaveHeader")=WaveHeader2
    return(x)
  }
  # Note that only unsigned 16 bit data can be read by readBin
  WaveData=myread( what=WaveTypeInfo$what,size=WaveTypeInfo$size,n=WaveHeader2$npts,
    signed=(WaveTypeInfo$signAdjustment==0))
  # Handle adjustment for unsigned integer data
  if(WaveTypeInfo$signAdjustment!=0  && WaveTypeInfo$size>2){
    WaveData=.ConvertIntToUInt(WaveData,WaveTypeInfo$signAdjustment)
  }
  
  # Finish up
  attr(WaveData,"dataUnits")=WaveHeader2$dataUnits
  attr(WaveData,"dimUnits")=WaveHeader2$dimUnits[WaveHeader2$nDim>0]

  if(BinHeader2$noteSize>0) {
    #attr(WaveData,"Note")=.readCharsWithEnc(con,BinHeader2$noteSize,encoding)
  }
  attr(WaveData,"WaveHeader")=WaveHeader2
  attr(WaveData,"BinHeader")=BinHeader2
  attr(WaveData,"start")=attr(WaveData,"WaveHeader")$hsB
  attr(WaveData,"deltat")=attr(WaveData,"WaveHeader")$hsA
  WaveData
}

.ReadIgorBinary.V5<-function(con,Verbose=FALSE,ReturnTimeSeries=NULL,endian=NULL,HeaderOnly=FALSE){
  # File pointer should be positioned at the start of the header
  # this should be 2 bytes into the wave data 
  # (ie after endian and version bytes).  Store that position:
  startPos=seek(con)
  
  # Read the BinHeader5 (64 bytes)
  # 1 byte  char
  # 2 bytes short
  # 4 bytes int, long, float, Handle, any kind of pointer
  # 8 bytes double
  MAXDIMS=4

# typedef struct BinHeader5 {
#   short version;            // Version number for backwards compatibility.
#   short checksum;           // Checksum over this header and the wave header.
#   long wfmSize;           // The size of the WaveHeader5 data structure plus the wave data.
#   long formulaSize;         // The size of the dependency formula, if any.
#   long noteSize;            // The size of the note text.
#   long dataEUnitsSize;        // The size of optional extended data units.
#   long dimEUnitsSize[MAXDIMS];    // The size of optional extended dimension units.
#   long dimLabelsSize[MAXDIMS];    // The size of optional dimension labels.
#   long sIndicesSize;          // The size of string indicies if this is a text wave.
#   long optionsSize1;          // Reserved. Write zero. Ignore on read.
#   long optionsSize2;          // Reserved. Write zero. Ignore on read.
# } BinHeader5;

  BinHeader5Def=data.frame(name=I(c("checksum","wfmSize","formulaSize","noteSize","dataEUnitsSize",
      "dimEUnitsSize","dimLabelsSize","sIndicesSize","optionsSize1","optionsSize2")),
    size=c(2,rep(4,9)),what="integer",n=c(rep(1,5),rep(4,2),rep(1,3)))
  BinHeader5=list()
  for(i in seq(nrow(BinHeader5Def)))
    BinHeader5[[BinHeader5Def$name[i]]]=readBin(con,endian=endian,what=BinHeader5Def$what[i],size=BinHeader5Def$size[i],n=BinHeader5Def$n[i])
  if(Verbose) print(BinHeader5)
  
  # Read the WaveHeader5 (320 bytes)
  seek(con,where=startPos+64-2)
  WaveHeader5=list()
  myread=function(what="integer",size=4,...) readBin(con,endian=endian,what=what,size=size,...)
  
  # next WaveHeader5 pointer
  myread()
  WaveHeader5$creationDate=.readIgorDate(con,endian)
  WaveHeader5$modDate=.readIgorDate(con,endian)
  WaveHeader5$npts=myread()
  WaveHeader5$type=myread(what="raw",size=1,n=2)
  
  myread(size=1,n=10)
  WaveHeader5$WaveName=.readNullTermString(con,32)
  myread(n=2,size=4)
  WaveHeader5$nDim=myread(n=MAXDIMS)
  #highestDim=max(which(WaveHeader5$nDim>0))
  dims=WaveHeader5$nDim[WaveHeader5$nDim>0]
  nDims=length(dims)
  #if(any(WaveHeader5$nDim[-1]>0)) warning(paste("Ignoring additional dimensions for wave with dims",WaveHeader5$nDim))

  WaveHeader5$sfA=myread(n=MAXDIMS,what="double",size=8)
  WaveHeader5$sfB=myread(n=MAXDIMS,what="double",size=8)  
  # Units
  WaveHeader5$dataUnits=.readNullTermString(con,3+1)
  WaveHeader5$dimUnits=replicate(MAXDIMS,.readNullTermString(con,3+1))
  
  # Platform
  # skip to correct location
  seek(con,2+2+8+8+4*(MAXDIMS*2+2),origin="current")
  # unsigned char platform;
  # // 0=unspecified, 1=kMacPlatform, 2=kWinPlatform

  WaveHeader5$platform=myread(size=1,signed=FALSE)
  if(WaveHeader5$platform==1 || (WaveHeader5$platform==0 && endian=="big")){
    encoding="macintosh"
  } else {
    encoding="WINDOWS-1252"
  }
  # reencode character fields
  charfields=sapply(WaveHeader5,is.character)
  WaveHeader5[charfields]=lapply(WaveHeader5[charfields],iconv,from=encoding,to="")

  # Read the wave data 
  seek(con,startPos+64+320-2)
  WaveTypeInfo=.DetermineIgorWaveType(WaveHeader5,endian=endian)
  if(Verbose) print(WaveHeader5)
  if(Verbose) cat("data position = ",seek(con),"\n")

  # Have the option to return the header info alone - as a sort of
  # preview
  if(HeaderOnly) {
    x=NA; attr(x,"WaveHeader")=WaveHeader5
    return(x)
  }

  if(WaveTypeInfo$what=="character"){
    # gist is we are going to have a char vector containing npts items;
    # each item is going to be nchars longs, where nchars is a vector
    # generated by reading npts longs from right after the end
    # of the txt wave.
    
    dataStartPos=seek(con) #store current location
    # skip to the end of the wave data
    seek(con,sum(unlist(BinHeader5[2:7]))-320,"current")
    if(Verbose) cat("Reading offsets at:",seek(con),"\n")
    offsets=myread(n=WaveHeader5$npts)
    if(Verbose) cat("offets:",offsets,"\n")
    nchars=diff(c(0,offsets))
    if(sum(nchars)>BinHeader5$wfmSize  || any(nchars<0) ) {
      warning(paste("Unable to read text wave",WaveHeader5$WaveName))
      return (NULL)
    }
    # return to start of data
    seek(con,dataStartPos)
#     if(T) WaveData="test"
#     else{
    WaveData=readChar(con,nchars)
    # convert from appropriate text encoding to R default
    if(WaveHeader5$platform==1 || (WaveHeader5$platform==0 && endian=="big")){
      if(Verbose) cat("Converting text wave from macintosh encoding to R default\n")
      WaveData=iconv(WaveData,from="macintosh",to="")
    } else {
      if(Verbose) cat("Converting text wave from WINDOWS-1252 encoding to R default\n")
      WaveData=iconv(WaveData,from="WINDOWS-1252",to="")
    }
#     }
  } else {
    # Note that only unsigned 16 bit data can be read by readBin
    WaveData=myread( what=WaveTypeInfo$what,size=WaveTypeInfo$size,n=WaveHeader5$npts,
      signed=(WaveTypeInfo$signAdjustment==0))
    # Handle adjustment for unsigned integer data
    if(WaveTypeInfo$signAdjustment!=0  && WaveTypeInfo$size>2){
      # nb must convert int to numeric because R does not handle ints >
      # 2^31-1
      WaveData=.ConvertIntToUInt(WaveData,WaveTypeInfo$signAdjustment)
    }
  }
  # Set units 
  attr(WaveData,"dataUnits")=WaveHeader5$dataUnits
  attr(WaveData,"dimUnits")=WaveHeader5$dimUnits
  # Read anything else
  if(BinHeader5$formulaSize>0) {
    attr(WaveData,"Dependency Formula")= .readNullTermString(con,BinHeader5$formulaSize,encoding)
  }
  if(BinHeader5$noteSize>0) {
    attr(WaveData,"Note")=.readCharsWithEnc(con,BinHeader5$noteSize,encoding)
  }
  
  # ignore dataEUnitsSize
  if(BinHeader5$dataEUnitsSize>0)
    readBin(con,what=raw(), n = BinHeader5$dataEUnitsSize)
  
  if(any(BinHeader5$dimEUnitsSize>0))
    readBin(con,what=raw(), n = sum(BinHeader5$dimEUnitsSize))
  
  # Trim units down to active dimensions
  attr(WaveData,"dimUnits")=attr(WaveData,"dimUnits")[WaveHeader5$nDim>0]

  if(any(BinHeader5$dimLabelsSize>0))
    readBin(con,what=raw(), n = sum(BinHeader5$dimLabelsSize))
  
  # Finish up
  # Re-dimension
  if(nDims>1) dim(WaveData)=dims
  attr(WaveData,"WaveHeader")=WaveHeader5
  attr(WaveData,"BinHeader")=BinHeader5
  return (WaveData)
}

#' Convert an Igor wave (wave list) loaded by read.ibw into an R time series
#'
#' Where there are multiple waves, they are assumed to be of compatible lengths
#' so that they can be joined together by \code{cbind}.
#'
#' @param WaveData, a wave or list of waves
#' @param ReturnOriginalDataOnError If we can't make a time series, return
#'   return original data (default TRUE)
#' @return a time series or multi time series (\code{\link[stats]{ts}},
#'   \code{mts})
#' @author jefferis
#' @export
#' @importFrom stats ts
#' @family igor-io
WaveToTimeSeries<-function(WaveData,ReturnOriginalDataOnError=TRUE){
  if(is.list(WaveData)) {
    # process separate waves into multi wave time series
    l=lapply(WaveData,WaveToTimeSeries)
    return(do.call(cbind,l))
  }
  tspw = tsp.igorwave(WaveData)
  res=try(ts(WaveData,start=tspw[1],frequency=tspw[3]),silent=TRUE)
  if(inherits(res,'try-error')){
    warning(res)
    WaveData
  } else res
}

#' Return tsp attribute of Igor wave (start, end, frequency)
#' 
#' Note that end = (npts-1) * deltat
#' @param wave Igor wave loaded by \code{read.ibw} or\code{read.pxp}
#' @return numeric vector with elements start, end, frequency
#' @author jefferis
#' @seealso \code{\link[stats]{tsp}}
#' @export
tsp.igorwave<-function(wave){
  bh=attr(wave,"BinHeader")
  if(is.null(bh)) stop("Can't find BinHeader")
  wh=attr(wave,"WaveHeader")
  if(is.null(wh)) stop("Can't find WaveHeader")
  if(bh$version==2){
    # WaveHeader2
    start=wh$hsB
    deltat=wh$hsA
    npts=wh$npts
  } else if(bh$version==5){
    # WaveHeader5, can be multi-dimensional
    start=wh$sfB[1]
    deltat=wh$sfA[1]
    npts=wh$nDim[1]
  } else {
    stop(paste("Unsupported Igor Wave Version Number,",bh$version))
  }
  return(c(start=start,end=deltat*(npts-1),frequency=1/deltat))
}
jefferis/IgorR documentation built on Aug. 25, 2024, 9:37 p.m.