r - 如何在 R 中迭代向量并替换值

Question

这是一个相当简单的任务，但我正在尝试思考如何使用带有键和值的数据帧来匹配值。我尝试过合并，但由于行数不同，我不确定这是否合适。

我是否可以编写一个 for 循环，它将循环遍历输入数据帧中的每个键并更改 Product 的值(如果它是查找表中的值之一)？

基本上，我的数据如下所示:

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))

我想将 NA 替换为相应查找表中的产品值:

lookup_key <- c(1245,1546, 7764, 9909)
lookup_product <- c("Ice Cream","Soda", "Bacon","Cheese")
lookup_data <- as.dataframe(cbind(lookup_key, lookup_product))

最后，我希望最终的数据框看起来像这样:

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

选项 1:使用 R 基函数:

矢量解:

input$input_product[input$input_key %in% lookup_data$lookup_key == TRUE] <- 
    lookup_product[lookup_data$lookup_key %in% input$input_key == TRUE]

注意: ==TRUE 是多余的，添加只是为了更好地理解。

使用 lapply 函数:

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]
        }
    }
)

注意:注意全局赋值操作(<<)

使用 for 循环:

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]
    }
}

注意:这里我们只需要一个简单的分配。

在上述情况下，您需要创建数据框，设置输入参数: stringsAsFactors 作为 FALSE ，例如:

input <- as.data.frame(cbind(input_key, input_product), stringsAsFactors = FALSE)
lookup_data <- as.data.frame(cbind(lookup_key, lookup_product), stringsAsFactors = FALSE)

然后你会得到输出:

> 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
> 

选项 2:使用 data.table 包

我发现这个使用内部联接的优雅解决方案:

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.table 对于数据集操作实际上非常强大。让我们解释一下背后的语法:

• setDT :通过引用(不发生复制)将数据帧转换为 data.table ，因为原始数据集不是 data.table 类，这就是方法 即时转换它们。请注意，现在不必使用属性 stringsAsFactors，因为 data.table 的默认值为 FALSE 。
• input[lookup_data, nomatch=0] :是使用 data.table 包创建内部联接的方式(请参阅此 link )。意思就是截取两个表。值为 no match 的 0 选项意味着不会为 i 的该行返回任何行(在我们的例子中: lookup_data )。

这将是输出:

> 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 :从外部分配列 数据集，具有内部数据集的值。

• [] :打印结果(用于验证解决方案目的)

有关 data.table 的更多信息，我建议阅读 documentation 包，它附带了许多示例。在 R 中运行以下命令也是一个好主意(加载 data.table 包后):

example(data.table)

它提供了 50 多个示例(与包文档中的相同)以及关于该包的不同用途的相应结果。

性能

让我们在性能方面比较所有可能的替代方案。那么我们需要修改 用于增加其大小的输入数据集:

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)

将所有不同的替代方案包装到相应的给定函数中。我已经包括了 通过 @count 提出的 dplyr 解决方案

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)
}

现在测试每个解决方案(仔细检查)。

复制输入数据集，因为 data.table 通过引用进行操作。我们需要从头开始创建一个副本。

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)

我们使用 compare 包，因为 all.equal 无法比较数据帧 有了一个data.table对象，因为属性值，所以我们需要一个 仅检查值的比较。

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"))

现在让我们使用 microbenchmark 包来比较所有解决方案的时间性能

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)

结果如下:

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 

此外，我们可以通过以下方式绘制解决方案:

library(ggplot2) #nice log plot of the output
qplot(y=time, data=op, colour=expr) + scale_y_log10()

此顺序上性能最好的是:Vectorial、data.table、dplyr、for-loop、lapply。