On disk vector

.Rbuildignore

@@ -7,3 +7,5 @@
 ^hooks$
 ^playground$
 ^revdep$
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -2,3 +2,4 @@
 *.so
 *.o
 *.rds
+.Rproj.user

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: MALDIquant
-Version: 1.19.1
-Date: 2019-03-03
+Version: 1.19.15
+Date: 2019-03-05
 Title: Quantitative Analysis of Mass Spectrometry Data
 Authors@R: c(person("Sebastian", "Gibb", role=c("aut", "cre"),
         email="mail@sebastiangibb.de",
@@ -25,4 +25,84 @@ URL: http://strimmerlab.org/software/maldiquant/
 BugReports: https://github.com/sgibb/MALDIquant/issues/
 LazyLoad: yes
 VignetteBuilder: knitr
-RoxygenNote: 5.0.1
+RoxygenNote: 6.1.1
+Collate:
+    'AllClasses.R'
+    'AllGenerics.R'
+    'Deprecated.R'
+    'hidden_aliases.R'
+    'OnDiskVector-class.R'
+    'alignSpectra-functions.R'
+    'approxfun-methods.R'
+    'as-methods.R'
+    'as.matrix-functions.R'
+    'as.matrix-methods.R'
+    'averageMassSpectra-functions.R'
+    'binPeaks-functions.R'
+    'calculateLabelPositions-functions.R'
+    'calibrateIntensity-functions.R'
+    'calibrateIntensity-methods.R'
+    'colMedians-functions.R'
+    'constructor-functions.R'
+    'coordinates-methods.R'
+    'deprecated-functions.R'
+    'detectPeaks-methods.R'
+    'determineWarpingFunctions-functions.R'
+    'doByLabels-functions.R'
+    'estimateBaseline-functions.R'
+    'estimateBaseline-methods.R'
+    'estimateNoise-functions.R'
+    'estimateNoise-methods.R'
+    'filterPeaks-functions.R'
+    'findEmptyMassObjects-functions.R'
+    'findLocalMaxima-methods.R'
+    'grouper-functions.R'
+    'intensity-methods.R'
+    'intensityMatrix-functions.R'
+    'irregular-functions.R'
+    'isEmpty-methods.R'
+    'isFunctionList-functions.R'
+    'isMassObject-functions.R'
+    'isMassObjectList-functions.R'
+    'isRegular-methods.R'
+    'isValidHalfWindowSize-functions.R'
+    'labelPeaks-methods.R'
+    'lapply-functions.R'
+    'length-methods.R'
+    'lines-methods.R'
+    'localMaxima-functions.R'
+    'mapply-functions.R'
+    'mass-methods.R'
+    'match.closest-functions.R'
+    'memoryUsage-functions.R'
+    'merge-functions.R'
+    'metaData-methods.R'
+    'monoisotopic-functions.R'
+    'monoisotopicPeaks-methods.R'
+    'morphologicalFilter-functions.R'
+    'msiSlices-functions.R'
+    'mz-methods.R'
+    'onAttach.R'
+    'plot-methods.R'
+    'plotMsiSlice-functions.R'
+    'plotMsiSlice-methods.R'
+    'points-methods.R'
+    'range-functions.R'
+    'referencePeaks-functions.R'
+    'removeBaseline-methods.R'
+    'removeEmptyMassObjects-functions.R'
+    'reorder-functions.R'
+    'replaceNegativeIntensityValues-functions.R'
+    'show-functions.R'
+    'show-methods.R'
+    'smoothIntensity-methods.R'
+    'smoothingFilters-functions.R'
+    'snr-methods.R'
+    'subset-methods.R'
+    'totalIonCurrent-methods.R'
+    'transformIntensity-methods.R'
+    'trim-methods.R'
+    'unlist-functions.R'
+    'valid-methods.R'
+    'warp-functions.R'
+    'warpingFunction-functions.R'

NAMESPACE

@@ -49,13 +49,17 @@ importFrom("utils",
 
 
 exportClasses("MassPeaks",
-              "MassSpectrum")
+              "MassSpectrum",
+              "MassSpectrumOnDisk",
+              "OnDiskVector")
 
 export("alignSpectra",
        "averageMassSpectra",
        "binPeaks",
        "createMassPeaks",
        "createMassSpectrum",
+       "createMassSpectrumOnDisk",
+       "OnDiskVector",
        "determineWarpingFunctions",
        "filterPeaks",
        "findEmptyMassObjects",

R/AllClasses.R

@@ -1,17 +1,63 @@
 ## basic class for all spectra based information
+
+# AbstractMassObject (VIRTUAL, mass/intensity = "numeric"/"matter_vec", metaData="list/matter")
+# ├── AbstractMassSpectrum (VIRTUAL, just for method implementation)
+# │   ├── MassSpectrum (mass/intensity = "numeric"/"double", metaData="list")
+# │   ├── MassSpectrumOnDisk (mass/intensity = "OnDiskVector", metaData="list")
+# └── MassPeaks (mass/intensity = "numeric"/"double", metaData="list")
+
+
+setClass("OnDiskVector",
+         slots=list(
+                path="character",
+                mpath="character",
+                modification="integer",
+                n="numeric",
+                offset="numeric",
+                size="integer"
+         ),
+         prototype=list(
+                path=character(),
+                mpath=character(),
+                modification=0L,
+                n=numeric(),
+                offset=numeric(),
+                size=integer()
+         )
+)
+
+
+## Set a class union to extend slots 
+#  type to matter Objects
+setClassUnion("NumericOrOnDisk", c("numeric", "OnDiskVector"))
+
 setClass("AbstractMassObject",
-         slots=list(mass="numeric", intensity="numeric",
+         slots=list(mass="NumericOrOnDisk",  
+                    intensity="NumericOrOnDisk", 
                     metaData="list"),
-         prototype=list(mass=numeric(), intensity=numeric(),
+         prototype=list(mass=numeric(), 
+                        intensity=numeric(),
                         metaData=list()),
          contains="VIRTUAL")
 
+## represnt abstract spectrum
+setClass("AbstractMassSpectrum",
+         contains="AbstractMassObject")
+
 ## represent a spectrum
 setClass("MassSpectrum",
-         contains="AbstractMassObject")
+         contains="AbstractMassSpectrum")
+
+## represent an On-disk spectrum 
+setClass("MassSpectrumOnDisk",
+         contains="AbstractMassSpectrum")
 
 ## represent a peak list from a single spectrum
 setClass("MassPeaks",
          slots=list(snr="numeric"),
          prototype=list(snr=numeric()),
          contains="AbstractMassObject")
+
+
+
+

R/AllGenerics.R

@@ -77,7 +77,7 @@ if (is.null(getGeneric("coordinates<-"))) {
 
 ## end of AbstractMassObject
 
-## MassSpectrum
+## MassSpectrum/MassSpectrumOnDisk i.e. AbstractMassSpectrum
 if (is.null(getGeneric("approxfun"))) {
   setGeneric("approxfun",
              function(x, y=NULL, method="linear", yleft, yright, rule=1, f=0,
@@ -128,7 +128,7 @@ if (is.null(getGeneric("totalIonCurrent"))) {
   setGeneric("totalIonCurrent",
              function(object) standardGeneric("totalIonCurrent"))
 }
-## end of MassSpectrum
+## end of MassSpectrum/MassSpectrumOnDisk
 
 ## MassPeaks
 if (is.null(getGeneric("labelPeaks"))) {

R/OnDiskVector-class.R

@@ -0,0 +1,189 @@
+#' @include hidden_aliases.R
+NULL
+
+#' @title OnDiskVector class
+#'
+#' @name OnDiskVector
+#'
+#' @aliases OnDiskVector-class
+#'
+#' @description
+#'
+#' [OnDiskVector-class] objects support the storage of numeric data on-disk. The
+#' data are just loaded into memory when they have to be processed.
+#'
+#' @slot path file path
+#' @slot mpath file path to the modification counter file
+#' @slot modification counter, to detect modification after `odv2 <- odv`
+#' @slot n length of the vector
+#' @slot offset offset of the data in the file
+#' @slot size size of one vector element in the file
+#'
+#' @author Sebastian Gibb <mail@@sebastiangibb.de>
+#'
+#' @noRd
+
+setClass("OnDiskVector",
+    slots=list(
+        path="character",
+        mpath="character",
+        modification="integer",
+        n="numeric",
+        offset="numeric",
+        size="integer"
+    ),
+    prototype=list(
+        path=character(),
+        mpath=character(),
+        modification=0L,
+        n=numeric(),
+        offset=numeric(),
+        size=integer()
+    )
+)
+
+OnDiskVector <- function(x, path, n=length(x), offset=0L, size=8L) {
+    if (missing(x) && missing(path))
+        stop("'x' or 'path' are necessary.")
+    if (!missing(x)) {
+        if (missing(path))
+            path <- tempfile()
+        writeBin(as.double(x), con=path, size=size, endian="little")
+    }
+    mpath <- paste(path, "mod", sep=".")
+    writeBin(0L, mpath, size=NA_integer_, endian="little")
+    new("OnDiskVector", path=path, mpath=mpath, n=n, offset=offset, size=size)
+}
+
+.valid.OnDiskVector.path <- function(x) {
+    if (length(x) != 1L)
+        return("'path' has to be a 'character' of length 1.")
+    if (!file.exists(x))
+        return(paste0("File '", x, "' doesn't exists!"))
+    NULL
+}
+
+.valid.OnDiskVector.modification <- function(x) {
+    if (length(x) != 1L)
+        return("'modification' has to be a 'numeric' of length 1.")
+    NULL
+}
+
+.valid.OnDiskVector.n <- function(x) {
+    if (length(x) != 1L)
+        return("'n' has to be a 'numeric' of length 1.")
+    NULL
+}
+
+.valid.OnDiskVector.offset <- function(x) {
+    if (length(x) != 1L)
+        return("'offset' has to be a 'numeric' of length 1.")
+    if (x < 0)
+        return("'offset' has to be >= 0.")
+    NULL
+}
+
+.valid.OnDiskVector.size <- function(x) {
+    if (length(x) != 1L)
+        return("'size' has to be a 'integer' of length 1.")
+    if (log2(x) %% 1)
+        return("'size' has to be 2^x.")
+    NULL
+}
+
+# .isModified.OnDiskVector <- function(x) {
+#     m <- readBin(x@mpath, integer(), n=1L, size=NA_integer_, endian="little")
+#     if (m != x@modification)
+#         stop(x@path, " was modified by a different object.")
+#     FALSE
+# }
+
+setValidity("OnDiskVector", function(object) {
+    msg <- c(
+        .valid.OnDiskVector.path(object@path),
+        .valid.OnDiskVector.path(object@mpath),
+        .valid.OnDiskVector.modification(object@n),
+        .valid.OnDiskVector.n(object@n),
+        .valid.OnDiskVector.offset(object@offset),
+        .valid.OnDiskVector.size(object@size)
+    )
+    if (is.null(msg)) { TRUE } else { msg }
+})
+
+#' @rdname hidden_aliases
+setMethod("length", "OnDiskVector", function(x)x@n)
+
+#' @rdname hidden_aliases
+setMethod(f="[",
+    signature=signature(x="OnDiskVector", i="numeric", j="missing"),
+    definition=function(x, i, j, ..., drop=FALSE) {
+    if (any(i < 1) || any (i > x@n))
+        stop("Index out of boundaries.")
+
+    #.isModified.OnDiskVector(x)
+    f <- file(x@path, "rb")
+    on.exit(close(f))
+
+    if (length(i) == 1L) {
+        if (x@offset || i > 1L)
+            seek(f, where=x@offset + (i - 1L) * x@size, rw="read")
+        .readBin(f, n=1L, size=x@size)
+    } else if (length(i) == 2) {
+        if (x@offset || i[1L] > 1L)
+            seek(f, where=x@offset + (i[1L] - 1L) * x@size, rw="read")
+        y <- .readBin(f, n=1L, size=x@size)
+            seek(f, where=x@offset + (i[2L] - 1L) * x@size, rw="read")
+        c(y, .readBin(f, n=1L, size=x@size))
+    } else {
+        if (x@offset)
+            seek(f, where=x@offset, rw="read")
+        # that's stupid but not used often
+        .readBin(f, n=x@n, size=x@size)[i]
+    }
+})
+
+#' @rdname hidden_aliases
+setMethod(f="[",
+    signature=signature(x="OnDiskVector", i="missing", j="missing"),
+    definition=function(x, i, j, ..., drop=FALSE) {
+    #.isModified.OnDiskVector(x)
+    f <- file(x@path, "rb")
+    on.exit(close(f))
+    if (x@offset)
+        seek(f, where=x@offset, rw="read")
+    .readBin(f, n=x@n, size=x@size)
+})
+
+#' @rdname hidden_aliases
+setReplaceMethod(f="[",
+    signature=signature(x="OnDiskVector", i="missing", j="missing"),
+    definition=function(x, i, j, ..., value) {
+    if (length(value) != x@n) {
+        stop("Length of 'value' doesn't match length of 'x'.")
+    }
+    f <- file(x@path, "r+b") # unpredictable behaviour with "wb" 
+    on.exit(close(f))
+
+    if (x@offset)
+        seek(f, where=x@offset, rw="write")
+    writeBin(as.double(value), f, size=x@size, endian="little", useBytes = TRUE)
+
+    x@modification <- x@modification + 1L
+    writeBin(x@modification, x@mpath, size=NA_integer_, endian="little")
+    # warning("The OnDiskVector has been modified by the following call:\n", 
+    #         deparse(match.call(definition = sys.function(sys.parent(n=5)))), "\n")
+    x
+})
+
+#' @rdname hidden_aliases
+setMethod("min", "OnDiskVector", function(x)min(x[]))
+
+#' @rdname hidden_aliases
+setMethod("max", "OnDiskVector", function(x)max(x[]))
+
+#' @rdname hidden_aliases
+setMethod("range", "OnDiskVector", function(x)range(x[]))
+
+.readBin <- function(x, n, size) {
+    readBin(x, double(), n=n, size=size, signed=TRUE, endian="little")
+}