fix test for plotmat for NoSuggests-scenario

R/DollarNames.R

@@ -0,0 +1,29 @@
+##' command line completion for $
+##'
+##' @aliases .DollarNames .DollarNames,hyperSpec-method
+##' @author C. Beleites
+##' @seealso \code{\link[utils]{.DollarNames}}
+##' @export
+##' @rdname dollarnames
+##' @keywords utilities
+##' @title command line completion for $
+##' @param x the hyperSpecobject
+##' @param pattern pattern to look for
+##' @return the name of the extra data slot
+##' @importFrom utils .DollarNames
+.DollarNames.hyperSpec <- function (x, pattern = "")
+  grep (pattern, colnames (x@data), value = TRUE)
+
+.test (.DollarNames.hyperSpec) <- function(){
+  context (".DollarNames")
+
+  test_that("expansion on missing pattern", {
+    expect_equal(.DollarNames (flu), colnames (flu))
+  })
+
+  test_that("expansion on missing pattern", {
+    expect_equal(.DollarNames (flu, "f"), "filename")
+    expect_equal(.DollarNames (flu, "c"), c ("spc", "c"))
+  })
+
+}

R/NEW-functions.R

@@ -0,0 +1,78 @@
+
+#' Future functions
+#'
+#' These functions will be introduced in \pkg{hyperSpec} v1.0 and will replace
+#' some current functions. Now they appear here just for compatibility with
+#' other packages, which should be released on CRAN. They are not intended to
+#' be used by \pkg{hyperSpec} v0.100 users directly.
+#'
+#' @param ... Arguments to functions.
+#' @param x,from,to,ref_wl Arguments to functions.
+#'
+#' @name Future-functions
+NULL
+
+
+#' @rdname Future-functions
+#' @include fileio.optional.R
+#' @export
+.spc_io_postprocess_optional <- function(...) {
+  .fileio.optional(...)
+}
+
+
+#' @rdname Future-functions
+#' @include wl.R
+#' @export
+wl_convert_units <- function(x, from, to, ref_wl = NULL) {
+  wlconv(points = x, src = from, dst = to, laser = ref_wl)
+}
+
+#' @rdname Future-functions
+#' @include options.R
+#' @export
+hy_set_options <- function(...) {
+  hy.setOption(...)
+}
+
+#' @rdname Future-functions
+#' @include options.R
+#' @export
+hy_get_option <- function(...) {
+  hy.getOption(...)
+}
+
+#' @rdname Future-functions
+#' @include options.R
+#' @export
+hy_set_options <- function(...) {
+  hy.getOptions(...)
+}
+
+#' @rdname Future-functions
+#' @include read.txt.long.R
+#' @export
+read_txt_long <- function(...) {
+  read.txt.long(...)
+}
+
+#' @rdname Future-functions
+#' @include read.txt.wide.R
+#' @export
+read_txt_wide <- function(...) {
+  read.txt.wide(...)
+}
+
+#' @rdname Future-functions
+#' @include wl.R
+#' @export
+.wl_fix_unit_name <- function(...) {
+  .fixunitname(...)
+}
+
+#' @rdname Future-functions
+#' @include chk.hy.R
+#' @export
+assert_hyperSpec  <- function(...) {
+  chk.hy(...)
+}

R/call.list.R

@@ -0,0 +1,16 @@
+###-----------------------------------------------------------------------------
+###
+### generate a list of function arguments for the calling function
+###
+##'@noRd
+.call.list <- function (x = NULL) {
+  if (is.null (x))
+    x <- sys.call (-1)
+
+  if (length (x) < 3L)
+    I (list ())
+  else {
+    x <- as.list (x [- (1 : 2)])
+    I (x)
+  }
+}

R/chk.hy.R

