r - 在 r 中跨多个列应用一个函数

Question

我有一个需要两个参数的函数，我的函数(高度，体重)

我的数据是这样的

myfunc<-function(height,weight){
x<-height/weight^2
}

htmale1<-c(1.70,1.75,1.76)
htmale2<-c(1.98,1.99,1.99)
wtmale1<-c(60,62,60)
wtmale2<-c(79,85,102)
htfemale1<-c(1.54,1.55,1.60)
htfemale2<-c(1.76,1.77,1.77)
wtfemale1<-c(45,49,52)
wtfemale2<-c(70,69,64)

df<-data.frame(htmale1,htmale2,wtmale1,wtmale2,htfemale1,htfemale2,wtfemale1,wtfemale2)

我想创建名为 bmim1 的变量，它是 myfunc(htmale1,wtmale1), bmim2,bmif1,bmif2,使用各自列的高度和重量。

现在我只是单独创建它们:

df$bmim1<-myfunc(htmale1,wtmale1)
df$bmim2<-myfunc(htmale2,wtmale2)
df$bmif1<-myfunc(htfemale1,wtfemale1)
df$bmif2<-myfunc(htfemale2,wtfemale2)

我确信有更短的代码可以做到这一点，比如

for(i in 1:3){#specify what to do with the strings?#} 

但也许这可以使用 apply 或 map 来完成？

Answer 1

我们可以使用split.default来拆分成一个data.frame列表

lst1 <- lapply(split.default(df, sub("\\D+", "", names(df))), 
    function(x) 
     sapply(split.default(x, sub("^[hw]t(\\D+)\\d+", "\\1", names(x))),
         function(y) myfunc(y[[1]], y[[2]])))
cbind(df, do.call(cbind, Map(function(x, y) setNames(as.data.frame(x), 
   paste0("bmi", substr(colnames(x), 1, 1), y)), lst1, names(lst1))))

---

或者另一种选择是使用 pivot_longer reshape 为长格式，然后通过汇总进行分组

library(dplyr)
library(tidyr)
pivot_longer(df, cols = everything(),
    names_to = c(".value", "gender", "rep"),
         names_pattern = "^([hw]t)(\\D+)(\\d)")
# A tibble: 12 x 4
   gender rep      ht    wt
   <chr>  <chr> <dbl> <dbl>
 1 male   1       170    60
 2 male   2       198    79
 3 female 1       154    45
 4 female 2       176    70
 5 male   1       175    62
 6 male   2       199    85
 7 female 1       155    49
 8 female 2       177    69
 9 male   1       176    60
10 male   2       199   102
11 female 1       160    52
12 female 2       177    64

对于 reshape 后的数据，使用 group by 操作。 myfunc 的输出不清楚。如果它是一个向量，我们可以直接应用该函数并返回 summarise 中的输出。但是，如果输出结构是 list 或 tibble，将其包装在 list 中，然后使用 tidyr::unnest

pivot_longer(df, cols = everything(),
    names_to = c(".value", "gender", "rep"), 
    names_pattern = "^([hw]t)(\\D+)(\\d)") %>% 
   group_by(gender, rep) %>%
   summarise(out = myfunc(ht, wt))

更新

根据更新后的 OP 的帖子，我们可以使用

library(data.table)
library(stringr)
pivot_longer(df, cols = everything(),
     names_to = c(".value", "gender", "rep"), 
     names_pattern = "^([hw]t)(\\D+)(\\d)") %>% 
    group_by(gender, rep) %>%
    summarise(out = myfunc(ht, wt), .groups = 'drop') %>% 
    transmute(newcol = str_c('bmi', substr(gender, 1, 1), rep), out, 
              rn = rowid(newcol)) %>%
   pivot_wider(names_from = newcol, values_from = out) %>% 
   select(-rn) %>% 
    bind_cols(df, .)

-输出

 htmale1 htmale2 wtmale1 wtmale2 htfemale1 htfemale2 wtfemale1 wtfemale2      bmif1      bmif2      bmim1      bmim2
1     170     198      60      79       154       176        45        70 0.07604938 0.03591837 0.04722222 0.03172568
2     175     199      62      85       155       177        49        69 0.06455643 0.03717706 0.04552549 0.02754325
3     176     199      60     102       160       177        52        64 0.05917160 0.04321289 0.04888889 0.01912726

使用的函数是

myfunc<-function(height,weight){
   height/weight^2

}

更新

或者另一种选择是

df %>%
     mutate(across(starts_with('ht'),
     ~ myfunc(., get(str_replace(cur_column(), 'ht', 'wt'))), 
        .names = '{str_replace(.col, "ht", "bmi")}'))

-输出

htmale1 htmale2 wtmale1 wtmale2 htfemale1 htfemale2 wtfemale1 wtfemale2   bmimale1   bmimale2 bmifemale1 bmifemale2
1     170     198      60      79       154       176        45        70 0.04722222 0.03172568 0.07604938 0.03591837
2     175     199      62      85       155       177        49        69 0.04552549 0.02754325 0.06455643 0.03717706
3     176     199      60     102       160       177        52        64 0.04888889 0.01912726 0.05917160 0.04321289