diff --git a/R/RcppExports.R b/R/RcppExports.R index b2cd7b1..cba542c 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,6 +1,10 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 +to_int_checked <- function(x) { + .Call(`_bigmemory_to_int_checked`, x) +} + GetIndivMatrixElements <- function(bigMatAddr, col, row) { .Call(`_bigmemory_GetIndivMatrixElements`, bigMatAddr, col, row) } diff --git a/R/bigmemory.R b/R/bigmemory.R index 0aff2dc..51a4034 100644 --- a/R/bigmemory.R +++ b/R/bigmemory.R @@ -61,7 +61,7 @@ setMethod('describe', signature(x='big.matrix'), big.matrix <- function(nrow, ncol, type=options()$bigmemory.default.type, init=NULL, dimnames=NULL, separated=FALSE, backingfile=NULL, backingpath=NULL, descriptorfile=NULL, - binarydescriptor=FALSE, + binarydescriptor=FALSE, shared=options()$bigmemory.default.shared) { if (!is.null(backingfile)) @@ -83,7 +83,7 @@ big.matrix <- function(nrow, ncol, type=options()$bigmemory.default.type, if (type == 'short') typeVal <- 2 if (type == 'char') typeVal <- 1 if (type == 'raw' || type == 'byte') typeVal <- 3 - + if (is.null(typeVal)) stop('invalid type') if (!is.null(dimnames)) { rownames <- dimnames[[1]] @@ -118,12 +118,12 @@ big.matrix <- function(nrow, ncol, type=options()$bigmemory.default.type, filebacked.big.matrix <- function(nrow, ncol, type=options()$bigmemory.default.type, init=NULL, dimnames=NULL, separated=FALSE, - backingfile=NULL, backingpath=NULL, + backingfile=NULL, backingpath=NULL, descriptorfile=NULL, binarydescriptor=FALSE) { - + if (nrow < 1 | ncol < 1) stop('A big.matrix must have at least one row and one column') - + typeVal <- NULL if (type == 'integer') typeVal <- 4 if (type == 'float') typeVal <- 6 @@ -131,7 +131,7 @@ filebacked.big.matrix <- function(nrow, ncol, if (type == 'short') typeVal <- 2 if (type == 'char') typeVal <- 1 if (type == 'raw' || type == 'byte') typeVal <- 3 - + if (is.null(typeVal)) stop('invalid type') if (!is.null(dimnames)) { @@ -153,7 +153,7 @@ filebacked.big.matrix <- function(nrow, ncol, backingpath <- "" } - if (is.null(descriptorfile) && !anon.backing) + if (is.null(descriptorfile) && !anon.backing) { warning(paste("No descriptor file given, it will be named", paste(backingfile, '.desc', sep=''))) @@ -173,7 +173,7 @@ filebacked.big.matrix <- function(nrow, ncol, if (backingpath != "") { backingpath <- paste(backingpath, '', sep=.Platform$file.sep) } - + if(file.exists(paste(backingpath, backingfile, sep=.Platform$file.sep))){ stop("Backing file already exists! Either remove or specify different backing file") @@ -183,10 +183,10 @@ filebacked.big.matrix <- function(nrow, ncol, backingpath <- paste(getwd(), "", sep=.Platform$file.sep) } - address <- CreateFileBackedBigMatrix(as.character(backingfile), - as.character(backingpath), as.double(nrow), - as.double(ncol), as.character(colnames), - as.character(rownames), as.integer(typeVal), + address <- CreateFileBackedBigMatrix(as.character(backingfile), + as.character(backingpath), as.double(nrow), + as.double(ncol), as.character(colnames), + as.character(rownames), as.integer(typeVal), as.double(init), as.logical(separated)) if (is.null(address)) { @@ -201,13 +201,13 @@ filebacked.big.matrix <- function(nrow, ncol, if (is.null(descriptorfile) && !anon.backing) { warning(paste("A descriptor file has not been specified. ", - "A descriptor named ", backingfile, + "A descriptor named ", backingfile, ".desc will be created.", sep='')) descriptorfile <- paste(backingfile, ".desc", sep='' ) } if (!anon.backing) { - descriptorfilepath <- paste(backingpath, descriptorfile, + descriptorfilepath <- paste(backingpath, descriptorfile, sep=.Platform$file.sep) if(binarydescriptor) { saveRDS(describe(x), file=descriptorfilepath) @@ -221,10 +221,10 @@ filebacked.big.matrix <- function(nrow, ncol, #' @rdname big.matrix #' @export -setGeneric('as.big.matrix', +setGeneric('as.big.matrix', function(x, type=NULL, separated=FALSE, backingfile=NULL, backingpath=NULL, - descriptorfile=NULL, binarydescriptor=FALSE, + descriptorfile=NULL, binarydescriptor=FALSE, shared=options()$bigmemory.default.shared) { standardGeneric('as.big.matrix') }) @@ -253,19 +253,19 @@ setMethod('as.big.matrix', signature(x='matrix'), } if (is.null(type)) type <- typeof(x) - - if (type %in% c("integer","double", "short", "char", "float", + + if (type %in% c("integer","double", "short", "char", "float", "raw")) { - y <- big.matrix(nrow=nrow(x), ncol=ncol(x), type=type, - init=NULL, dimnames=dimnames(x), + y <- big.matrix(nrow=nrow(x), ncol=ncol(x), type=type, + init=NULL, dimnames=dimnames(x), separated=separated, - backingfile=backingfile, + backingfile=backingfile, backingpath=backingpath, - descriptorfile=descriptorfile, + descriptorfile=descriptorfile, binarydescriptor=binarydescriptor, shared=shared) y[seq_len(nrow(x)),seq_len(ncol(x))] <- x - junk <- gc() + junk <- gc() } else stop('bigmemory: that type is not implemented.') return(y) }) @@ -279,14 +279,14 @@ setMethod('as.big.matrix', signature(x='data.frame'), warning(paste("Coercing data.frame to matrix via factor", "level numberings.")) if (is.null(type)) type <- options()$bigmemory.default.type - if (type %in% c("integer","double", "short", "char", "raw", + if (type %in% c("integer","double", "short", "char", "raw", "float")) { - y <- big.matrix(nrow=nrow(x), ncol=ncol(x), type=type, - init=NULL, dimnames=dimnames(x), + y <- big.matrix(nrow=nrow(x), ncol=ncol(x), type=type, + init=NULL, dimnames=dimnames(x), separated=separated, - backingfile=backingfile, + backingfile=backingfile, backingpath=backingpath, - descriptorfile=descriptorfile, + descriptorfile=descriptorfile, binarydescriptor=binarydescriptor, shared=shared) oldbtw <- options()$bigmemory.typecast.warning @@ -297,10 +297,10 @@ setMethod('as.big.matrix', signature(x='data.frame'), y[,i] <- x[,i] } options(bigmemory.typecast.warning=oldbtw) - junk <- gc() + junk <- gc() } else stop('bigmemory: that type is not implemented.') return(y) - + }) @@ -314,8 +314,8 @@ setMethod('as.big.matrix', signature(x='vector'), } x <- matrix(x, length(x), 1) warning("Coercing vector to a single-column matrix.") - return(as.big.matrix(x, type, separated, backingfile, - backingpath, descriptorfile, + return(as.big.matrix(x, type, separated, backingfile, + backingpath, descriptorfile, binarydescriptor, shared)) }) @@ -343,7 +343,7 @@ rownames.bm <- function(x) { return(ret) } -assign('colnames.bm<-', +assign('colnames.bm<-', function(x, value) { checkReadOnly(x) if (is.character(value)) { @@ -375,7 +375,7 @@ assign('rownames.bm<-', warning("row names coerced to character") } } - if (length(value) != nrow(x) & !is.null(value)) + if (length(value) != nrow(x) & !is.null(value)) stop("length of 'rownames' not equal to array extent.") SetRowNames(x@address, value) return(x) @@ -394,7 +394,7 @@ setMethod('ncol', signature(x="big.matrix"), #' @rdname ncol-methods #' @export -setMethod('nrow', signature(x="big.matrix"), +setMethod('nrow', signature(x="big.matrix"), function(x) return(CGetNrow(x@address))) #' @title Dimensions of a big.matrix object @@ -496,11 +496,11 @@ GetCols.bm <- function(x, j, drop=TRUE) { "columns of the matrix.")) j <- which(j) } - + tempj <- CCleanIndices(as.double(j), as.double(ncol(x))) if (is.null(tempj[[1]])) stop("Illegal column index usage in extraction.\n") if (tempj[[1]]) j <- tempj[[2]] - + retList <- GetMatrixCols(x@address, as.double(j)) mat <- .addDimnames(retList, nrow(x), length(j), drop) return(mat) @@ -532,7 +532,7 @@ GetAll.bm <- function(x, drop=TRUE) { return(mat) } -#' @title Extract or Replace +#' @title Extract or Replace #' @description Extract or replace big.matrix elements #' @name Extract,big.matrix #' @param x A \code{big.matrix object} @@ -581,7 +581,7 @@ setMethod("[", if(nargs() == 2){ return(GetIndivVectorElements.bm(x,i)) }else{ - return(GetRows.bm(x, i)) + return(GetRows.bm(x, i)) } }) @@ -648,12 +648,12 @@ SetElements.bm <- function(x, i, j, value) { if ( options()$bigmemory.typecast.warning && ((typeof(value) == "double") && (typeof(x) != "double") || - (typeof(value) == "integer" && (typeof(x) != "double" && + (typeof(value) == "integer" && (typeof(x) != "double" && typeof(x) != "float" && - typeof(x) != "integer")) || + typeof(x) != "integer")) || (typeof(value) == "double" && (typeof(x) == "float")) || (typeof(value) == "raw" && (typeof(x) != "raw")) - )) + )) { warning(paste0("Assignment will down cast from ", typeof(value), " to ", typeof(x), "\nHint: To remove this warning type: ", @@ -664,7 +664,7 @@ SetElements.bm <- function(x, i, j, value) { # If we are assigning from a matrix, make sure the dimensions agree. if (is.matrix(value)) { - if (ncol(value) != length(j) | nrow(value) != length(i)) + if (ncol(value) != length(j) || nrow(value) != length(i)) { stop("Matrix dimensions do not agree with big.matrix instance set size.") } @@ -672,29 +672,17 @@ SetElements.bm <- function(x, i, j, value) { # Otherwise, make sure we are assigning the correct number of things # (rep if necessary) numReps <- totalts / length(value) - if (numReps != round(numReps)) + if (numReps != round(numReps)) { - stop(paste("number of items to replace is not a multiple of", - "replacement length")) - } - } - if (typeof(x) != 'double') { - integerVals <- na.omit(as.integer(value)) - if ( sum(integerVals == na.omit(as.integer(value))) != - length(integerVals) | is.factor(value)) { - warning("non-integer (possibly Inf or -Inf) typecast to integer") + stop("number of items to replace is not a multiple of replacement length") } } switch(typeof(x), - 'double' = {SetMatrixElements(x@address, as.double(j), as.double(i), - as.double(value))}, - 'float' = {SetMatrixElements(x@address, as.double(j), as.double(i), - as.double(value))}, - #Don't convert raw before assigning them - 'raw' = {SetMatrixElements(x@address, as.double(j), as.double(i), - value)}, - SetMatrixElements(x@address, as.double(j), as.double(i), - as.integer(value)) + 'double' = {SetMatrixElements(x@address, as.double(j), as.double(i), as.double(value))}, + 'float' = {SetMatrixElements(x@address, as.double(j), as.double(i), as.double(value))}, + #Don't convert raw before assigning them + 'raw' = {SetMatrixElements(x@address, as.double(j), as.double(i), value)}, + SetMatrixElements(x@address, as.double(j), as.double(i), to_int_checked(value)) ) x } @@ -747,7 +735,7 @@ SetIndivElements.bm <- function(x, i, value) { as.double(i[,1]), as.single(value))}, #Don't convert raw before assigning them 'raw' = {SetIndivMatrixElements(x@address, as.double(i[,2]), - as.double(i[,1]), value)}, + as.double(i[,1]), value)}, SetIndivMatrixElements(x@address, as.double(i[,2]), as.double(i[,1]), as.integer(value))) x @@ -763,23 +751,23 @@ SetIndivVectorElements.bm <- function(x, i, value) { if(any(i > length(x))){ stop("indices out of range.") } - + if(length(value) > length(i)) { stop("value elements longer than indices") } - + if(length(value) < length(i)) { if(length(value) != 1){ stop("value must be of length equal to 'i' or 1") } } - + if(length(value) == 1) { value <- rep(value, length(i)) } - + SetIndivVectorMatrixElements(x@address, as.integer(i), value) - + x } @@ -806,7 +794,7 @@ SetCols.bm <- function(x, j, value) if ( options()$bigmemory.typecast.warning && ((typeof(value) == "double") && (typeof(x) != "double") || (typeof(value) == "integer" && - (typeof(x) != "double" && typeof(x) != "integer")) || + (typeof(x) != "double" && typeof(x) != "integer")) || (typeof(value) == "double" && (typeof(x) == "float"))) || (typeof(value) == "raw" && (typeof(x) != "raw"))) { warning(cat("Assignment will down cast from ", typeof(value), " to ", @@ -820,7 +808,7 @@ SetCols.bm <- function(x, j, value) if (ncol(value) != length(j) | nrow(value) != nrow(x)) { stop("Matrix dimensions do not agree with big.matrix instance set size.") } - } + } else if (length(value) != totalts) { # Otherwise, make sure we are assigning the correct number of things # (rep if necessary) @@ -837,14 +825,14 @@ SetCols.bm <- function(x, j, value) warning("non-integer (possibly Inf or -Inf) typecast to integer") } } - + switch(typeof(x), 'double' = {SetMatrixCols(x@address, as.double(j), as.double(value))}, 'float' = {SetMatrixCols(x@address, as.double(j), as.single(value))}, #Don't convert raw before assigning them 'raw' = {SetMatrixCols(x@address, as.double(j), value)}, SetMatrixCols(x@address, as.double(j), as.integer(value))) - + x } @@ -866,11 +854,11 @@ SetRows.bm <- function(x, i, value) { tempi <- CCleanIndices(as.double(i), as.double(nrow(x))) if (is.null(tempi[[1]])) stop("Illegal row index usage in extraction.\n") if (tempi[[1]]) i <- tempi[[2]] - + if ( options()$bigmemory.typecast.warning && ((typeof(value) == "double") && (typeof(x) != "double") || (typeof(value) == "integer" && - (typeof(x) != "double" && typeof(x) != "integer")) || + (typeof(x) != "double" && typeof(x) != "integer")) || (typeof(value) == "double" && (typeof(x) == "float"))) || (typeof(value) == "raw" && (typeof(x) != "raw"))) { warning(cat("Assignment will down cast from ", typeof(value), " to ", @@ -889,12 +877,12 @@ SetRows.bm <- function(x, i, value) { if (ncol(value) != ncol(x) | nrow(value) != length(i)) { stop("Matrix dimensions do not agree with big.matrix instance set size.") } - } + } else if (length(value) != totalts) { # Otherwise, make sure we are assigning the correct number of things # (rep if necessary) numReps <- totalts / length(value) - if (numReps != round(numReps)) + if (numReps != round(numReps)) { stop(paste("number of items to replace is not a multiple of", "replacement length")) @@ -907,14 +895,14 @@ SetRows.bm <- function(x, i, value) { warning("non-integer (possibly Inf or -Inf) typecast to integer") } } - + switch(typeof(x), 'double' = {SetMatrixRows(x@address, as.double(i), as.double(value))}, 'float' = {SetMatrixRows(x@address, as.double(i), as.single(value))}, #Don't convert raw before assigning them 'raw' = {SetMatrixRows(x@address, as.double(i), value)}, SetMatrixRows(x@address, as.double(i), as.integer(value))) - + x } @@ -924,7 +912,7 @@ SetAll.bm <- function(x, value) { if ( options()$bigmemory.typecast.warning && ((typeof(value) == "double") && (typeof(x) != "double") || (typeof(value) == "integer" && - (typeof(x) != "double" && typeof(x) != "integer")) || + (typeof(x) != "double" && typeof(x) != "integer")) || (typeof(value) == "double" && (typeof(x) == "float"))) || (typeof(value) == "raw" && (typeof(x) != "raw"))) { warning(cat("Assignment will down cast from ", typeof(value), " to ", @@ -938,17 +926,17 @@ SetAll.bm <- function(x, value) { if (ncol(value) != ncol(x) | nrow(value) != nrow(x)) { stop("Matrix dimensions do not agree with big.matrix instance set size.") } - } + } else if (length(value) != totalts) { # Otherwise, make sure we are assigning the correct number of things # (rep if necessary) numReps <- totalts / length(value) if (numReps != round(numReps)) { - stop(paste("number of items to replace is not a multiple of", + stop(paste("number of items to replace is not a multiple of", "replacement length")) } } - if (typeof(x) != 'double') + if (typeof(x) != 'double') { integerVals <- na.omit(as.integer(value)) if ( sum(integerVals == na.omit(as.integer(value))) != @@ -956,14 +944,14 @@ SetAll.bm <- function(x, value) { warning("non-integer (possibly Inf or -Inf) typecast to integer") } } - + switch(typeof(x), 'double' = {SetMatrixAll(x@address, as.double(value))}, 'float' = {SetMatrixAll(x@address, as.single(value))}, #Don't convert raw before assigning them 'raw' = {SetMatrixAll(x@address, value)}, SetMatrixAll(x@address, as.integer(value))) - + x } @@ -1048,7 +1036,7 @@ setMethod('[<-', setMethod('[<-', signature(x = "big.matrix", i = "numeric", j="missing", value = "numeric"), function(x, i, j, ..., value){ - + if (nargs() == 3){ SetIndivVectorElements.bm(x, i, value) } else { @@ -1075,7 +1063,7 @@ setMethod('[<-', setMethod('[<-', signature(x = "big.matrix", i = "numeric", j="missing", value = "matrix"), function(x, i, j, ..., value){ - + if (nargs() == 3) { SetIndivVectorElements.bm(x, i, value) } else { @@ -1128,7 +1116,7 @@ setMethod('[<-', function(x, i, j, value) SetIndivElements.bm(x, i, value)) #' @title The Type of a big.matrix Object -#' @description \code{typeof} returns the storage type of a +#' @description \code{typeof} returns the storage type of a #' \code{big.matrix} object #' @param x A \code{big.matrix} object #' @export @@ -1194,7 +1182,7 @@ setMethod('tail', signature(x="big.matrix"), #' option then it will convert to a base R matrix and print all elements. #' @param x A \code{big.matrix} object #' @export -setMethod('print', signature(x='big.matrix'), +setMethod('print', signature(x='big.matrix'), function(x) { if (options()$bigmemory.print.warning==TRUE) { @@ -1213,7 +1201,7 @@ setMethod('print', signature(x='big.matrix'), ################################################################### # mwhich() # -# x big.matrix +# x big.matrix # cols is.numeric or is.character # vals list of scalar or 2-vectors otherwise # comps could be missing, in which case we'll fill in 'eq' in signature, @@ -1253,7 +1241,7 @@ setMethod('mwhich', setMethod('mwhich', signature(x='big.matrix', op='missing'), function(x, cols, vals, comps) - return(mwhich.internal(x, cols, vals, comps, op='AND', + return(mwhich.internal(x, cols, vals, comps, op='AND', whichFuncName=MWhichBigMatrix))) # @rdname mwhich-methods @@ -1262,15 +1250,15 @@ setMethod('mwhich', function(x, cols, vals, comps) { if (is.integer(x)) - return(mwhich.internal(x, cols, vals, comps, op='AND', + return(mwhich.internal(x, cols, vals, comps, op='AND', whichFuncName=MWhichRIntMatrix)) if (is.numeric(x)) - return(mwhich.internal(x, cols, vals, comps, op='AND', + return(mwhich.internal(x, cols, vals, comps, op='AND', whichFuncName=MWhichRNumericMatrix)) stop("Unsupported matrix type given to mwhich") }) -mwhich.internal <- function(x, cols, vals, comps, op, whichFuncName) +mwhich.internal <- function(x, cols, vals, comps, op, whichFuncName) { cols <- cleanupcols(cols, ncol(x), colnames(x)) if (length(setdiff(cols, seq_len(ncol(x)))) > 0) @@ -1278,7 +1266,7 @@ mwhich.internal <- function(x, cols, vals, comps, op, whichFuncName) # if vals or comps are not lists but are length 1 or 2, make them # trivial lists. - if ( !is.list(vals) & + if ( !is.list(vals) & (length(vals)==1 || length(vals)==2) ) { vals <- list(vals) } else { @@ -1368,13 +1356,13 @@ mwhich.internal <- function(x, cols, vals, comps, op, whichFuncName) ret <- NULL if (is.big.matrix(x)) { - ret <- whichFuncName(x@address, as.double(testCol), - as.double(minVal), as.double(maxVal), + ret <- whichFuncName(x@address, as.double(testCol), + as.double(minVal), as.double(maxVal), as.integer(chkmin), as.integer(chkmax), as.integer(opVal)) } else { ret <- whichFuncName(x, nrow(x), - as.double(testCol), - as.double(minVal), as.double(maxVal), + as.double(testCol), + as.double(minVal), as.double(maxVal), as.integer(chkmin), as.integer(chkmax), as.integer(opVal)) } ret @@ -1409,8 +1397,8 @@ setMethod('dimnames<-', signature(x = "big.matrix", value='list'), #' @template write.big.matrix_template #' @export -setGeneric('write.big.matrix', - function(x, filename, row.names=FALSE, col.names=FALSE, sep=",") +setGeneric('write.big.matrix', + function(x, filename, row.names=FALSE, col.names=FALSE, sep=",") standardGeneric('write.big.matrix')) #' @rdname write.big.matrix @@ -1428,10 +1416,10 @@ setMethod('write.big.matrix', signature(x='big.matrix',filename='character'), } if (col.names & !HasRowColNames(x@address)[2]) { col.names <- FALSE - warning(paste("No column names exist, overriding your", + warning(paste("No column names exist, overriding your", "col.names option.\n")) } - WriteMatrix(x@address, filename, as.logical(row.names), + WriteMatrix(x@address, filename, as.logical(row.names), as.logical(col.names), sep) invisible(NULL) }) @@ -1439,20 +1427,20 @@ setMethod('write.big.matrix', signature(x='big.matrix',filename='character'), #' @rdname write.big.matrix #' @export -setGeneric('read.big.matrix', - function(filename, sep=',', header=FALSE, col.names=NULL, row.names=NULL, - has.row.names=FALSE, ignore.row.names=FALSE, type=NA, skip=0, - separated=FALSE, backingfile=NULL, backingpath=NULL, +setGeneric('read.big.matrix', + function(filename, sep=',', header=FALSE, col.names=NULL, row.names=NULL, + has.row.names=FALSE, ignore.row.names=FALSE, type=NA, skip=0, + separated=FALSE, backingfile=NULL, backingpath=NULL, descriptorfile=NULL, binarydescriptor=FALSE, extraCols=NULL, - shared=options()$bigmemory.default.shared) + shared=options()$bigmemory.default.shared) standardGeneric('read.big.matrix')) #' @importFrom stats na.omit #' @rdname write.big.matrix setMethod('read.big.matrix', signature(filename='character'), - function(filename, sep, header, col.names, row.names, has.row.names, - ignore.row.names, type, skip, separated, backingfile, backingpath, - descriptorfile, binarydescriptor, extraCols, + function(filename, sep, header, col.names, row.names, has.row.names, + ignore.row.names, type, skip, separated, backingfile, backingpath, + descriptorfile, binarydescriptor, extraCols, shared=options()$bigmemory.default.shared) { if (!is.logical(header)) @@ -1473,7 +1461,7 @@ setMethod('read.big.matrix', signature(filename='character'), colNames <- NULL if (header) { colNames <- unlist(strsplit( - scan(filename, what='character', skip=skip, nlines=1, sep="\n", + scan(filename, what='character', skip=skip, nlines=1, sep="\n", quiet=TRUE), split=sep)) colNames <- gsub("\"", "", colNames, perl=TRUE) colNames <- gsub("\'", "", colNames, perl=TRUE) @@ -1505,7 +1493,7 @@ setMethod('read.big.matrix', signature(filename='character'), # available, otherwise, figure it out. if (!is.null(colNames)) numCols <- length(colNames) else { - numCols <- length(firstLineVals) - has.row.names + numCols <- length(firstLineVals) - has.row.names } if (length(firstLineVals) - has.row.names != numCols) @@ -1516,8 +1504,8 @@ setMethod('read.big.matrix', signature(filename='character'), if (is.character(row.names)) { rowNames <- row.names ignore.row.names <- TRUE - } else { - stop("Invalid row.names (must be a vector of names if used).\n") + } else { + stop("Invalid row.names (must be a vector of names if used).\n") } } @@ -1526,7 +1514,7 @@ setMethod('read.big.matrix', signature(filename='character'), if (has.row.names) firstLineVals <- firstLineVals[-1] if (sum(na.omit(as.integer(firstLineVals)) == na.omit(as.double(firstLineVals))) == - numCols ) { + numCols ) { type <- 'integer' } warning(paste("Because type was not specified, we chose", type, @@ -1543,23 +1531,23 @@ setMethod('read.big.matrix', signature(filename='character'), } bigMat <- big.matrix(nrow=numRows, ncol=createCols, type=type, - dimnames=list(rowNames, colNames), init=NULL, + dimnames=list(rowNames, colNames), init=NULL, separated=separated, backingfile=backingfile, backingpath=backingpath, descriptorfile=descriptorfile, - binarydescriptor=binarydescriptor, + binarydescriptor=binarydescriptor, shared=options()$bigmemory.default.shared) # has.row.names indicates whether or not there are row names; # we take ignore.row.names from the user, but pass (essentially) # use.row.names (which is !ignore.row.names) to C: ReadMatrix( - as.character(filename), - bigMat@address, - as.double(skip+headerOffset), - as.double(numRows), - as.double(numCols), - as.character(sep), + as.character(filename), + bigMat@address, + as.double(skip+headerOffset), + as.double(numRows), + as.double(numCols), + as.character(sep), as.logical(has.row.names), as.logical(!ignore.row.names)) @@ -1620,7 +1608,7 @@ cleanuprows <- function(rows=NULL, nr=NULL, rownames=NULL) { #' @template deepcopy_template #' @export -deepcopy <- function(x, cols=NULL, rows=NULL, +deepcopy <- function(x, cols=NULL, rows=NULL, y=NULL, type=NULL, separated=NULL, backingfile=NULL, backingpath=NULL, descriptorfile=NULL, binarydescriptor=FALSE, @@ -1645,7 +1633,7 @@ deepcopy <- function(x, cols=NULL, rows=NULL, binarydescriptor=binarydescriptor, shared) } if (is.big.matrix(x) && is.big.matrix(y)) { - CDeepCopy(x@address, y@address, as.double(rows), as.double(cols), + CDeepCopy(x@address, y@address, as.double(rows), as.double(cols), getOption("bigmemory.typecast.warning")) } else { for (i in seq_len(length(cols))) y[,i] <- x[rows,cols[i]] @@ -1654,7 +1642,7 @@ deepcopy <- function(x, cols=NULL, rows=NULL, return(y) } -# Following the R convention we are going to assume Unix directory +# Following the R convention we are going to assume Unix directory # separators '/' as opposed to the Windows convention '\'. #' @rdname sub.big.matrix @@ -1680,7 +1668,7 @@ setGeneric('sub.big.matrix', function(x, firstRow=1, lastRow=NULL, setMethod('sub.big.matrix', signature(x='big.matrix'), function(x, firstRow, lastRow, firstCol, lastCol, backingpath) { - return(sub.big.matrix(describe(x), firstRow, lastRow, firstCol, lastCol, + return(sub.big.matrix(describe(x), firstRow, lastRow, firstCol, lastCol, backingpath)) }) @@ -1707,10 +1695,10 @@ setMethod('sub.big.matrix', signature(x='big.matrix.descriptor'), stop(paste("A sub.big.matrix object could not be created", "with the specified parameters")) } - SetRowOffsetInfo(rbm@address, - as.double(rowOffset + GetRowOffset(rbm@address)), + SetRowOffsetInfo(rbm@address, + as.double(rowOffset + GetRowOffset(rbm@address)), as.double(numRows) ) - SetColumnOffsetInfo(rbm@address, + SetColumnOffsetInfo(rbm@address, as.double(colOffset + GetColOffset(rbm@address)), as.double(numCols)) return(rbm) @@ -1724,15 +1712,15 @@ DescribeBigMatrix <- function(x) { if (!is.filebacked(x)) { if (is.shared(x)) { list(sharedType = 'SharedMemory', - sharedName = shared.name(x), + sharedName = shared.name(x), totalRows = GetTotalRows(x@address), totalCols = GetTotalColumns(x@address), rowOffset = GetRowOffset(x@address), colOffset = GetColOffset(x@address), nrow=nrow(x), ncol=ncol(x), - rowNames=rownames(x), - colNames=colnames(x), - type=typeof(x), + rowNames=rownames(x), + colNames=colnames(x), + type=typeof(x), separated=is.separated(x)) } else { stop("you can't describe a non-shared big.matrix.") @@ -1740,15 +1728,15 @@ DescribeBigMatrix <- function(x) { } else { list(sharedType = 'FileBacked', filename = file.name(x), - dirname = format_path(dir.name(x)), # need extra '/' on Windows + dirname = format_path(dir.name(x)), # need extra '/' on Windows totalRows = GetTotalRows(x@address), totalCols = GetTotalColumns(x@address), rowOffset = GetRowOffset(x@address), colOffset = GetColOffset(x@address), nrow=nrow(x), ncol=ncol(x), - rowNames=rownames(x), - colNames=colnames(x), - type=typeof(x), + rowNames=rownames(x), + colNames=colnames(x), + type=typeof(x), separated=is.separated(x)) } } @@ -1770,36 +1758,36 @@ attach.big.matrix <- function(obj, ...) { #' @param obj The filename of the descriptor for a filebacked matrix, #' assumed to be in the directory specified #' @param ... possibly \code{path} which gives the path where the descriptor -#' and/or filebacking can be found. +#' and/or filebacking can be found. #' @export setMethod('attach.resource', signature(obj = 'character'), function(obj, ...) { path <- list(...)[['path']] - + if (is.null(path) || path == "") { # unspecified path extra argument fileWithPath <- path.expand(obj) } else { if (dirname(obj) != ".") { # path also specified in obj warning(paste("Two paths were specified in attach.resource.", - "The one associated with the file will be used.", + "The one associated with the file will be used.", sep="\n")) fileWithPath <- path.expand(obj) } else { fileWithPath <- path.expand(file.path(path, obj)) } } - + if (!file.exists(fileWithPath)) stop( paste("The file", fileWithPath, "could not be found") ) if (dir.exists(fileWithPath)) stop( paste(fileWithPath, "is a directory") ) - - info <- tryCatch(readRDS(fileWithPath), + + info <- tryCatch(readRDS(fileWithPath), error = function(er) dget(fileWithPath)) if (info@description$sharedType == "FileBacked") { info@description$dirname <- format_path(dirname(fileWithPath)) } - + attach.resource(info, path = NULL, ...) }) @@ -1816,8 +1804,8 @@ setMethod('attach.resource', signature(obj='big.matrix.descriptor'), if (info$type == 'float') typeLength <- 6 if (info$type == 'double') typeLength <- 8 if (info$type == 'raw' ) typeLength <- 3 - - if (is.null(typeLength)) + + if (is.null(typeLength)) stop('invalid type') readonly <- list(...)[['readonly']] @@ -1825,14 +1813,14 @@ setMethod('attach.resource', signature(obj='big.matrix.descriptor'), if (!is.logical(readOnly)) { stop("The readOnly argument must be of type logical") } - + if (info$sharedType == 'SharedMemory') { - address <- CAttachSharedBigMatrix(as.character(info$sharedName), - as.double(info$totalRows), - as.double(info$totalCols), - as.character(info$rowNames), - as.character(info$colNames), - as.integer(typeLength), + address <- CAttachSharedBigMatrix(as.character(info$sharedName), + as.double(info$totalRows), + as.double(info$totalCols), + as.character(info$rowNames), + as.character(info$colNames), + as.integer(typeLength), as.logical(info$separated), as.logical(readOnly)) } else { @@ -1842,30 +1830,30 @@ setMethod('attach.resource', signature(obj='big.matrix.descriptor'), { stop(paste("The backing file", file, "could not be found")) } - } else { + } else { # It's separated and we need to check for each column. fn <- paste0(file, "_column_", 1:info$ncol - 1) noexists <- which(!file.exists(fn)) if (length(noexists)) # report the first non-existing - stop(paste("The backing file", fn[noexists[1]], + stop(paste("The backing file", fn[noexists[1]], "could not be found")) } address <- CAttachFileBackedBigMatrix( - as.character(info$filename), - as.character(info$dirname), - as.double(info$totalRows), - as.double(info$totalCols), - as.character(info$rowNames), - as.character(info$colNames), - as.integer(typeLength), - as.logical(info$separated), + as.character(info$filename), + as.character(info$dirname), + as.double(info$totalRows), + as.double(info$totalCols), + as.character(info$rowNames), + as.character(info$colNames), + as.integer(typeLength), + as.logical(info$separated), as.logical(readOnly)) } if (!is.null(address)) { SetRowOffsetInfo(address, info$rowOffset, info$nrow) SetColumnOffsetInfo(address, info$colOffset, info$ncol) ret <- new('big.matrix', address=address) - # If the user did not specify read-only but the big matrix could + # If the user did not specify read-only but the big matrix could # only be opened read-only then issue a warning. if (readOnly != is.readonly(ret)) { warning("big.matrix object could only be opened read-only.") @@ -1873,7 +1861,7 @@ setMethod('attach.resource', signature(obj='big.matrix.descriptor'), } else { stop("Fatal error in attach: big.matrix could not be attached.") } - return(ret) + return(ret) }) @@ -1952,16 +1940,16 @@ morder <- function(x, cols, na.last=TRUE, decreasing = FALSE) { { stop("Bad column indices.") } - + switch(class(x), - "big.matrix"=OrderBigMatrix(x@address, as.double(cols), + "big.matrix"=OrderBigMatrix(x@address, as.double(cols), as.integer(na.last), as.logical(decreasing) ), "matrix" = switch(typeof(x), - 'integer'=OrderRIntMatrix(x, nrow(x), as.double(cols), - as.integer(na.last), + 'integer'=OrderRIntMatrix(x, nrow(x), as.double(cols), + as.integer(na.last), as.logical(decreasing) ), - 'double'=OrderRNumericMatrix(x, nrow(x), as.double(cols), - as.integer(na.last), + 'double'=OrderRNumericMatrix(x, nrow(x), as.double(cols), + as.integer(na.last), as.logical(decreasing) ), stop("Unsupported matrix value type.")), stop("unsupported matrix type") @@ -1976,25 +1964,25 @@ morderCols <- function(x, rows, na.last=TRUE, decreasing = FALSE) { if (sum(rows > nrow(x)) > 0 | sum(rows < 1) > 0 | sum(is.na(rows) > 0)) { stop("Bad row indices.") } - + switch(class(x), - "big.matrix"=OrderBigMatrixCols(x@address, as.double(rows), - as.integer(na.last), + "big.matrix"=OrderBigMatrixCols(x@address, as.double(rows), + as.integer(na.last), as.logical(decreasing) ), "matrix"=switch(typeof(x), - 'integer'=OrderRIntMatrixCols(x, nrow(x), ncol(x), - as.double(rows), - as.integer(na.last), + 'integer'=OrderRIntMatrixCols(x, nrow(x), ncol(x), + as.double(rows), + as.integer(na.last), as.logical(decreasing) ), - 'double'=OrderRNumericMatrixCols(x, nrow(x), ncol(x), - as.double(rows), - as.integer(na.last), + 'double'=OrderRNumericMatrixCols(x, nrow(x), ncol(x), + as.double(rows), + as.integer(na.last), as.logical(decreasing) ), - 'raw' = OrderRIntMatrixCols(x, nrow(x), ncol(x), as.double(rows), - as.integer(na.last), + 'raw' = OrderRIntMatrixCols(x, nrow(x), ncol(x), as.double(rows), + as.integer(na.last), as.logical(decreasing) ), stop("Unsupported matrix value type.")), - stop("unsupported matrix type")) + stop("unsupported matrix type")) } #' @rdname morder @@ -2035,27 +2023,27 @@ mpermute <- function(x, order=NULL, cols=NULL, allow.duplicates=FALSE, ...) ) return(invisible(TRUE)) - + } #' @rdname morder #' @export -mpermuteCols <- function(x, order=NULL, rows=NULL, +mpermuteCols <- function(x, order=NULL, rows=NULL, allow.duplicates=FALSE, ...) { if (is.null(order) && is.null(rows)) stop("You must specify either order or cols.") - + if (!is.null(order) && !is.null(rows)) stop("You must specify either order or cols.") - + if (!is.null(order)) { if (length(order) != ncol(x)) stop("order parameter must have the same length as ncol(x)") - + if (!allow.duplicates && sum(duplicated(order)) > 0) stop("order parameter contains duplicated entries.") - + r <- range(order) if (is.na(r[1])) stop("order parameter contains NAs") @@ -2064,7 +2052,7 @@ mpermuteCols <- function(x, order=NULL, rows=NULL, } else { order <- morderCols(x, rows, ...) } - + switch(class(x), "big.matrix" = { ReorderBigMatrixCols(x@address, order) @@ -2079,9 +2067,9 @@ mpermuteCols <- function(x, order=NULL, rows=NULL, }, stop("unimplemented class") ) - + invisible(TRUE) - + } #' @rdname big.matrix @@ -2129,4 +2117,3 @@ getCType <- function(x) { } return(retList[[1]]) } - diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index fabb807..c39e18e 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -5,6 +5,17 @@ using namespace Rcpp; +// to_int_checked +SEXP to_int_checked(SEXP x); +RcppExport SEXP _bigmemory_to_int_checked(SEXP xSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< SEXP >::type x(xSEXP); + rcpp_result_gen = Rcpp::wrap(to_int_checked(x)); + return rcpp_result_gen; +END_RCPP +} // GetIndivMatrixElements SEXP GetIndivMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row); RcppExport SEXP _bigmemory_GetIndivMatrixElements(SEXP bigMatAddrSEXP, SEXP colSEXP, SEXP rowSEXP) { @@ -866,6 +877,7 @@ END_RCPP } static const R_CallMethodDef CallEntries[] = { + {"_bigmemory_to_int_checked", (DL_FUNC) &_bigmemory_to_int_checked, 1}, {"_bigmemory_GetIndivMatrixElements", (DL_FUNC) &_bigmemory_GetIndivMatrixElements, 3}, {"_bigmemory_GetIndivVectorMatrixElements", (DL_FUNC) &_bigmemory_GetIndivVectorMatrixElements, 2}, {"_bigmemory_ReorderRIntMatrix", (DL_FUNC) &_bigmemory_ReorderRIntMatrix, 4}, diff --git a/src/bigmemory.cpp b/src/bigmemory.cpp index 4c66fd8..8cdcacb 100644 --- a/src/bigmemory.cpp +++ b/src/bigmemory.cpp @@ -24,14 +24,14 @@ using namespace Rcpp; * For example, the SetMatrixElements function * Normally the function looks like this: * SetMatrixElements >(... - + * Where both the CType and RType are double but with float * types R is still passing only double. Trying to pass RType * as float will result in all NA values. So the function ultimately * must still pass double like so: * SetMatrixElements >(... */ - + template string ttos(T i) @@ -95,8 +95,8 @@ void SetMatrixElements( BigMatrix *pMat, SEXP col, SEXP row, SEXP values, // Function contributed by Peter Haverty at Genentech. template -SEXP -GetIndivMatrixElements( +SEXP +GetIndivMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, NumericVector col, NumericVector row) { @@ -115,8 +115,8 @@ GetIndivMatrixElements( // Function contributed by Charles Detemran Jr. template -SEXP - GetIndivVectorMatrixElements( +SEXP + GetIndivVectorMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, NumericVector elems) { @@ -125,26 +125,26 @@ SEXP RcppType retVec(numElems); index_type i = 0; int idx = 0; - + for (index_type j = 0; j < elems.size(); j++){ CType element = mat[i][static_cast(elems[j])-1]; retVec[idx] = element == static_cast(NA_C) ? static_cast(NA_R) : element; idx += 1; } - + return(retVec); } // Function contributed by Charles Detemran Jr. template void - SetIndivVectorMatrixElements( + SetIndivVectorMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, NumericVector elems, NumericVector inVec) { BMAccessorType mat(*pMat); index_type i = 0; - + for (index_type j = 0; j < elems.size(); j++){ mat[i][static_cast(elems[j])-1] = inVec[j]; } @@ -223,7 +223,7 @@ void SetMatrixCols( BigMatrix *pMat, SEXP col, SEXP values, { pColumn = mat[static_cast(pCols[i])-1]; for (j=0; j < numRows; ++j) - { + { kIndex = k++%valLength; pColumn[j] = ((pVals[kIndex] < C_MIN || pVals[kIndex] > C_MAX) ? static_cast(NA_C) : @@ -274,7 +274,7 @@ void SetAllMatrixElements( BigMatrix *pMat, SEXP value, //bool outOfRange=false; if (val < C_MIN || val > C_MAX || isna(val)) - { + { if (!isna(val)) { //outOfRange=true; @@ -293,10 +293,10 @@ void SetAllMatrixElements( BigMatrix *pMat, SEXP value, } template -SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, +SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, SEXP col, SEXP row, SEXPTYPE sxpType) { - VecPtr vec_ptr; + VecPtr vec_ptr; BMAccessorType mat(*pMat); double *pCols = REAL(col); double *pRows = REAL(row); @@ -326,7 +326,7 @@ SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, CType *pColumn; index_type k=0; index_type i,j; - for (i=0; i < numCols; ++i) + for (i=0; i < numCols; ++i) { if (isna(pCols[i])) { @@ -338,7 +338,7 @@ SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, else { pColumn = mat[static_cast(pCols[i])-1]; - for (j=0; j < numRows; ++j) + for (j=0; j < numRows; ++j) { if (isna(pRows[j])) { @@ -346,8 +346,8 @@ SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, } else { - pRet[k] = (pColumn[static_cast(pRows[j])-1] == - static_cast(NA_C)) ? static_cast(NA_R) : + pRet[k] = (pColumn[static_cast(pRows[j])-1] == + static_cast(NA_C)) ? static_cast(NA_R) : (static_cast(pColumn[static_cast(pRows[j])-1])); } ++k; @@ -362,7 +362,7 @@ SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, for (i=0; i < numCols; ++i) { if (!isna(pCols[i])) - SET_STRING_ELT( rCNames, i, + SET_STRING_ELT( rCNames, i, Rf_mkChar(colNames[static_cast(pCols[i])-1].c_str()) ); } SET_VECTOR_ELT(ret, 2, rCNames); @@ -376,8 +376,8 @@ SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, { if (!isna(pRows[i])) { - SET_STRING_ELT( rRNames, i, - Rf_mkChar(rowNames[static_cast(pRows[i])-1].c_str()) ); + SET_STRING_ELT( rRNames, i, + Rf_mkChar(rowNames[static_cast(pRows[i])-1].c_str()) ); } } SET_VECTOR_ELT(ret, 1, rRNames); @@ -386,6 +386,24 @@ SEXP GetMatrixElements( BigMatrix *pMat, double NA_C, double NA_R, return ret; } +// Function by Florian Prive +// [[Rcpp::export]] +SEXP to_int_checked(SEXP x) { + if (TYPEOF(x) == INTSXP) return x; + NumericVector nv(x); + int i, n = nv.size(); + IntegerVector res(n); + for (i = 0; i < n; i++) { + res[i] = nv[i]; + if (nv[i] != res[i]) { + warning("Value changed when converting to integer type."); + break; + } + } + for (; i < n; i++) res[i] = nv[i]; + return res; +} + // Function contributed by Peter Haverty at Genentech. // [[Rcpp::export]] SEXP GetIndivMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row) @@ -501,10 +519,10 @@ SEXP GetIndivVectorMatrixElements(SEXP bigMatAddr, NumericVector elems) } template -SEXP GetMatrixRows( BigMatrix *pMat, double NA_C, double NA_R, +SEXP GetMatrixRows( BigMatrix *pMat, double NA_C, double NA_R, SEXP row, SEXPTYPE sxpType) { - VecPtr vec_ptr; + VecPtr vec_ptr; BMAccessorType mat(*pMat); double *pRows=REAL(row); index_type numRows = Rf_length(row); @@ -532,10 +550,10 @@ SEXP GetMatrixRows( BigMatrix *pMat, double NA_C, double NA_R, CType *pColumn = NULL; index_type k=0; index_type i,j; - for (i=0; i < numCols; ++i) + for (i=0; i < numCols; ++i) { pColumn = mat[i]; - for (j=0; j < numRows; ++j) + for (j=0; j < numRows; ++j) { if (isna(pRows[j])) { @@ -543,8 +561,8 @@ SEXP GetMatrixRows( BigMatrix *pMat, double NA_C, double NA_R, } else { - pRet[k] = (pColumn[static_cast(pRows[j])-1] == - static_cast(NA_C)) ? static_cast(NA_R) : + pRet[k] = (pColumn[static_cast(pRows[j])-1] == + static_cast(NA_C)) ? static_cast(NA_R) : (static_cast(pColumn[static_cast(pRows[j])-1])); } ++k; @@ -570,8 +588,8 @@ SEXP GetMatrixRows( BigMatrix *pMat, double NA_C, double NA_R, { if (!isna(pRows[i])) { - SET_STRING_ELT( rRNames, i, - Rf_mkChar(rowNames[static_cast(pRows[i])-1].c_str()) ); + SET_STRING_ELT( rRNames, i, + Rf_mkChar(rowNames[static_cast(pRows[i])-1].c_str()) ); } } SET_VECTOR_ELT(ret, 1, rRNames); @@ -581,10 +599,10 @@ SEXP GetMatrixRows( BigMatrix *pMat, double NA_C, double NA_R, } template -SEXP GetMatrixCols( BigMatrix *pMat, double NA_C, double NA_R, +SEXP GetMatrixCols( BigMatrix *pMat, double NA_C, double NA_R, SEXP col, SEXPTYPE sxpType) { - VecPtr vec_ptr; + VecPtr vec_ptr; BMAccessorType mat(*pMat); double *pCols=REAL(col); index_type numCols = Rf_length(col); @@ -613,7 +631,7 @@ SEXP GetMatrixCols( BigMatrix *pMat, double NA_C, double NA_R, CType *pColumn = NULL; index_type k=0; index_type i,j; - for (i=0; i < numCols; ++i) + for (i=0; i < numCols; ++i) { if (isna(pCols[i])) { @@ -625,9 +643,9 @@ SEXP GetMatrixCols( BigMatrix *pMat, double NA_C, double NA_R, else { pColumn = mat[static_cast(pCols[i])-1]; - for (j=0; j < numRows; ++j) + for (j=0; j < numRows; ++j) { - pRet[k] = (pColumn[j] == static_cast(NA_C)) ? static_cast(NA_R) : + pRet[k] = (pColumn[j] == static_cast(NA_C)) ? static_cast(NA_R) : (static_cast(pColumn[j])); ++k; } @@ -641,7 +659,7 @@ SEXP GetMatrixCols( BigMatrix *pMat, double NA_C, double NA_R, for (i=0; i < numCols; ++i) { if (!isna(pCols[i])) - SET_STRING_ELT( rCNames, i, + SET_STRING_ELT( rCNames, i, Rf_mkChar(colNames[static_cast(pCols[i])-1].c_str()) ); } SET_VECTOR_ELT(ret, 2, rCNames); @@ -653,7 +671,7 @@ SEXP GetMatrixCols( BigMatrix *pMat, double NA_C, double NA_R, SEXP rRNames = Rf_protect(Rf_allocVector(STRSXP, numRows)); for (i=0; i < numRows; ++i) { - SET_STRING_ELT( rRNames, i, Rf_mkChar(rowNames[i].c_str()) ); + SET_STRING_ELT( rRNames, i, Rf_mkChar(rowNames[i].c_str()) ); } SET_VECTOR_ELT(ret, 1, rRNames); } @@ -662,10 +680,10 @@ SEXP GetMatrixCols( BigMatrix *pMat, double NA_C, double NA_R, } template -SEXP GetMatrixAll( BigMatrix *pMat, double NA_C, double NA_R, +SEXP GetMatrixAll( BigMatrix *pMat, double NA_C, double NA_R, SEXPTYPE sxpType) { - VecPtr vec_ptr; + VecPtr vec_ptr; BMAccessorType mat(*pMat); index_type numCols = pMat->ncol(); index_type numRows = pMat->nrow(); @@ -693,12 +711,12 @@ SEXP GetMatrixAll( BigMatrix *pMat, double NA_C, double NA_R, CType *pColumn = NULL; index_type k=0; index_type i,j; - for (i=0; i < numCols; ++i) + for (i=0; i < numCols; ++i) { pColumn = mat[i]; - for (j=0; j < numRows; ++j) + for (j=0; j < numRows; ++j) { - pRet[k] = (pColumn[j] == static_cast(NA_C)) ? static_cast(NA_R) : + pRet[k] = (pColumn[j] == static_cast(NA_C)) ? static_cast(NA_R) : (static_cast(pColumn[j])); ++k; } @@ -721,7 +739,7 @@ SEXP GetMatrixAll( BigMatrix *pMat, double NA_C, double NA_R, SEXP rRNames = Rf_protect(Rf_allocVector(STRSXP, numRows)); for (i=0; i < numRows; ++i) { - SET_STRING_ELT( rRNames, i, Rf_mkChar(rowNames[i].c_str()) ); + SET_STRING_ELT( rRNames, i, Rf_mkChar(rowNames[i].c_str()) ); } SET_VECTOR_ELT(ret, 1, rRNames); } @@ -732,7 +750,7 @@ SEXP GetMatrixAll( BigMatrix *pMat, double NA_C, double NA_R, template SEXP ReadMatrix(SEXP fileName, BigMatrix *pMat, SEXP firstLine, SEXP numLines, SEXP numCols, SEXP separator, - SEXP hasRowNames, SEXP useRowNames, double C_NA, double posInf, + SEXP hasRowNames, SEXP useRowNames, double C_NA, double posInf, double negInf, double notANumber) { BMAccessorType mat(*pMat); @@ -808,7 +826,7 @@ SEXP ReadMatrix(SEXP fileName, BigMatrix *pMat, { mat[j-offset][i] = static_cast(posInf); } - else if (std::isinf(d) && d < 0) + else if (std::isinf(d) && d < 0) { mat[j-offset][i] = static_cast(negInf); } @@ -852,7 +870,7 @@ SEXP ReadMatrix(SEXP fileName, BigMatrix *pMat, } else { - Rf_warning( + Rf_warning( (string("Incorrect number of entries in row ")+ttos(j)).c_str()); } } @@ -894,13 +912,13 @@ void WriteMatrix( BigMatrix *pMat, SEXP fileName, SEXP rowNames, } fprintf(FP, "%s", s.c_str()); s.clear(); - for (i=0; i < pMat->nrow(); ++i) + for (i=0; i < pMat->nrow(); ++i) { if ( LOGICAL(rowNames)[0] == Rboolean(TRUE) && !rn.empty()) { s += "\"" + rn[i] + "\"" + sepString; } - for (j=0; j < pMat->ncol(); ++j) + for (j=0; j < pMat->ncol(); ++j) { if ( isna(mat[j][i]) ) { @@ -911,10 +929,10 @@ void WriteMatrix( BigMatrix *pMat, SEXP fileName, SEXP rowNames, s += ttos(mat[j][i]); } if (j < pMat->ncol()-1) - { + { s += sepString; } - else + else { s += "\n"; } @@ -968,7 +986,7 @@ struct SecondLess : public std::binary_function return lhs.second < rhs.second; } } - + bool _naLast; }; @@ -1000,14 +1018,14 @@ struct SecondGreater : public std::binary_function template struct SecondIsNA : public std::unary_function { - bool operator()( const PairType &val ) const + bool operator()( const PairType &val ) const { return isna(val.second); } }; template -void reorder_matrix( MatrixAccessorType m, SEXP orderVec, +void reorder_matrix( MatrixAccessorType m, SEXP orderVec, index_type numColumns, FileBackedBigMatrix *pfbm ) { double *pov = REAL(orderVec); @@ -1030,7 +1048,7 @@ void reorder_matrix( MatrixAccessorType m, SEXP orderVec, // It likely could use improvement as it just goes element by element // Added 9-17-2015 by Charles Determan template -void reorder_matrix2( MatrixAccessorType m, Rcpp::IntegerVector pov, +void reorder_matrix2( MatrixAccessorType m, Rcpp::IntegerVector pov, index_type numRows, FileBackedBigMatrix *pfbm ) { // double *pov = REAL(orderVec); @@ -1038,11 +1056,11 @@ void reorder_matrix2( MatrixAccessorType m, Rcpp::IntegerVector pov, typedef std::vector Values; Values vs(m.ncol()); index_type i,j; - + for (j=0; j < numRows; ++j) { for (i=0; i < m.ncol(); ++i) - { + { vs[i] = m[static_cast(pov[i])-1][j]; } for(i = 0; i < m.ncol(); ++i) @@ -1077,7 +1095,7 @@ SEXP get_order( MatrixAccessorType m, SEXP columns, SEXP naLast, for (i=0; i < static_cast(m.nrow()); ++i) { val = m[col][i]; - if (!isna(val)) + if (!isna(val)) { ov.push_back( std::make_pair( static_cast(i), val) ); } @@ -1102,7 +1120,7 @@ SEXP get_order( MatrixAccessorType m, SEXP columns, SEXP naLast, while (i < ov.size()) { val = m[col][static_cast(ov[i].first)]; - if (!isna(val)) + if (!isna(val)) { ov[i++].second = val; } @@ -1122,12 +1140,12 @@ SEXP get_order( MatrixAccessorType m, SEXP columns, SEXP naLast, } if (LOGICAL(decreasing)[0] == 0) { - std::stable_sort(ov.begin(), ov.end(), + std::stable_sort(ov.begin(), ov.end(), SecondLess(Rf_asInteger(naLast)) ); } else { - std::stable_sort(ov.begin(), ov.end(), + std::stable_sort(ov.begin(), ov.end(), SecondGreater(Rf_asInteger(naLast))); } } @@ -1166,7 +1184,7 @@ SEXP get_order2( MatrixAccessorType m, SEXP rows, SEXP naLast, for (i=0; i < static_cast(m.ncol()); ++i) { val = m[row][i]; - if (!isna(val)) + if (!isna(val)) { ov.push_back( std::make_pair( static_cast(i), val) ); } @@ -1191,7 +1209,7 @@ SEXP get_order2( MatrixAccessorType m, SEXP rows, SEXP naLast, while (i < ov.size()) { val = m[static_cast(ov[i].first)][row]; - if (!isna(val)) + if (!isna(val)) { ov[i++].second = val; } @@ -1211,12 +1229,12 @@ SEXP get_order2( MatrixAccessorType m, SEXP rows, SEXP naLast, } if (LOGICAL(decreasing)[0] == 0) { - std::stable_sort(ov.begin(), ov.end(), + std::stable_sort(ov.begin(), ov.end(), SecondLess(Rf_asInteger(naLast)) ); } else { - std::stable_sort(ov.begin(), ov.end(), + std::stable_sort(ov.begin(), ov.end(), SecondGreater(Rf_asInteger(naLast))); } } @@ -1237,18 +1255,18 @@ SEXP get_order2( MatrixAccessorType m, SEXP rows, SEXP naLast, // [[Rcpp::export]] void ReorderRIntMatrix( SEXP matrixVector, SEXP nrow, SEXP ncol, SEXP orderVec ) { - return reorder_matrix( - MatrixAccessor(INTEGER(matrixVector), + return reorder_matrix( + MatrixAccessor(INTEGER(matrixVector), static_cast(Rf_asInteger(nrow))), orderVec, static_cast(Rf_asInteger(ncol)), NULL ); } // [[Rcpp::export]] -void ReorderRNumericMatrix( SEXP matrixVector, SEXP nrow, SEXP ncol, +void ReorderRNumericMatrix( SEXP matrixVector, SEXP nrow, SEXP ncol, SEXP orderVec ) { - return reorder_matrix( - MatrixAccessor(REAL(matrixVector), + return reorder_matrix( + MatrixAccessor(REAL(matrixVector), static_cast(Rf_asInteger(nrow))), orderVec, static_cast(Rf_asInteger(ncol)), NULL ); } @@ -1308,38 +1326,38 @@ void ReorderBigMatrix( SEXP address, SEXP orderVec ) } // [[Rcpp::export]] -void ReorderRIntMatrixCols( - Rcpp::IntegerMatrix matrixVector, - SEXP nrow, - SEXP ncol, +void ReorderRIntMatrixCols( + Rcpp::IntegerMatrix matrixVector, + SEXP nrow, + SEXP ncol, Rcpp::IntegerVector orderVec ) { - reorder_matrix2( - MatrixAccessor(INTEGER(matrixVector), + reorder_matrix2( + MatrixAccessor(INTEGER(matrixVector), static_cast(Rf_asInteger(nrow)), static_cast(Rf_asInteger(ncol))), orderVec, static_cast(Rf_asInteger(nrow)), NULL ); - + Rcpp::CharacterVector cols = colnames(matrixVector); colnames(matrixVector) = cols[orderVec - 1]; - + return; } // [[Rcpp::export]] -void ReorderRNumericMatrixCols( Rcpp::NumericMatrix matrixVector, SEXP nrow, SEXP ncol, +void ReorderRNumericMatrixCols( Rcpp::NumericMatrix matrixVector, SEXP nrow, SEXP ncol, Rcpp::IntegerVector orderVec ) { - reorder_matrix2( - MatrixAccessor(REAL(matrixVector), + reorder_matrix2( + MatrixAccessor(REAL(matrixVector), static_cast(Rf_asInteger(nrow)), static_cast(Rf_asInteger(ncol))), orderVec, static_cast(Rf_asInteger(nrow)), NULL ); - - + + Rcpp::CharacterVector cols = colnames(matrixVector); colnames(matrixVector) = cols[orderVec - 1]; - + return; } @@ -1418,9 +1436,9 @@ void ReorderBigMatrixCols( SEXP address, SEXP orderVec ) SEXP OrderRIntMatrix( SEXP matrixVector, SEXP nrow, SEXP columns, SEXP naLast, SEXP decreasing ) { - return get_order( - MatrixAccessor(INTEGER(matrixVector), - static_cast(Rf_asInteger(nrow))), + return get_order( + MatrixAccessor(INTEGER(matrixVector), + static_cast(Rf_asInteger(nrow))), columns, naLast, decreasing ); } @@ -1428,9 +1446,9 @@ SEXP OrderRIntMatrix( SEXP matrixVector, SEXP nrow, SEXP columns, SEXP OrderRNumericMatrix( SEXP matrixVector, SEXP nrow, SEXP columns, SEXP naLast, SEXP decreasing ) { - return get_order( - MatrixAccessor(REAL(matrixVector), - static_cast(Rf_asInteger(nrow))), + return get_order( + MatrixAccessor(REAL(matrixVector), + static_cast(Rf_asInteger(nrow))), columns, naLast, decreasing ); } @@ -1446,7 +1464,7 @@ SEXP OrderBigMatrix(SEXP address, SEXP columns, SEXP naLast, SEXP decreasing) return get_order( SepMatrixAccessor(*pMat), columns, naLast, decreasing ); case 2: - return get_order( SepMatrixAccessor(*pMat), + return get_order( SepMatrixAccessor(*pMat), columns, naLast, decreasing ); case 3: return get_order( SepMatrixAccessor(*pMat), @@ -1493,10 +1511,10 @@ SEXP OrderBigMatrix(SEXP address, SEXP columns, SEXP naLast, SEXP decreasing) SEXP OrderRIntMatrixCols( SEXP matrixVector, SEXP nrow, SEXP ncol, SEXP rows, SEXP naLast, SEXP decreasing ) { - return get_order2( - MatrixAccessor(INTEGER(matrixVector), + return get_order2( + MatrixAccessor(INTEGER(matrixVector), static_cast(Rf_asInteger(nrow)), - static_cast(Rf_asInteger(ncol))), + static_cast(Rf_asInteger(ncol))), rows, naLast, decreasing ); } @@ -1504,15 +1522,15 @@ SEXP OrderRIntMatrixCols( SEXP matrixVector, SEXP nrow, SEXP ncol, SEXP OrderRNumericMatrixCols( SEXP matrixVector, SEXP nrow, SEXP ncol, SEXP rows, SEXP naLast, SEXP decreasing ) { - return get_order2( - MatrixAccessor(REAL(matrixVector), + return get_order2( + MatrixAccessor(REAL(matrixVector), static_cast(Rf_asInteger(nrow)), - static_cast(Rf_asInteger(ncol))), + static_cast(Rf_asInteger(ncol))), rows, naLast, decreasing ); } // [[Rcpp::export]] -SEXP OrderBigMatrixCols(SEXP address, SEXP rows, +SEXP OrderBigMatrixCols(SEXP address, SEXP rows, SEXP naLast, SEXP decreasing) { BigMatrix *pMat = reinterpret_cast(R_ExternalPtrAddr(address)); @@ -1524,7 +1542,7 @@ SEXP naLast, SEXP decreasing) return get_order2( SepMatrixAccessor(*pMat), rows, naLast, decreasing ); case 2: - return get_order2( SepMatrixAccessor(*pMat), + return get_order2( SepMatrixAccessor(*pMat), rows, naLast, decreasing ); case 3: return get_order2( SepMatrixAccessor(*pMat), @@ -1604,7 +1622,7 @@ SEXP CCleanIndices(SEXP indices, SEXP rc) return ret; } } - + if ( (zeroIndexCount == numIndices) && (numIndices > 0) ) { protectCount += 2; @@ -1625,7 +1643,7 @@ SEXP CCleanIndices(SEXP indices, SEXP rc) return ret; } if (zeroIndexCount > 0) - { + { protectCount += 2; SEXP returnCond = Rf_protect(Rf_allocVector(LGLSXP,1)); LOGICAL(returnCond)[0] = (Rboolean)1; @@ -1636,7 +1654,7 @@ SEXP CCleanIndices(SEXP indices, SEXP rc) { if (static_cast(pIndices[i]) != 0) { - newPIndices[j++] = pIndices[i]; + newPIndices[j++] = pIndices[i]; } } SET_VECTOR_ELT(ret, 0, returnCond); @@ -1667,7 +1685,7 @@ SEXP CCleanIndices(SEXP indices, SEXP rc) Indices::iterator it; for (i=0; i < static_cast(numIndices); ++i) { - it = std::lower_bound(ind.begin(), ind.end(), + it = std::lower_bound(ind.begin(), ind.end(), static_cast(-1*pIndices[i])); if ( it != ind.end() && *it == -1*static_cast(pIndices[i]) ) { @@ -1711,9 +1729,9 @@ SEXP HasRowColNames(SEXP address) { BigMatrix *pMat = (BigMatrix*)R_ExternalPtrAddr(address); SEXP ret = Rf_protect(Rf_allocVector(LGLSXP,2)); - LOGICAL(ret)[0] = + LOGICAL(ret)[0] = pMat->row_names().empty() ? Rboolean(0) : Rboolean(1); - LOGICAL(ret)[1] = + LOGICAL(ret)[1] = pMat->column_names().empty() ? Rboolean(0) : Rboolean(1); Rf_unprotect(1); return ret; @@ -1729,7 +1747,7 @@ SEXP GetIndexRowNames(SEXP address, SEXP indices_) Rcpp::IntegerVector indices = Rcpp::as(indices_); Rcpp::CharacterVector rcpp_rn = Rcpp::wrap(rn); return rcpp_rn[indices-1]; -// vector c_idx = Rcpp::as >(indices); +// vector c_idx = Rcpp::as >(indices); // return StringVec2RChar(rn, c_idx, indices.size()); } @@ -1742,7 +1760,7 @@ SEXP GetIndexColNames(SEXP address, SEXP indices_) Rcpp::IntegerVector indices = Rcpp::as(indices_); Rcpp::CharacterVector rcpp_cn = Rcpp::wrap(cn); return rcpp_cn[indices-1]; -// vector c_idx = Rcpp::as >(indices); +// vector c_idx = Rcpp::as >(indices); // return StringVec2RChar(cn, c_idx, indices.size()); } @@ -1799,14 +1817,14 @@ SEXP CIsSubMatrix(SEXP bigMatAddr) { BigMatrix *pMat = reinterpret_cast(R_ExternalPtrAddr(bigMatAddr)); SEXP ret = Rf_protect(Rf_allocVector(LGLSXP,1)); - if ( pMat->col_offset() > 0 || + if ( pMat->col_offset() > 0 || pMat->row_offset() > 0 || - pMat->nrow() < pMat->total_rows() || - pMat->ncol() < pMat->total_columns() ) + pMat->nrow() < pMat->total_rows() || + pMat->ncol() < pMat->total_columns() ) { LOGICAL(ret)[0] = (Rboolean) 1; - } - else + } + else { LOGICAL(ret)[0] = (Rboolean) 0; } @@ -1848,8 +1866,8 @@ SEXP IsSharedMemoryBigMatrix(SEXP bigMatAddr) { BigMatrix *pMat = (BigMatrix*)R_ExternalPtrAddr(bigMatAddr); SEXP ret = Rf_protect(Rf_allocVector(LGLSXP,1)); - LOGICAL(ret)[0] = - dynamic_cast(pMat) == NULL ? + LOGICAL(ret)[0] = + dynamic_cast(pMat) == NULL ? static_cast(0) : static_cast(1); Rf_unprotect(1); @@ -1861,8 +1879,8 @@ SEXP IsFileBackedBigMatrix(SEXP bigMatAddr) { BigMatrix *pMat = (BigMatrix*)R_ExternalPtrAddr(bigMatAddr); SEXP ret = Rf_protect(Rf_allocVector(LGLSXP,1)); - LOGICAL(ret)[0] = - dynamic_cast(pMat) == NULL ? + LOGICAL(ret)[0] = + dynamic_cast(pMat) == NULL ? static_cast(0) : static_cast(1); Rf_unprotect(1); @@ -1901,7 +1919,7 @@ inline bool Gcomp(double a, double b, int op) { template -SEXP MWhichMatrix( MatrixType mat, index_type nrow, SEXP selectColumn, +SEXP MWhichMatrix( MatrixType mat, index_type nrow, SEXP selectColumn, SEXP minVal, SEXP maxVal, SEXP chkMin, SEXP chkMax, SEXP opVal, double C_NA ) { index_type numSc = Rf_length(selectColumn); @@ -1926,7 +1944,7 @@ SEXP MWhichMatrix( MatrixType mat, index_type nrow, SEXP selectColumn, } val = (double) mat[(index_type)sc[j]-1][i]; if (chkmin[j]==-1) { // this is an 'neq' - if (ov==1) { + if (ov==1) { // OR with 'neq' if ( (minV!=val) || ( (isna(val) && !isna(minV)) || @@ -1938,18 +1956,18 @@ SEXP MWhichMatrix( MatrixType mat, index_type nrow, SEXP selectColumn, // AND with 'neq' // if they are equal, then break out. if ( (minV==val) || (isna(val) && isna(minV)) ) break; } - } else { // not a 'neq' + } else { // not a 'neq' // If it's an OR operation and it's true for one, it's true for the // whole row. if ( ( (Gcomp(val, minV, chkmin[j]) && Lcomp(val, maxV, chkmax[j])) || - (isna(val) && isna(minV))) && ov==1 ) { + (isna(val) && isna(minV))) && ov==1 ) { ++count; break; } // If it's an AND operation and it's false for one, it's false for // the whole row. - if ( ( (Lcomp(val, minV, 1-chkmin[j]) || Gcomp(val, maxV, 1-chkmax[j])) + if ( ( (Lcomp(val, minV, 1-chkmin[j]) || Gcomp(val, maxV, 1-chkmax[j])) || (isna(val) && !isna(minV)) || (!isna(val) && isna(minV)) ) && ov == 0 ) break; @@ -1979,7 +1997,7 @@ SEXP MWhichMatrix( MatrixType mat, index_type nrow, SEXP selectColumn, if (ov==1) { // OR with 'neq' if ( (minV!=val) || - ( (isna(val) && !isna(minV)) || + ( (isna(val) && !isna(minV)) || (!isna(val) && isna(minV)) ) ) { retVals[k++] = i+1; break; @@ -2096,7 +2114,7 @@ SEXP CreateRAMMatrix(SEXP row, SEXP col, SEXP colnames, SEXP rownames, } SEXP address = R_MakeExternalPtr( dynamic_cast(pMat), R_NilValue, R_NilValue); - R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, + R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, (Rboolean) TRUE); return address; } @@ -2108,7 +2126,7 @@ SEXP CreateRAMMatrix(SEXP row, SEXP col, SEXP colnames, SEXP rownames, { Rprintf("Exception caught while trying to create shared matrix."); } - delete(pMat); + delete(pMat); Rf_error("The shared matrix could not be created\n"); return(R_NilValue); } @@ -2119,17 +2137,17 @@ SEXP CreateRAMMatrix(SEXP row, SEXP col, SEXP colnames, SEXP rownames, // [[Rcpp::export]] void SetRowOffsetInfo( SEXP bigMatAddr, SEXP rowOffset, SEXP numRows ) { - BigMatrix *pMat = + BigMatrix *pMat = reinterpret_cast(R_ExternalPtrAddr(bigMatAddr)); pMat->row_offset(static_cast(REAL(rowOffset)[0])); pMat->nrow(static_cast(REAL(numRows)[0])); - + } // [[Rcpp::export]] void SetColumnOffsetInfo( SEXP bigMatAddr, SEXP colOffset, SEXP numCols ) { - BigMatrix *pMat = + BigMatrix *pMat = reinterpret_cast(R_ExternalPtrAddr(bigMatAddr)); pMat->col_offset(static_cast(REAL(colOffset)[0])); pMat->ncol(static_cast(REAL(numCols)[0])); @@ -2178,8 +2196,8 @@ template std::string type_name(); Rcpp::String GetTypeString( SEXP bigMatAddr ) { Rcpp::XPtr pMat(bigMatAddr); - - + + switch(pMat->matrix_type()) { case 1: @@ -2219,7 +2237,7 @@ SEXP GetMatrixSize( SEXP bigMat ) Rcpp::XPtr pMat(BM_address); // return the matrix size (in bytes) return Rcpp::wrap(pMat->allocation_size()); -} +} // [[Rcpp::export]] @@ -2227,18 +2245,18 @@ SEXP MWhichBigMatrix( SEXP bigMatAddr, SEXP selectColumn, SEXP minVal, SEXP maxVal, SEXP chkMin, SEXP chkMax, SEXP opVal ) { Rcpp::XPtr pMat(bigMatAddr); - + if (pMat->separated_columns()) { switch (pMat->matrix_type()) { case 1: return MWhichMatrix( SepMatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_CHAR); case 2: return MWhichMatrix( SepMatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_SHORT); case 3: return MWhichMatrix( SepMatrixAccessor(*pMat), @@ -2246,15 +2264,15 @@ SEXP MWhichBigMatrix( SEXP bigMatAddr, SEXP selectColumn, SEXP minVal, opVal, NA_BYTE); case 4: return MWhichMatrix( SepMatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_INTEGER); case 6: return MWhichMatrix( SepMatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_FLOAT); case 8: return MWhichMatrix( SepMatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_REAL); } } @@ -2264,11 +2282,11 @@ SEXP MWhichBigMatrix( SEXP bigMatAddr, SEXP selectColumn, SEXP minVal, { case 1: return MWhichMatrix( MatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_CHAR); case 2: return MWhichMatrix( MatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_SHORT); case 3: return MWhichMatrix( MatrixAccessor(*pMat), @@ -2276,15 +2294,15 @@ SEXP MWhichBigMatrix( SEXP bigMatAddr, SEXP selectColumn, SEXP minVal, opVal, NA_BYTE); case 4: return MWhichMatrix( MatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_INTEGER); case 6: return MWhichMatrix( MatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_FLOAT); case 8: return MWhichMatrix( MatrixAccessor(*pMat), - pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, + pMat->nrow(), selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_REAL); } } @@ -2297,7 +2315,7 @@ SEXP MWhichRIntMatrix( SEXP matrixVector, SEXP nrow, SEXP selectColumn, { index_type numRows = static_cast(Rf_asInteger(nrow)); MatrixAccessor mat(INTEGER(matrixVector), numRows); - return MWhichMatrix >(mat, numRows, + return MWhichMatrix >(mat, numRows, selectColumn, minVal, maxVal, chkMin, chkMax, opVal, NA_INTEGER); } @@ -2313,15 +2331,15 @@ SEXP MWhichRNumericMatrix( SEXP matrixVector, SEXP nrow, SEXP selectColumn, // [[Rcpp::export]] SEXP CCountLines(SEXP fileName) -{ +{ FILE *FP; double lineCount = 0; char readChar; FP = fopen(CHAR(Rf_asChar(fileName)), "r"); SEXP ret = Rf_protect(Rf_allocVector(REALSXP,1)); - REAL(ret)[0] = -1; + REAL(ret)[0] = -1; if (FP == NULL) { - Rf_unprotect(1); + Rf_unprotect(1); return(ret); } do { @@ -2329,8 +2347,8 @@ SEXP CCountLines(SEXP fileName) if ('\n' == readChar) ++lineCount; } while( readChar != EOF ); fclose(FP); - REAL(ret)[0] = lineCount; - Rf_unprotect(1); + REAL(ret)[0] = lineCount; + Rf_unprotect(1); return(ret); } @@ -2346,13 +2364,13 @@ SEXP ReadMatrix(SEXP fileName, SEXP bigMatAddr, { case 1: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, + fileName, pMat, firstLine, numLines, numCols, separator, hasRowNames, useRowNames, NA_CHAR, NA_CHAR, NA_CHAR, NA_CHAR); case 2: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_SHORT, NA_SHORT, NA_SHORT, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_SHORT, NA_SHORT, NA_SHORT, NA_SHORT); case 3: return ReadMatrix >( @@ -2361,18 +2379,18 @@ SEXP ReadMatrix(SEXP fileName, SEXP bigMatAddr, NA_BYTE); case 4: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_INTEGER, NA_INTEGER, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_INTEGER, NA_INTEGER, NA_INTEGER, NA_INTEGER); case 6: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_FLOAT, NA_FLOAT, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_FLOAT, NA_FLOAT, NA_FLOAT, NA_FLOAT); case 8: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_REAL, R_PosInf, R_NegInf, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_REAL, R_PosInf, R_NegInf, R_NaN); } } @@ -2382,13 +2400,13 @@ SEXP ReadMatrix(SEXP fileName, SEXP bigMatAddr, { case 1: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, + fileName, pMat, firstLine, numLines, numCols, separator, hasRowNames, useRowNames, NA_CHAR, NA_CHAR, NA_CHAR, NA_CHAR); case 2: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_SHORT, NA_SHORT, NA_SHORT, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_SHORT, NA_SHORT, NA_SHORT, NA_SHORT); case 3: return ReadMatrix >( @@ -2397,18 +2415,18 @@ SEXP ReadMatrix(SEXP fileName, SEXP bigMatAddr, NA_BYTE); case 4: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_INTEGER, NA_INTEGER, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_INTEGER, NA_INTEGER, NA_INTEGER, NA_INTEGER); case 6: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_FLOAT, NA_FLOAT, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_FLOAT, NA_FLOAT, NA_FLOAT, NA_FLOAT); case 8: return ReadMatrix >( - fileName, pMat, firstLine, numLines, numCols, - separator, hasRowNames, useRowNames, NA_REAL, R_PosInf, R_NegInf, + fileName, pMat, firstLine, numLines, numCols, + separator, hasRowNames, useRowNames, NA_REAL, R_PosInf, R_NegInf, R_NaN); } } @@ -2706,7 +2724,7 @@ SEXP GetMatrixAll(SEXP bigMatAddr) void SetMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row, SEXP values) { Rcpp::XPtr pMat(bigMatAddr); - + if (pMat->separated_columns()) { switch (pMat->matrix_type()) @@ -2716,8 +2734,8 @@ void SetMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row, SEXP values) pMat, col, row, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixElements >( - pMat, col, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixElements >( + pMat, col, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -2725,15 +2743,15 @@ void SetMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row, SEXP values) pMat, col, row, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixElements >( + SetMatrixElements >( pMat, col, row, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixElements >( + SetMatrixElements >( pMat, col, row, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixElements >( + SetMatrixElements >( pMat, col, row, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -2746,8 +2764,8 @@ void SetMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row, SEXP values) pMat, col, row, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixElements >( - pMat, col, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixElements >( + pMat, col, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -2755,15 +2773,15 @@ void SetMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row, SEXP values) pMat, col, row, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixElements >( + SetMatrixElements >( pMat, col, row, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixElements >( + SetMatrixElements >( pMat, col, row, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixElements >( + SetMatrixElements >( pMat, col, row, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -2771,10 +2789,10 @@ void SetMatrixElements(SEXP bigMatAddr, SEXP col, SEXP row, SEXP values) // Function contributed by Charles Determan Jr. // [[Rcpp::export]] -void +void SetIndivVectorMatrixElements( - SEXP bigMatAddr, - NumericVector elems, + SEXP bigMatAddr, + NumericVector elems, NumericVector inVec) { BigMatrix *pMat = @@ -2919,8 +2937,8 @@ void SetMatrixAll(SEXP bigMatAddr, SEXP values) pMat, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixAll >( - pMat, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixAll >( + pMat, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -2928,15 +2946,15 @@ void SetMatrixAll(SEXP bigMatAddr, SEXP values) pMat, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixAll >( + SetMatrixAll >( pMat, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixAll >( + SetMatrixAll >( pMat, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixAll >( + SetMatrixAll >( pMat, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -2949,8 +2967,8 @@ void SetMatrixAll(SEXP bigMatAddr, SEXP values) pMat, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixAll >( - pMat, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixAll >( + pMat, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -2958,15 +2976,15 @@ void SetMatrixAll(SEXP bigMatAddr, SEXP values) pMat, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixAll >( + SetMatrixAll >( pMat, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixAll >( + SetMatrixAll >( pMat, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixAll >( + SetMatrixAll >( pMat, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -2985,8 +3003,8 @@ void SetMatrixCols(SEXP bigMatAddr, SEXP col, SEXP values) pMat, col, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixCols >( - pMat, col, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixCols >( + pMat, col, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -2994,15 +3012,15 @@ void SetMatrixCols(SEXP bigMatAddr, SEXP col, SEXP values) pMat, col, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixCols >( + SetMatrixCols >( pMat, col, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixCols >( + SetMatrixCols >( pMat, col, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixCols >( + SetMatrixCols >( pMat, col, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -3015,8 +3033,8 @@ void SetMatrixCols(SEXP bigMatAddr, SEXP col, SEXP values) pMat, col, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixCols >( - pMat, col, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixCols >( + pMat, col, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -3024,15 +3042,15 @@ void SetMatrixCols(SEXP bigMatAddr, SEXP col, SEXP values) pMat, col, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixCols >( + SetMatrixCols >( pMat, col, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixCols >( + SetMatrixCols >( pMat, col, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixCols >( + SetMatrixCols >( pMat, col, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -3051,8 +3069,8 @@ void SetMatrixRows(SEXP bigMatAddr, SEXP row, SEXP values) pMat, row, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixRows >( - pMat, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixRows >( + pMat, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -3060,15 +3078,15 @@ void SetMatrixRows(SEXP bigMatAddr, SEXP row, SEXP values) pMat, row, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixRows >( + SetMatrixRows >( pMat, row, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixRows >( + SetMatrixRows >( pMat, row, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixRows >( + SetMatrixRows >( pMat, row, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -3081,8 +3099,8 @@ void SetMatrixRows(SEXP bigMatAddr, SEXP row, SEXP values) pMat, row, values, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_INTEGER); break; case 2: - SetMatrixRows >( - pMat, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, + SetMatrixRows >( + pMat, row, values, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_INTEGER); break; case 3: @@ -3090,15 +3108,15 @@ void SetMatrixRows(SEXP bigMatAddr, SEXP row, SEXP values) pMat, row, values, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_INTEGER); break; case 4: - SetMatrixRows >( + SetMatrixRows >( pMat, row, values, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_INTEGER); break; case 6: - SetMatrixRows >( + SetMatrixRows >( pMat, row, values, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_FLOAT); break; case 8: - SetMatrixRows >( + SetMatrixRows >( pMat, row, values, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -3121,16 +3139,16 @@ SEXP CreateLocalMatrix(SEXP row, SEXP col, SEXP colnames, SEXP rownames, } // [[Rcpp::export]] -SEXP CreateFileBackedBigMatrix(SEXP fileName, SEXP filePath, SEXP row, - SEXP col, SEXP colnames, SEXP rownames, SEXP typeLength, SEXP ini, +SEXP CreateFileBackedBigMatrix(SEXP fileName, SEXP filePath, SEXP row, + SEXP col, SEXP colnames, SEXP rownames, SEXP typeLength, SEXP ini, SEXP separated) { try { FileBackedBigMatrix *pMat = new FileBackedBigMatrix(); string fn; - string path = ((filePath == R_NilValue) ? - "" : + string path = ((filePath == R_NilValue) ? + "" : RChar2String(filePath)); if (Rf_isNull(fileName)) { @@ -3221,7 +3239,7 @@ SEXP CreateFileBackedBigMatrix(SEXP fileName, SEXP filePath, SEXP row, } SEXP address = R_MakeExternalPtr( dynamic_cast(pMat), R_NilValue, R_NilValue); - R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, + R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, (Rboolean) TRUE); return address; } @@ -3237,12 +3255,12 @@ SEXP CreateFileBackedBigMatrix(SEXP fileName, SEXP filePath, SEXP row, } // [[Rcpp::export]] -SEXP CAttachSharedBigMatrix(SEXP sharedName, SEXP rows, SEXP cols, +SEXP CAttachSharedBigMatrix(SEXP sharedName, SEXP rows, SEXP cols, SEXP rowNames, SEXP colNames, SEXP typeLength, SEXP separated, SEXP readOnly) { SharedMemoryBigMatrix *pMat = new SharedMemoryBigMatrix(); - bool connected = pMat->connect( + bool connected = pMat->connect( string(CHAR(STRING_ELT(sharedName,0))), static_cast(REAL(rows)[0]), static_cast(REAL(cols)[0]), @@ -3264,18 +3282,18 @@ SEXP CAttachSharedBigMatrix(SEXP sharedName, SEXP rows, SEXP cols, } SEXP address = R_MakeExternalPtr( dynamic_cast(pMat), R_NilValue, R_NilValue); - R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, + R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, (Rboolean) TRUE); return address; } // [[Rcpp::export]] -SEXP CAttachFileBackedBigMatrix(SEXP fileName, - SEXP filePath, SEXP rows, SEXP cols, SEXP rowNames, SEXP colNames, +SEXP CAttachFileBackedBigMatrix(SEXP fileName, + SEXP filePath, SEXP rows, SEXP cols, SEXP rowNames, SEXP colNames, SEXP typeLength, SEXP separated, SEXP readOnly) { FileBackedBigMatrix *pMat = new FileBackedBigMatrix(); - bool connected = pMat->connect( + bool connected = pMat->connect( string(CHAR(STRING_ELT(fileName,0))), string(CHAR(STRING_ELT(filePath,0))), static_cast(REAL(rows)[0]), @@ -3298,7 +3316,7 @@ SEXP CAttachFileBackedBigMatrix(SEXP fileName, } SEXP address = R_MakeExternalPtr( dynamic_cast(pMat), R_NilValue, R_NilValue); - R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, + R_RegisterCFinalizerEx(address, (R_CFinalizer_t) CDestroyBigMatrix, (Rboolean) TRUE); return address; } @@ -3311,12 +3329,12 @@ SEXP SharedName( SEXP address ) if (psmbm) return String2RChar(psmbm->shared_name()); Rf_error("Object is not a shared memory big.matrix."); return R_NilValue; - + } // [[Rcpp::export]] -SEXP FileName( SEXP address ) -{ +SEXP FileName( SEXP address ) +{ BigMatrix *pMat = (BigMatrix*)R_ExternalPtrAddr(address); FileBackedBigMatrix *pfbbm = dynamic_cast(pMat); if (pfbbm) return String2RChar(pfbbm->file_name()); @@ -3325,8 +3343,8 @@ SEXP FileName( SEXP address ) } // [[Rcpp::export]] -SEXP DirName( SEXP address ) -{ +SEXP DirName( SEXP address ) +{ BigMatrix *pMat = (BigMatrix*)R_ExternalPtrAddr(address); FileBackedBigMatrix *pfbbm = dynamic_cast(pMat); if (pfbbm) return String2RChar(pfbbm->file_path()); @@ -3335,14 +3353,14 @@ SEXP DirName( SEXP address ) } // [[Rcpp::export]] -SEXP Flush( SEXP address ) -{ - FileBackedBigMatrix *pMat = - reinterpret_cast(R_ExternalPtrAddr(address)); +SEXP Flush( SEXP address ) +{ + FileBackedBigMatrix *pMat = + reinterpret_cast(R_ExternalPtrAddr(address)); FileBackedBigMatrix *pfbbm = dynamic_cast(pMat); SEXP ret = Rf_protect(Rf_allocVector(LGLSXP,1)); if (pfbbm) - { + { LOGICAL(ret)[0] = pfbbm->flush() ? (Rboolean)TRUE : Rboolean(FALSE); } else @@ -3357,8 +3375,8 @@ SEXP Flush( SEXP address ) // [[Rcpp::export]] SEXP IsShared( SEXP address ) { - FileBackedBigMatrix *pMat = - reinterpret_cast(R_ExternalPtrAddr(address)); + FileBackedBigMatrix *pMat = + reinterpret_cast(R_ExternalPtrAddr(address)); SEXP ret = Rf_protect(Rf_allocVector(LGLSXP,1)); LOGICAL(ret)[0] = pMat->shared() ? (Rboolean)TRUE : Rboolean(FALSE); Rf_unprotect(1); @@ -3379,13 +3397,13 @@ SEXP isnil(SEXP address) // Rcpp attributes can be used for R calls and the others // are only used in the C code -// WHERE IS THIS CALLED FROM? Maybe only from C, not from R? +// WHERE IS THIS CALLED FROM? Maybe only from C, not from R? // We might like to be able to do this recycling efficiently in other // cases? I thought we did. void SetAllMatrixElements(SEXP bigMatAddr, SEXP value) { Rcpp::XPtr pMat(bigMatAddr); - + if (pMat->separated_columns()) { switch (pMat->matrix_type()) @@ -3395,7 +3413,7 @@ void SetAllMatrixElements(SEXP bigMatAddr, SEXP value) pMat, value, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_REAL); break; case 2: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_REAL); break; case 3: @@ -3403,15 +3421,15 @@ void SetAllMatrixElements(SEXP bigMatAddr, SEXP value) pMat, value, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_REAL); break; case 4: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_REAL); break; case 6: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_REAL); break; case 8: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -3424,7 +3442,7 @@ void SetAllMatrixElements(SEXP bigMatAddr, SEXP value) pMat, value, NA_CHAR, R_CHAR_MIN, R_CHAR_MAX, NA_REAL); break; case 2: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_SHORT, R_SHORT_MIN, R_SHORT_MAX, NA_REAL); break; case 3: @@ -3432,15 +3450,15 @@ void SetAllMatrixElements(SEXP bigMatAddr, SEXP value) pMat, value, NA_BYTE, R_BYTE_MIN, R_BYTE_MAX, NA_REAL); break; case 4: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_INTEGER, R_INT_MIN, R_INT_MAX, NA_REAL); break; case 6: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_FLOAT, R_FLT_MIN, R_FLT_MAX, NA_REAL); break; case 8: - SetAllMatrixElements >( + SetAllMatrixElements >( pMat, value, NA_REAL, R_DOUBLE_MIN, R_DOUBLE_MAX, NA_REAL); } } @@ -3449,8 +3467,7 @@ void SetAllMatrixElements(SEXP bigMatAddr, SEXP value) // This doesn't appear to be used anywhere?!?! void* GetDataPtr(SEXP address) { - SharedBigMatrix *pMat = + SharedBigMatrix *pMat = reinterpret_cast(R_ExternalPtrAddr(address)); return pMat->data_ptr(); } - diff --git a/src/symbols.rds b/src/symbols.rds new file mode 100644 index 0000000..ebfc09d Binary files /dev/null and b/src/symbols.rds differ