代码之家  ›  专栏  ›  技术社区  ›  Cettt

在潮韵诗中反复变异

  •  2
  • Cettt  · 技术社区  · 8 年前

    考虑以下表格和以下矢量:

    library(tidyverse)
    a <- tibble(val1 = 10:15, val2 = 20:25)
    params <- 1:3
    

    我还有一个功能 myfun 它以一个任意长度的向量和一个整数作为输入,并返回一个相同长度的向量。出于演示目的,您可以考虑

    myfun <- function(x, k) dplyr::lag(x, k)
    

    我要为中的每一列创建以下内容: a 以及中的每个元素 params 我想创建一个新列 myfun(col, params[i]) . 例如,在上面的玩具示例中,可以这样实现:

    a %>% mutate_at(1:2, funs(run1 = myfun), k = params[1]) %>% 
      mutate_at(1:2, funs(run2 = myfun), k = params[2]) %>% 
      mutate_at(1:2, funs(run3 = myfun), k = params[3]) 
    

    有没有更优雅的方法来做到这一点?如果参数很长,则此解决方案将不可行。当然,我们可以用for循环来实现这一点,但我认为在tidyverse中可能有一个解决方案(可能使用 purrr::map ?)

    谢谢您!

    2 回复  |  直到 7 年前
        1
  •  2
  •   Cettt    7 年前

    下面是一个使用tidyverse的解决方案:

    library(tidyverse)
    a <- tibble(val1 = 10:15, val2 = 20:25)
    params <- 1:3
    
    #set the column names, add leading zeroes based om max(params)
    run_names <- paste0("run", formatC(params, width = nchar(max(params)), flag = "0"))
    
    #what functions to perform
    lag_functions <- setNames(paste("dplyr::lag( ., ", params, ")"), run_names)
    #perfporm functions 
    a %>% mutate_at(vars(1:2), funs_(lag_functions ))
    
    # # A tibble: 6 x 8
    #    val1  val2 val1_run1 val2_run1 val1_run2 val2_run2 val1_run3 val2_run3
    #   <int> <int>     <int>     <int>     <int>     <int>     <int>     <int>
    # 1    10    20        NA        NA        NA        NA        NA        NA
    # 2    11    21        10        20        NA        NA        NA        NA
    # 3    12    22        11        21        10        20        NA        NA
    # 4    13    23        12        22        11        21        10        20
    # 5    14    24        13        23        12        22        11        21
    # 6    15    25        14        24        13        23        12        22
    
        2
  •  1
  •   akrun    8 年前

    重复的滞后更容易在 data.table 作为 shift 可以取向量 n S

    library(data.table)
    # create a vector of new column names
    nm1 <- paste0(rep(names(a), each = length(params)),  '_run', params) 
    # get the `shift` of the Subset of Data.table (`.SD`)
    # by default type is "lag"
    # assign the output to the column names created earlier
    setDT(a)[, (nm1)  := shift(.SD, n = params)]    a
    #   val1 val2 val1_run1 val1_run2 val1_run3 val2_run1 val2_run2 val2_run3
    #1:   10   20        NA        NA        NA        NA        NA        NA
    #2:   11   21        10        NA        NA        20        NA        NA
    #3:   12   22        11        10        NA        21        20        NA
    #4:   13   23        12        11        10        22        21        20
    #5:   14   24        13        12        11        23        22        21
    #6:   15   25        14        13        12        24        23        22
    

    或者使用 tidyverse 具有 parse_exprs

    library(tidyverse)
    library(rlang)
    # create a string with `rep` and `paste`
    nm2 <- glue::glue('lag({rep(names(a), each = length(params))}, n = {rep(params, length(a))})') %>% paste(., collapse=";")
    # convert string to expression with parse_exprs and evaluate (`!!!`)
    a %>% 
       mutate(!!! parse_exprs(nm2)) %>%
       rename_at(-(1:2), ~nm1)
    # A tibble: 6 x 8
    #   val1  val2 val1_run1 val1_run2 val1_run3 val2_run1 val2_run2 val2_run3
    #  <int> <int>     <int>     <int>     <int>     <int>     <int>     <int>
    #1    10    20        NA        NA        NA        NA        NA        NA
    #2    11    21        10        NA        NA        20        NA        NA
    #3    12    22        11        10        NA        21        20        NA
    #4    13    23        12        11        10        22        21        20
    #5    14    24        13        12        11        23        22        21
    #6    15    25        14        13        12        24        23        22