Nothing
###########################################################################/**
# @RdocDefault writeMat
#
# @title "Writes a MAT file structure"
#
# \description{
# This function takes the given variables (\code{...}) and places them in a
# MAT file structure, which is then written to a binary connection.
# }
#
# @synopsis
#
# \arguments{
# \item{con}{Binary @connection to which the MAT file structure should be
# written to. A string is interpreted as filename, which then will be
# opened (and closed afterwards).}
# \item{...}{\emph{Named} variables to be written where the names
# must be unique.}
# \item{fixNames}{If @TRUE, periods within names of R variables
# and fields are converted to underscores.}
# \item{matVersion}{A @character string specifying what MAT file format
# version to be written to the connection. If \code{"5"}, a MAT v5 file
# structure is written. No other formats are currently supported.}
# \item{onWrite}{Function to be called just before starting to write to
# connection. Since the MAT file structure does not contain information
# about the total size of the structure this argument makes it possible
# to first write the structure size (in bytes) to the connection.}
# \item{verbose}{Either a @logical, a @numeric, or a @see "R.utils::Verbose"
# object specifying how much verbose/debug information is written to
# standard output. If a Verbose object, how detailed the information is
# is specified by the threshold level of the object. If a numeric, the
# value is used to set the threshold of a new Verbose object. If @TRUE,
# the threshold is set to -1 (minimal). If @FALSE, no output is written
# (and neither is the \link[R.utils:R.utils-package]{R.utils} package required).
# }
#
# Note that \code{...} must \emph{not} contain variables with names equal
# to the arguments \code{matVersion} and \code{onWrite}, which were chosen
# because we believe they are quite unique to this write method.
# }
#
# \value{
# Returns (invisibly) the number of bytes written. Any bytes written by
# any onWrite function are \emph{not} included in this count.
# }
#
# \section{Limitations}{
# Currently only the uncompressed MAT version 5 file format [6] is
# supported, that is, compressed MAT files cannot be written (only read).
#
# Moreover, the maximum variable size supported by the MAT version 5
# file format is 2^31 bytes [6]. In R, this limitation translates to
# 2^31-1 bytes, which corresponds to for instance an integer object
# with 536870912 elements or double object with 268435456 elements.
# }
#
# \section{Details on onWrite()}{
# If specified, the \code{onWrite()} function is called before the
# data is written to the connection. This function must take a @list
# argument as the first argument. This will hold the element \code{con}
# which is the opened @connection to be written to.
# It will also hold the element \code{length}, which specified the
# number of bytes to be written. See example for an illustration.
#
# \emph{Note}, in order to provide the number of bytes before actually
# writing the data, a two-pass procedure has to be taken, where the
# first pass is imitating a complete writing without writing anything
# to the connection but only counting the total number of bytes. Then
# in the second pass, after calling \code{onWrite()}, the data is written.
# }
#
# \examples{@include "../incl/writeMat.R"
#
# \dontrun{
# # When writing to a stream connection the receiver needs to know on
# # beforehand how many bytes are available. This can be done by using
# # the 'onWrite' argument.
# onWrite <- function(x)
# writeBin(x$length, con = x$con, size = 4, endian = "little")
# writeMat(con, A = A, B = B, onWrite = onWrite)
# }
# }
#
# @author
#
# \references{
# [1] The MathWorks Inc., \emph{MATLAB - MAT-File Format, version 5}, June 1999.\cr
# [2] The MathWorks Inc., \emph{MATLAB - Application Program Interface Guide, version 5}, 1998.\cr
# [3] The MathWorks Inc., \emph{MATLAB - MAT-File Format, version 7}, September 2009.\cr
# [4] The MathWorks Inc., \emph{MATLAB - MAT-File Format, version R2012a}, September 2012.\cr
# [5] The MathWorks Inc., \emph{MATLAB - MAT-File Format, version R2015b}, September 2015.\cr
# [6] The MathWorks Inc., \emph{MATLAB - MAT-File Versions}, December 2015.
# \url{https://www.mathworks.com/help/matlab/import_export/mat-file-versions.html}\cr
# }
#
# \seealso{
# @see "readMat".
# }
#
# @keyword file
# @keyword IO
#*/###########################################################################
setMethodS3("writeMat", "default", function(con, ..., fixNames = TRUE, matVersion = "5", onWrite = NULL, verbose = FALSE) {
#===========================================================================
# General functions to write MAT v5 files (and later MAT v4 files). BEGIN
#===========================================================================
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The MAT file format (<= 7) only supports 2^31 bytes per variable [6]
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
MAX_WRITABLE_BYTES <- min(2^31, .Machine$integer.max)
maxBytesError <- function(nbrOfBytes, size) {
throw(sprintf("MAT file format error: Object is too large to be written to a MAT v%s file, which only supports variables of maximum 2^31 bytes. The object that cannot be written has %.0f elements each of %d bytes totalling %.0f bytes: %s", matVersion, nbrOfBytes/size, size, nbrOfBytes, sQuote(conDescription)))
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Function to make a variable name into a safe MATLAB variable name.
# For instance, periods ('.') are replaced by underscores ('_').
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (fixNames) {
asSafeMatlabName <- function(name) gsub(".", "_", name, fixed = TRUE)
} else {
asSafeMatlabName <- function(name) name
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Function to write (or just count) an object to a connection.
#
# This function will also keep track of the actual number of bytes written.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
writeBinMat <- function(con, object, size, signed = TRUE, endian = "little") {
nbrOfBytes <- size*length(object)
## Is the number of bytes supported by the MAT file format?
if (nbrOfBytes > MAX_WRITABLE_BYTES) maxBytesError(nbrOfBytes, size)
if (!is.null(con)) {
writeBin(object, con = con, size = size, endian = endian)
}
nbrOfBytes
} # writeBinMat()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Function to write (or just count) a character string to a connection.
#
# This function will also keep track of the actual number of bytes written.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
writeCharMat <- function(con, object, nchars = nchar(object)) {
if (!is.null(con)) {
writeChar(object, con = con, nchars = nchars, eos = NULL)
### verbose && printf(verbose, "writeCharMat(<length = %d>, nchars = %d)\n", length(object), nchars)
}
nchars
} # writeCharMat()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# ASCII is the 8-bit ASCII table with ASCII characters from 0-255.
#
# Extracted from the R.oo package. Also inside readMat().
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ASCII <- c(
"", "\001", "\002", "\003", "\004", "\005", "\006", "\007", # 000-007
"\010", "\011", "\012", "\013", "\014", "\015", "\016", "\017", # 010-017
"\020", "\021", "\022", "\023", "\024", "\025", "\026", "\027", # 020-027
"\030", "\031", "\032", "\033", "\034", "\035", "\036", "\037", # 030-037
"\040", "\041", "\042", "\043", "\044", "\045", "\046", "\047", # 040-047
"\050", "\051", "\052", "\053", "\054", "\055", "\056", "\057", # 050-057
"\060", "\061", "\062", "\063", "\064", "\065", "\066", "\067", # 060-067
"\070", "\071", "\072", "\073", "\074", "\075", "\076", "\077", # 070-077
"\100", "\101", "\102", "\103", "\104", "\105", "\106", "\107", # 100-107
"\110", "\111", "\112", "\113", "\114", "\115", "\116", "\117", # 110-117
"\120", "\121", "\122", "\123", "\124", "\125", "\126", "\127", # 120-127
"\130", "\131", "\132", "\133", "\134", "\135", "\136", "\137", # 130-137
"\140", "\141", "\142", "\143", "\144", "\145", "\146", "\147", # 140-147
"\150", "\151", "\152", "\153", "\154", "\155", "\156", "\157", # 150-157
"\160", "\161", "\162", "\163", "\164", "\165", "\166", "\167", # 160-167
"\170", "\171", "\172", "\173", "\174", "\175", "\176", "\177", # 170-177
"\200", "\201", "\202", "\203", "\204", "\205", "\206", "\207", # 200-207
"\210", "\211", "\212", "\213", "\214", "\215", "\216", "\217", # 210-217
"\220", "\221", "\222", "\223", "\224", "\225", "\226", "\227", # 220-227
"\230", "\231", "\232", "\233", "\234", "\235", "\236", "\237", # 230-237
"\240", "\241", "\242", "\243", "\244", "\245", "\246", "\247", # 240-247
"\250", "\251", "\252", "\253", "\254", "\255", "\256", "\257", # 250-257
"\260", "\261", "\262", "\263", "\264", "\265", "\266", "\267", # 260-267
"\270", "\271", "\272", "\273", "\274", "\275", "\276", "\277", # 270-277
"\300", "\301", "\302", "\303", "\304", "\305", "\306", "\307", # 300-307
"\310", "\311", "\312", "\313", "\314", "\315", "\316", "\317", # 310-317
"\320", "\321", "\322", "\323", "\324", "\325", "\326", "\327", # 320-327
"\330", "\331", "\332", "\333", "\334", "\335", "\336", "\337", # 330-337
"\340", "\341", "\342", "\343", "\344", "\345", "\346", "\347", # 340-347
"\350", "\351", "\352", "\353", "\354", "\355", "\356", "\357", # 350-357
"\360", "\361", "\362", "\363", "\364", "\365", "\366", "\367", # 360-367
"\370", "\371", "\372", "\373", "\374", "\375", "\376", "\377" # 370-377
)
# We removed ASCII 0x00, because it represents an empty string in
# R v2.7.0 (and maybe some earlier version) and in R v2.8.0 we will get
# a warning. However, for backward compatibility we will still use it
# for version prior to R v2.7.0. See also email from Brian Ripley
# on 2008-04-23 on this problem.
if (getRversion() < "2.7.0") ASCII[1] <- eval(parse(text = "\"\\000\""))
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Function to convert a vector of ASCII chars into a vector of integers.
#
# Extracted from the R.oo package.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
charToInt <- function(ch) {
match(ch, ASCII) - 1
}
#===========================================================================
# General functions to write MAT v5 files (and later MAT v4 files). END
#===========================================================================
#===========================================================================
# MAT v5 specific BEGIN
#===========================================================================
writeMat5 <- function(con, objects, onWrite = onWrite, format = "matlab") {
writeHeader <- function(con) {
verbose && enter(verbose, "writeHeader()")
# Write 124 bytes header description
rVersion <- paste(c(R.Version()$major, R.Version()$minor), collapse = ".")
description <- paste("MATLAB 5.0 MAT-file, Platform: ", .Platform$OS.type, ", Software: R v", rVersion, ", Created on: ", date(), sep = "")
bfr <- unlist(strsplit(description, split = "", fixed = TRUE), use.names = FALSE)
bfr <- charToInt(bfr)
bfr <- c(bfr, rep(32, max(124-length(bfr), 0)))
if (length(bfr) > 124) bfr <- bfr[1:124]
nbrOfBytes <- writeBinMat(con, as.integer(bfr), size = 1)
# Write version
version <- 256L ## version == 0x0100 [6]
nbrOfBytes <- nbrOfBytes + writeBinMat(con, version, size = 2, endian = "little")
# Write endian information
nbrOfBytes <- nbrOfBytes + writeCharMat(con, "IM")
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeHeader()
writeDataElement <- function(con, object, nbrOfBytes = NA) {
# 1 2 3 4 5 6 7 8
# +----+----+----+----+----+----+----+----+
# | Data type | Number of Bytes | Tag
# +---------------------------------------+
# | |
# | Variable size | Data
# | |
# +---------------------------------------+
verbose && enter(verbose, "writeDataElement()")
verbose && str(verbose, object)
writeTag <- function(dataType, nbrOfBytes, compressed = FALSE) {
## verbose && enter(verbose, sprintf("writeTag(%s, nbrOfBytes = %d, compressed = %s)", dataType, nbrOfBytes, compressed))
knownTypes <- c("miINT8" = 8, "miUINT8" = 8, "miINT16" = 16, "miUINT16" = 16, "miINT32" = 32, "miUINT32" = 32, "miSINGLE" = NA, NA, "miDOUBLE" = 64, NA, NA, "miINT64" = 64, "miUINT64" = 64, "miMATRIX" = NA)
type <- which(names(knownTypes) == dataType)
if (length(type) == 0)
stop("Unknown Data Element Tag type: ", dataType)
## Is the number of bytes supported by the MAT file format?
if (nbrOfBytes > MAX_WRITABLE_BYTES) maxBytesError(nbrOfBytes, knownTypes[type]/8)
nbrOfBytesTag <- nbrOfBytes
nbrOfBytes <- 0
if (compressed) {
bfr <- nbrOfBytesTag * 256^2 + type
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(bfr), size = 4, endian = "little")
} else {
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(type), size = 4, endian = "little")
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(nbrOfBytesTag), size = 4, endian = "little")
}
# Sanity check
if(nbrOfBytes != 4 && nbrOfBytes != 8) {
stop("Internal error: Number of bytes written by writeTag() is not 4 or 8: ", nbrOfBytes)
}
### verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeTag()
writePadding <- function(padding, ...) {
if (padding > 0) {
### verbose && enter(verbose, "Padding with ", padding, " zeros")
writeBinMat(con, rep(0L, times = padding), size = 1)
### verbose && exit(verbose)
}
padding
} # writePadding()
writeArrayFlags <- function(class, complex = FALSE, global = FALSE, logical = FALSE) {
verbose && enter(verbose, "writeArrayFlags(): ", class)
knownClasses <- c("mxCELL_CLASS" = NA, "mxSTRUCT_CLASS" = NA, "mxOBJECT_CLASS" = NA, "mxCHAR_CLASS" = 8, "mxSPARSE_CLASS" = NA, "mxDOUBLE_CLASS" = NA, "mxSINGLE_CLASS" = NA, "mxINT8_CLASS" = 8, "mxUINT8_CLASS" = 8, "mxINT16_CLASS" = 16, "mxUINT16_CLASS" = 16, "mxINT32_CLASS" = 32, "mxUINT32_CLASS" = 32)
classID <- which(names(knownClasses) == class)
if (length(classID) == 0)
stop("Unknown tag type: ", class)
flags <- c(2^3*complex, 2^2*global, 2^1*logical, 0)
flags <- sum(flags)
# Array Flags [miUINT32]
tagSize <- writeTag(dataType = "miUINT32", nbrOfBytes = 8)
nbrOfBytes <- tagSize
bfr <- flags*256 + classID
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(bfr), size = 4, endian = "little")
# Undefined
nbrOfBytes <- nbrOfBytes + writeBinMat(con, 0L, size = 4)
verbose && exit(verbose)
# Return number of written bytes
nbrOfBytes
} # writeArrayFlags()
writeDimensionsArray <- function(dim = c(1, 1)) {
nbrOfDimensions <- length(dim)
nbrOfBytes <- nbrOfDimensions*4
verbose && enter(verbose, "writeDimensionsArray(): dim = c(", paste(dim, collapse = ", "), ")")
# Pad bytes?
padding <- 8 - ((nbrOfBytes-1) %% 8 + 1)
if (padding < 0) {
stop("Internal error: Negative padding: ", padding)
}
# Dimensions Array [miINT32]
tagSize <- writeTag(dataType = "miINT32", nbrOfBytes = nbrOfBytes)
nbrOfBytes <- tagSize
# Write the dimensions
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(dim), size = 4, signed = TRUE, endian = "little")
# Write padded bytes
nbrOfBytes <- nbrOfBytes + writePadding(padding)
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeDimensionsArray()
writeArrayName <- function(name) {
verbose && enter(verbose, "writeArrayName(): '", name, "'")
name <- asSafeMatlabName(name)
name <- unlist(strsplit(name, split = "", fixed = TRUE), use.names = FALSE)
name <- charToInt(name)
nbrOfBytes <- length(name)
# NOTE: Compression is not optional (as stated in [1]). /HB 020828
compressed <- (nbrOfBytes > 0 && nbrOfBytes <= 4)
# Pad bytes?
if (compressed) {
padding <- 4 - ((nbrOfBytes-1) %% 4 + 1)
} else {
padding <- 8 - ((nbrOfBytes-1) %% 8 + 1)
}
if (padding < 0) {
stop("Internal error: Negative padding: ", padding)
}
# Dimensions Array [miINT8]
tagSize <- writeTag(dataType = "miINT8", nbrOfBytes = nbrOfBytes, compressed = compressed)
nbrOfBytes <- tagSize
# Write characters
if (length(name) > 0) {
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(name), size = 1, endian = "little")
}
# Write padded bytes
nbrOfBytes <- nbrOfBytes + writePadding(padding)
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeArrayName()
writeNumericPart <- function(values) {
verbose && enter(verbose, "writeNumericPart(): ", length(values), " value(s).")
if (is.integer(values)) {
dataType <- "miINT32"
sizeOf <- 4
} else if (is.double(values)) {
dataType <- "miDOUBLE"
sizeOf <- 8
} else {
dataType <- "miDOUBLE"
sizeOf <- 8
}
values <- as.vector(values)
nbrOfBytes <- length(values) * sizeOf
# Pad bytes?
padding <- 8 - ((nbrOfBytes-1) %% 8 + 1)
if (padding < 0) {
stop("Internal error: Negative padding: ", padding)
}
# Numeric Part [Any of the numeric data types]
tagSize <- writeTag(dataType = dataType, nbrOfBytes = nbrOfBytes)
nbrOfBytes <- tagSize
# Write numeric values
nbrOfBytes <- nbrOfBytes + writeBinMat(con, values, size = sizeOf, endian = "little")
# Write padded bytes
nbrOfBytes <- nbrOfBytes + writePadding(padding)
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeNumericPart()
writeCharPart <- function(values) {
verbose && enter(verbose, "writeCharPart(): '", values, "'")
values <- unlist(strsplit(values, split = "", fixed = TRUE), use.names = FALSE)
values <- charToInt(values)
values <- as.vector(values)
sizeOf <- 2
nbrOfBytes <- length(values) * sizeOf
# Pad bytes?
padding <- 8 - ((nbrOfBytes-1) %% 8 + 1)
if (padding < 0) {
stop("Internal error: Negative padding: ", padding)
}
# NOTE: MATLAB is not following the tags fully! Characters
# can *not* be written as miINT8 here, since MATLAB
# will assume miUINT16 anyway. /HB 020828
# Character Part [miUINT16]
tagSize <- writeTag(dataType = "miUINT16", nbrOfBytes = nbrOfBytes)
nbrOfBytes <- tagSize
# Write characters
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(values), size = sizeOf)
# Write padded bytes
nbrOfBytes <- nbrOfBytes + writePadding(padding)
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeCharPart()
writeFieldNameLength <- function(maxLength = 32) {
verbose && enter(verbose, "writeFieldNameLength(): ", maxLength)
nbrOfBytes <- 4
# Pad bytes?
padding <- 4 - ((nbrOfBytes-1) %% 4 + 1)
if (padding < 0) {
stop("Internal error: Negative padding: ", padding)
}
# Field Name Length [miINT32]
tagSize <- writeTag(dataType = "miINT32", nbrOfBytes = 4, compressed = TRUE)
nbrOfBytes <- tagSize
# Write maxLength
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(maxLength), size = 4, endian = "little")
# Write padded bytes
nbrOfBytes <- nbrOfBytes + writePadding(padding)
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeFieldNameLength()
writeFieldNames <- function(fieldNames, maxLength = 32) {
verbose && enter(verbose, "writeFieldNames(): ", length(fieldNames), " names(s)")
verbose && cat(verbose, "Field names: ", hpaste(sQuote(fieldNames)))
# Field Names [miINT8]
nbrOfBytes <- length(fieldNames)*maxLength
tagSize <- writeTag(dataType = "miINT8", nbrOfBytes = nbrOfBytes)
nbrOfBytes <- tagSize
for (kk in seq_along(fieldNames)) {
name <- fieldNames[kk]
name <- asSafeMatlabName(name)
if (nchar(name) > maxLength-1)
stop("Too long field name: ", name)
bfr <- unlist(strsplit(name, split = "", fixed = TRUE), use.names = FALSE)
bfr <- charToInt(bfr)
# Append trailing '\0'
bfr <- c(bfr, 0)
# Pad with '\0':s
bfr <- c(bfr, rep(0, max(0, maxLength-length(bfr))))
nbrOfBytes <- nbrOfBytes + writeBinMat(con, as.integer(bfr), size = 1)
}
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeFieldNames()
writeNumericArray <- function(name, data) {
verbose && enter(verbose, "writeNumericArray(): ", name)
if (is.integer(data)) {
class <- "mxINT32_CLASS"
sizeOf <- 4
} else if (is.double(data)) {
class <- "mxDOUBLE_CLASS"
sizeOf <- 8
} else if (is.complex(data)) {
class <- "mxDOUBLE_CLASS"
sizeOf <- 8
} else {
class <- "mxDOUBLE_CLASS"
sizeOf <- 8
}
complex <- is.complex(data)
global <- FALSE
logical <- is.logical(data)
# str(list(name, class, complex, global, logical, data))
nbrOfBytes <- writeArrayFlags(class = class, complex = complex, global = global, logical = logical)
nbrOfBytes <- nbrOfBytes + writeDimensionsArray(dim = dim(data))
nbrOfBytes <- nbrOfBytes + writeArrayName(name = name)
if (is.complex(data)) {
nbrOfBytes <- nbrOfBytes + writeNumericPart(Re(data))
nbrOfBytes <- nbrOfBytes + writeNumericPart(Im(data))
} else {
nbrOfBytes <- nbrOfBytes + writeNumericPart(data)
}
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeNumericArray()
writeCharArray <- function(name, data) {
verbose && enter(verbose, "writeCharArray(): '", data, "'")
if (length(data) > 1)
stop("writeCharArray() only supports one string at the time.")
nbrOfBytes <- writeArrayFlags(class = "mxCHAR_CLASS", complex = FALSE, global = FALSE, logical = FALSE)
nbrOfBytes <- nbrOfBytes + writeDimensionsArray(dim = c(1, nchar(data)))
nbrOfBytes <- nbrOfBytes + writeArrayName(name = name)
nbrOfBytes <- nbrOfBytes + writeCharPart(data)
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeCharArray()
writeStructure <- function(name, structure) {
verbose && enter(verbose, sprintf("writeStructure(name = %s)", sQuote(name)))
nbrOfBytes <- writeArrayFlags(class = "mxSTRUCT_CLASS", complex = FALSE, global = FALSE, logical = FALSE)
nbrOfBytes <- nbrOfBytes + writeDimensionsArray(dim = c(1, 1))
nbrOfBytes <- nbrOfBytes + writeArrayName(name = name)
nbrOfBytes <- nbrOfBytes + writeFieldNameLength(maxLength = 32)
nbrOfBytes <- nbrOfBytes + writeFieldNames(names(structure), maxLength = 32)
for (kk in seq_along(structure)) {
field <- structure[[kk]]
verbose && printf(verbose, "Field %s:\n", sQuote(names(structure)[kk]))
## FIXME: The following turns vectors and arrays into
## one-column matrices, cf. Issue #30. /HB 2015-12-29
field <- as.matrix(field)
field <- list(field)
## Should we add? names(field) <- names(structure)[kk]
nbrOfBytes <- nbrOfBytes + writeDataElement(con, field)
}
verbose && exit(verbose)
# Return number of bytes written
nbrOfBytes
} # writeStructure()
writeCellArrayDataElement <- function(name, cells) {
complex <- is.complex(cells)
global <- FALSE
logical <- is.logical(cells)
nbrOfBytes <- writeArrayFlags(class = "mxCELL_CLASS", complex = complex, global = global, logical = logical)
nbrOfBytes <- nbrOfBytes + writeDimensionsArray(dim = dim(cells))
nbrOfBytes <- nbrOfBytes + writeArrayName(name = name)
for (kk in seq_along(cells)) {
cell <- cells[kk]
nbrOfBytes <- nbrOfBytes + writeDataElement(con, cell)
}
# Return number of bytes written
nbrOfBytes
} # writeCellArrayDataElement()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# writeDataElement() main code
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Count only?
if (is.na(nbrOfBytes)) {
verbose && enter(verbose, "Counting only")
nbrOfBytes <- writeDataElement(con = NULL, object = object, nbrOfBytes = 0)
tagSize <- attr(nbrOfBytes, "tagSize")
nbrOfBytes <- nbrOfBytes - tagSize
verbose && cat(verbose, "nbrOfBytes = ", nbrOfBytes)
verbose && exit(verbose)
}
# Get the data element (and its name)
name <- names(object)
if (is.null(name))
name <- ""
# stop("Name of object is missing.")
value <- object[[1]]
if (is.null(value)) {
value <- as.array(integer(0))
}
# Get the data type
dataType <- "miMATRIX"
if (is.integer(value)) {
dataType <- "miINT32"
sizeOf <- 4
}
if (is.double(value)) {
dataType <- "miDOUBLE"
sizeOf <- 8
}
if (is.complex(value)) {
sizeOf <- 2*8
}
if (is.character(value)) {
dataType <- "miMATRIX"
sizeOf <- 1
}
if (is.list(value)) {
dataType <- "miMATRIX"
sizeOf <- 1
}
if (!is.null(dim(value))) {
dataType <- "miMATRIX"
}
# # Get the number of bytes
# nbrOfBytes <- length(value) * sizeOf
# "For data elements representing "MATLAB arrays", (type miMATRIX),
# the value of the Number Of Bytes field includes padding bytes in
# the total. For all other MAT-file data types, the value of the
# Number of Bytes field does *not* include padding bytes."
if (dataType == "miMATRIX") {
padding <- 8 - ((nbrOfBytes-1) %% 8 + 1)
if (padding < 0) {
stop("Internal error: Negative padding: ", padding)
}
if (padding > 0) {
nbrOfBytes <- nbrOfBytes + padding
}
}
# Write the Data Element Tag
tagSize <- writeTag(dataType = dataType, nbrOfBytes = nbrOfBytes)
nbrOfBytes <- tagSize
verbose && cat(verbose, "Data type: ", sQuote(mode(value)))
if (is.numeric(value) || is.complex(value) || is.logical(value)) {
if (is.logical(value)) {
dim <- dim(value)
value <- as.integer(value)
dim(value) <- dim
}
if (is.null(dim(value)))
value <- as.matrix(value)
nbrOfBytes <- nbrOfBytes + writeNumericArray(name = name, data = value)
} else if (is.character(value)) {
if (length(value) == 1) {
nbrOfBytes <- nbrOfBytes + writeCharArray(name = name, data = value)
} else {
value <- as.matrix(value)
nbrOfBytes <- nbrOfBytes + writeCellArrayDataElement(name = name, cells = value)
}
} else if (is.list(value)) {
nbrOfBytes <- nbrOfBytes + writeStructure(name = name, structure = value)
} else {
stop("NON-SUPPORTED DATA TYPE: Do not know how to write objects of this type: ", sQuote(mode(value)))
}
verbose && exit(verbose)
attr(nbrOfBytes, "tagSize") <- tagSize
# Return number of bytes written
nbrOfBytes
} # writeDataElement()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# "Main program"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'verbose':
if (inherits(verbose, "Verbose")) {
} else if (is.numeric(verbose)) {
verbose <<- Verbose(threshold = verbose)
} else {
verbose <<- Verbose(threshold = -as.integer(as.logical(verbose)))
}
# Since writeMat5() is wrapped inside the writeMat() function, we can
# assume that 'con' really is a connection and 'objects' really is a
# list.
# If format == "matlab" (default), all scalars and vectors are
# written as arrays, which is the only format MATLAB reads.
# Otherwise, they are written as is, which the MAT v5 format indeed
# supports. However, since this is probably not going to be needed
# by anyone, we have decided to not put the 'format' argument in the
# main function readMat(), but if ever need, just add it there too.
if (!is.null(format) && format == "matlab") {
for (kk in seq_along(objects)) {
object <- objects[[kk]]
if (!is.null(object)) {
if (!is.array(object) && !is.list(object)) {
object <- as.array(object)
}
objects[[kk]] <- object
}
}
}
writeAll <- function(con, objects) {
nbrOfBytes <- writeHeader(con)
verbose && enter(verbose, "writeAll()")
for (kk in seq_along(objects)) {
verbose && enter(verbose, sprintf("Writing element #%d of %d", kk, length(objects)))
object <- objects[kk] # NOT [[kk]], has to be a list!
verbose && cat(verbose, "Element name: ", sQuote(names(object)))
verbose && str(verbose, object)
nbrOfBytesKK <- writeDataElement(con, object)
verbose && cat(verbose, "Number of bytes written: ", nbrOfBytesKK)
nbrOfBytes <- nbrOfBytes + nbrOfBytesKK
verbose && exit(verbose)
}
verbose && exit(verbose)
# Return bytes written
nbrOfBytes
} # writeAll()
# When writing to streams, that is, to other connections than files,
# we have to "send over" the number of bytes first to inform the
# receiver how big the succeeding streamed MAT object is.
# In order to accomplish this, we first have to count the number of
# bytes needed and then we send the stream. Here we do this by
# a two-pass procedure: 1) count Number of Bytes of written while
# writing to "void", and 2) redo the same with real writing.
# Count size of MAT structure in bytes and pass to onWrite()?
if (!is.null(onWrite)) {
nbrOfBytes <- writeAll(con = NULL, objects)
onWrite(list(con = con, length = nbrOfBytes))
}
# Write MAT structure to connection
nbrOfBytes <- writeAll(con, objects)
invisible(nbrOfBytes)
} # writeMat5()
#===========================================================================
# MAT v5 specific END
#===========================================================================
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# "Main program"
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Make sure arguments are named, otherwise name them automagically
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Wrap up the objects to be written in a list structure.
args <- list(...)
# Assert that objects to be written by writeMat() are named
names <- names(args)
if (is.null(names) || any(names == "")) {
throw("Detected non-named objects. Non-named objects will not be available in MATLAB if completed. Use writeMat(..., x = a, y = y) and not writeMat(..., x = a, y): ", deparse(sys.call()))
}
if (any(duplicated(names))) {
throw("Detected objects with duplicated names (", paste(names[duplicated(names)], collapse = ", "), "). Only the last occurance of each duplicated object will be available in MATLAB if completed: ", deparse(sys.call()))
}
### if (is.null(names)) {
### names <- rep("", times = length(args))
### }
###
### # Detect non-named arguments
### notNamed <- (nchar(names) == 0)
### idxs <- which(notNamed)
### if (length(idxs) > 0) {
### # Inferring the names from the passed objects
### names2 <- as.character(substitute(args))
### names2 <- names2[idxs]
###
### # Check which are syntactically valid R names,
### # e.g. not just writeMat(..., 1:10).
### isValid <- sapply(names2, FUN = function(name) {
### expr <- parse(text = sprintf("%s <- NULL", name))
### res <- tryCatch({ eval(expr); TRUE }, error = function(ex) { FALSE })
### res
### })
###
### # Fix invalid names
### if (any(!isValid)) {
### names3 <- names2[!isValid]
### names3 <- sprintf("unnamed%d", seq_along(names3))
### names2[!isValid] <- names3
### }
###
### # Add the inferred names
### names[idxs] <- names2
### names(args) <- names
### } # if (length(idxs) > 0)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Setup the connection to be written to
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## Close connection when exiting?
close <- FALSE
on.exit({ if (close) close(con) })
## Description of the output file/connection
conDescription <- NA_character_
## Writing to temporary file?
pathnameT <- NULL
if (inherits(con, "connection")) {
if (!isOpen(con)) {
open(con, open = "wb")
close <- TRUE
}
conDescription <- as.character(summary(con)$description)
} else {
# For all other types of values of 'con' make it into a character string.
# This will for instance also make it possible to use object of class
# File in the R.io package to be used.
pathname <- as.character(con)
## Default has always been to overwrite existing file
## Should this be made an argument?
overwrite <- TRUE
pathname <- Arguments$getWritablePathname(pathname, mustNotExist = FALSE)
if (overwrite && isFile(pathname)) file.remove(pathname)
## Write to temporary file and rename only if successful
pathnameT <- pushTemporaryFile(pathname)
conDescription <- pathnameT
# Now, assume that 'con' is a filename specifying a file to be opened.
con <- file(pathnameT, open = "wb")
close <- TRUE
}
# Assert that it is a binary connection
if (summary(con)$text != "binary")
stop("Can only write a MAT file structure to a *binary* connection.")
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Write the data
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (matVersion == "5") {
nbrOfBytes <- writeMat5(con, objects = args, onWrite = onWrite)
} else {
stop("Can not write MAT file. Unknown or unsupported MAT version: ", matVersion)
}
## Close connection (only iff opened above)
if (close) {
close <- FALSE
close(con)
}
## Rename temporary file? (only iff successful)
if (!is.null(pathnameT)) popTemporaryFile(pathnameT)
invisible(nbrOfBytes)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.