R/speclib.R

In hsdar: Manage, Analyse and Simulate Hyperspectral Data

setMethod("speclib", signature(spectra = "matrix", wavelength = "numeric"), 
          function(spectra, wavelength, ...)
  return(.createspeclib(spectra, wavelength, ...))
)

setMethod("speclib", signature(spectra = "SpatialGridDataFrame", wavelength = "numeric"), 
          function(spectra, wavelength, ...)
  {
    spectra <- t(as.matrix(.getImgMatrix_SpatialGridDataFrame(spectra)))
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "numeric", wavelength = "numeric"), 
          function(spectra, wavelength, ...)
  {
    spectra <- matrix(spectra, ncol = length(wavelength))
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "matrix", wavelength = "data.frame"), 
          function(spectra, wavelength, ...)
  return(.createspeclib(spectra, wavelength, ...))
)

setMethod("speclib", signature(spectra = "SpatialGridDataFrame", wavelength = "data.frame"), 
          function(spectra, wavelength, ...)
  {
    spectra <- t(as.matrix(.getImgMatrix_SpatialGridDataFrame(spectra)))
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "numeric", wavelength = "data.frame"), 
          function(spectra, wavelength, ...)
  {
    spectra <- matrix(spectra, ncol = nrow(wavelength))
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "matrix", wavelength = "matrix"), 
          function(spectra, wavelength, ...)
  return(.createspeclib(spectra, wavelength, ...))
)

