【问题标题】:paste grid -- expand.grid for string concatenation粘贴网格 -- expand.grid 用于字符串连接
【发布时间】:2016-06-14 02:09:09
【问题描述】:

如果我们想得到两个向量的所有组合,可以使用rep/recycling rules:

x <- 1:4
y <- 1:2

cbind(rep(x, each = length(y)), rep(y, length(x)))
#      [,1] [,2]
# [1,]    1    1
# [2,]    1    2
# [3,]    2    1
# [4,]    2    2
# [5,]    3    1
# [6,]    3    2
# [7,]    4    1
# [8,]    4    2

expand.grid 更好——它为我们处理所有重复。

expand.grid(x, y)
#   Var1 Var2
# 1    1    1
# 2    2    1
# 3    3    1
# 4    4    1
# 5    1    2
# 6    2    2
# 7    3    2
# 8    4    2

有用于连接字符串的简单版本吗?喜欢paste.grid?我有一个命名对象,其中很多对象的名称都类似于 x_y_z,其中 xyz 变化类似于上面的 xy

例如,假设x 可以是"avg""median"y 可以是"male""female",而z 可以是"height""weight"。我们怎样才能简明扼要地得到这三者的全部 8 种组合?

使用rep 很痛苦:

x <- c("avg", "median")
y <- c("male", "female")
z <- c("height", "weight")
paste(rep(x, each = length(y) * length(z)),
      rep(rep(y, each = length(z)), length(x)),
      rep(z, length(x) * length(y)), sep = "_")

再利用 expand.grid 有点笨拙(而且可能效率低下):

apply(expand.grid(x, y, z), 1, paste, collapse = "_")

我错过了什么吗?有没有更好的方法来做到这一点?

【问题讨论】:

  • 拥有Reduce,您可以将二进制函数扩展到更多参数:Reduce(function(x, y) paste(rep(x, each = length(y)), rep(y, length(x)), sep = "_"), list(x, y, z))。这也可以避免多次重新连接相同的元素,并且在某些情况下可能很有效。
  • @alexis_laz 哦,哇,我实际上只是通过检查其他答案想出了相同的功能。请作为答案发布,因为除了手动拼出 rep 序列之外,它比其他任何方法都快。

标签: r combinations string-concatenation


【解决方案1】:

是的,interaction 就是这样做的

levels(interaction(x,y,z,sep='_'))

实现与您的rep 代码几乎相同。

输出:

[1] “avg_female_height” “median_female_height” “avg_male_height” “median_male_height” “avg_female_weight” [6] “median_female_weight” “avg_male_weight” “median_male_weight”

