Merge pull request #9 from sebkopf/dev

merging dev into master for new version release

.gitignore

@@ -6,3 +6,12 @@
 .R*
 *.*~
 .Rproj.user
+
+# Local package copy for autotest
+.local/*
+
+# Tmp directory
+tmp/*
+
+# Ignore plots created by testing functionality
+tests/testthat/*.pdf

DESCRIPTION

@@ -12,10 +12,10 @@ LazyLoad: yes
 Depends:
     plyr,
     reshape2,
+    ggplot2,
     isotopia
 Suggests:
     testthat,
-    ggplot2,
     gridExtra,
     xlsx
 Roxygen: list(wrap = FALSE)
@@ -28,6 +28,8 @@ Collate:
     'IrmsContinuousFlowDataClass.R'
     'IrmsDualInletDataClass.R'
     'IsodatFileClass.R'
+    'IsodatDualInletFileClass.R'
+    'IsodatClumpedCO2FileClass.R'
     'IsodatHydrogenContinuousFlowFileClass.R'
     'export.R'
     'isoread.R'

Makefile

@@ -27,3 +27,13 @@ check: build
 	cd ..;\
 	R CMD check $(PKGNAME)_$(PKGVERS).tar.gz --as-cran
 
+local-install:
+	rm -rf .local
+	mkdir .local
+	R CMD Install --library=.local .
+
+autotest: local-install
+
+	R -q -e "library(isoread, lib.loc = '.local')" \
+          -e "library(testthat)" \
+          -e "auto_test_package(pkg='.')"

NAMESPACE

@@ -1,4 +1,4 @@
-# Generated by roxygen2 (4.0.0): do not edit by hand
+# Generated by roxygen2 (4.0.2): do not edit by hand
 
 export(export_data)
 export(isoread)
@@ -9,4 +9,6 @@ export(reload)
 export(summarize_all)
 exportClasses(BinaryFile)
 exportClasses(IrmsContinuousFlowData)
+exportClasses(IsodatClumpedCO2File)
+exportClasses(IsodatDualInletFile)
 exportClasses(IsodatHydrogenContinuousFlowFile)

R/BinaryFileClass.R

@@ -83,6 +83,8 @@ BinaryFile <- setRefClass(
       return(read)
     },
 
+    # IMPLEMENT skip_after_each for easy recuriing motive recognition
+    # current problem with that is that it loops through by type (=col)
     parse_array = function(types, n, id = NA, skip_first = 0) {
       "repeatedly read the same set of information into a data frame
 
@@ -124,40 +126,48 @@ BinaryFile <- setRefClass(
       pos <<- as.integer(pos + nbyte)
     },
 
-    find_key = function(pattern, occurence = 1) {
-      "find a key by a regexp pattern"
+    find_key = function(pattern, occurence = NULL, fixed = FALSE, byte_min = 0, byte_max = length(rawdata)) {
+      "finds all keys matching 'key' or a specific occurence of it (use -1 for last occurence)
+      #' @param fixed whether to find the key(s) by regexp match or fixed string (default = pattern)
+      #' @param byte_min only look for keys that start after this position
+      #' @param byte_max only look for keys that start before this position
+      #' @return the lines of the keys data frame with all the information about the found key(s)"
 
       if (nrow(keys) == 0)
         stop("no keys available, make sure load() was called")
 
-      if (nrow(match <- keys[grep(pattern, keys$value),]) == 0)
-        stop("pattern '", pattern, "' was not found")
+      sub_keys <- subset(keys, byteStart > byte_min & byteStart < byte_max)
+      if (nrow(sub_keys) == 0)
+        stop("no keys in this byte interval: ", byte_min, " - ", byte_max)
 
-      if (occurence == -1) occurence <- nrow(match)
+      if (length(idx <- grep(pattern, sub_keys$value, fixed = fixed)) == 0)
+        stop("key '", pattern, "' was not found")
 
-      if (occurence > nrow(match))
-        stop("pattern '", pattern, "' was found but only has ", nrow(match), " occurences ",
-             "(trying to select occurence #", occurence, ")")
+      if (!is.null(occurence)) {
+        if (occurence == -1) occurence <- length(idx)
 
-      return(match[occurence, "value"])
+        if (occurence > length(idx))
+          stop("key '", key, "' was found but only has ", length(idx), " occurences ",
+               "(trying to select occurence #", occurence, ")")
+      } else {
+        occurence <- 1:length(idx) # return ALL found occurences
+      }
+
+      return(sub_keys[idx[occurence], , drop=F])
     },
 
-    move_to_key = function(key, occurence = 1) {
-      "moves position to the end of a specific occurence of a key (use -1 for last occurence)"
-
-      if (nrow(keys) == 0)
-        stop("no keys available, make sure load() was called")
-
-      if (nrow(match <- subset(keys, value==key)) == 0)
-        stop("key '", key, "' was not found")
-
-      if (occurence == -1) occurence <- nrow(match)
-
-      if (occurence > nrow(match))
-        stop("key '", key, "' was found but only has ", nrow(match), " occurences ",
-             "(trying to select occurence #", occurence, ")")
-
-      pos <<- as.integer(match[occurence, "byteEnd"]) + 1L
+    move_to_key = function(key, occurence = 1, fixed = TRUE) {
+      "moves position to the end of a specific key or occurence of a key 
+      #' @param key either a string or a data.frame line with key value and byteEnd (the way it is returned by find_key)
+      #' @param occurence if key is a string, which occurence to move to? (use -1 for last occurence)
+      #' @param fixed whether to find the key (if a string) by regexp match or fixed string (default = fixed string)"
+
+      if (is(key, "character")) key <- find_key(key, occurence, fixed)
+      else if (is(key, "list")) key <- as.data.frame(key)
+
+      if (!is(key, "data.frame") || nrow(key) != 1 || !("byteEnd" %in% names(key))) 
+        stop("not a valid key entry, can't move there: ", key)
+      pos <<- as.integer(key["byteEnd"]) + 1L
     },
 
     read_file = function(){
@@ -278,7 +288,10 @@ BinaryFile <- setRefClass(
       rbind(
         data.frame(Property = c("File location", "Date"), 
                    Value = c(file.path(filepath, filename), format(creation_date))),
-        data.frame(Property = names(data), Value = vapply(data, as.character, FUN.VALUE = character(1), USE.NAMES = FALSE))
+        data.frame(Property = names(data), 
+                   Value = vapply(data, 
+                                  function(i) if (is(i, "data.frame")) "data frame (not shown)" else as.character(i[1]), 
+                                  FUN.VALUE = character(1), USE.NAMES = FALSE))
       )
     },
 

R/IrmsContinuousFlowDataClass.R

@@ -56,13 +56,15 @@ IrmsContinousFlowData <- setRefClass(
 
     # DATA CHECKS ============================
 
-    check_data = function(...) {
-      "check the data consistency, calls \\code{check_crom_data} and \\code{check_peak_table}"
-      callSuper(...)
+    # FIXME: refactor such that check_chrom_data is renmaed directly to check_mass_data
+    check_mass_data = function(...) {
       check_chrom_data(...)
-      check_peak_table(...)
     },
 
+    # FIXME: refactor such that check_data_table is renamed directly to check_peak_table
+    check_data_table = function(...) {
+      check_peak_table(...)
+    },
 
     check_chrom_data = function(masses = names(.self$plotOptions$masses), 
                                 ratios = names(.self$plotOptions$ratios), ..., warn = TRUE) {
@@ -139,6 +141,11 @@ IrmsContinousFlowData <- setRefClass(
 
     # DATA RETRIEVAL ==============
 
+    # FIXME: refactor such that check_chrom_data is renmaed directly to check_mass_data
+    get_data_table = function(...){
+      get_peak_table(...)
+    },
+
     get_peak_table = function(type = c("ref", "data", "both")) {
       "retrieve the peak table"
 

R/IrmsDataClass.R

@@ -5,7 +5,10 @@
 IrmsData <- setRefClass(
   "IrmsData",
   fields = list (
-    plotOptions = 'list'
+    plotOptions = 'list', # stores options for plotting the data
+    massData = 'data.frame', # stores raw data for all measured masses (e.g. voltages)
+    dataTable = 'data.frame', # stores processed data table (=data summary)
+    dataTableColumns = 'data.frame' # the columns of the data table
     ),
   methods = list(
     #' constructor
@@ -16,7 +19,19 @@ IrmsData <- setRefClass(
 
     init_irms_data = function() {
       "initialize irms data container"
-      plotOptions <<- list()
+
+      # template for plot options
+      plotOptions <<- list(
+        masses = list() # example entry: mass46 = list(label = "Mass 46", color="black") 
+      )
+
+      # template for dataTableColumn definitions
+      # data - name of the column header for in the data
+      # column - name of the column stored in the data table
+      # units - units of the data are in
+      # type - which mode it is (character, numeric, logical, Ratio, Abundance, Delta, etc.)
+      # show - whether to show this column in standard data table outputs
+      dataTableColumns <<- data.frame(data = character(), column = character(), units = character(), type = character(), show = logical(), stringsAsFactors = FALSE)
     },
 
     #' @example setSettings(a=5, b='test', ...)
@@ -35,11 +50,43 @@ IrmsData <- setRefClass(
       plotOptions <<- modifyList(plotOptions, options)
     },
 
+    # DATA CHECKS ============================
+
     #' check internal consistency of data
     check_data = function(...) {
+      check_mass_data(...)
+      check_data_table(...)
+    },
+
+    check_mass_data = function(...) {
+      "checks the consistency of the raw mass data" 
+    },
+
+    check_data_table = function(...) {
+      "checks the consistency of the table data" 
     },
 
+    # DATA RETRIEVAL ==============
+
+    #' get data for masses
+    #' @param masses which masses to retrieve, all defined ones by default
+    #' @param melt whether to melt the data frame
+    get_mass_data = function(masses = names(.self$plotOptions$masses), melt = FALSE, ...) {
+      "get the mass trace data for specific masses, can be provided in \\code{melt = TRUE} long format
+      for easy use in ggplot style plotting"
+      stop("not implemented for this class")
+    },
+
+    get_data_table = function(...) {
+      "retrieve the data table"
+      stop("not implemented for this class")
+    },
+
+    # PLOTTING ===================
+
+    #' plot data
     plot = function(...) {
+      "plot data with standard plot functions (fast) to standard output"
       stop("not implemented for this class")
     },