R/AQSysUtils.R

In LLSR: Data Analysis of Liquid-Liquid Systems using R

#' @importFrom dplyr count
###############################################################################
# Set plot area to export high resolution pictures
AQSysHR <- function(HR) {
  par.defaults <- par(no.readonly = TRUE)
  par(par.defaults)
  if (HR == TRUE) {
    clwd = 10
    par(
      mar = c(5, 6, 5, 3) + 0.5,
      cex = 2.5,
      cex.lab = 2.5,
      cex.axis = 2.5,
      cex.main = 2.5,
      cex.sub = 2.5,
      lwd = clwd,
      mgp = c(4, 2, 0)
    )
  } else{
    clwd = 1
    par(
      mar = c(5, 4, 4, 2) + 0.1,
      cex = 1,
      cex.lab = 1,
      cex.axis = 1,
      cex.main = 1,
      cex.sub = 1,
      lwd = clwd
    )
  }
  return(clwd)
}
# Display message when package is loaded
.onAttach <- function(libname, pkgname) {
  packageStartupMessage(
    '
    Be aware that LLSR is a collaborative package that still in
    development and your help is essential.\n
    If you found any bugs or have a suggestion, do not hesitate and
    contact us on https://github.com/diegofcoelho/LLSR/issues.\n
    You also can fork this project directly from github and commit
    improvements to us (http://diegofcoelho.github.io/LLSR/).\n
    The information used in the database was obtained free of charge
    but it might be copyrighted by third parties and references must
    be included appropriately.\n',
    domain = NULL,
    appendLF = TRUE
  )
}
#
matchUID <- function(UIDList, UIDMatrix) {
  uniqeUIDs <- as.character(unique(UIDList))
  #
  req_results <- sapply(uniqeUIDs, function(uid) {
    unlist(which(UIDMatrix == uid, TRUE))
  })
  #
  if (is.list(req_results)) {
    db.binodals.index <- do.call(rbind, req_results)[, "row"]
  } else {
    db.binodals.index <- req_results[1:(length(req_results) / 2)]
  }
  #
  return(db.binodals.index)
}
#
matchTpH <- function(TpH, BinodalMatrix, pH) {
  #
  if (pH) {RowIdx <- 1} else {RowIdx <- 2}
  #
  db.TpH.results <- which(BinodalMatrix == TpH, TRUE)
  #
  if (length(db.TpH.results) != 0) {
    db.TpH.check <- which(db.TpH.results[, "row"] == RowIdx)
    #
    db.binodals.index <- db.TpH.results[db.TpH.check, "col"]
    #
    db.binodals.index <-
      sapply(db.binodals.index, function(idx) {
        if (is.odd(idx)) {
          idx
        } else {
          idx - 1
        }
      })
    #
  } 
  if (length(db.TpH.results) != 0) {
    #
    db.binodals.seq <- sort(c(db.binodals.index, db.binodals.index + 1))
    db.binodals.index <- unlist(ifelse(length(db.binodals.index) == 0, 0, 
                                       list(db.binodals.seq)))
    #
    return(BinodalMatrix[, db.binodals.index])
  } else{
    return(data.frame())
  }
}
#
matchBNDL <- function(compNameList, BinodalMatrix) {
  #
  if (length(compNameList) == 0) {return(c())} else {
    (compNameList <- unlist(compNameList))
  }
  #
  db.binodals.index <-  unlist(sapply(compNameList, function(compName) {
    which(digest(compName, algo = "md5") == apply(
      BinodalMatrix, 1:2, digest, algo = "md5")[c(1, 3, 5),], TRUE)[, "col"]
  }))
  #
  if (length(unlist(db.binodals.index)) == 0) {return(c())}
  #
  db.binodals.index <- sapply(db.binodals.index, function(idx) {
      if (is.odd(idx)) {
        idx
      } else {
        idx - 1
      }
    })
  #
  db.binodals.index <- sort(unique(c(db.binodals.index, db.binodals.index + 1)))
  #
  return(db.binodals.index)
}
#
matchComp <- function(compNameList, db.matrix){
  #
  if (length(compNameList) == 0) {return(c())} else {
    (compNameList <- unlist(compNameList))
  }
  #
  ans <- unique(unname(unlist(sapply(compNameList, function(compName) {
    which(digest(compName, algo = "md5") == apply(
      db.matrix, 1:2, digest, algo = "md5")[, c("A", "B", "C")], TRUE)[, "row"]
  }))))
  return(ans)
}
#
idx2name <- function(idx, casdb) {
  casdb[casdb$CAS.INDEX == idx,]$CAS.NAME
}
#
commaReplacer <- function(str) {
  as.numeric(gsub(",", ".", str))
}
#
getBNDL <- function(workBook, sheets) {
  # initialize variables
  sys.nrow <- NULL
  sys.mrow <- NULL
  sys.ncol <- NULL
  sys.data <- NULL
  # make a loop through all sheets that satisfy the condition
  # the integrity of the worksheets will be evaluated before the merge
  # and determine which system in the workbook have bigger dataset (mrow)
  for (SheetIndex in grep("BINODAL", sheets)) {
    # determine the number of row and columns in the worksheet
    sys.nrow <-
      nrow(readWorkbook(
        xlsxFile = workBook,
        sheet = SheetIndex,
        colNames = FALSE
      ))
    sys.ncol <-
      ncol(readWorkbook(
        xlsxFile = workBook,
        sheet = SheetIndex,
        colNames = FALSE
      ))
    # initialize variables for first run only
    if (is.null(sys.mrow))
      sys.mrow <- sys.nrow
    if (sys.nrow > sys.mrow)
      sys.mrow <- sys.nrow
    # Each system must have two columns. If the total number in a sheet is odd
    #  it triggers an error (check AQSys.err.R for details)
    if (is.odd(sys.ncol)) {
      AQSys.err("9")
    }
  }
  #
  for (SheetIndex in grep("BINODAL", sheets)) {
    # Read data from a sheet and workbook provided by the user-invoked function
    sys.temp <-
      readWorkbook(xlsxFile = workBook,
                   sheet = SheetIndex,
                   colNames = FALSE)
    # DISCONSIDER THE FIRST TWO COLUMNS FROM THE STANDARD DATASHEET, 
    # WHICH EXIST TO EXEMPLIFY USERS HOW TO FILL THE WORKSHEET
    sys.temp <- sys.temp[, 0:-2]
    # COUNT NUMBER OF ROWS
    sys.nrow <- nrow(sys.temp)
    # populate all rows are initialized with NA
    if (sys.nrow < sys.mrow) {
      sys.temp[sys.mrow, ] <- NA
    }
    # if no system has been added, just add the first sheet
    if (is.null(sys.data)) {
      sys.data <- sys.temp
    } else {
      # but if sys.data have data, convert it to list and concatenate it with
      # data from the current sheet. Then convert it to dataframe and store it.
      sys.data <- bindDATA(list("SET1" = sys.data, "SET2" = sys.temp))
      #sys.data <- as.data.frame(c(sys.data, sys.temp), stringsAsFactors=FALSE)
    }
  }
  # return all data merged into a single dataframe
  invisible(sys.data)
}
#
getCAS <- function(workBook, sheets) {
  # Initiate data.frame
  casdb <- data.frame(stringsAsFactors = FALSE)
  # find a sheet with the "CASDB" fragment in its name and load it
  # casdb <- readWorksheet(workBook, grep("CASDB", sheets), header = TRUE)
  casdb <- readWorkbook(xlsxFile = workBook, 
               sheet = grep("CASDB", sheets), colNames = TRUE)
  #define casdb headers
  names(casdb) <-
    c("CAS.INDEX", "CAS.CODE", "CAS.NAME", "CAS.COMMON")
  return(casdb)
}
#
getREF <- function(workBook, sheets) {
  # initiate data.frame
  refdb <- data.frame(stringsAsFactors = FALSE)
  # find a sheet with the "REFDB" fragment in its name and load it
  refdb <- readWorkbook(xlsxFile = workBook, 
                        sheet = grep("REFDB", sheets), colNames = TRUE)
    #readWorksheet(workBook, grep("REFDB", sheets), header = TRUE)
  # initiate its second column
  #refdb[, 2] <- NA
  # define refdb headers
  names(refdb) <-
    c("REF.INDEX", "REF.NAME", "REF.MD5", "REF.URL", "REF.YEAR")
  # encrypt entries found in the file using md5 and store it in refdb
  refdb[, 3] <- sapply(refdb[, 2], digest, algo = "md5")
  # return data.frame containing all read references
  return(refdb)
}
#
SysIdxToRef <- function(refSheet, db.cas, db.data) {
  sysNum <- ncol(db.data) / 2
  for (i in seq(1, sysNum)) {
    db.data[3, i * 2] <- db.cas[db.data[3, i * 2], "CAS.NAME"]
    db.data[3, i * 2 - 1] <- db.cas[db.data[3, i * 2 - 1], "CAS.NAME"]
    db.data[4, i * 2 - 1] <- refSheet[db.data[4, i * 2 - 1], 3]
  }
  db.data[6:nrow(db.data),] <- sapply(db.data[6:nrow(db.data),], commaReplacer)
  return(UIDGen(db.data))
}
#
IdxToRef <- function(db.ref, db.data, db.cas) {
  # encrypt entries found in the file using md5 and store it in refdb
  db.data[, "REF.MD5"] <- db.ref[db.data[, "REF.MD5"], 3]
  db.data[, "A"] <- sapply(db.data[, "A"], idx2name, casdb = db.cas)
  db.data[, "B"] <- sapply(db.data[, "B"], idx2name, casdb = db.cas)
  db.data[, "C"] <- ifelse(is.valid(db.data[, "C"]), 
                           sapply(db.data[, "C"], idx2name, casdb = db.cas), 
                           db.data[, "C"])
  return(UIDGen(db.data))
}
#
insertRow <- function(existingDF, newrow, r) {
  existingDF[seq(r + 1, nrow(existingDF) + 1),] <- 
    existingDF[seq(r, nrow(existingDF)),]
  existingDF[r,] <- newrow
  existingDF
}
#
saveDATA <- function(path, data) {
  workBook <- loadWorkbook(path)
  sheets <- getSheetNames(path)
  #
  if (any(grepl("results", sheets))) {
    res_idx <- grep("results", sheets)
    removeWorksheet(workBook, sheet = res_idx)
  } else {
    addWorksheet(workBook, sheetName = "results")
  }
  #
  writeData(
    wb = workBook,
    x = data,
    sheet = "results",
    startRow = 1,
    startCol = 1
  )
  saveWorkbook(workBook)
  #return()
}
#
getTL <- function(workBook, sheets) {
  sys.nrow <- 0
  sys.mrow <- NULL
  sys.ncol <- NULL
  sys.data <- NULL
  sys.block <- NULL
  # path must point to a xlsx or xls file
  sys.temp <- data.frame()
  for (SheetIndex in grep("TIELINE", sheets)) {
    sys.temp <-
      rbind(sys.temp,
            readWorkbook(
              xlsxFile = workBook,
              sheet = SheetIndex,
              cols = seq(1, 17),
              colNames = TRUE,
              skipEmptyCols = FALSE
            ))
  }
  #
  names(sys.temp) <-
    c(
      "REF.MD5",
      "A",
      "B",
      "ORDER",
      "PH",
      "TEMP",
      "TOP.A",
      "TOP.B",
      "BOT.A",
      "BOT.B",
      "GLB.A",
      "GLB.B",
      "C",
      "TOP.C",
      "BOT.C",
      "GLB.C",
      "TLSlope"
    )
  # Account for user mistakes while typing data to the worksheet by detecting
  # which components are the top and bottom ones
  for (tlr in seq(1, nrow(sys.temp))) {
    if (sys.temp[tlr, "TOP.A"] > sys.temp[tlr, "TOP.B"]) {
      sys.temp[tlr, "TLSlope"] <-
        ((sys.temp[tlr, "BOT.A"] - sys.temp[tlr, "TOP.A"]) / 
           (sys.temp[tlr, "BOT.B"] - sys.temp[tlr, "TOP.B"]))
      sys.temp[tlr, "ORDER"] <- "YX"
    } else {
      sys.temp[tlr, "TLSlope"] <-
        ((sys.temp[tlr, "BOT.B"] - sys.temp[tlr, "TOP.B"]) / 
           (sys.temp[tlr, "BOT.A"] - sys.temp[tlr, "TOP.A"]))
      sys.temp[tlr, "ORDER"] <- "XY"
    }
  }
  # sys.temp[,19]<-((sys.temp[,9]-sys.temp[,7])/(sys.temp[, 10]-sys.temp[,8]))
  #
  uniqeKeys <- count(sys.temp, PH, TEMP, A, B, C)
  #
  return(list("uniqeKeys" = uniqeKeys, "systems" = sys.temp))
}
#
XLSCheck <- function(workBook, sheets) {
  #req_sheets <- c("BINODAL", "TIELINE", "PAR", "REFDB", "CAS")
  req_sheets <- c("BINODAL", "TIELINE", "REFDB", "CAS")
  cat("Checking XLS file integrity...\n\n")
  for (sheet in req_sheets) {
    cat(sheet, " worksheet", ": ", sep = "")
    if (any(grepl(sheet, sheets))) {
      cat("[OK]\n")
    } else {
      cat("[ERROR] (Worksheet is missing!)\n")
    }
  }
  cat("\n")
}
#
nameIT <- function(XYData) {
  #  NAMING SYSTEMS AND COMPONENT COLUMNS ACCORDINGLY
  DATA.LENGTH <- ncol(XYData)
  DATA.NSYS <- DATA.LENGTH / 2
  DATA.NAMES <-
    paste(
      rep("S", DATA.LENGTH),
      rep(1:DATA.NSYS, each = 2),
      "_",
      "C",
      rep(LETTERS[1:2], each = 1),
      sep = ""
    )
  names(XYData) <- DATA.NAMES
  return(XYData)
}
#
bindDATA <- function(XYData) {
  # ID-ING DATASETS
  SET1.DATA <- XYData[["SET1"]]
  SET1.NROW <- nrow(SET1.DATA)
  SET2.DATA <- XYData[["SET2"]]
  SET2.NROW <- nrow(SET2.DATA)
  # CHECK WHICH DATASET IS BIGGER TO EVEN OUT THE SMALLEST
  if (SET1.NROW > SET2.NROW) {
    SET3.DATA <-
      as.data.frame(matrix(
        nrow = (SET1.NROW - SET2.NROW),
        ncol = ncol(SET2.DATA)
      ), stringsAsFactors = FALSE)
    colnames(SET3.DATA) <- colnames(SET2.DATA)
    OUT.DATA <- rbind(SET2.DATA, SET3.DATA)
    SET2.DATA <- OUT.DATA
  } else {
    SET3.DATA <-
      as.data.frame(matrix(
        nrow = (SET2.NROW - SET1.NROW),
        ncol = ncol(SET1.DATA)
      ), stringsAsFactors = FALSE)
    colnames(SET3.DATA) <- colnames(SET1.DATA)
    OUT.DATA <- rbind(SET1.DATA, SET3.DATA)
    SET1.DATA <- OUT.DATA
  }
  DATA.OUTPUT <- cbind(SET1.DATA, SET2.DATA)
  # RETURN BINDED DATASET
  return(DATA.OUTPUT)
}
#
toBNDL <- function(workBook, sheets) {
  # initialize variables
  sys.nrow <- 0
  sys.block <- NULL
  # path must point to a xlsx or xls file
  TLData <- getTL(workBook, sheets)
  uniqeKeys <- TLData[["uniqeKeys"]]
  sys.temp <- TLData[["systems"]]
  names(sys.temp)
  sys.nrow <- (max(uniqeKeys$n) - 1) * 2 + 5
  sys.block <-
    unname(data.frame(matrix(nrow = sys.nrow), stringsAsFactors = FALSE))
  #
  for (sys in 1:nrow(uniqeKeys)) {
    system_data <- sys.temp[which(
      (sys.temp$PH == uniqeKeys[sys, ]$PH | is.na(sys.temp$PH)) &
        sys.temp$TEMP == uniqeKeys[sys, ]$TEMP &
        sys.temp$A == uniqeKeys[sys, ]$A &
        sys.temp$B == uniqeKeys[sys, ]$B
    ), names(sys.temp)]
    XYdt <- NULL
    #
    for (tieline in 1:nrow(system_data)) {
      if (is.null(XYdt)) {
        #
        XYdt <- data.frame(
          c(
            system_data[tieline, "PH"],
            system_data[tieline, "TEMP"],
            system_data[tieline, "A"],
            system_data[tieline, "REF.MD5"],
            NA
          ),
          c(
            system_data[tieline, "C"],
            system_data[tieline, "GLB.C"],
            system_data[tieline, "B"],
            system_data[tieline, "ORDER"],
            NA
          ),
          stringsAsFactors = FALSE
        )
        names(XYdt) <- c("COLUMN_1", "COLUMN_2")
      } else{
        dFF <- data.frame(
          as.numeric(c(system_data[tieline, "TOP.A"], 
                       system_data[tieline, "BOT.A"])),
          as.numeric(c(system_data[tieline, "TOP.B"], 
                       system_data[tieline, "BOT.B"])),
          stringsAsFactors = FALSE
        )
        names(dFF) <- c("COLUMN_1", "COLUMN_2")
        XYdt <- rbind(XYdt, dFF)
      }
    }
    # ORDER DATA - POINTS ARE SCATTERED DUE TIE-LINE DATA BINDING
    XYdt.temp <- XYdt[6:nrow(XYdt),]
    XYdt.temp <- data.frame(sapply(XYdt[6:nrow(XYdt),], 
                                   function(x) as.numeric(x)))
    #
    XYdt.temp <- XYdt.temp[with(XYdt.temp, order(-COLUMN_1)), ]
    XYdt[6:nrow(XYdt),] <- XYdt.temp
    #
    if (nrow(XYdt) < sys.nrow) {
      XYdt <-
        data.frame(rbind(as.matrix(XYdt), matrix(
          ncol = 2, nrow = (sys.nrow - nrow(XYdt))
        )), stringsAsFactors = FALSE)
    }
    #
    sys.block <- cbind(sys.block, XYdt)
  }
  #
  sys.ncol <- ncol(sys.block[, 0:-1])
  if (is.odd(sys.ncol)) {
    AQSys.err("9")
  }
  return(sys.block[, 0:-1])
}
#
AQSys.merge <- function(wrbk, sheets) {
  # merges data contained in all sheets from the same workbook which are named 
  # using the pattern datasource_sheetname_YX in its name. the order in the end
  # is optional by now but will soon be part of the main function
  #
  # initialize variables
  sys.nrow <- NULL
  sys.mrow <- NULL
  sys.ncol <- NULL
  sys.data <- NULL
  # make a loop through all sheets that satisfy the condition
  # the integrity of the worksheets will be evaluated before the merge
  # and determine which system in the workbook have bigger dataset (mrow)
  for (nSh in grep("datasource_", sheets)) {
    # determine the number of row and columns in the worksheet
    sys.nrow <-
      nrow(readWorkbook(
        xlsxFile = wrbk,
        sheet = nSh,
        colNames = FALSE
      ))
    sys.ncol <-
      ncol(readWorkbook(
        xlsxFile = wrbk,
        sheet = nSh,
        colNames = FALSE
      ))
    # initialize variables for first run only
    if (is.null(sys.mrow))
      sys.mrow <- sys.nrow
    if (sys.nrow > sys.mrow)
      sys.mrow <- sys.nrow
    # Each system must have two columns. If the total number in a sheet is odd
    #  it triggers an error (check AQSys.err.R for details)
    if (is.odd(sys.ncol))
      AQSys.err("2")
  }
  #
  for (nSh in grep("datasource_", sheets)) {
    #
    sys.temp <- readWorkbook(xlsxFile = wrbk, sheet = nSh, colNames = FALSE)
    sys.nrow <- nrow(sys.temp)
    # populate all rows are initialized with NA
    if (sys.nrow < sys.mrow) {
      sys.temp[sys.mrow, ] <- NA
    }
    # if no system has been added, just add the first sheet
    if (is.null(sys.data)) {
      sys.data <- sys.temp
      # but if sys.data have data, convert it to list and concatenate it with 
      # data from the current sheet. Then convert it to dataframe and store it.
    } else {
      sys.data <- as.data.frame(c(sys.data, sys.temp), stringsAsFactors = FALSE)
    }
  }
  # return all data merged into a single dataframe
  invisible(sys.data)
}
#
TLAnalysis <- function(workBook, sheets) {
  #
  ColNum <- 8 # Number of Columns
  # 
  TLData <- getTL(workBook, sheets)
  uniqeKeys <- TLData[["uniqeKeys"]]
  sys.temp <- TLData[["systems"]]
  #
  sys.slopes <- data.frame(matrix(nrow = nrow(uniqeKeys), ncol = ColNum))
  names(sys.slopes) <- c("REF.MD5", "A", "B", "ORDER", "PH", "TEMP", "C", 
                         "TLSlope")
  for (sys in 1:nrow(uniqeKeys)) {
    #
    system_data <- sys.temp[which(
      (sys.temp$PH == uniqeKeys[sys, ]$PH | is.na(sys.temp$PH)) &
        sys.temp$TEMP == uniqeKeys[sys, ]$TEMP &
        sys.temp$A == uniqeKeys[sys, ]$A &
        sys.temp$B == uniqeKeys[sys, ]$B
    ), names(sys.temp)]
    #
    TLSlopes <- system_data[, ncol(system_data)]
    sys.slopes[sys, 1:ColNum] <-
      system_data[1, -7:-(ncol(system_data) - 5)][-8:-(ncol(system_data) - 7)]
    #
    TLSlope <- mean(TLSlopes[which((abs(median(TLSlopes) - TLSlopes) /
                                      max(abs(TLSlopes))) < 0.15)])
    #
    if (!is.nan(TLSlope)) {
      sys.slopes[sys, ColNum] <- TLSlope
    }
  }
  return(sys.slopes)
}
#
toNumeric <- function(XYData, Order) {
  # convert and name variables accordingly into vectors
  if (tolower(Order) == "xy") {
    xc <- as.vector(as.numeric(sub(",", ".", XYData[, 1], fixed = TRUE)))
    yc <- as.vector(as.numeric(sub(",", ".", XYData[, 2], fixed = TRUE)))
  } else{
    xc <- as.vector(as.numeric(sub(",", ".", XYData[, 2], fixed = TRUE)))
    yc <- as.vector(as.numeric(sub(",", ".", XYData[, 1], fixed = TRUE)))
  }
  # and combine them into a dataframe
  XYdt <- data.frame(XC = xc, YC = yc)
  # Remove NA's
  XYdt <- XYdt[complete.cases(XYdt),]
  #
  if ((nrow(XYdt) > 0) && (max(XYdt) <= 1)) {
    XYdt <- XYdt * 100
  }
  #return data silently - should it be Visible or hidden?
  invisible(XYdt)
}
#
UIDGen <- function(db.data) {
  OUTPUT.DATA <- NULL
  BY.ROW <- ("REF.MD5" %in% colnames(db.data))
  #
  if (BY.ROW) {
    UID <- sapply(paste(db.data[, "REF.MD5"],
                        db.data[, "A"],
                        db.data[, "B"],
                        db.data[, "PH"],
                        db.data[, "TEMP"],
                        sep = "_"),
                  digest,
                  algo = "md5")
    OUTPUT.DATA <- cbind(UID, db.data)
    rownames(OUTPUT.DATA) <- NULL
  } else {
    DATA.LENGTH <- ncol(db.data)
    DATA.NSYS <- DATA.LENGTH / 2
    for (IDX in seq(1, DATA.NSYS)) {
      db.data[5, 2 * IDX - 1] <-
        digest(paste(db.data[4, 2 * IDX - 1],
                     db.data[3, 2 * IDX - 1],
                     db.data[3, 2 * IDX],
                     db.data[1, 2 * IDX - 1],
                     db.data[2, 2 * IDX - 1],
                     sep = "_"),
               algo = "md5")
    }
    OUTPUT.DATA <- db.data
  }
  return(OUTPUT.DATA)
}
#
ChckBndrs <- function(BNFn, slope, BNDL, xmax){
  #
  yMin <- BNFn(xmax)
  Gn <- function(yMin, slope, xmax, x) {
    yMin + slope * (x - xmax)
  }
  #
  x_min_b <- min(uniroot.all(function(x) (BNFn(x) - Gn(yMin, slope, xmax, x)),
                             c(0, xmax), tol = 0.001)) 
  y_max_b <- max(BNDL["Y"])
  ymax <- BNFn(x_min_b)
  #
  while (ymax > y_max_b) {
    xmax <- xmax - 0.01
    yMin <- BNFn(xmax)
    x_min_b <- min(uniroot.all(function(x) (BNFn(x) - Gn(yMin, slope, xmax, x)), 
                               c(0, xmax), tol = 0.001)) 
    ymax <- BNFn(x_min_b)
  }
  return(xmax)
  
}
#
RevMD5 <- function(table, db.data){
    BY.ROW <- ("REF.MD5" %in% colnames(table))
    if (BY.ROW) {
      REF.MD5 <- table[["REF.MD5"]]
      table[["REF.MD5"]] <- sapply(REF.MD5, function(x) {
        db.data$db.ref[db.data$db.ref$REF.MD5 == x, "REF.NAME"]
      })
      names(table)[grep("REF.MD5", names(table))] <- "REF"
    } else {
      DATA.LENGTH <- ncol(table)
      DATA.NSYS <- DATA.LENGTH / 2
      for (IDX in seq(1, DATA.NSYS)) {
        REF.MD5 <- table[4, 2 * IDX - 1]
        table[4, 2 * IDX - 1] <-
          db.data$db.ref[db.data$db.ref$REF.MD5 == REF.MD5, "REF.NAME"]
      }
    }
    return(table)
}
#
RevREF <- function(db.tables, db.data) {
  tables <- names(db.tables)
  if (!is.data.frame(db.tables)) {
    for (table in tables) {
      if (!is.data.frame(db.tables[[table]])) {
        nested_tables <-  names(db.tables[[table]])
        for (nested_table in nested_tables) {
          db.tables[[table]][[nested_table]] <-
            RevMD5(db.tables[[table]][[nested_table]], db.data)
        }
      } else {
        db.tables[[table]] <- RevMD5(db.tables[[table]], db.data)
      }
    }
  } else {
    db.tables <- RevMD5(db.tables, db.data)
  }
  return(db.tables)
}