Merge pull request #25 from jread-usgs/object-refactor

Object refactor

DESCRIPTION

@@ -14,5 +14,7 @@ Copyright: This software is in the public domain because it contains materials
     http://www.usgs.gov/visual-id/credit_usgs.html#copyright
 Imports:
     yaml
+Suggests:
+    testthat
 LazyLoad: yes
 LazyData: yes

NAMESPACE

@@ -1,15 +1,23 @@
 # Generated by roxygen2 (4.1.1): do not edit by hand
 
+S3method("[",sensor)
+S3method(calc_flags,sensor)
+S3method(flag,sensor)
+S3method(flags,sensor)
+S3method(print,sensor)
+S3method(sensor,data.frame)
+S3method(sensor,sensor)
+S3method(times,sensor)
+S3method(values,sensor)
+S3method(window,sensor)
 export(MAD)
-export(block_stats)
-export(build_flags)
-export(clean_data)
-export(error_code)
+export(flag)
+export(flag.data.frame)
 export(load_sensor)
 export(load_sqc)
-export(persistent)
-export(plot_summary)
-export(stat_window)
-export(threshold)
-export(window_data)
+export(read)
+export(read.default)
+export(sensor)
 import(yaml)
+importFrom(stats,window)
+importFrom(tools,file_ext)

R/config.R

@@ -0,0 +1,4 @@
+as.qconfig <- function(x){
+  class(x) <- 'qconfig'
+  return(x)
+}

R/custom-functions.R

@@ -0,0 +1,68 @@
+
+call.mad <- function(vals){
+  b = 1.4826    # assuming a normal distribution
+  # from Huber 1981:
+  med.val  <-	median(vals)					# median of the input data
+  abs.med.diff	<-	abs(vals-med.val)	# absolute values minus med
+  abs.med	<-	median(abs.med.diff)			# median of these values
+
+  MAD  <-	b*abs.med
+
+  MAD.normalized <- abs.med.diff/MAD # division by zero
+
+  MAD.normalized[is.na(MAD.normalized)] = 0 # doesn't protect against NAs that enter in data.in
+  return(MAD.normalized)
+}
+#'@title median absolute deviation outlier test
+#'@name MAD
+#'@aliases MAD
+#'@aliases median.absolute.deviation
+#'@param x values
+#'@param windows vector of equal length to x specifying windows
+#'@return a vector of MAD normalized values relative to an undefined rejection criteria (usually 2.5 or 3).
+#'@keywords MAD
+#'@author
+#'Jordan S. Read
+#'@export
+MAD <- function(x, windows=parent.frame()$windows){
+
+  stopifnot(length(x) == length(windows))
+  # what is the underlying distribution? (important for assigning "b")
+
+  MAD.out <- vector(length=length(x))
+  un.win <- unique(windows)
+
+  for (i in 1:length(un.win)){
+    win.i <- un.win[i]
+    val.i <- windows == win.i
+    MAD.out[val.i] = call.mad(x[val.i])
+  }
+  return(MAD.out)
+
+}
+
+call.cv <- function(data.in){
+  CV <- 100*sd(data.in)/mean(data.in)
+  CV <- rep(CV,length(data.in))
+  return(CV)
+}  
+coefficient.of.variation <- function(data.in){
+
+
+  if (is.data.frame(data.in)){
+    if (!"block.ID" %in% names(data.in)){stop("CV can only accept numeric data, or a data.frame with the block.ID column for windowed data")}
+    CV.out <- vector(length=nrow(data.in))
+    un.win <- unique(data.in$block.ID)
+
+    for (i in 1:length(un.win)){
+      win.i <- un.win[i]
+      val.i <- data.in$block.ID == win.i
+      CV.out[val.i] = call.cv(data.in$sensor.obs[val.i])
+    }
+    return(CV.out)
+  } else {
+    return(call.cv(data.in))
+  }
+
+
+}

R/expression-helpers.R

@@ -0,0 +1,24 @@
+
+expr_fun <- function(expr){
+  expr <- gsub("\\s","",expr)
+  return(strsplit(expr,split = '[()]')[[1]][1])
+}
+
+expr_var <- function(expr){
+  expr <- gsub("\\s","",expr)
+  if (grepl(pattern = '[(]',expr)){
+    var.nm <- strsplit(expr,split = '[()]')[[1]][2]
+  } else {
+    var.nm <- strsplit(expr,split = '[><=]')[[1]][1]
+  }
+  return(var.nm)
+}
+
+match.sqc.fun <- function(expr){
+  fun = getAnywhere(expr_fun(expr))
+  if (length(fun$objs) == 0)
+    NULL
+  else
+    fun = fun$objs[[1]]
+  return(fun)
+}