Блог

В качестве примера у меня есть следующий фрейм данных:

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

У меня есть функция:

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

Я хочу следующее:

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

Проблема в том, что в моем наборе данных есть тонны триплетов, поэтому не идеально записывать их один за другим.

Вот базовые параметры 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))
  )
)
 

Вывод

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

Я бы преобразовал 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
 

^{Создано 2020-12-03 пакетом reprex (версия 0.3.0)}

Я думаю, было бы проще / короче объединить столбцы в отдельную группу и применить функцию к каждому столбцу.

 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