Wednesday, February 15, 2017

Look up value in a reference table (Similar to Excel's VLOOKUP function)

vlookup <- function(x, x.vector, y.vector = seq(x.vector), exact = FALSE, na.action = FALSE) 
{
    ## PURPOSE: Look up value in a reference table (Similar to Excel's VLOOKUP function)
    ## ARGUMENT:
    ##    x: a vector of Look Up Value (should not contain NA values)
    ##    x.vector: a vector where the "x" value can be located (approximately).
    ##    y.vector: a vector containing the return value that correponds the identified location in the "x.vector".
    ##              Default to the index to the x.vector.
    ##    exact: if T, the numeric values have to match exactly. 
    ##    na.action: If T and if cannot find the lookup value, return the input value. 
    ## RETURN: a scale value that corresponds to the "x" lookup value. 
    ## DATE: 20 Oct 2016, 16:30
    ## -----------------------------------------------------
    
    ans <- NULL
    if (is.numeric(x)) {
        if (exact) {
            ans <- y.vector[match(x, x.vector)]
        } else {
            ans <- y.vector[match.approx(x, x.vector)]
        }
    } else if (is.character(x)) {
        ans <- y.vector[match(x, x.vector)]
    }      

    if (na.action) {
        idx <- is.na(ans)
        ans[idx] <- x[idx]
    }
    ans
}
if (F) {                                # Unit Test 
    vlookup(c(68.2, 73), c(54, 60, 68.1, 72, 80), LETTERS[1:5]) # "C" "D"
    vlookup(c(2, 3.1), 1:5)                                     # 2 3
    vlookup(c(2, 3.1), 1:5, exact = T)                          # 2 NA
    vlookup(c("C", "E"), LETTERS[1:5], LETTERS[11:15]) #  "M" "O"
    vlookup(c("C", "X"), LETTERS[1:5], LETTERS[11:15]) #  "M" NA
    vlookup(c("C", "X"), LETTERS[1:5], LETTERS[11:15], na.action = T) #  "M" "X"
}


match.approx <- function(x, y) {
    ## Purpose: Match Approximately for Numerical Data
    ## Arguments:
    ##   "x":  a vector of numeric values.
    ##   "y":  a vector of numeric values. 
    ## RETURN:
    ##   The index in "y" that indicates the closest y value to each of "x" value. 
    ## Author: Feiming Chen, Date: 15 Feb 2017, 10:41
    ## ________________________________________________
    
    sapply(x, function(x0) which.min(abs(x0 - y)))
}
if (F) {
  match.approx(c(4.2, 1.2, 15), 1:10)                #  4  1 10
}

No comments:

Post a Comment