#' @include visa.R
#'
#' Class 'Spectra'/'SpectraDatabase'
#'
#' An S4 Class `Spectra`, with five slots of data.
#' It has `SpectraDatabase` as the alias.
#'
#' @name Spectra-class
#' @rdname Spectra-class
#' @aliases Spectra,Spectra-class
#' @docType class
#' @slot spectra A matrix
#' @slot wavelength A numeric vector
#' @slot w.unit A character string
#' @slot data A data.frame
#' @importFrom methods new
#' @exportClass Spectra
Spectra <- setClass("Spectra",
slots = c(spectra = "matrix",
wavelength = "numeric",
w.unit = "character",
data = "data.frame"))
setValidity("Spectra",
function(object){
w <- length(object)
if (length(w) != 0L && any(w != w[[1]]))
return("object width is not constant")
TRUE
}
)
setMethod("initialize", "Spectra",
function(.Object,
spectra = matrix(0),
wavelength = numeric(0),
w.unit = character(0),
data = data.frame(), ...){
.Object <- methods::callNextMethod()
if(length(.Object@data) == 0 && ncol(.Object@spectra) != length(.Object@wavelength)){
stop("specified spectra and wavelength of different dimensions")
} else if (length(.Object@data) >= 1 && nrow(.Object@spectra) != nrow(.Object@data)){
stop("specified spectra and data of different lengths")
} else
.Object
}
)
#' Class 'SpectraDatabase'
#'
#' SpectraDatabase is an extended 'Spectra' class, with associated vegetation data ('data')
#' in a \link{data.frame}.
#'
#' @name SpectraDatabase-class
#' @rdname SpectraDatabase-class
#' @aliases SpectraDatabase-class,spectra.database
#' @docType class
#' @slot spectra A matrix
#' @slot wavelength A numeric vector
#' @slot w.unit A character string
#' @slot data A data.frame of vegetation data corresponding to the spectra
#' @export
#' @exportClass SpectraDatabase
setClass("SpectraDatabase",
contains = "Spectra",
slots = c(data="data.frame"),
validity = function(object){
w <- length(object)
if (length(w) != 0L && any(w != w[[1]]))
return("object width is not constant")
TRUE
}
)
setMethod("initialize", "SpectraDatabase",
function(.Object,
spectra = matrix(0),
wavelength = numeric(0),
w.unit = character(0),
data = data.frame(0), ...){
.Object <- methods::callNextMethod()
if(nrow(.Object@spectra) != nrow(.Object@data) && length(.Object@wavelength) >1)
stop("specified 'spectra' and 'data' of different lengths")
.Object
}
)
#' Create a Spectra or SpectraDatabase
#'
#' Constructor \code{as.spectra} creates a Spectra object.
#'
#' @name as.spectra
#' @rdname Spectra-class
#' @param spectra A matrix
#' @param wavelength A numeric vector
#' @param w.unit A character string
#' @param data A data.frame
#' @param ... Other parameters
#' @examples
#' s <- as.spectra(matrix(1:100, 4), 1:25, "nm", data.frame(x = letters[1:4]))
#' str(s)
#'
#' @export
as.spectra <- function(spectra = matrix(0),
wavelength = numeric(0),
w.unit = "nm",
data = data.frame(), ...){
return(methods::new("Spectra", spectra, wavelength, w.unit, data, ...))
}
#' Create a Spectra or SpectraDatabase
#'
#' Constructor \code{as.spectra.database} creates a SpectraDatabase object.
#'
#' @rdname Spectra-class
#' @examples
#' s <- as.spectra.database(matrix(1:100, 4), 1:25, "nm", data.frame(x = letters[1:4]))
#' str(s)
#' @export
as.spectra.database <- function(spectra = matrix(0),
wavelength = numeric(0),
w.unit = "nm",
data = data.frame(), ...){
return(methods::new("Spectra", spectra, wavelength, w.unit, data, ...))
}
#' Class 'SpectraMatrix'
#'
#' SpectraMatrix is a extended 'Spectra' class.
#'
#' @name SpectraMatrix-class
#' @rdname SpectraMaxtrix-class
#' @aliases SpectraMaxtrix-class,spectra.maxtrix
#' @docType class
#' @export
#' @exportClass SpectraMatrix
setClass("SpectraMatrix",
contains = "Spectra",
validity = function(object){
w <- length(object)
if (length(w) != 0L && any(w != w[[1]]))
return("object width is not constant")
TRUE
}
)
setMethod("initialize", "SpectraMatrix",
function(.Object,
spectra = matrix(0),
wavelength = numeric(0),
w.unit = character(0), ...){
.Object <- methods::callNextMethod()
if(ncol(.Object@spectra) != length(.Object@wavelength))
stop("specified spectra and wavelength are of different lengths")
.Object
}
)
#' Create a SpectraMatrix
#'
#' Constructor \code{as.spectra.matrix} creates a SpectraMatrix object.
#'
#' @name as.spectra.matrix
#' @rdname SpectraMaxtrix-class
#' @param spectra A matrix
#' @param wavelength A numeric vector
#' @param w.unit A character string
#'
#' @return
#' \item{sdf}{Returns a SpectraDataFrame.}
#'
#' @examples
#' smatrix <- as.spectra.matrix(matrix(1:10, 1), 1:10, "nm")
#' str(smatrix)
#' @export
as.spectra.matrix <- function(spectra = matrix(0),
wavelength = numeric(0),
w.unit = character(0)){
sls <- methods::new("SpectraMatrix", spectra, wavelength, w.unit)
smat <- sls@spectra
colnames(smat) <- paste(wavelength, w.unit)
# rownames(smat) <- sls@s.id
smat
}
#' Class 'SpectraDataFrame'
#'
#' SpectraDataFrame is an extended 'Spectra' class, with associated vegetation data ('data')
#' in a \link{data.frame}.
#'
#' @name SpectraDataFrame-class
#' @rdname SpectraDataFrame-class
#' @aliases SpectraDataFrame,spectra.data.frame
#' @docType class
#' @slot spectra A matrix
#' @slot wavelength A numeric vector
#' @slot w.unit A character string
#' @slot data A data.frame of vegetation data corresponding to the spectra
#' @export
#' @exportClass SpectraDataFrame
setClass("SpectraDataFrame",
contains = "Spectra",
slots = c(data="data.frame"),
validity = function(object){
w <- length(object)
if (length(w) != 0L && any(w != w[[1]]))
return("object width is not constant")
TRUE
}
)
setMethod("initialize", "SpectraDataFrame",
function(.Object,
spectra = matrix,
wavelength = numeric,
w.unit = character,
data = data.frame, ...){
.Object <- methods::callNextMethod()
if(nrow(.Object@spectra) != nrow(.Object@data) && length(.Object@wavelength) >1)
stop("specified 'spectra' and 'data' of different lengths")
.Object
}
)
#' Create a SpectraDataFrame
#'
#' Constructor \code{as.spectra.data.frame} function creates a SpectraDataFrame object, which is equivalent to the use of \link{as.specdf}.
#'
#' @name as.spectra.data.frame
#' @rdname SpectraDataFrame
#' @aliases as.specdf
#' @param data A data.frame
#' @param spectra A matrix
#' @param wavelength A numeric vector
#' @param w.unit A character string
#' @param ... Other options for similar format of variables
#'
#' @return
#' \item{sdf}{Returns a SpectraDataFrame.}
#' @examples
#' sdf <- as.spectra.data.frame(matrix(1:10, 1), 1:10, "nm", data.frame(a = 1, b =2))
#' str(sdf)
#' @export
as.spectra.data.frame <- function(spectra = matrix(0),
wavelength = numeric(0),
w.unit = character(0),
data = data.frame(0), ...){
sls <- methods::new("SpectraDataFrame", spectra, wavelength, w.unit, data)
spectra <- sls@spectra
colnames(spectra) <- paste(wavelength, w.unit)
sdf <- sls@data
sdf$spectra <- spectra
sdf
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.