【问题标题】:How to return the last value in a vector that met a certain condition如何返回满足特定条件的向量中的最后一个值
【发布时间】:2018-02-02 09:59:56
【问题描述】:

我有一个向量(在数据框中),里面的数字越来越多。我想找到所有连续的数字并将它们替换为系列中的第一个数字。这可以在没有循环的情况下完成吗?

我的输入数据是:

V1
1
4
5
7
10
15
16
17
20

我想要的输出是:

V1    Out
1     1
4     4
5     4
7     7
10    10
15    15
16    15
17    15
20    20

到目前为止,我设法使用 diff() 计算了两行之间的差异,并循环遍历向量以替换正确的值。

V1 <- c(1, 4, 5, 7, 10, 15, 16, 17, 20)
df <- data.frame(V1)
df$diff <- c(0, diff(df$V1) == 1)
df$Out <- NA
for (j in 1:(nrow(df))){
    if (df$diff[j] == 0){
        df$Out[j] <- df$V1[j]
    } else {
        df$Out[j] <- df$V1[max(which(df$diff[1:j] == 0))]
    }
}

它可以完成这项工作,但效率很低。有没有办法摆脱循环并使这段代码更快?

非常感谢!

【问题讨论】:

    标签: r


    【解决方案1】:

    使用 base R 你可以做到,

    with(d1, ave(V1, cumsum(c(1, diff(V1) != 1)), FUN = function(i) i[1]))
    #[1]  1  4  4  7 10 15 15 15 20
    

    dplyr

    library(dplyr)
    
    d1 %>% 
     group_by(grp = cumsum(c(1, diff(V1) != 1))) %>% 
     mutate(out = first(V1))
    

    data.table

    library(data.table)
    
    setDT(d1)[, out := first(V1), by = cumsum(c(1, diff(V1) != 1))]
    

    【讨论】:

    • ave 是一个循环函数。在后台,ave 使用 split 和 lapply。
    • 哦.. 谢谢。我认为他需要一种矢量化的方式.. 对不起
    【解决方案2】:

    另一种选择,分 3 步,使用 zoo 包:

    V2定义为V1

    df$V2 <- df$V1
    

    将连续值(diff1)替换为NA

    df$V2[c(FALSE, diff(df$V1)==1)] <- NA
    

    最后,使用zoo::na.locfNAs 替换为最后一个值:

    library(zoo)
    df$V2 <- na.locf(df$V2)
    

    输出:

    df
    #   V1 V2
    # 1  1  1
    # 2  4  4
    # 3  5  4
    # 4  7  7
    # 5 10 10
    # 6 15 15
    # 7 16 15
    # 8 17 15
    # 9 20 20
    

    另一行文字,使用magrittr

    library(magrittr)
    df$V2 <- df$V1 %>% replace(c(FALSE, diff(df$V1)==1), NA) %>% na.locf
    

    【讨论】:

      【解决方案3】:

      使用shift()lag() 而不是diff()

      目前提供的所有解决方案都使用diff(V1) 来确定连续数字。另一方面,data.tabledplyr 分别包括 shift()lag() 也可以使用的函数(@Frank 也建议)。

      所以,而不是Sotos' data.table approach

      library(data.table)
      setDT(d1)[, out := first(V1), by = cumsum(c(1, diff(V1) != 1))]
      

      我们可以写

      setDT(d1)[, out := V1[1], by = cumsum(V1 - shift(V1, fill = V1[1]) != 1)]
      

      dplyr 解决方案变为

      library(dplyr)
      d1 %>% 
        group_by(grp = cumsum(V1 - lag(V1, default = V1[1]) != 1)) %>% 
        mutate(out = first(V1)) 
      

      同样,基础 R 解变为

      library(data.table)
      with(d1, ave(V1, cumsum(V1 - shift(V1, fill = V1[1]) != 1), FUN = function(i) i[1]))
      

      Cath's zoo::na.locf() approach

      library(zoo)
      library(magrittr)
      library(data.table)
      df$V2 <- df$V1 %>% replace(DF$V1 == shift(DF$V1, fill = DF$V1[1]) + 1, NA) %>% na.locf()
      

      基准测试

      有这么多可用的方法,我想知道哪种方法最快。此外,我注意到所有解决方案都使用 double 类型的常量 1 而不是 integer 常量 1L,尽管问题是关于连续的表示类型 integer 的数字。同样,使用NA 代替NA_integer_

      类型转换可能会增加性能损失,这就是某些包(例如data.table)发出警告或错误的原因。因此,我发现调查类型转换对基准测试结果的影响很有趣。

      基准数据

      通过从 2 M 个数字中采样创建一个具有 1 M 行的 data.frame。为了保持一致,结果始终存储在 data.frame 的 Out 列中。对于data.table 版本,使用DF 的副本。

      library(data.table)
      n <- 1e6L
      f <- 2L
      set.seed(1234L)
      DF <- data.frame(V1 = sort(sample.int(f*n, n)),
                       Out = 1:n)
      DT <- data.table(DF)
      DT
      

      基准代码

      正在测试 12 种不同的方法,每种方法都有 doubleinteger 常量,总共产生 24 个变体。

      library(magrittr)
      library(microbenchmark)
      bm <- microbenchmark(
        ave_diff = DF$Out <- with(DF, ave(V1, cumsum(c(1, diff(V1) != 1)), FUN = function(i) i[1])),
        ave_shift = DF$Out <- with(DF, ave(V1, cumsum(V1 - shift(V1, fill = V1[1]) != 1), FUN = function(i) i[1])),
        zoo_diff = {DF$Out <- DF$V1; DF$Out[c(FALSE, diff(DF$V1) == 1)] <- NA; DF$Out <- zoo::na.locf(DF$Out)},
        zoo_pipe = DF$Out <- DF$V1 %>% replace(c(FALSE, diff(DF$V1) == 1), NA) %>% zoo::na.locf(),
        zoo_shift = DF$Out <- DF$V1 %>% replace(DF$V1 == shift(DF$V1, fill = DF$V1[1]) + 1, NA) %>% zoo::na.locf(),
        dp_diff = r2 <- DF %>% 
          dplyr::group_by(grp = cumsum(c(1, diff(V1) != 1))) %>% 
          dplyr::mutate(Out = first(V1)),
        dp_lag = r3 <- DF %>% 
          dplyr::group_by(grp = cumsum(V1 - dplyr::lag(V1, default = V1[1]) != 1)) %>% 
          dplyr::mutate(Out = first(V1)),
        dt_diff = DT[, Out := V1[1], by = cumsum(c(1, diff(V1) != 1))],
        dt_shift1 = DT[, Out := V1[1], by = cumsum(V1 - shift(V1, fill = V1[1]) != 1)],
        dt_shift2 = DT[, Out := V1[1], by = cumsum(V1 != shift(V1, fill = V1[1]) + 1)],
        dt_zoo_diff = DT[, Out := V1][c(FALSE, diff(DF$V1) == 1), Out := NA][, Out := zoo::na.locf(Out)],
        dt_zoo_shift = DT[, Out := V1][V1 == shift(V1, fill = V1[1]) + 1, Out := NA][, Out := zoo::na.locf(Out)],
        ave_diff_L = DF$Out <- with(DF, ave(V1, cumsum(c(1L, diff(V1) != 1L)), FUN = function(i) i[1L])),
        ave_shift_L = DF$Out <- with(DF, ave(V1, cumsum(V1 - shift(V1, fill = V1[1L]) != 1L), FUN = function(i) i[1L])),
        zoo_diff_L = {DF$Out <- DF$V1; DF$Out[c(FALSE, diff(DF$V1) == 1L)] <- NA_integer_; DF$Out <- zoo::na.locf(DF$Out)},
        zoo_pipe_L = DF$Out <- DF$V1 %>% replace(c(FALSE, diff(DF$V1) == 1L), NA_integer_) %>% zoo::na.locf(),
        zoo_shift_L = DF$Out <- DF$V1 %>% replace(DF$V1 == shift(DF$V1, fill = DF$V1[1L]) + 1L, NA_integer_) %>% zoo::na.locf(),
        dp_diff_L = r2 <- DF %>% 
          dplyr::group_by(grp = cumsum(c(1L, diff(V1) != 1L))) %>% 
          dplyr::mutate(Out = first(V1)),
        dp_lag_L = r3 <- DF %>% 
          dplyr::group_by(grp = cumsum(V1 - dplyr::lag(V1, default = V1[1L]) != 1L)) %>% 
          dplyr::mutate(Out = first(V1)),
        dt_diff_L = DT[, Out := V1[1L], by = cumsum(c(1L, diff(V1) != 1L))],
        dt_shift1_L = DT[, Out := V1[1L], by = cumsum(V1 - shift(V1, fill = V1[1L]) != 1L)],
        dt_shift2_L = DT[, Out := V1[1L], by = cumsum(V1 != shift(V1, fill = V1[1L]) + 1L)],
        dt_zoo_diff_L = DT[, Out := V1][c(FALSE, diff(DF$V1) == 1L), Out := NA_integer_][, Out := zoo::na.locf(Out)],
        dt_zoo_shift_L = DT[, Out := V1][V1 == shift(V1, fill = V1[1L]) + 1L, Out := NA_integer_][, Out := zoo::na.locf(Out)],
        times = 20L
      )
      

      基准测试结果

      library(ggplot2)
      autoplot(bm)
      

      注意时间轴的对数刻度。

      Unit: milliseconds
                 expr        min         lq      mean    median        uq       max neval   cld
             ave_diff 2594.89941 2643.32224 2752.9753 2723.7035 2868.6586 3006.0420    20     e
            ave_shift  947.13267 1001.70742 1107.7351 1047.6835 1218.5809 1395.5059    20   c  
             zoo_diff  100.13967  130.23284  197.7273  142.8525  262.1980  428.2976    20 a    
             zoo_pipe  104.98025  112.04101  181.3073  119.5275  185.3215  434.2936    20 a    
            zoo_shift   88.86549   98.49058  177.2143  110.5392  260.1160  416.9985    20 a    
              dp_diff 1148.18227 1219.68396 1303.6350 1290.5575 1344.1400 1628.1786    20    d 
               dp_lag  712.58827  746.77952  804.8908  776.3303  809.8323 1157.2102    20  b   
              dt_diff  226.67524  233.81038  292.0675  241.9369  275.8491  517.1760    20 a    
            dt_shift1  199.64651  207.39276  255.1607  215.7960  223.7947  882.9923    20 a    
            dt_shift2  203.87617  210.06736  260.8550  218.9917  244.7247  499.8797    20 a    
          dt_zoo_diff  109.45194  121.41501  216.3579  159.0960  278.5257  483.1110    20 a    
         dt_zoo_shift   94.59905  109.32432  204.0329  127.0619  373.8622  430.0885    20 a    
           ave_diff_L  992.12820 1041.12873 1127.8128 1071.8525 1217.1493 1457.3166    20   c  
          ave_shift_L  905.41152  973.81932 1063.2237 1015.6805 1170.2522 1323.9317    20   c  
           zoo_diff_L  103.30228  114.63442  227.4359  140.5280  300.3003  822.3366    20 a    
           zoo_pipe_L  103.89433  112.16467  231.3165  133.3362  398.7240  545.7856    20 a    
          zoo_shift_L   91.88764  104.21339  157.6434  138.7488  165.0197  401.3890    20 a    
            dp_diff_L  749.65952  766.00479  851.0737  806.1116  886.6429 1155.3144    20  b   
             dp_lag_L  731.08180  757.95232  823.0169  794.4421  827.7100 1079.2576    20  b   
            dt_diff_L  214.97477  226.80928  241.3575  232.7037  244.8673  323.6259    20 a    
          dt_shift1_L  199.80509  211.20539  277.5616  218.3371  259.9801  513.2925    20 a    
          dt_shift2_L  200.37902  204.23732  224.7275  210.7217  216.6133  470.6335    20 a    
        dt_zoo_diff_L  111.64757  122.62327  162.4947  140.4175  174.0932  409.0788    20 a    
       dt_zoo_shift_L   95.91114  109.24219  164.7059  126.5924  170.2320  388.6558    20 a
      

      观察

      对于给定的问题规模和结构:

      • zoo::na.locf() 方法比使用分组的各种实现更快,并且 na.locf()shift() 的组合略有优势。
      • 第二个但最接近的是 data.table 与分组。
      • 慢三倍但慢三倍是dplyr
      • 最后一个是 ave(),它比最快的慢 20 倍以上,每次运行最多需要 3 秒。
      • shift()/lag() 版本总是比diff() 快。
      • 类型转换很重要。使用diff() 的版本尤其受到影响,例如,具有整数常量的 ave_diff 比双常量版本快约 2.5 倍。

      【讨论】:

      • 是的,动物园岩石 ;-D
      【解决方案4】:

      使用dplyrtidyr

      library(tidyr)
      library(dplyr)
      
      
      > df %>% mutate(
      +   diff=c(0,diff(V1))==1,
      +   V2=ifelse(diff,NA,V1)
      +   ) %>% 
      +   fill(V2) %>% 
      +   select(-diff)
        V1 V2
      1  1  1
      2  4  4
      3  5  4
      4  7  7
      5 10 10
      6 15 15
      7 16 15
      8 17 15
      9 20 20
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2018-05-04
        • 1970-01-01
        • 1970-01-01
        相关资源
        最近更新 更多