From e3335bd5296bbbad4a530d7ced2ec3ab49643ec3 Mon Sep 17 00:00:00 2001 From: phaverty Date: Fri, 29 Jun 2018 16:59:54 -0700 Subject: [PATCH 1/2] fix a few cases of vectorized or in branching logic rather than scalar or --- R/bigmemory.R | 373 +++++++++++++++++++++++++------------------------- 1 file changed, 183 insertions(+), 190 deletions(-) diff --git a/R/bigmemory.R b/R/bigmemory.R index 0aff2dc..3a8ba65 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,23 @@ 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")) + stop("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") + if ( sum(integerVals == na.omit(as.integer(value))) != length(integerVals) || is.factor(value)) { + warning("non-integer (possibly Inf or -Inf) typecast to integer") } } 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), as.integer(value)) ) x } @@ -747,7 +741,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 +757,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 +800,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 +814,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 +831,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 +860,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 +883,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 +901,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 +918,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 +932,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 +950,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 +1042,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 +1069,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 +1122,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 +1188,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 +1207,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 +1247,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 +1256,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 +1272,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 +1362,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 +1403,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 +1422,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 +1433,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 +1467,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 +1499,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 +1510,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 +1520,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 +1537,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 +1614,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 +1639,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 +1648,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 +1674,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 +1701,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 +1718,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 +1734,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 +1764,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 +1810,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 +1819,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 +1836,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 +1867,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 +1946,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 +1970,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 +2029,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 +2058,7 @@ mpermuteCols <- function(x, order=NULL, rows=NULL, } else { order <- morderCols(x, rows, ...) } - + switch(class(x), "big.matrix" = { ReorderBigMatrixCols(x@address, order) @@ -2079,9 +2073,9 @@ mpermuteCols <- function(x, order=NULL, rows=NULL, }, stop("unimplemented class") ) - + invisible(TRUE) - + } #' @rdname big.matrix @@ -2129,4 +2123,3 @@ getCType <- function(x) { } return(retList[[1]]) } - From d6ad7d3faa7dc14083784c2a8ad7aa007327ceee Mon Sep 17 00:00:00 2001 From: phaverty Date: Mon, 2 Jul 2018 15:29:36 -0700 Subject: [PATCH 2/2] a faster way to convert to int and check for values that change during conversion. From Florian Prive and used in SetElementValues.bm --- R/RcppExports.R | 4 + R/bigmemory.R | 8 +- src/RcppExports.cpp | 12 ++ src/bigmemory.cpp | 503 +++++++++++++++++++++++--------------------- src/symbols.rds | Bin 0 -> 17920 bytes 5 files changed, 277 insertions(+), 250 deletions(-) create mode 100644 src/symbols.rds 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 3a8ba65..51a4034 100644 --- a/R/bigmemory.R +++ b/R/bigmemory.R @@ -677,18 +677,12 @@ SetElements.bm <- function(x, i, j, value) { stop("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") - } - } 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)) + SetMatrixElements(x@address, as.double(j), as.double(i), to_int_checked(value)) ) x } 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 0000000000000000000000000000000000000000..ebfc09d206911cf61117ad9d28a37a210c9aa3ea GIT binary patch literal 17920 zcmagFWl$tR)3%Gd!{RWwv$)&hEbi{^?(XjH?y$JKyDh%BySwwT`@HY-MVvTsPXDOB zIxB0YYa+U*D)UZ21QgJ}1N7X>ta?u*UR9#tl~=S`q`-hVL_}d!UyErY&8pK_qH+EG zuIcH(tjPrf8hz9~W>v`$e$;)q2Y^wdhe@y7Q&Zcd*AKa61Mz0@_J_}KDUCb95Mp%C z0B@a&f0kNAL`dZ8z?T$x+it~Sv*z~Rg_L>Q8rtQ{<G{{}_%Ux8|0} z7H#f&onb-28;c2j-jMlRrHoKK@g)KBB?ZRT$?t+MgQ z&%k49O)^g>&!XGewXX@rGmj)$!~>m#e|75Qx+ zIy==t;kItegv{0WPjb#82kff5fGsYYKd(e?vP(<)bb`CdlfCsy$%h)4n|r+3?~JF@ z_Dyf6+wUI_4^~PXL&I#{Z53NBC~qFGeRc3ean0%jN_5v=%-pt8lWYr2lPpml>6hv$ z23j0BYjT}oCy&#hdGXd~uE6-(FJQ&ac1=2RE_t*mh0825Wjqw&({yF->(d(3*Vz!y z?xk&^di3m6xtpxLTH`$(uG{*{_}20wV|xF)E<}N+{mu<~GsSE3ddNZeK6=+->hb!$ ze~nDFIOG=$X_V~-?atlN^RMbmQA|D>{WXE2B6;~2Vs)xbCr7J~Bq!{#^(9ah0g;w( z&3B*(D?Lye*;non0ge?4+L2=s3jBO|gPk>4KRE>QN?jZ4BEjyh@TrKQx^a~fOY%L1 z#zoCS$k{uwcnV~$yn(j|VGtxy^+cw-1H~ZRP4{V}B<~o+5-;-}2_;3i=n=~O63mau z!9)dqW5u`Hu2nFCzJd%*F=tslmXI<(C;LF{GFs8~3pCcuK76L?j-q3-eLn&jK4pdg2U#9(M)KWr*M zZDh6?VHSc)o>(>0N&rJ8%DLxco_3Ch-1v?@!~+`P zOWF}VKKkUY`ggAKH{3+s7#b(CV#!?+*;7(ueEFgRcaejzD8QkNXe{JX-#9_Vux{gd5>h|YcGLavs1geB{d7NL zY4|ys9$iQw*ig!?eqJS(*1;@I&>xk+DL<^$0qEBqm`GFZnG(Kh)ap%1ZQ{<2HtAow zcqdw}@JeIe7nm1~*gLg#>c14jFrA0%pwWA5Fb)tcD@-!MQm>f#8TQ1gM(pF#Sv0`q zDa^&7ZO@W6@!eD>8|$vgNtw_tFz2#N9z#@jbah*mbs_(XLDHg4sB%WV$7@s=?WyS? zNE=cj$GWtcwXY)}hH_Bw@D0;FR_njq5lA|kCL?w% zdfg?~k_*M*9vYB9fn6GE%YTtKIcUKMMAr}!i=sKMtRfq?@6(4uhA1*RJsKS(cz|g|!N5~Br0xoJL=s>O9itN+ElA?2vV(4b z6z-F+fF5ukirVOyd9m#XBE)$tdDfo3?-3X=TQ4SO`+fHjRP>t;&sjLV8hHEfWq}uv zLc@=npK11qmYzYSbUcjGmccJVzV2IT2cRab3I~Oqd$F-T3rq_X_#Ndr(M%m z_NZ4wrwHx$`U5j91@kAFLIib(D^t8l31ZH!fP9&rKB)pz@a$I{RMsNwIY;xi0)Cc5A6|0LVm*GIUPsgxy48A5QHka+hLFj<;f!D@3%aX&>cE zX(L@D^&di+3hKS>X)ua0`R-}aLG-hf$G?CKOyhw0m%MM5o8CYb)hDieXf-?u_(>(B zn*HPDOv?*1Eq1rt!-zj(f2itdu{oS)l^u9_=Ex>^-%e{D`qMzjK&R-kC4Hag%Vjrw z2)FZ>*mENZAxiThk*`($;Tdi=S8=tR9`(6}JS_}Ei#X>T8B;4zxtFOOq*5%Nb43m- zXkI;6yE6EEfFe6Hz88~^zcr6n@nMe;qtkbW2}o$oDGjK(*e&1+6n1we7W;)@pw6fV z0NBdhpfUdD+E=BBxQBSBC;Y4;)jE%@ds~fhv=V`FgZw<^*uKVO$BB{E&Zj8gz6;no zh28R0D-#l+oNcF+*OuGIghMR59wy0w@f5ysgIIF5TvyWuUyMMy9Wa1DM=@AqfNcJa z&1d|icttB=`9mjAr)fR|YtAgX*^Q#7o&XRikMPWT)9(ZVoV~F zeB-Pb2POxx5)KY!PP|QFd1_oah)DWyXL6i;7M_ZEQb4b%QZZ(J1?!NZjJV`O;e??~ z`PXU1PzHwV6)Olo9*;N+&{*aaeI)-gC&3F-dP+0H@m!4w{}TZ0iDd{BK*@$L zP2~|C5Ql?E9yQz_=KK4=uG*+!J|!FKMP4zNPy}YikVY{YDns?rgwSdbn?c|skRZpU zhIX{&1m1|0syrn8#9^|lmBb+<53g3{cJKJ7=jI~%M8ELc6)PU8`Vmcl!qwW_y@2Ay zTuSaJp%_pG3Th2Q-t2A+u?_;P9Y?^jS$LyN0FG4TO0^;-<>d6zzkiW1u_;8D9k~Q8TL4{tcWmVet zY#iznZm3?O?O6r~#v4{*EV&RrVL}pdqT;BO>LP9n++@vx>D_W0^H`xc@=2LXyPKP% zz=mlDv^VXt%96+EWxh}ID1!90p(8vyTQyb>*FkLt2OfH5OgbW4_lfTqWeG{*p2n-7 z7v=#DoPN2N$?FxFhfg%8KLv|sC@2|ofoVf6xZmN9L-3l!50jD;3*3?E8?1EpA@ud! zMp6lv^IOtIJ@sn3o{Get4^{tDEovN~d-Ejb68|?~xSddhN$%8fu2xJU$X48&nRpYK z=hEkFDkfiV=~`~pDT!+*kWIF1=B?2W;FMlZoR4nQWh}v#+a{&H4&kkN7L1AWb}df+ zI32vj#`@->alY0M;BN`s%ZfKaw1K*O6ndX`-#f~?Z*m~`r55A$!Oj5T`2>W?_mY0E z3)gDPymu;kaRnWzm_4 zf}Si8cmg40y$U?Q9E)CHBG`s!r$!rk%^nA3njpA0aEhfzLpIPg#%_ zKz%`Pp#$ka-F+|ENNjTfZAf^zOH~9NvU~)P4cY!%`MWsgF`D2QJZxXzW$@H=m~=V4 zi6g@;{qd-J_XgUp9?M6!k^4+!!~IYX#1L@<$6wnRbR4%?9pcLN5%=~e?u)a-&5yjZ zdFQZn^q6oc2{K4-IuH|^N|x_=b7_EuU@fhm7@*Ni2F?B)wk(^O`(pTIPz@A`Upru!Uq#XF98lRmR9Ij;xc!-q2N>>zTCdni?KC_!r6`2R{pYt1&vZJ} z(u>q8YvUdn)Ec*{+Mlc@$yRIHq<}1xk+S2>J1;iqU+>(LlV&+-Rr?-rc}5;xtU2{! z+6Qyj0@BkaP`XurN+=#__OshtP15vIe?p4`M?gZFq>qasgCHcriNW(K8jo0hO0q4V z6+}x(E*PyeJL2)3|18I(E5U>*2+*8WfTplCGBI;VlhDaO7GKyMeY&!!T#M>{cjuJU ze_@Gm%*Vy`;nIuErjF%tdQ%Y{Yi=$mf%qx6+4m@Cawa7?`Lvj=g9op;k0^?|PeAqI zk3QE|W09cW7!dJUN7FA0>L|Id)+H7Gn;$9d@_VD5_4C)dujs&hAY*@gvtYmcSSB+< zcchL{m?B3$@iMeGom5}6_j;8xw#&T0R)PWq?;p05K3sr9$^>( zOCGEuH{p@ef2@MYY6KFj#KZPSM=Vbhyu_h7*$;6;QmJy0v5^F#&J2F}(adBF&Y@7Q zlL`-{AqFhrZKO#9Pay_Hu?@v^8g1=8v`dz7i~-~YZouh)9|Pf7+*{NEvbwy~VjX6E ze76()oK&A78ZC9-d+biR-$Erit6?dBQI}vQB{CTt)%fX)wj~Z>v%jv6e5S`{mfDM2 zn4uf8k9e8?f#k?eo_nEe{gF?WnS8ATUwCXNbb1Q7urU`+FE!Q}${=ipGNF<7T5fRI zvG4o0Z7+dqMPtY4^R)ivYy^J1z_56K0$L{)DR`6E$Ztm0-z8TeY3>}tal*6~_0hF{ z>1O23-x@R~3eKXvDa={gJzl8?lC#l_>r{~T+)GjD%`F8Ud)t^}ARWP<@s z(Pg~xe58tm9}avw+kKTMuWL1@WY3~?x^aedU5PP6_+2{;y_Nt_ff%Go1vkPm@(Gnk zUvHGf82QL81Q|)qrH3YNgNf?Ks7~|lT~x{g%63IP2SJzdk5`ySx4|?lBavW`;u{|n zEMMT~E4a%$t(`iB8>OT0Qx74q0N1K3-xAgwd$dZ~v5)K;a((6?OiJj)W-(2HKw+hM z!4w*vvf1+*>#ys`<-6%9lc3x4_(Vg3791pRMzOP6RS!i;**xl~f6ZR5 zh0FBrz&nSQmSiiLN;$@{Eh#uRmP&6j*OqvL^^B0lBL5xkobI+kE(%O0$@FQK;B!68 z;6*2Y#>>6@QpUZ!S%Jpg9jz+G9{M_bzcgQS42&6JoOJcNHW=fX83+lYd_c_NS;?PJ z0d8H5hGjE-c6r&a3^LBW9b7PEw2-mxk+4p)oSXOWrW}48cWWg3lIG9WeGbWJ?+7=) zbI10;m~=bJcm5=c0&$>|??#w{gOa*g^q7P?ELxfwvesf0z=4ekd0v`AXX$rK!E?o4 zia#z_KGaqkmfhYdhH#|(i{R`aC0~&pC{lFB1D~;rNuf|8uKI~U3}`##71h&O?@jpq zOBi|MaZ5S2QyaGbAus-x9yEqm%GhA^H(E7VLY)lDni(C<;j z-R>y?2Vt4eNJmuhXK>!=iQ#~gI4@@F8r`aKc*{{!Lr#Xpx7@O#y1f-6RA)t3x$L5ex>S93G^W ztYa|3&qdGtcyf#zrU9X1O6ica6XBioGDZDHZxOI4@6wP$zDtWvskJyTcu7B)_Dw4C z3O^uLV`6~9s&MD2^~xxXZQOdaA!V4z=liO*eQ2{PiT8A=5>J8hv4JboAjQMIhy(r|QQv{cbtxH- z*c@&{`oz{`jj#4p5A|w?W;*9J#3*j-xg;cu0tU0x&nq=|I;4KOj`%1G;ItgV11t2n zPU1vdx0?OY^-3Y_VrK94c++so2yIw?;j*C{;o)PWKh4WT2inStZQ0PMm%~)ZFKBSq71^*GE6h2sn^mdclm9+l9J}Q%-?SAg0Z`yM;CGpU&het zRqCJM;v>A?UglnHMrksWO)d+Cp#Tg}Yp=v%bVk=Z8rhlr)0!=Ns?Kj8EL1P43Io$r zgXUB&{80v_&mP*yV=>_rY1ELoMMgGMcERq~RH&jmYwtydCE)t>p5dz8X?)*@^`B~a z(zHkRDHwe2Lkom9&Pk?@s5RMkFaeL^^3eD)&^gN6N>>wWUlzd!Y_bv`_LO0E-gqC- z&|Tv3?|!y#0qPgT3orn+mN%85fNOrfiR44FkVlvz@bwz>H0{R&TN7)2hvK2F59pGm zx+VQxBNMU=dDh1nrv&^nk`p?=$0HVQ8D4v;gecK}Wc61@!%IER~B4NbJ zyWR)Ve#0L_<$Te`hbG(=WjKOSO+|8y&5z-aVJC02iE3*{C<=2`g(qpDujd7FHQD5| zImmkrxZPcK#cus&k=91z!{|Tj%w&ZMsx^X*V6Q(0-yixZr*fX ze4GJ2rrkcy-IE-3JIdF(pP}VSPv@|2pEoCF4g4xZffv`z^O=-42Y3eHm0&{-ngCe$ z$h|G_LjeBhN9Jp@a2Y$?47v)-;2JZgnBEICj6k-Unm z!>82)_{rF$LhE@-4V>7#|V^Z&pK)$akl-tp2` z{f^C<1o3Y+MwCS-q1QlakoLbaU~iDFxEbbn%NqYkSR&6gDeXpiif-JEn;cRg^^tmq zGAROn%QQ{K-9BSQ;@xUCHz_K^hV=jVHugXSW0PqlV(ZC$r)E%RFXq+7BgWIkBjNi& z+T%?^aEcLHeS1iX1n`e&g0-yH?L@*InS#9ayMycTJCn`D7dj1kidgAS-(JU$wQ`fV z>3JY94f*mp0PoAYUIwj;ir4|QCrX%x^q2UNEa5h!V-vn3Xe&FFmYUh~`fKq?@Tu>O z@D;4?MrqZJa}$iR1^=}K$ISdYEd~5mjDl-MS&Q}CCY1NPrYbz+^$dMnDUP=omXI#} zI{g$n>el5tk#x)u+#?h4Z+C^^YflnzIj7{Rf{g5tHdt)u87O&44%QPItyA1nhhYi9 zzz?Z^K~&&hMbQ`|eg&5-Sp>I9`4r4(--VCnww#w$4k8M;4wH59W?4?2BytgWn?Va@ zrJ*<^=7yqqx{2PRFOFzljU$UzBIA&DH6=BG`pVOFBi=&mXMq~WCuZ6eE0R^_FLO-B=gw&;^%rbt2CVk@J>;rSbq z=n73z{U#0#moZPkh(ezDn>uv}v>p#vF(;ol;QB0H#8~nVD~!#ZA^rYQC0Lt2bvOX`NSi$u!zBhb97|f=61UwhxRuIV}9Ph1b(PgsvuF9ST8PoVE}M zy{qoc5S_2I9jNWb-548Mdt(W3kFw8Am+WDmw3(D^N1LjfX??e!jKQ}K?#lx)7#wMZ3s8OcO2x}0C_%JvsaruNp@ov(~=n;waVvfiX4 zGg^{mlcQ_zCtyr>Y*8e%w=4?os9lc@kj8RNC1zEZwRm(0IfXGHVb~-61CsKF4!8aa zB)5*4m6#E3eb7U3yG59?8&`nYj%~fM%Yaq%^FMrPLK$X&tGe)Rraa`QK zQNk1~WY(1Ow^k70xxM`XoV8icsOSJq=brGj1D~`>E8fL8+`;X+a`M1g2dD*!Hq8UMdOh zzOHhv1Fc86=o*xeR?J0BBgh>EH{9|%{b#hf1U$I&aBe<`#@m$-wtEPR@)&Os%!DG$ z>|Y2f%M`a`qq)j7kpp~`b!E3**|~2761h^b1r#~svA-ztF9rW4-!DSA`y#}nzqIz3 zX8w{8LQFF>;=n-hbWC<`CbU5oT}jv`GU`!sLi9VjuwMScjp!D~E|EML5AFxfYe;oO z$5TKpe!IWvn%y5+X46nsv?wlhoNx&EwcvcaVOzo9x!Y^9%oiip6xhroIN?Khm+-;? z!QMR1IS0#0`)}SMTjG`wVI87SNXu|=Zh@O3P(NKSYPHWuoq3H`bTNG}>{>^6m*>`b)mC^AxoJ1FxSETJ7%+OJemMl12UETIjTXZBcx z?|vJ+9vHm->*P*84TYWYbIT2i@aL~M(H1G>K1bw6)+fVJhQrDyVrv70=957u=>B}y zBx)l2#xpn(d_0N5}U6aMcc+WRM(VjY|kPK4J~OXmVR3u*&jJ+1i|DAiLpU4eS^ z4dizOiZF;7w}P);;kh>*qMWbY$Xj50gmeeIvyg?A89xIC^{&1NkC9NIq`&|4&^IZu zQ5bL|K$k% z*AWfV7=V_lgrL$!U~1Abl&OwY1zfKjY%x)mw2e(~Vf6oRN>@uS>AzoxLy?+H$=NfA zWaa<_#uZPG|J!qqI26trUf&RvxZc6ZO_A-5tNfIq*t2wQ-60eXd?g&5G$!9IJ)xsW z#yQ}Oh`)|*4e=Rf&&vknA!mN8K^K(>+~vU+-IA?!Dz0~;*OIv9K`!>IHLB0uk2?3w zz3ZziO2~M;805h+x2@1E|Th+y`jT{By_VQnu7pq04*v zY0(yLakhUs?z8saDtwpe%6ZP*L9cu8mzW3YjMYaM5(V>8l`PP<5eJ|rFa~^k58sMm z|C5rJPEJp!%~46SWkR-)%+ z3CkRs!m%JP+4r7~WgbQLNE@{OS|OC!WWYz#_V@BGO~LJ{P=LO@L%pcPgJ}Q;?Vnca z2Sp$()WiuY9bwh5Zi;7c4V9qr-LRCOo7osL@zvBDvGb&OYj<8!e6WXwoLrNNi#c*H z)vc|Y&rCfSiM}~B_=-@C{uj%;7frWbt3@rD9F;?Nj~W8lRyX63p%u}I<5>HB=eAXT zTJ4ZNq9>=KJg)GypWu2-kz9;o~3*F_!2usJmB=UEu z!cdICp-lnARba@MmlQUQMjJv;q3;q;U1zTdY84daE}FjBnn#haJi7w4-yNrd+-dIq zMkYLmk^w^vJvWvWw)gu^o<6qY_HJwg|3VXmAqY+-Kavw$r@$3OWX9Z#92NQR2em16 zSbH8tN0YR#+fTZu;vzN`r(p;@W!{%K?5{OW)PMsoOFub9zk3VvQ2SoJ-{~BV4BC{K zfFpHfe4OI8K26?L0`)!4`eYGfbSHh_V8>PLYCJ4V*kPn^{wI-)${UR_-pVMK^*6ME zbYc3R&_)uwW)fV@QBcgVoGco#>II56^MjJ4M~nQ$JQ`HL)AmoPEg{a3U6=Ww1pV=_VN66k&!5a<)DY9`sByAZ~iFk>gJQh&W}CMsumIkw0Y4ubTW zvSGguc|CIwi3nU1GSzxKbucB&2;-d{v4)p( zw1^>Sr~t^lHPPC?vWqu9u`$xs-VJd+*ggudYt%omrJ5v^fU|^vfe{$JT=7W7jcHW4 zKhB<&ToFYF8gs2~zWJk7Oa8;*vs^X#Wu57XnJcgcD4t0-j0$VfJh~MrsF?D zNC`e{s?A{Y@9Of+hg=ei+CGVt(2ER*nMM-?BI9_vSI$qB5I0uU!qU!1V+_3cB@$f~ zYF%uMR@kf%8uixz?#Eaf7P+OHngjKZKYe$!UbvZ|cmA=wW35DUGuYy&zl%=8zW>s3 zJkpIWxUa(GsD&x3?B<`%pA9rmrn0zLvZ+UMle=0%wLcN$PP^t0A_BuG!awY6F=e;w zd;V3!4J0Sa0aJbupJgHEj{?R?stx8;oNjWgy2Q=Ld}gT`v=YdeBTI$iY&NeuK72S~ zn$JtVgxpABguj0%JjTmI#uRP(wr-Qz8uv$cL16l#1>_F-T?eT#)Qnx9*C1+US$ATf zR$2my1bsV17_7M2t*Eqt*{Y8&-gR^|FQ}R1mULYcJN2$YO?7>)NQP67@F(I%xdFEN zF&HVb299jDRi{VF!a&7(c#8R+k`GQ$iRO8E%K!RCwNTEyAug`$lGMN!ex^bKLOVPPTs)HM^rkUn;E2SibZ@<7w#crH{`APl7o^Ze?umEW_a z4+Z^w+n(^dYT)J&GJiA?!fnjh3NVva-Kdqz1uz7tQ1l#Y%^=SH;gLnET*ZoWr^#@H z<$>l@IXc#;>+|A@(Nj#EuHW~gm|Bx?mWL+Lj_$+~+9f+_4LK}+07~GgiG%uRZ;>U1 zFiAjen+=O~#M|f{PF)s8W7fPUbr*5rpA2dEy%6fA#|KTmWItjTydEl!j?Y7buI8NN zH`)(kYy<;A=0i+@DFnRmQwpv*Ww%aOlahfw)ac@Ov|8nxEcc?a5}o6eTAWU(L~5Ik zz8*AU+bwh?XB)J5Ku3tf6V&ht9-wSn_{Pzh8)~%eSS;5=C(9QJ9yX-^8;Mr|5u`zY zbv_g)J{SH+GLR`Jh;eY$aCwRp;Mz!xA|!B;MxFDD0#O!~YKY-eO>6;HIyf3i+`K6pli56W8+C`X*Jp=7IUY6$nM;musXA$Pwy?Q z+#6Z*R4ka>8w2mne@RtuklmeFiBxCTXm_5T-fIWf3qPstv^C^A#SChN3rWI8jVbex zt2$hlAIdFUt4(VF&*kmA_O7D2S!#UnKa^{BrK%ZqCe!l9=Ekp4<1NH2mZNvdO>+qq ziX`AhY?ce7WHth>WwgZ#h_$=R`YTEx)lA}vX>W3Jis2JaYA|OkiRy!L-1Ic#OK$kK zU$@(XgB+}Pf{wG(t#FM;_|aGKho)u)dAP|MdU0}n$1$B06`sM{5#B0EJlwWJQOQ44^j zD&$AfX?(4b(iA?3QkBF|vXa{aQmMTbV^gL0DWU9so1vvz(uQE}nA0dl<=7`u=$}E? z3r!?te(X7CYczUl__VlN&5T#XU%k_7&e)$p#r=h&l5IN$pz{_bu4B4q;se z&ZywZD3;n5{OxTt>7Xt9&+v0B8wn~)s!a$bRga<7c$kc_X8v!B+1E{l|M{T*brqm` zYxWEE!qwue!Nu{2K5eEy4(noIMeAxEqGX-B`D;$CZLb^qBAnH+#-Y_( zX*!$hr#JreBQwOl73cQcCpp{F$I?R}?Hn1!Wn&WTlzDsU+CiVSXzSKmbHtd{_cP~2 z*s0k68oAs4Yi#;wWR<_@RNbJ^SH^7$a(VR3C);M(c~T!v{FVQ3{Tojn;PA?4c#`wm zR77DCD&KI>Wp+A1KOcMvn&^82`zb2kIdrf?abi)gA9jV({sw<# z!uZFVkYb@1QvO>%mTv=&BDn0+9}qRrsy9B$@W89iHGh4zx3+)V^T28}A@{{{r2iq6Lv$n|49+{N~#>8aF*t{I z*1npy+^;5DtoP-$;bR{c-_(!>Pm~LRw8fXNwcueFnKVKcGSF;5g z1Q*t*c7sIKU|t~%tT>M3GYV!C8b-AFSL<_<2-DL6@?Q0O_IsTh@>a3bdb5}lqPp0TS-5C1n$7!7=~CJmN_Lp7sFI$~7$xre>zGdusn z2OCC>vLG~)gS2;x&_s&mz%p%!RV5^RFDvI&MbV!$p*Zw*#ErLi7goH9FZ_yfCTb+J z^ZEdupq9mLd%aOiED76vm%o|0Z&HJiZ@<~mpr5WHxIE9@Xen8GS3hv)53=KM;A)hS zB2m}J994R?Uo+DX1viO9=z5SoI93oYtzy_7)>yXt@-tu=T0hp2{HLjy^oASbqXlC!g8 zKw|D5m(fb?;~Vc~p^-%2!aUqtPe-47O>>loD|(@KjE9{_Q=R+G57Y^A#PKA638I&| z-uJtGrMo+3w|pFz;u$7`*6bT@t$LHugv%+^?7LByoe%ew_M4GKE)lP@#~=WC5I{Kd zJ?1^;^o{-d+mm$wpYyMWPD~Aq0@F0%5#{+hVz1w4qNi4LWfG;`O{+b4$62D4-vr<- zgWp2c<{{S1e#${d%YGAp%aA+wIrBN2N6Z^^W-6CrT>B&LGReU$lz(v+Bf7x)z}I!i z*VJD3l?LnuXdJiPr%7F#w(Ui>fwkTPNCk}(^feXwjD>MxYtn?zN7P)h02mn+ry>`Z z)LCnM->$gdKQ13%Z5E}2v32?SsoGciBW<l2=bRjwySdu3K6^am9mK>zmUA*T+?aesSzuv`B7cdX6JyI{}@PkKxO-mW*jp#?{Qi+PIp+-<0}M!|DE*s&2Dr1HK1x@ zKL7${3lYgT#`m4LCYzs3MS4DN@XQ1e@e}KW44|{~0DEHocF((^DjR+bDFkh~x$}KiuF;;KQ{M*dhxFwGfV?k2 z?(utm3OXmhxh()q3A+38VF4Wi<)5$j16bH=rpl$361^49)l)K054uAxw>`c#PhY1P z6x?*S)2RZdW41{bmDBZV30Bz6$NsOr>dnn__4bFW|4J1RJeLmZ-#gm>4X)~a^e)Bs zylj5H>eL?CdUfjQFZyh{#&>2f><)hre3Z=ds7-ou+IOA*Ja{!z1>S7xc_PtfxIeV`jQnsVfwyt0X&IWo0dZW|x?&$_|r<20RYh;=YbRdV-lCmM#*lLOTUxOpxh)WOFD_#y(m6LfJGeBZp31pY*L-uw-vnnL0Y zuWobuoJX14O__Vi3(x_18$iN*6bzt~5#7CA3I^iMT|#(zN8Q56bHh~yJosMvxifA} z192tg-8%qM0nFYWM!M_N7C+j3pOG!;wx-2^F?d1GuxI(0FSxw6GJ#Wv`8_c0R)a_e zmIR0QrV|E!UvD#Y>71qdegeH&L#84Q?gL-tU5-kcevT}e_<%(Y1N&@bW6AP?Jb-Q? zifVqCaso{O8~^C^&5Z3#>+ysgE+DzSCnM~7pWuA+#+`h+8E4YXTHYQ<>|Om5 z5p&JBO#5!+Iz%GaW`p+TxqaJ1JbUcDMTK5I1bOY!25f;&68E%$^6~+{fY+GBBG%-b z-#>dY>wYA$biE1ccF$q~f5<`%vCQZg>TiwDfj+PWP<=fe{s*;k-rXZ5qCFhY*rB~& zL0>X6r7QQt=5^pr>9!s>X_)F!0H&xG3B)DP>n;Mw8CcCB!d5d^Pa8(?Wh!?MhhYgF zM9RzC^HOo%iV5(<&qiIz;Ih4ID`fHt_7b zHPfYpxdC|w>6wFnYxa`eWxioGqJo-KQRJTRsHov?1K&XoIt&Vy1H9YK!oJ1E|J3vx zaW9DBDicER3G~DRwUOle49gyJ?Ek9V69arnja-9x?hN#axJG>hbZB#W*lqld+2er% z&FN$Dlds1EF_mv~8r05~3vcTkAA9J%4&R5Y?YnS~8zs~whPb)kW#y%YsEg0lf z0RcP6hDv}f!FP7JkcSc=+?HyPKH+`8#cx0z5x$RyR=s`>W=IHYB|zKxH;Omasnfo% zKcHMUp?6^WiuOK4CcVJ!@bwW9KY%X*KWy=~Kzrf0aKZcqA3%G9_Avrn9DAlOwtM-Y zTtDC6gFrt}mLD4-AUDQ)Y(r%v-uxVP(X<)5?|?Xb9eBVxHo>3oe7(UoUY&hkEx+c= z@T3jwPkiKo4|ORQpmGe}*L~nZKl4s-)P({C`49xf-t4;qo`nefsQiQ7Q5y7^A7n3N zPD>^hS^V)n!_dys-JfOC5^&gSXM^vLg3(UjTD?tj zao$?aW{N3twf0B+^$bnC1e<`h*wH>!R%CHo7>~uOwG`&YBawYr>~)euYH9o=;9xb* z8$}=^!>HdG*4_1buEKV?V`HIDJQ||BmBu&ew&1tQq8XHm$CGI;l@EJ51>_0Pl9APwD$cJO z-rZVWi=f6q1FOcqmEGEhlN#QUx&!C5DxyrI1tZmaAj;OtNdK$GwsU8^MRQ1umQlFo zuFzZ)aDEFcemwr^(p)#|DDXxY|3$_!PJea98SdsGfA_z=rg;23RHoS)jk(+gmZKKe zs?B?iu9X@$>fDR8ZnXHP2inxb=@ly3IcSY+p)8Hf+|8U1L;H&}pc#jl`FQP zNTOOCYt@2kJo9RxRkEPE1RE3R)5tU$>Clfga=ZAHpU2 zA_U~v8u$>XFJB~JYb$o4FW(R-TML6$@LKDpHINpTyD&&6Rko`&po;&!lb`ePf_t^r zql7nK^Fwm0)UXfznjeRduM`df^4Bd9f~@_&%>zB`Yibcfz8Zo#uCgIcJk#$6o<5F9 zx8mbm?9Xh%+==8b_FZ* zwJ_ok{}T^Sdb$N0tm|)fF7+v;mE1M0IzC{VTBFyJbEGUlTu8VcAi?f^tkFYZ$fP#1 z7hMPqF{vcziyuktInY1W(Oc5gpLWqapN~Y=fk%2>u{T?RFxn9YuLcK)48`V8euTAy z4tO^~J1E#tyrsb_c`rmIn4Mj$u(m_haQz zGAEHzG|UcGPRG533=aqTJ`Cu-hiMXW%CdOkXI|iNbchlN15FCIOTeMcPZ^p_lA{%! z2zwpQ?EIIT$TvLVz-#@J=X4u=9lvr+C`AT!X_oh1$@+s)Qw*ZVsmzEVW1S*zu~1JV zoVe<+Q610LsHA z$tE%3F=QQNL+wb{(WkBxxXY<0njj%N0W&A#r8Q0--d|@HOxfIMskK`@hmG z;9hLO`Z)QpK>0!!g~ATSud1t<5(*KbRg7K*sR(@`rPGFxm_&;h^*{IsBGJQkq=*O* z{ktV#yL+*c$g15P^TmrCM5w?IG?mjV)BSfauuW%a{j3*-(GXwT%3~R-qC;JJZc{)u z)Wfz3q151yh*&1$W5Z(kl9dx6)H!MlC ze}63AE1&6KWWqn#-%y0;vFwBj#r5|csUqM7gJe7;Ac%*?Wq^o>eEAZnLq7Ry`V*}J z>EwgP1tQ1(1Rj+Y!h-^oVubfV2p{-$twA#C5th+@$ohnhef>Sm@aB!Q;>)}3m{hjy#u8gA;tPhXY%FBAOU8`(ew(&KkIOETtx%p${iuegR(yDJ)S%YpSbvO}t_3=f=3&A;sPo;K`0e>>e6he_Ggb03T5p_Hioo z^x$$gMKMMD8{eKGg z4KLYarN;kng?r^#>YGIBunP4a6)*87)+!uE@IyVfm7;-fiFtbWEIN zQN@y+C`3`iu6mWbVBD|L&^ctTVf4J&(pxT~e%AjJ=K~o0@r2~JM*gQLbTrdX9%6TS zj1N`Z4=*wOxO03Q*ymhG7?b+G3OohK6K`etxH9Z3XbZfXxOndOY6;@`!EDru!n zx@n~o7Su&|FqzyDj_$gvzC`DY3qqS11no{{=(l(apJ6wmk_Gqil*J;;F21YpdDf}j z{I345!VA|Dz7-0Mwbf-f(#dd$8bWQK7&*~MH&*NZivRwK|8}nU%XxC*S^@I#572BKpNqW5 zAm!F7ZGKVmW{Qz^YI~oXyb{u+tQi%w^BKx}3{r`nuKT6Rn<++7Pi=h0(xVu{jx-|P z-ZwDsF-RrqzwT!;Z>AVU^*8y31{G+k<~*jKPMY@9_vFi+C-HszVv)G$@G~Cjmg(9p z?+SRI`Mes!rsk<-6Ms*(u!$W61!PSy$19uccF824q>FnwEHrH+L-R%mp1EeR@~EQI z72W=5Q?hqX<~g=N|KrMXObD=M<;wREU zb2Dz`YWAs4o$qlrP(|ya z*6GS!`{t|gz0%e{Tw3!5Uf=>#7rFqdZ~H>+9=?Y^O7N=jDmuQ~@)H~OLybS2Xp7IT zwRcHh;V-DS2Vzybh~I(PH{ literal 0 HcmV?d00001