@@ -0,0 +1,20 @@
+##' Check whether an object is a hyperSpec object and validate the object
+##'
+##' @title Validation of hyperSpec objects
+##' @aliases validObject validObject,hyperSpec-method chk.hy
+##' @author C. Beleites
+##' @seealso \code{\link[methods]{validObject}}
+##' @param object the object to check
+##' @return \code{TRUE} if the check passes, otherwise stop with an
+##' error.
+##' @keywords methods
+##' @export
+##' @examples 
+##' chk.hy (chondro)
+##' validObject (chondro)
+chk.hy <- function (object){
+  if (! is (object, "hyperSpec"))
+    stop ("no hyperSpec object")
+
+  TRUE
+}

R/chondro.R

@@ -0,0 +1,51 @@
+.make.chondro <- function (){
+  new ("hyperSpec",
+       spc =  (tcrossprod (.chondro.scores, .chondro.loadings) +
+               rep (.chondro.center, each = nrow (.chondro.scores))),
+       wavelength = .chondro.wl,
+       data = .chondro.extra, labels = .chondro.labels)
+}
+
+##' Raman spectra of 2 Chondrocytes in Cartilage
+##' A Raman-map (laterally resolved Raman spectra) of chondrocytes in
+##' cartilage.
+##' 
+##' See the vignette \code{vignette ("chondro", package = "hyperSpec")}.
+##' 
+##' @name chondro
+##' @docType data
+##' @format The data set has 875 Raman spectra measured on a 25 \eqn{\times}{x}
+##'   35 grid with 1 micron step size. Spatial information is in
+##'   \code{chondro$x} and \code{chondro$y}. Each spectrum has 300 data points
+##'   in the range of ca. 600 - 1800 cm\eqn{^{-1}}{^-1}.
+##' @author A. Bonifacio and C. Beleites
+##' @keywords datasets
+##' @references The raw data is available at \url{http://hyperspec.r-forge.r-project.org/blob/chondro.zip}
+##' @export chondro
+##' @examples
+##' 
+##' 
+##' chondro
+##' 
+##' ## do baseline correction
+##' baselines <- spc.fit.poly.below (chondro)
+##' chondro <- chondro - baselines
+##' 
+##' ## area normalization
+##' chondro <- chondro / colMeans (chondro)
+##' 
+##' ## substact common composition
+##' chondro <- chondro - quantile (chondro, 0.05)
+##' 
+##' cols <- c ("dark blue", "orange", "#C02020")
+##' plotmap (chondro, clusters ~ x * y, col.regions = cols)
+##' 
+##' cluster.means <- aggregate (chondro, chondro$clusters, mean_pm_sd)
+##' plot (cluster.means, stacked = ".aggregate", fill = ".aggregate", col = cols)
+##' 
+##' ## plot nucleic acid bands
+##' plotmap (chondro[, , c( 728, 782, 1098, 1240, 1482, 1577)],
+##'        col.regions = colorRampPalette (c ("white", "gold", "dark green"), space = "Lab") (20))
+##' 
+delayedAssign ("chondro", .make.chondro ())
+

R/count_lines.R

@@ -0,0 +1,37 @@
+##' count lines (of an ASCII file)
+##'
+##' @param file the file name or connection
+##' @param chunksize `file` is read in chunks of `chunksize` lines. 
+##' @return number of lines in file
+##' @export
+##' @md
+##' @author C. Beleites
+count_lines <- function(file, chunksize = 1e4) {
+  nlines <- 0
+
+  con <- file(file, open = "r")
+  on.exit(close (con))
+
+  while ((n <- length (readLines(con, n = chunksize))) > 0L)
+    nlines <- nlines + n
+
+  nlines
+}
+
+.test (count_lines) <- function (){
+  context ("count_lines")
+
+  tmpfile <- tempfile()
+  on.exit (unlink (tmpfile))
+
+  writeLines("blabla\nblubb", con = tmpfile)
+
+  test_that("file read in one chunk", 
+            expect_equal (count_lines (tmpfile), 2)
+  )
+
+  test_that("file read in more chunks", 
+            expect_equal (count_lines (tmpfile, chunksize = 1L), 2)
+  )
+
+}

