R/AbsFxn.R

In USGS-R/USGSHydroOpt: Tools for optical data analysis

#' getAbs
#'
#' Retrieves individual absorbance coefficients
#'
#' @param dataAbs dataframe with absorbance spectra results, one column per sample, and one column
#' containing the wavelength at which an absorbance measurment is made. 
#' @param waveCol character column name to define the wavelengths for which absorbance was measured.
#' @param wavs numeric vector with absorbance wavelengths to extract.
#' @param colSubsetString unique characters to identify which columns have absorbance data. 
#' The default is "gr" to comply with the common naming from the CA WSC.
#' @param dataSummary dataframe with summary absorbance and fluoresence data. This 
#' function adds columns to the end of this dataframe as additional summary data.
#' @param grnum character column name that defines the column with sample names in the dataSummary dataframe.
#' These names are used to merge spectral slope data into the summary dataframe. 
#' @return summary absorbance and fluorescence dataframe with the additional absorbance peaks extracted using getAbs
#' @export
#' @examples
#' dataAbs <- dfabs
#' waveCol <- "wavelengths"
#' wavs <- c(430,530,630,730)
#' colSubsetString <- "gr"
#' dataSummary <- dfsummary
#' grnum <- "GRnumber"
#' testAbs <- getAbs(dataAbs,waveCol,wavs,
#'                colSubsetString,dataSummary,grnum)
#' # note that the new absorbance coefficients specified in wavs have been
#' #added to the end of dataSummary
getAbs <- function(dataAbs,waveCol,wavs,colSubsetString,dataSummary,grnum){
  df <- dataAbs[,grep(colSubsetString,names(dataAbs))]
  df <- df[,dataSummary[,grnum]]
  grnums <- dataSummary[,grnum]
  L <- dataAbs[,waveCol]
  
  dfAbsSig <- data.frame(GRnumber=grnums)
  
  for(j in 1:length(wavs)){
    if(length(which(dataAbs[,waveCol]==wavs[j]))>0){
      AbsCol <- which(dataAbs[,waveCol]==wavs[j])
      A <- as.numeric(df[AbsCol,])
      dfAbsSig <- cbind(dfAbsSig,A)
    }else{
      AbsCol <- which(abs(dataAbs[,waveCol]-wavs[j])==min(abs(dataAbs[,waveCol]-wavs[j])))
      AbsWav <- dataAbs[,waveCol][which(abs(dataAbs[,waveCol]-wavs[j])==min(abs(dataAbs[,waveCol]-wavs[j])))]
      wavs[j] <- AbsWav
      A <- as.numeric(df[AbsCol,])
      dfAbsSig <- cbind(dfAbsSig,A)
    }
    
  }
  Anames <- paste("A",wavs,sep="")
  names(dfAbsSig) <- c(grnum,Anames)
  dataSummary <- merge(dataSummary,dfAbsSig,by=grnum)
  return(dataSummary)
}