setMethod("speclib", signature(spectra = "SpatialGridDataFrame", wavelength = "matrix"), 
          function(spectra, wavelength, ...)
  {
    spectra <- t(as.matrix(.getImgMatrix_SpatialGridDataFrame(spectra)))
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "numeric", wavelength = "matrix"), 
          function(spectra, wavelength, ...)
  {
    spectra <- matrix(spectra, ncol = nrow(wavelength))
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "character", wavelength = "numeric"), 
          function(spectra, wavelength, ...)
  {
    return(speclib(brick(spectra), wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "HyperSpecRaster"), 
          function(spectra, ...)
  {
    ref_system <- as.character(crs(spectra))
    
    v <- getValues(spectra)
    
    res <- speclib(v, spectra@wavelength, fwhm = if (length(spectra@fwhm) > 0) spectra@fwhm else NULL, 
                   SI = if (nrow(spectra@SI) > 0) spectra@SI else NULL, 
                   rastermeta = rastermeta(spectra))
    return(res)                                    
  }
)

setMethod("speclib", signature(spectra = "RasterBrick", wavelength = "numeric"), 
          function(spectra, wavelength, ...)
  {
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "RasterBrick", wavelength = "data.frame"), 
          function(spectra, wavelength, ...)
  {
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "Speclib", wavelength = "numeric"), 
          function(spectra, wavelength, ...)
  {
    return(.createspeclib(spectra(spectra), wavelength, ...))
  }
)

setMethod("speclib", signature(spectra = "RasterBrick", wavelength = "matrix"), 
          function(spectra, wavelength, ...)
  {
    return(.createspeclib(spectra, wavelength, ...))
  }
)

setMethod("brick", signature(x = "Speclib"),
          function(x, ...)
  {
    if (!x@spectra@fromRaster)
      stop("Cannot convert Speclib to brick if spectra are stored as matrix")
    dots <- list(...)
    dots$x <- x@spectra@spectra_ra

    b <- do.call(brick, dots)
    if (any(names(dots) == "values"))
    {
      if (!dots$values)
        return(b)
    }
    if (nlayers(b) <= nbands(x))
    {
      if (nlayers(b) > 1)
      {
        b1 <- try(setValues(b, spectra(x, j = 1:nlayers(b))), silent = TRUE)
      } else {
        b1 <- try(setValues(b, as.numeric(spectra(x))), silent = TRUE)
      }
      if (!inherits(b1, "try-error"))
        return(b1)
    }
    return(b)  
  }
)

setMethod("$", signature(x = "Speclib"), 
          function(x, name)
  {
    slot(x, name)
  }
)

setMethod("as.data.frame", signature(x = "Speclib"), 
          function(x, row.names = NULL, optional = FALSE, includeAttr = FALSE, ...)
  {
    x_dat <- as.data.frame(spectra(x), row.names = row.names, optional = optional, ...)
    names(x_dat) <- bandnames(x)
    if (!includeAttr)
      return(x_dat)
      
    if (ncol(SI(x)) > 0)
      return(cbind(x_dat, SI(x)))
  }
)

# setMethod("speclib", signature(spectra = "hyperSpec"), 
#           function(spectra, ...)
#   return(.createspeclib(as.matrix(spectra), spectra@wavelength, ...))
# )


.createspeclib <- function (spectra,
                           wavelength,
                           fwhm = NULL,
                           SI = NULL,
                           usagehistory = NULL,
                           transformation = NULL,
                           continuousdata = "auto",
                           wlunit = "nm",
                           xlabel = "Wavelength",
                           ylabel = "Reflectance",
                           rastermeta = NULL
                          )
{
  
  if (class(spectra)[1] %in% c("RasterBrick", "HyperSpecRaster"))
  {
    fromRaster <- TRUE
    
#     valid_data <- NULL
  } else {   
    if (class(spectra)[1] == "RasterLayer")
    {
      spectra <- brick(spectra)
      fromRaster <- TRUE
    } else {
#        valid_data <- attr(spectra, "valid_data")
      fromRaster <- FALSE
      dim_spectra <- c(nrow(spectra), ncol(spectra))
    }
  }

  wavelength.is.range <- FALSE
  if (class(wavelength)[1] == "data.frame" || class(wavelength)[1] == "matrix")
  {
    wavelength <- as.data.frame(wavelength)
    if (ncol(wavelength)==1)
    {
      wavelength <- as.vector(wavelength)
      if (!is.null(fwhm))
        if (length(fwhm)!=length(wavelength))
          stop("Length of fwhm and wavelength differ")
      if (!fromRaster)
      {
        if (length(wavelength)==dim_spectra[1])
        {
          if (length(wavelength)==dim_spectra[2])
          {
            warning("Could not determine orientation of spectra data. \n  
                    Make sure that columns are wavelength and rows samples")
          } else {
            spectra <- t(spectra)
          }
        }
      }
    } else {
      wavelength.is.range <- TRUE
      if (!fromRaster)
      {
        if (nrow(wavelength)==dim_spectra[1])
        {
          if (nrow(wavelength)==dim_spectra[2])
          {
            warning("Could not determine orientation of spectra data. \n  
                    Make sure that columns are wavelength and rows samples")
          } else {
            spectra <- t(spectra)
          }
        }
      }
    }
  } else {
    if (!is.null(fwhm))
    {
      wavelength.is.range <- TRUE
      if (length(fwhm)!=length(wavelength))
        stop("Length of fwhm and wavelength differ")
    }
    if (!fromRaster)
    {
      if (length(wavelength)==dim_spectra[1])
      {
        if (length(wavelength)==dim_spectra[2])
        {
          warning("Could not determine orientation of spectra data. \n  
                  Make sure that columns are bands and rows different samples")
        } else {
          spectra <- t(spectra)
        }
      }
    }
  }

  if (!fromRaster)
  {
    names <- NULL
    rn <- row.names(spectra)
    if (!is.null(rn))
    {
      rn <- as.factor(rn)
      if (nlevels(rn)!=length(rn))
      {
        warning("  some row.names duplicated: --> Spectra does not have IDs")
        rn <- as.factor(1:length(rn))
      }
      rn <- as.character(rn)
    } else {
      rn <- character()
    }
    spectra <- as.matrix(spectra)
    cn <- colnames(spectra)
    rownames(spectra) <- NULL
    colnames(spectra) <- NULL
  } else {
    cn <- c(1:spectra@data@nlayers)
    rn <- character()    
  }
  

  if (!wavelength.is.range)
  {
    if (length(wavelength) > 1)
    {
      range <- wavelength[-1] - wavelength[-1*length(wavelength)]
      range <- c(as.numeric(range),range[length(range)])
      if (sd(range)==0)
        range <- mean(range)
      fwhm <- range
    } else {
      fwhm <- 1
    }
  } else {
    if (!is.null(fwhm))
    {
      if (is.data.frame(wavelength))
        wavelength <- rowMeans(wavelength)
    }
  }

  if (is.null(SI)) 
    SI <- data.frame()
    
  if (is.null(usagehistory))   
    usagehistory <- character()
  
  if (is.null(transformation))   
    transformation <- character()
    
  if (is.null(rastermeta))   
    rastermeta <- list()
  
  wavelength <- wavelength * .ConvWlFwd(wlunit)
  fwhm       <- fwhm * .ConvWlFwd(wlunit)   

  result <- new("Speclib", 
                spectra = spectra, 
                wavelength = wavelength,
                fwhm = fwhm,
                wavelength.is.range = wavelength.is.range,
                continuousdata = continuousdata,
                SI = SI,
                transformation = transformation,
                usagehistory = usagehistory,
                wlunit = wlunit,
                xlabel = xlabel,
                ylabel = ylabel,
                rastermeta = rastermeta                
               )
  idSpeclib(result) <- rn
  bandnames(result) <- cn
#   if (!is.null(valid_data))
#   {
#     result@spectra@valid_spec@removedPixel <- sum(!valid_data)
#     result@spectra@valid_spec@validPixel <- valid_data
#   }

  if (validObject(result))
  { 
    return(result)
  }
}

setMethod("initialize", signature(.Object = "Speclib"),
          function(.Object, ...)
{  
  dots <- list(...)

  if (any(names(dots) == "continuousdata"))
  {
    if (dots$continuousdata != "auto")
    {
      if (mode(dots$continuousdata) != "logical")
        stop("continuousdata must be 'auto', TRUE or FALSE")
      continuousdata <- dots$continuousdata
    } else {
      if (length(dots$wavelength) > 1)
      {
        continuousdata <- max(dots$wavelength[-1*length(dots$wavelength)]-dots$wavelength[-1]) <= 20
      } else {
        continuousdata <- FALSE
      }
    }
  } else {
    continuousdata <- TRUE
  }

  if (any(names(dots) == "wavelength"))
  {
    wavelength <- dots$wavelength
  } else {
    wavelength <- numeric()
#     stop("Wavelength information required")
  }

  if (any(names(dots) == "spectra"))
  {
    spectra <- dots$spectra
    fromRaster <- class(spectra)[1] %in% c("RasterBrick", "HyperSpecRaster")
    spectra <- new(".Spectra",
                   fromRaster = fromRaster,
                   spectra_ma = if (fromRaster) matrix() else spectra,
                   spectra_ra = if (fromRaster) spectra else new("RasterBrick"))
  } else {
    spectra <- new(".Spectra")
#     stop("Spectra required")
  }

  if (any(names(dots) == "SI"))
  {
    SI <- dots$SI
  } else {
    SI <- data.frame()
  }

  if (any(names(dots) == "fwhm"))
  {
    fwhm <- dots$fwhm
  } else {
    fwhm <- dots$wavelength[-1] - dots$wavelength[-1*length(dots$wavelength)]
    fwhm <- c(fwhm, fwhm[length(fwhm)])
  }

  if (any(names(dots) == "wavelength.is.range"))
  {
    wavelength.is.range <- dots$wavelength.is.range
  } else {
    wavelength.is.range <- FALSE
  }

  if (any(names(dots) == "transformation"))
  {
    transformation <- dots$transformation
  } else {
    transformation <- "NONE"
  }
  
  if (any(names(dots) == "usagehistory"))
  {
    usagehistory <- dots$usagehistory
  } else {
    usagehistory <- ""
  }

  if (any(names(dots) == "wlunit"))
  {
    wlunit <- dots$wlunit
  } else {
    wlunit <- "nm"
  }

  if (any(names(dots) == "xlabel"))
  {
    xlabel <- dots$xlabel
  } else {
    xlabel <- "Wavelength"
  }

  if (any(names(dots) == "ylabel"))
  {
    ylabel <- dots$ylabel
  } else {
    ylabel <- "Reflectance"
  }
  
  if (any(names(dots) == "rastermeta"))
  {
    rastermeta <- dots$rastermeta
  } else {
    rastermeta <- list()
  }
  
  object <- .Object
  
  object@spectra             <- spectra
  object@wavelength          <- wavelength
  object@fwhm                <- fwhm
  object@continuousdata      <- continuousdata
  object@wavelength.is.range <- wavelength.is.range
  object@transformation      <- transformation
  object@SI                  <- new(".SI", SI)
  object@usagehistory        <- usagehistory
  object@wlunit              <- wlunit
  object@xlabel              <- xlabel
  object@ylabel              <- ylabel
  object@rastermeta          <- rastermeta
  return(object)
}
)

.getImgMatrix_SpatialGridDataFrame <- function(sp_dat)
  return(as.matrix(sp_dat@data))