將具有多列的相同 function 作為輸入應用到具有 tidyverse 的 R 中的多列

Question

例如，我有以下數據框：

df <- data.frame(a1=1,a2=2,a3=3,b1=1,b2=2,b3=3)

我有一個 function：

fn <- function(x,y,z) x^y+(z-x)^(y-x)

我想要以下內容：

df <- df %>% mutate(a=fn(a1,a2,a3),b=fn(b1,b2,b3))

問題是，我的數據集中有大量的三元組，因此將它們一一寫出來並不理想。

Answer 1

以下是基本的 R 選項，使用：

• split.default + lapply + do.call

cbind(
  df,
  lapply(
    split.default(df, gsub("\\d+", "", names(df))),
    function(x) do.call(fn, unname(x))
  )
)

• reshape + lapply + do.call

cbind(
  df,
  lapply(
    subset(
      reshape(
        setNames(df, gsub("(\\d+)$", "\\.\\1", names(df))),
        direction = "long",
        varying = 1:length(df)
      ),
      select = -c(time, id)
    ),
    function(x) do.call(fn, as.list(x))
  )
)

Output

  a1 a2 a3 b1 b2 b3 a b
1  1  2  3  1  2  3 3 3

Answer 2

我會將df轉換為長格式，然后使用lag創建 3 列，然后在它們上應用fn()

library(tidyverse)

df_long <- df %>% 
  pivot_longer(everything(),
               names_to = c(".value", "set"),
               names_pattern = "(.)(.)")

df_longer <- df_long %>% 
  pivot_longer(-c(set),
               names_to = "key",
               values_to = "val") %>% 
  arrange(key)
df_longer
#> # A tibble: 6 x 3
#>   set   key     val
#>   <chr> <chr> <dbl>
#> 1 1     a         1
#> 2 2     a         2
#> 3 3     a         3
#> 4 1     b         1
#> 5 2     b         2
#> 6 3     b         3

lag然后應用fn() ，只保留非NA val_fn

df_longer <- df_longer %>% 
  group_by(key) %>% 
  mutate(val_lag1 = lag(val, n = 1),
         val_lag2 = lag(val, n = 2)) %>% 
  mutate(val_fn = fn(val_lag2, val_lag1, val)) %>% 
  filter(!is.na(val_fn))
df_longer
#> # A tibble: 2 x 6
#> # Groups:   key [2]
#>   set   key     val val_lag1 val_lag2 val_fn
#>   <chr> <chr> <dbl>    <dbl>    <dbl>  <dbl>
#> 1 3     a         3        2        1      3
#> 2 3     b         3        2        1      3

^{由reprex package (v0.3.0) 於 2020 年 12 月 3 日創建}

Answer 3

我認為將列組合到單獨的組中並將 function 應用於每列會更容易/更短。

library(dplyr)
library(tidyr)

df %>%
  pivot_longer(cols = everything(), 
               names_to = '.value', 
               names_pattern = '([a-z]+)') %>%
  summarise(across(.fns = ~do.call(fn, as.list(.)))) -> result
result

#     a     b
#  <dbl> <dbl>
#1     3     3

如果需要，您可以將result綁定到原始數據集。

bind_cols(df, result)
#  a1 a2 a3 b1 b2 b3 a b
#1  1  2  3  1  2  3 3 3