【讨论】:

    【解决方案2】:

    使用data.table的CJ交叉连接函数:

    library(data.table)
    CJ(x,y,z)[, paste(V1,V2,V3, sep = "_")]
    #[1] "avg_female_height"    "avg_female_weight"    "avg_male_height"      "avg_male_weight"     
    #[5] "median_female_height" "median_female_weight" "median_male_height"   "median_male_weight"
    

    或者您的apply 方法的变体是:

    do.call(paste, c(expand.grid(x, y, z), sep = "_"))
    #[1] "avg_male_height"      "median_male_height"   "avg_female_height"    "median_female_height"
    #[5] "avg_male_weight"      "median_male_weight"   "avg_female_weight"    "median_female_weight"
    

    【讨论】:

    • 不错。 do.call 也可用于data.table 方法:CJ(x,y,z)[, do.call(paste,c(.SD,sep="_"))],只是为了避免键入所有列名。
    • 正确,@nicola。我也发布了它,但后来删除了它,因为我认为没有它 data.table 方法会更快(但没有测试它)。随意将其添加到答案中,因为我自己目前无法这样做。
    【解决方案3】:

    基本的 (microbenchmark::microbenchmark) 基准测试显示通过使用:

    library(tidyr)
    library(magrittr)
    
    df <- data.frame(x, y, z)
    
    df %>%
      complete(x, y, z) %>%
      unite("combo", x, y, z, sep = "_")
    

    apply 技术有点慢,但可能更直接和矢量化变体:

    df <- expand.grid(x, y, z)
    df$combo <- paste(df$Var1, df$Var1, df$Var3, sep = "_")
    

    应该有人用data.table 的方法来插话...


    基准测试:小网格(256 个元素)

    set.seed(21034)
    x <- sample(letters, 4, TRUE)
    y <- sample(letters, 4, TRUE)
    z <- sample(letters, 4, TRUE)
    a <- sample(letters, 4, TRUE)
    
    library(data.table)
    library(microbenchmark)
    library(magrittr)
    library(tidyr)
    
    microbenchmark(times = 25L,
                   DT1 = CJ(x, y, z, a)[ , paste(V1, V2, V3, V4, sep = "_")],
                   DT2 = CJ(x, y, z, a)[ , do.call(paste, c(.SD, sep = "_"))],
                   app1 = do.call(paste, c(expand.grid(x, y, z, a), sep = "_")),
                   app2 = paste((df <- expand.grid(x, y, z, a))$Var1,
                                df$Var2, df$Var3, sep = "_"),
                   magg_outer = outer(x, y, paste, sep = "_") %>%
                     outer(z, paste, sep = "_") %>%
                     outer(a, paste, sep = "_") %>% as.vector,
                   magg_tidy = data.frame(x, y, z, a) %>% 
                     complete(x, y, z, a) %>%
                     unite("combo", x, y, z, a, sep = "_"),
                   interaction = levels(interaction(x, y, z, a, sep = "_")),
                   original = apply(expand.grid(x, y, z, a), 1, paste, collapse = "_"),
                   rep = paste(rep(x, each = (ny <- length(y)) * (nz <- length(z)) *
                                     (na <- length(a))),
                               rep(rep(y, each = nz * na), (nx <- length(x))),
                               rep(rep(z, each = na), nx * ny), sep = "_"),
                   Reduce = Reduce(function(x, y) paste(rep(x, each = length(y)), 
                                                         rep(y, length(x)), sep = "_"), 
                                   list(x, y, z, a)))
    
    # Unit: microseconds
    #         expr      min        lq       mean    median        uq       max neval    cld
    #          DT1  529.578  576.6400  624.00002  589.8270  604.9845  5449.287  1000    d  
    #          DT2  561.028  606.4220  639.94659  620.4335  636.2735  5484.514  1000    d  
    #         app1  201.043  225.4475  240.36960  233.4795  243.7090  4244.687  1000  b    
    #         app2  196.692  225.6130  244.33543  234.0455  243.7925  4110.605  1000  b    
    #   magg_outer  164.352  194.1395  205.30300  204.4220  211.1990   456.122  1000  b    
    #    magg_tidy 1872.228 2038.1560 2150.98234 2067.8770 2126.1025 21891.884  1000      f
    #  interaction  254.885  295.1935  313.54392  306.6680  316.8095  4196.465  1000   c   
    #     original  852.018  935.4960  976.24388  954.5115  972.5550  4973.724  1000     e 
    #          rep   50.737   54.1515   60.22671   55.3660   56.9220  3823.655  1000 a     
    #       Reduce   58.395   65.3860   68.46049   66.8920   68.5640   158.184  1000 a     
    

    基准测试:大型网格(1,000,000 个元素)

    set.seed(21034)
    x <- sprintf("%03d", sample(100))
    y <- sprintf("%03d", sample(100))
    z <- sprintf("%02d", sample(10))
    a <- sprintf("%02d", sample(10))
    
    library(data.table)
    library(microbenchmark)
    library(magrittr)
    library(tidyr)
    
    microbenchmark(times = 25L,
                   DT1 = CJ(x, y, z, a)[ , paste(V1, V2, V3, V4, sep = "_")],
                   DT2 = CJ(x, y, z, a)[ , do.call(paste, c(.SD, sep = "_"))],
                   app1 = do.call(paste, c(expand.grid(x, y, z, a), sep = "_")),
                   app2 = paste((df <- expand.grid(x, y, z, a))$Var1,
                                df$Var2, df$Var3, sep = "_"),
                   magg_outer = outer(x, y, paste, sep = "_") %>%
                     outer(z, paste, sep = "_") %>%
                     outer(a, paste, sep = "_") %>% as.vector,
                   magg_tidy = data.frame(x, y, z, a) %>% 
                     complete(x, y, z, a) %>%
                     unite("combo", x, y, z, a, sep = "_"),
                   interaction = levels(interaction(x, y, z, a, sep = "_")),
                   original = apply(expand.grid(x, y, z, a), 1, paste, collapse = "_"),
                   rep = paste(rep(x, each = (ny <- length(y)) * (nz <- length(z)) *
                                     (na <- length(a))),
                               rep(rep(y, each = nz * na), (nx <- length(x))),
                               rep(rep(z, each = na), nx * ny), sep = "_"),
                   Reduce = Reduce(function(x, y) paste(rep(x, each = length(y)), 
                                                         rep(y, length(x)), sep = "_"), 
                                   list(x, y, z, a)))
    
    # Unit: milliseconds
    #         expr       min        lq      mean    median        uq       max neval  cld
    #          DT1  360.6528  467.8408  517.4579  520.1484  549.1756  861.1567    25 ab  
    #          DT2  355.0438  504.9642  572.0732  551.9106  615.6621  927.3210    25  b  
    #         app1  727.4513  766.3053  926.1888  910.3998  957.7610 1690.1540    25   c 
    #         app2  472.5724  567.1121  633.5304  600.3779  634.3158 1135.7535    25  b  
    #   magg_outer  384.0112  475.5070  600.6317  525.8936  676.7134  927.6736    25  b  
    #    magg_tidy  520.6428  602.5028  695.5500  680.8821  748.8746 1180.1107    25  bc 
    #  interaction  353.7317  481.4732  531.0035  518.7084  585.0872  693.5171    25 ab  
    #     original 4965.1156 5358.8704 5914.3560 5780.6609 6074.7470 9024.6476    25    d
    #          rep  206.0964  236.5811  273.1093  252.8179  285.0910  455.1776    25 a   
    #       Reduce  322.0695  390.2595  446.3948  424.9185  508.5235  621.1878    25 ab  
    

    【讨论】:

    • 所以magrittr + tidyr 可以很好地扩展非常,但对于较小的样本来说是垃圾。似乎interaction 非常健壮,而且看起来也很漂亮,所以我想我会在那里奖励支票。所有这些答案都很棒!很高兴我问了这个问题。
    • @MichaelChirico 好交易。感谢您的编辑和一个简洁的问题。
    • 刚刚意识到为什么interaction 做得这么好——它会反复删除重复的元素!因此,如果 x = c("a", "a")y = c("b", "b"),所有其他方法将返回 4 个元素,但 interaction 仅返回 2 个。更新以消除这种不公平的优势,似乎 rep 是最好的。
    • 听起来你需要自己检查一下 :) 把它抽象成一个不错的函数怎么样?或者Reduce 方法是否成立?
    • 实际上刚刚得出亚历克西斯几小时前得出的结论! Reduce 确实是最强大的。在较小的样本上大约与 Rep 一样快,但在较大的样本上只比其他速度快 25%。
    【解决方案4】:

    使用outer() 怎么样?你的两个例子变成了

    x <- 1:4
    y <- 1:2
    as.vector(outer(x, y, paste, sep = "_"))
    ## [1] "1_1" "2_1" "3_1" "4_1" "1_2" "2_2" "3_2" "4_2"
    
    library(magrittr)
    x <- c("avg", "median")
    y <- c("male", "female")
    z <- c("height", "weight")
    outer(x, y, paste, sep = "_") %>% outer(z, paste, sep = "_") %>% as.vector
    ## [1] "avg_male_height"      "median_male_height"   "avg_female_height"    "median_female_height" "avg_male_weight"     
    ## [6] "median_male_weight"   "avg_female_weight"    "median_female_weight"
    

    第二个例子可以用Reduce()稍微简化一下:

    Reduce(function(a, b) outer(a, b, paste, sep = "_"), list(x, y, z)) %>% as.vector
    

    但是,它效率不高。使用microbenchmark,我发现使用rep() 的解决方案大约快10 倍。

    【讨论】:

    • 这实际上在基准测试中的表现给我留下了深刻的印象!不过,与 3 个或更多输入有关。
    • 事实证明,对于较小的示例,rep 是迄今为止最快的方法(尽管可能也是最笨拙的)
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2016-05-10
    • 1970-01-01
    • 1970-01-01
    • 2014-01-16
    • 2016-08-21
    • 1970-01-01
    • 2018-07-16
    相关资源
    最近更新 更多