R/cov.R

@@ -0,0 +1,53 @@
+##' Covariance matrices for hyperSpec objects
+##'
+##'
+##' @param x hyperSpec object
+##' @param y not supported
+##' @param use,method handed to  \code{\link[stats]{cov}}
+##' @return covariance matrix of size \code{nwl (x)} x  \code{nwl (x)}
+##' @seealso \code{\link[stats]{cov}}
+##' @author C. Beleites
+##' @rdname cov
+##' @export
+##' @examples
+##' image (cov (chondro))
+setMethod ("cov", signature = signature (x = "hyperSpec", y = "missing"), function (x, y, use, method){
+  validObject (x)
+
+  cov (x@data$spc, use = use, method = method)
+})
+
+
+##' @param ... ignored
+##' @param regularize regularization of the covariance matrix. Set \code{0} to switch off
+##'
+##' \code{pooled.cov} calculates pooled covariance like e.g. in LDA.
+##' @param groups factor indicating the groups
+##' @rdname cov
+##' @export
+##' @examples
+##' pcov <-  pooled.cov (chondro, chondro$clusters)
+##' plot (pcov$means)
+##' image (pcov$COV)
+##'
+pooled.cov <- function (x, groups, ..., regularize = 1e-5 * max (abs (COV))){
+  chk.hy (x)
+  validObject (x)
+
+  if (! is.factor (groups))
+    stop ("groups must be a factor")
+
+  x      <- x      [! is.na (groups)]
+  groups <- groups [! is.na (groups)]
+
+  means <- aggregate (x, groups, "mean") # TODO: speed up?
+
+  COV <- cov (x@data$spc - means@data$spc [as.numeric (groups),, drop = FALSE])
+
+  ## regularization
+  COV <- COV + diag (regularize, nrow (COV))
+
+  list (COV = COV,
+        means = means)
+}
+

R/deprecated.R

@@ -0,0 +1,43 @@
+
+
+##' @rdname read.asc.Andor
+##' @export
+##' @keywords internal
+scan.asc.Andor <- function (...) {.Deprecated("read.asc.Andor"); read.asc.Andor(...)}
+
+##' @rdname read.txt.Renishaw
+##' @export
+##' @keywords internal
+scan.txt.Renishaw <- function (...) {.Deprecated("read.txt.Renishaw()"); read.txt.Renishaw(...)}
+
+##' @rdname read.txt.Renishaw
+##' @export
+##' @keywords internal
+scan.zip.Renishaw <- function (...) {.Deprecated("read.(zip.Renishaw)"); read.zip.Renishaw(...)}
+
+##' @rdname read.txt.Witec
+##' @export
+##' @keywords internal
+scan.txt.Witec <- function (...) {.Deprecated("read.txt.Witec()"); read.txt.Witec(...)}
+
+##' @rdname read.txt.Witec
+##' @export
+##' @keywords internal
+scan.dat.Witec <- function (...) {.Deprecated("read.dat.Witec())"); read.dat.Witec(...)}
+
+##' @rdname read.txt.Witec
+##' @export
+##' @keywords internal
+scan.txt.Witec.Graph <- function (...) {.Deprecated("read.txt.Witec.Graph()"); read.txt.Witec.Graph(...)}
+
+
+#### DEFUNCT ##################################################################################################
+
+##' @export
+##' @rdname read.mat.Cytospec
+read.cytomat <- function (...){
+  .Defunct ("read.mat.Cytospec",
+            package = "hyperSpec",
+            msg = "read.mat.Cytospec is now defunct.\nPlease use read.mat.Cytospec instead.")
+}
+

R/factor2num.R

@@ -0,0 +1,10 @@
+###-----------------------------------------------------------------------------
+###
+### factor2num - conversion of a factor containing numerical levels
+###
+###
+##TODO: export
+
+factor2num <- function (f)
+	as.numeric(levels (f)) [as.numeric (f)]
+