Assign values based on "insufficient" look-up table - r

Question

I have to look up some scores and assign percentile value based on a fixed look-up table.
I've tried to solve this problem for some time now, and I have read this and this SO thread, but without solving my problem. My problem is that the raw score can be bigger then the values in the look-up table, in such cases the biggest percentile value is prescribed.
I have a look-up table like this,
lookup <- structure(list(Percentile = c(99, 95, 90, 85, 80, 75, 70, 65, 60, 55, 50, 45, 40, 35, 30, 25, 20, 15, 10, 5, 1), ACB = c(24, 19, 18, 17, 16, NA, 15, NA, 14, NA, NA, 13, NA, NA, NA, 12, NA, 11, 10, 9, 7), DFG = c(49, 39, 36, 33, 31, 30, 29, 28, 27, 26, 25, NA, 24, 23, 22, 21, 20, 19, 17, 14, 12), EIH = c(35, 30, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18, 17, 16, 15, NA, 14, NA, 13, 12, NA), GKJ = c(49, 39, 36, 33, 31, 30, 29, 28, 27, 26, 25, NA, 24, 23, 22, 21, 19, 18, 17, 15, 14), Total = c(112, 99, 91, 86, 82, 79, 76, 75, 73, 71, 69, 67, 66, 65, 63, 61, 59, 55, 51, 46, 39)), .Names = c("Percentile", "ACB", "DFG", "EIH", "GKJ", "Total"), row.names = c("99+", "95", "90", "85", "80", "75", "70", "65", "60", "55", "50", "45", "40", "35", "30", "25", "20", "15", "10", "5", "1"), class = "data.frame")
lookup
Percentile ACB DFG EIH GKJ Total
99+ 99 24 49 35 49 112
95 95 19 39 30 39 99
90 90 18 36 27 36 91
85 85 17 33 26 33 86
80 80 16 31 25 31 82
75 75 NA 30 24 30 79
70 70 15 29 23 29 76
65 65 NA 28 22 28 75
60 60 14 27 21 27 73
55 55 NA 26 20 26 71
50 50 NA 25 19 25 69
45 45 13 NA 18 NA 67
40 40 NA 24 17 24 66
35 35 NA 23 16 23 65
30 30 NA 22 15 22 63
25 25 12 21 NA 21 61
20 20 NA 20 14 19 59
15 15 11 19 NA 18 55
10 10 10 17 13 17 51
5 5 9 14 12 15 46
1 1 7 12 NA 14 39
and, som raw data that looks like this,
rawS_1 <- structure(list(ACB = 28, DFG = 39, EIH = 31, GKJ = NA_real_, Total = NA_real_), .Names = c("ACB", "DFG", "EIH", "GKJ", "Total"), row.names = "RawScore for ID 1", class = "data.frame")
rawS_1
ACB DFG EIH GKJ Total
RawScore for ID 1 28 39 31 NA NA
rawS_2 <- structure(list(ACB = 29, DFG = 51, EIH = 56, GKJ = 60, Total = 169), .Names = c("ACB", "DFG", "EIH", "GKJ", "Total"), row.names = "RawScore for ID 2", class = "data.frame")
rawS_2
ACB DFG EIH GKJ Total
RawScore for ID 2 29 51 56 60 169
and, this is what I would like to do,
ACB DFG EIH GKJ Total
RawScore for ID 1 12 39 19 NA NA
Percentile, ID 1 25 95 50 NA NA
ACB DFG EIH GKJ Total
RawScore for ID 2 29 51 56 60 169
Percentile, ID 2 99 99 99 99 99
I've tried to merge() with all.x = TRUE and suffixes = c(".x",".y")), but I keep getting what I don't want and help would be appreciated.

Answer 1

Rather than thinking of this as merging, I think you're better off thinking it as a problem of creating a function: you want a function that when given the raw value of (e.g.) ACB returns the percentile. Luckily R has a function designed to make a function from a table of numbers: approxfun.
The following code uses lapply to create a function for each column, and then shows how to call the the new functions:
vars <- names(lookup)[-1]
lookup_funs <- lapply(vars, function(var) {
df <- data.frame(x = lookup[[var]], y = lookup$Percentile)
df <- df[complete.cases(df), ]
approxfun(df$x, df$y, "constant", rule = 2)
})
names(lookup_funs) <- vars
lookup_funs$ACB(c(12, 29))
lookup_funs$Total(169)

Answer 2

Basic strategy is to use !is.na(vec) to index both the value and the percetile vectors. Here's a look at a single case. Which one would you prefer for input of 11 for ACB?
> rev(lookup$Percentile)[!is.na(lookup$ACB)][
findInterval( 11, c(-Inf,rev(lookup$ACB[!is.na(lookup$ACB)]), Inf))]
[1] 20
> rev(lookup$Percentile)[!is.na(lookup$ACB)][
findInterval( 11, c(-Inf,rev(lookup$ACB[!is.na(lookup$ACB)]), Inf))-1]
[1] 15
This gets you most of the way there for one row of data:
> for(i in names(rawS_1) ) {print(rawS_1[i]); print(rev(lookup$Percentile)[ !is.na(lookup[[i]]) ][ findInterval( rawS_1[i], c( rev( lookup[[i]][ !is.na(lookup[[i]] )]) ) )] )}
ACB
RawScore for ID 1 28
[1] 99
DFG
RawScore for ID 1 39
[1] 95
EIH
RawScore for ID 1 31
[1] 90
GKJ
RawScore for ID 1 NA
[1] NA
Total
RawScore for ID 1 NA
[1] NA
You do get into indexing overruns with the subtraction of 1 from indices at the high end of the scale, so you probably ought to add an extra element on the lookup vector after you decide what result you want to see.
for(i in names(rawS_2) ) {print(rawS_2[i]); print(rev(lookup$Percentile)[ !is.na(lookup[[i]]) ][ findInterval( rawS_2[i], c( rev( lookup[[i]][ !is.na(lookup[[i]] )]) ) )] )}
ACB
RawScore for ID 2 29
[1] 99
DFG
RawScore for ID 2 51
[1] 99
EIH
RawScore for ID 2 56
[1] 95
GKJ
RawScore for ID 2 60
[1] 99
Total
RawScore for ID 2 169
[1] 99