How to iterate through vector and replace values in R - r

Question

it's a fairly simple task, but I'm trying to wrap my head around how to match values using a dataframe with keys and values. I've tried merge, but as the number of rows is different, I'm not sure that's appropriate.
Is there a for loop I can write that will loop through each key in my input dataframe and change Product's value if it's one of the ones in the lookup table?
Essentially, my data looks like this:
input_key <- c(9061,8680,1546,5376,9550,9909,3853,3732,9209)
input_product <- c("Water", "Bread", NA, "Chips", "Chicken", NA, "Chocolate", "Donuts", "Juice")
input <- as.data.frame(cbind(input_key, input_product))
I'd like to replace the NAs with the Product values in the corresponding lookup table:
lookup_key <- c(1245,1546, 7764, 9909)
lookup_product <- c("Ice Cream","Soda", "Bacon","Cheese")
lookup_data <- as.dataframe(cbind(lookup_key, lookup_product))
Finally, I'm hoping to get the final dataframe looking like this:
output_key <- c(9061,8680,1546,5376,9550,9909,3853,3732,9209)
output_product <- c("Water", "Bread", "Soda", "Chips", "Chicken", "Cheese", Chocolate","Donuts", "Juice")
output_data <- as.data.frame(cbind(output_key, output_product))

Answer 1

OPTION 1: Using R-base functions:
Vectorial solution:
input$input_product[input$input_key %in% lookup_data$lookup_key == TRUE] <-
lookup_product[lookup_data$lookup_key %in% input$input_key == TRUE]
Note: The ==TRUE is redundant, added just for better understanding.
Using lapply function:
idx <- input$input_key %in% lookup_data$lookup_key
lapply((1:nrow(input)),
function(i) {
if (idx[i] == TRUE) {
jdx <- lookup_data$lookup_key %in% input$input_key[i]
input$input_product[i] <<- lookup_data$lookup_product[jdx == TRUE]
}
}
)
Note: Attention to the global assignment operation (<<)
Using for loop:
idx <- input$input_key %in% lookup_data$lookup_key
for (i in (1:nrow(input))) {
if (idx[i] == TRUE) {
jdx <- lookup_data$lookup_key %in% input$input_key[i]
input$input_product[i] <- lookup_data$lookup_product[jdx == TRUE]
}
}
Note: Here we just need a simple assignment.
In the above cases you need to create the data frames setting the input argument: stringsAsFactors as FALSE, for example:
input <- as.data.frame(cbind(input_key, input_product), stringsAsFactors = FALSE)
lookup_data <- as.data.frame(cbind(lookup_key, lookup_product), stringsAsFactors = FALSE)
Then you get the output:
> input
input_key input_product
1 9061 Water
2 8680 Bread
3 1546 Soda
4 5376 Chips
5 9550 Chicken
6 9909 Cheese
7 3853 Chocolate
8 3732 Donuts
9 9209 Juice
>
OPTION 2: Using data.tablepackage
I found this elegant solution using inner join:
require(data.table)
setkey(input,input_key)
setkey(lookup_data,lookup_key)
> setDT(input)[setDT(lookup_data), input_product := i.lookup_product, nomatch=0][]
input_key input_product
1: 1546 Soda
2: 3732 Donuts
3: 3853 Chocolate
4: 5376 Chips
5: 8680 Bread
6: 9061 Water
7: 9209 Juice
8: 9550 Chicken
9: 9909 Cheese
>
data.tableis actually very powerful for data set manipulation. Let's explain the syntax behind:
setDT: Converts a data frame by reference (no copy occurs) into data.table, because the original data sets are not a data.table classes, that's the way to
convert them on the fly. Notice that now it is not necessary to use the attribute stringsAsFactors because for data.tableits default value is FALSE.
input[lookup_data, nomatch=0]: Is the way, with data.table package to create a inner join (see this link). It means the interception of both tables. The no match option with value 0 means no rows will be returned for that row of i (in our case: lookup_data).
This would be the output:
> setDT(input)[setDT(lookup_data), nomatch=0][]
input_key input_product lookup_product
1: 1546 NA Soda
2: 9909 NA Cheese
>
input_product := i.lookup_product: assigns the column from the outer
data set, with the value of the inner data set.
[]: Prints the result (for verifying the solution purpose)
For more information about data.tableI would recommend to read the package documentation it comes with many examples. It is also a good idea to run in R the following command (after loading the data.tablepackage):
example(data.table)
It provides more than 50 examples (the same from the package documentation) with its corresponding result about the different uses of this package.
PERFORMANCE
Let's compare all possible alternatives in terms of performance. Then we need to modify
the input data set for increasing its size:
rep.num <- 1000
input_key <- rep(c(9061,8680,1546,5376,9550,9909,3853,3732,9209),rep.num)
input_product <- rep(c("Water", "Bread", NA, "Chips", "Chicken", NA, "Chocolate",
"Donuts", "Juice"),rep.num)
input <- as.data.frame(cbind(input_key, input_product), stringsAsFactors=F)
Wrap all different alternatives into a corresponding given function. I have included
the solution via dplyr proposed by #count
vectSol <- function(input, lookup_data) {
input$input_product[input$input_key %in% lookup_data$lookup_key == TRUE] <-
lookup_product[lookup_data$lookup_key %in% input$input_key == TRUE]
return(input)
}
lapplySol <- function(input, lookup_data) {
idx <- input$input_key %in% lookup_data$lookup_key
lapply((1:nrow(input)),
function(i) {
if (idx[i] == TRUE) {
jdx <- lookup_data$lookup_key %in% input$input_key[i]
input$input_product[i] <<- lookup_data$lookup_product[jdx == TRUE]
}
}
)
return(input)
}
forSol <- function(input, lookup_data) {
idx <- input$input_key %in% lookup_data$lookup_key
for (i in (1:nrow(input))) {
if (idx[i] == TRUE) {
jdx <- lookup_data$lookup_key %in% input$input_key[i]
input$input_product[i] <- lookup_data$lookup_product[jdx == TRUE]
}
}
return(input)
}
dataTableSol <- function (input, lookup_data) {
setkey(input,input_key)
setkey(lookup_data,lookup_key)
input[lookup_data, input_product := i.lookup_product, nomatch=0]
return(input)
}
dplyrSol <- function(input, lookup_data) {
rbind(input[!is.na(input$input_product),],
inner_join(lookup_data,input,by=c("lookup_key"="input_key")) %>%
select(lookup_key,lookup_product) %>%
rename(input_product = lookup_product, input_key = lookup_key))
return(input)
}
Now test each solution (double check).
Make a copy of the input data set, because data.table operate by reference. We need to create a copy from scratch.
input.copy <- setDT(as.data.frame(cbind(input_key, input_product), stringsAsFactors=F))
lookup_data.copy<- setDT(as.data.frame(cbind(lookup_key, lookup_product),
stringsAsFactors=F))
input1.out <- vectSol(input, lookup_data)
input2.out <- lapplySol(input, lookup_data)
input3.out <- forSol(input, lookup_data)
input4.out <- forSol(input, lookup_data)
input5.out <- dataTableSol(copy(input.copy), lookup_data.copy)
We use the package compare because all.equal fails for comparing a data frame
with a data.table object, because the attributes values, therefore we need a
comparison that only checks the values.
library(compare)
OK <- all(
all.equal(input1.out, input2.out) && all.equal(input1.out, input3.out)
&& all.equal(input1.out, input4.out)
&& compare(input1.out[order(input1.out$input_key),],
input5.out, ignoreAttrs=T)$result
)
try(if(!OK) stop("Result are not the same for all methods"))
Now let's to use microbenchmarkpackage for comparing the time performance of all solutions
library(microbenchmark)
op <- microbenchmark(
VECT = {vectSol(input, lookup_data)},
FOR = {forSol(input, lookup_data)},
LAPPLY = {lapplySol(input, lookup_data)},
DPLYR = {dplyrSol(input, lookup_data)},
DATATABLE = {dataTableSol(input.copy, lookup_data.copy)},
times=100L)
print(op)
Here is the result:
Unit: milliseconds
expr min lq mean median uq max neval cld
VECT 1.005890 1.078983 1.384964 1.108162 1.282269 6.562040 100 a
FOR 416.268583 438.545475 476.551526 449.679426 476.032938 740.027018 100 b
LAPPLY 428.456092 454.664204 492.918478 464.204607 501.168572 751.786224 100 b
DPLYR 13.371847 14.919726 16.482236 16.105815 17.086174 23.537866 100 a
DATATABLE 1.699995 2.059205 2.427629 2.279371 2.489406 8.542219 100 a
Additionally we can graph the solution, via:
library(ggplot2) #nice log plot of the output
qplot(y=time, data=op, colour=expr) + scale_y_log10()
The best performance on this order is: Vectorial, data.table, dplyr, for-loop, lapply.

Answer 2

Pretty tired so this is clumsy, but it should work for the data provided (your output sample is probaly wrong though):
require(dplyr)
rbind(input[!is.na(input$input_product),],
inner_join(lookup_data,input,by=c("lookup_key"="input_key")) %>%
select(lookup_key,lookup_product) %>%
rename(input_product = lookup_product, input_key = lookup_key))

Answer 3

This is easily done using the data.table package as follows:
# load sample data
input_data <- structure(list(
input_key =
structure(c(6L, 5L, 1L, 4L, 8L, 9L,
3L, 2L, 7L),
.Label = c("1546", "3732", "3853", "5376", "8680",
"9061", "9209", "9550", "9909"), class = "factor"),
input_product = structure(c(7L, 1L, NA, 3L, 2L, NA, 4L, 5L, 6L),
.Label = c("Bread", "Chicken", "Chips", "Chocolate",
"Donuts", "Juice", "Water"), class = "factor")),
.Names = c("input_key",
"input_product"),
row.names = c(NA, -9L), class = "data.frame")
lookup_data <- structure(list(
lookup_key = structure(1:4,
.Label = c("1245", "1546", "7764", "9909"), class = "factor"),
lookup_product = structure(c(3L,
4L, 1L, 2L), .Label = c("Bacon", "Cheese", "Ice Cream", "Soda"
), class = "factor")), .Names = c("lookup_key", "lookup_product"
), row.names = c(NA, -4L), class = "data.frame")
# convert to data.table and add keys for merging
library(data.table)
input <- data.table(input_data, key = 'input_key')
lookup <- data.table(lookup_data, key = 'lookup_key')
# merge the data (can use merge method as well)
DT <- lookup[input]
# where the input_product is NA, replace with lookup
DT[is.na(input_product), input_product := lookup_product]
print(DT)
# you can now get rid of lookup_product column, if you like
DT[, lookup_product:= NULL]
print(DT)
The final output of the above is:
> print(DT)
lookup_key input_product
1: 1546 Soda
2: 3732 Donuts
3: 3853 Chocolate
4: 5376 Chips
5: 8680 Bread
6: 9061 Water
7: 9209 Juice
8: 9550 Chicken
9: 9909 Cheese